floss/empc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Rewrite the transfert queue #2/2: rewrite the transfert queue as part of empc.

Browse source 
Add plenty of accessors for empc-object.

  Thanks to those accessors the implementation of empc-object may be changed if
  I find a better idea than a weird tree-like structure.

Use the new queue management.

  Due to what I consider a weird behavior of the original tq, function called
  from the process-filter may now be properly debugged.

  Functions are now called outside any `with-current-buffer' macro so *empc*
  buffer also work as expected.

  It will now be possible to put idle commands directly in queue management.

Fix what was broken by previous commit.

  Every feature should work like before.
This commit is contained in:
Renaud Casenave-Péré 2011-08-24 18:36:33 +09:00
parent 730902179e
commit 3962b7de8f
2 changed files with 275 additions and 161 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
TODO
View file

@ -30,9 +30,12 @@
* DONE Display the playlist in a buffer * DONE Display the playlist in a buffer
CLOSED: [2011-08-18 Thu 19:55] CLOSED: [2011-08-18 Thu 19:55]
* TODO Rewrite a tq.el like * DONE Rewrite a tq.el-like
CLOSED: [2011-08-24 Wed 18:21]
Need more flexibility and need to be able to play with the current buffer even in background Need more flexibility and need to be able to play with the current buffer even in background
Sync transfert when required
* TODO clean the code
Need to decide if every function can access the global variable
* TODO Create a proper playlist-mode * TODO Create a proper playlist-mode
Need to keep data shown in buffers separated from data given by the server to Need to keep data shown in buffers separated from data given by the server to
@ -40,6 +43,8 @@
* TODO Better notification system * TODO Better notification system
* TODO Sync transfert when required
* TODO Allow tampering the playlist * TODO Allow tampering the playlist
* TODO Display the music database in another buffer * TODO Display the music database in another buffer

427
empc.el
View file

@ -1,5 +1,3 @@
(require 'tq)
(defgroup empc nil (defgroup empc nil
"Customize group for empc." "Customize group for empc."
:group 'external :group 'external
@ -58,58 +56,116 @@
"The name of the buffer receiving output from server.") "The name of the buffer receiving output from server.")
(defconst empc-response-regexp (defconst empc-response-regexp
"^\\(OK\\( MPD \\)?\\|ACK \\[\\([0-9]+\\)@[0-9]+\\] \\(.+\\)\\)\n+\\'" "^\\(OK\\( MPD .*\\)?\\|ACK \\[\\([0-9]+\\)@[0-9]+\\] \\(.+\\)\\)\n+\\'"
"Regexp that matches the valid status strings that MusicPD can "Regexp that matches the valid status strings that MusicPD can
return at the end of a request.") return at the end of a request.")
(defvar empc-object nil (defvar empc-object nil
"Structure containing data for empc as a Property list. "Structure containing data for empc.
The structure has the following fields: The structure is of the form:
:process keeps the network-stream object. ((queue . (process . commands)) . (status . (playlist . playlist-songs)))
:queue stores the commands to send to the server as well as the The fields are describe below:
process keeps the network-stream object.
queue stores the commands to send to the server as well as the
function to call when receiving the response, and a closure to function to call when receiving the response, and a closure to
pass to the function together with the response. pass to the function together with the response.
This structure has the following type: This structure has the following type:
(command closure . fn). (command closure . fn).
:stream keeps the process playing the stream. commands keeps the commands available to the
:available-commands keeps the commands available to the
user. There is no need to send a command to the server if we user. There is no need to send a command to the server if we
know already this command is unavailable due to restricted know already this command is unavailable due to restricted
permissions or because the server has an older version. permissions or because the server has an older version.
:status is another plist describing the server status. status is another plist describing the server status.
:playlist-songs is a hash table storing informations about the songs playlist-songs is a hash table storing informations about the songs
currently in the playlist. currently in the playlist.
:playlist is a vector of song ids, keeping the order of the songs playlist is a vector of song ids, keeping the order of the songs
in the playlist.") in the playlist.")
;; Accessors for the empc object. ;; Accessors for the empc object.
(defun empc-process (object) (plist-get object :process)) (defun empc-process (object) (cadar object))
(defun empc-queue (object) (plist-get object :queue)) (defun empc-queue (object) (caar object))
(defun empc-stream (object) (plist-get object :stream)) (defun empc-stream (object) empc-stream-process)
(defun empc-available-commands (object) (plist-get object :available-commands)) (defun empc-commands (object) (cddar object))
(defun empc-status (object) (plist-get object :status)) (defun empc-status (object) (cadr object))
(defun empc-playlist-songs (object) (plist-get object :playlist-songs)) (defun empc-playlist-songs (object) (cdddr object))
(defun empc-playlist (object) (plist-get object :playlist)) (defun empc-playlist (object) (caddr object))
(defun empc-queue-head-command (object) (caaaar object))
(defun empc-queue-head-closure (object) (car (cdaaar object)))
(defun empc-queue-head-fn (object) (cdr (cdaaar object)))
(defun empc-queue-push (object command closure fn)
"Enqueue '(COMMAND . (CLOSURE . FN)) to the queue of OBJECT."
(unless (or (empc-queue object)
(not command))
(process-send-string (empc-process object) command)
(setq command nil))
(setcar (car object)
(nconc (empc-queue object)
(list (cons command (cons closure fn))))))
(defun empc-queue-pop (object)
"Pop the head of the queue. Return the new queue."
(setcar (car object) (cdr (empc-queue object)))
(when (and (empc-queue object)
(empc-queue-head-command object))
(process-send-string (empc-process object) (empc-queue-head-command object))))
(defun empc-commands-set (object commands) (setcdr (cdar object) commands))
(defun empc-status-put (object attr value) (setcar (cdr object) (plist-put (empc-status object) attr value)))
(defun empc-status-get (object attr) (plist-get (empc-status object) attr)) (defun empc-status-get (object attr) (plist-get (empc-status object) attr))
(defun empc-playlist-set (object playlist) (setcar (cddr object) playlist))
(defun empc-playlist-songs-set (object playlist-songs) (setcdr (cddr object) playlist-songs))
(defun empc-song (object pos) (gethash (elt (empc-playlist object) pos) (empc-playlist-songs object)))
(defun empc-current-song (object) (gethash (empc-status-get object :songid) (empc-playlist-songs object))) (defun empc-current-song (object) (gethash (empc-status-get object :songid) (empc-playlist-songs object)))
(defun empc-create (name buffer host port)
"Create and return a new object for empc. The parameters are as follows:
NAME is the name for the process. It is modified if necessary to
make it unique.
BUFFER is a buffer or buffer name to associate with the process.
Process output goes at end of that buffer. BUFFER may be nil,
meaning that the process is not associated with any buffer.
HOST is the name or IP address of the host to connect to.
SERVICE is the name of the service desired, or an integer specifying
a port number to connect to."
(let* ((process (open-network-stream name buffer host port))
(object `((nil ,process) nil nil))) ;; this weird form represents an empty object as described in empc-object
(empc-queue-push object nil nil `(lambda (proc string)
(message "Connection to %s established" ',host)))
(set-process-filter process `(lambda (proc string)
(empc-process-filter ',object string)))
(set-process-sentinel process 'empc-process-sentinel)
(if (fboundp 'set-process-query-on-exit-flag)
(set-process-query-on-exit-flag process nil)
(process-kill-without-query process))
(set-process-coding-system process 'utf-8-unix 'utf-8-unix)
(buffer-disable-undo (process-buffer process))
object))
(defun empc-close (object)
"Close OBJECT: delete the process and kill the buffers."
(let ((buffer (process-buffer (empc-process object))))
(delete-process (empc-process object))
(kill-buffer buffer)))
(defvar empc-idle-state nil) (defvar empc-idle-state nil)
(defvar empc-last-crossfade nil) (defvar empc-last-crossfade nil)
(defvar empc-mode-line-string "") (defvar empc-mode-line-string "")
(defvar empc-stream-process nil)
(defvar empc-may-pulse nil) (defvar empc-may-pulse nil)
(when (require 'pulse nil t) (when (require 'pulse nil t)
(setq empc-may-pulse t)) (setq empc-may-pulse t))
(defconst empc-playlist-map (make-keymap) "Keymap for `empc'") (defconst empc-playlist-map (make-keymap) "Keymap for `empc'")
(define-key empc-playlist-map "q" 'empc-bury-buffers) (define-key empc-playlist-map "q" 'empc-bury-buffers)
(define-key empc-playlist-map "Q" 'empc-quit) (define-key empc-playlist-map "Q" 'empc-quit)
@ -135,14 +191,58 @@ The structure has the following fields:
(when empc-verbose (when empc-verbose
(message "empc: connection closed")))))) (message "empc: connection closed"))))))
(defun empc-stream-process-sentinel (proc event) (defun empc-enqueue (object command closure fn)
"Add COMMAND to the end of the queue before sending it to the server."
(empc-queue-push object command closure fn)
(process-send-string (empc-process object) command))
(defun empc-process-filter (object string)
"Append STRING to the process buffer then process the data."
(let ((debug-on-error t)
(buffer (process-buffer (empc-process object))))
(when (buffer-live-p buffer)
(with-current-buffer buffer
(goto-char (point-max))
(insert string))
(empc-process-buffer object))))
(defun empc-process-buffer (object)
"If the output stored in the buffer contains the regexp
expressing the end of a command response, call the function
stored at the head of the queue with the associated closure and
the output as parameters."
(let ((buffer (process-buffer (empc-process object)))
(complete-response))
(when (buffer-live-p buffer)
(with-current-buffer buffer
(unless (= 0 (buffer-size))
(if (not (empc-queue object))
(let ((buf (generate-new-buffer "*spurious*")))
(copy-to-buffer buf (point-min) (point-max))
(delete-region (point-min) (point))
(pop-to-buffer buf nil)
(error "Spurious communication from process %s, see buffer %s"
(process-name (empc-process object))
(buffer-name buf)))
(goto-char (point-min))
(when (re-search-forward empc-response-regexp nil t)
(setq complete-response (buffer-substring (point-min) (point)))
(delete-region (point-min) (point)))))))
(when complete-response
(unwind-protect
(funcall (empc-queue-head-fn object)
(empc-queue-head-closure object) complete-response)
(empc-queue-pop object))
(empc-process-buffer object))))
(defun empc-stream-process-sentinel (object event)
"Process sentinel for `empc-stream-process'." "Process sentinel for `empc-stream-process'."
(let ((process (empc-process empc-object))) (let ((process (empc-process object)))
(when (and (eq (process-status proc) 'exit) (when (and (eq (process-status proc) 'exit)
process process
(processp process) (processp process)
(eq (process-status process) 'open) (eq (process-status process) 'open)
(eq (empc-status-get empc-object :state) 'play)) (eq (empc-status-get object :state) 'play))
(empc-toggle-pause 1))) (empc-toggle-pause 1)))
(setq empc-stream-process nil)) (setq empc-stream-process nil))
@ -162,13 +262,14 @@ The structure has the following fields:
(defun empc-echo-song (&optional song) (defun empc-echo-song (&optional song)
"Notify SONG in the echo area." "Notify SONG in the echo area."
(interactive) (interactive)
(unless song (let ((object empc-object))
(setq song (empc-current-song empc-object))) (unless song
(empc-echo-notify (concat "[" (int-to-string (+ (plist-get song :pos) 1)) (setq song (empc-current-song object)))
"/" (int-to-string (empc-status-get empc-object :playlistlength)) "] " (empc-echo-notify (concat "[" (int-to-string (+ (plist-get song :pos) 1))
(if (and (plist-get song :artist) (plist-get song :title)) "/" (int-to-string (empc-status-get object :playlistlength)) "] "
(concat (plist-get song :artist) " - " (plist-get song :title)) (if (and (plist-get song :artist) (plist-get song :title))
(plist-get song :file))))) (concat (plist-get song :artist) " - " (plist-get song :title))
(plist-get song :file))))))
(defun empc-mode-line-notify (msg) (defun empc-mode-line-notify (msg)
"Change the string to write in the mode-line and force-update it." "Change the string to write in the mode-line and force-update it."
@ -177,13 +278,14 @@ The structure has the following fields:
(defun empc-mode-line-song (&optional song) (defun empc-mode-line-song (&optional song)
"Notify SONG in the mode-line." "Notify SONG in the mode-line."
(unless song (let ((object empc-object))
(setq song (empc-current-song empc-object))) (unless song
(empc-mode-line-notify (concat "[" (int-to-string (+ (plist-get song :pos) 1)) (setq song (empc-current-song object)))
"/" (int-to-string (empc-status-get empc-object :playlistlength)) "] " (empc-mode-line-notify (concat "[" (int-to-string (+ (plist-get song :pos) 1))
(if (and (plist-get song :artist) (plist-get song :title)) "/" (int-to-string (empc-status-get object :playlistlength)) "] "
(concat (plist-get song :artist) " - " (plist-get song :title)) (if (and (plist-get song :artist) (plist-get song :title))
(plist-get song :file))))) (concat (plist-get song :artist) " - " (plist-get song :title))
(plist-get song :file))))))
(defun empc-response-parse-line (line) (defun empc-response-parse-line (line)
"Turn the given line into a cons cell. "Turn the given line into a cons cell.
@ -220,10 +322,11 @@ form '('error (error-code . error-message))."
(defun empc-response-get-commands (data) (defun empc-response-get-commands (data)
"Parse DATA to get the available commands." "Parse DATA to get the available commands."
(let ((available-commands)) (let ((object empc-object)
(commands))
(dolist (cell data) (dolist (cell data)
(setq available-commands (cons (cdr cell) available-commands))) (setq commands (cons (cdr cell) commands)))
(setq empc-object (plist-put empc-object :available-commands available-commands)))) (empc-commands-set object commands)))
(defun empc-status-on/off-stringify (status key) (defun empc-status-on/off-stringify (status key)
"Return `on' or `off' if KEY is active or inactive in STATUS." "Return `on' or `off' if KEY is active or inactive in STATUS."
@ -235,30 +338,31 @@ form '('error (error-code . error-message))."
According to what is in the diff, several actions can be performed: According to what is in the diff, several actions can be performed:
if :state or :songid is changed, report it to the user, if :state or :songid is changed, report it to the user,
if :state is set to 'play, start the streaming process." if :state is set to 'play, start the streaming process."
(let ((status-diff (empc-diff-status data)) (let ((object empc-object)
(status-diff (empc-diff-status data))
(notify nil)) (notify nil))
(when (plist-get status-diff :songid) (when (plist-get status-diff :songid)
(setq notify '(lambda () (when (empc-playlist-songs empc-object) (setq notify '(lambda () (when (empc-playlist-songs object)
(empc-mode-line-song (gethash (plist-get status-diff :songid) (empc-mode-line-song (gethash (plist-get status-diff :songid)
(empc-playlist-songs empc-object)))))) (empc-playlist-songs object))))))
(empc-playlist-goto-current-song)) (empc-playlist-goto-current-song))
(when (plist-get status-diff :state) (when (plist-get status-diff :state)
(if (eq (plist-get status-diff :state) 'play) (if (eq (plist-get status-diff :state) 'play)
(progn (progn
(unless notify (unless notify
(setq notify '(lambda () (when (empc-playlist-songs empc-object) (setq notify '(lambda () (when (empc-playlist-songs object)
(empc-mode-line-song))))) (empc-mode-line-song)))))
(empc-stream-start)) (empc-stream-start object))
(setq notify '(lambda () (empc-mode-line-notify (symbol-name (plist-get status-diff :state))))))) (setq notify '(lambda () (empc-mode-line-notify (symbol-name (plist-get status-diff :state)))))))
(when (or (plist-member status-diff :repeat) (plist-member status-diff :random) (when (or (plist-member status-diff :repeat) (plist-member status-diff :random)
(plist-member status-diff :single) (plist-member status-diff :consume) (plist-member status-diff :single) (plist-member status-diff :consume)
(plist-member status-diff :xfade)) (plist-member status-diff :xfade))
(setq notify '(lambda () (empc-echo-notify (format "repeat: %s, random: %s, single: %s, consume: %s, crossfade: %s" (setq notify '(lambda () (empc-echo-notify (format "repeat: %s, random: %s, single: %s, consume: %s, crossfade: %s"
(empc-status-on/off-stringify (empc-status empc-object) :repeat) (empc-status-on/off-stringify (empc-status object) :repeat)
(empc-status-on/off-stringify (empc-status empc-object) :random) (empc-status-on/off-stringify (empc-status object) :random)
(empc-status-on/off-stringify (empc-status empc-object) :single) (empc-status-on/off-stringify (empc-status object) :single)
(empc-status-on/off-stringify (empc-status empc-object) :consume) (empc-status-on/off-stringify (empc-status object) :consume)
(empc-status-on/off-stringify (empc-status empc-object) :xfade)))))) (empc-status-on/off-stringify (empc-status object) :xfade))))))
(when notify (when notify
(funcall notify)))) (funcall notify))))
@ -279,64 +383,63 @@ According to what is in the diff, several actions can be performed:
(defun empc-diff-status (data) (defun empc-diff-status (data)
"Get the diff from `empc-current-status' and server response." "Get the diff from `empc-current-status' and server response."
(let ((status-diff nil) (let ((object empc-object)
(new-status (empc-status empc-object)) (status-diff nil)
(attributes '(:volume :repeat :random :single :consume :playlist :playlistlength :state (attributes '(:volume :repeat :random :single :consume :playlist :playlistlength :state
:song :songid :nextsong :nextsongid :time :elapsed :bitrate :xfade :song :songid :nextsong :nextsongid :time :elapsed :bitrate :xfade
:mixrampdb :mixrampdelay :audio :updating_db :error))) :mixrampdb :mixrampdelay :audio :updating_db :error)))
(prog1 (dolist (attr attributes status-diff)
(dolist (attr attributes status-diff) (let ((value (empc-parse-status-attr attr (cdr (assoc (substring (symbol-name attr) 1) data)))))
(let ((value (empc-parse-status-attr attr (cdr (assoc (substring (symbol-name attr) 1) data))))) (unless (equal (empc-status-get object attr) value)
(unless (equal (empc-status-get empc-object attr) value) (setq status-diff (plist-put status-diff attr value))
(setq status-diff (plist-put status-diff attr value)) (empc-status-put object attr value))))))
(setq new-status (plist-put new-status attr value)))))
(setq empc-object (plist-put empc-object :status new-status)))))
(defun empc-playlist-goto-current-song () (defun empc-playlist-goto-current-song ()
"Put point at currently playing song." "Put point at currently playing song."
(interactive) (interactive)
(when (get-buffer "*empc*") (let ((object empc-object))
(let ((buffer nil)) (when (get-buffer "*empc*")
(unless (called-interactively-p) (let ((buffer nil))
(dolist (frame (frame-list)) (unless (called-interactively-p)
(with-selected-frame frame (dolist (frame (frame-list))
(let ((bwindow (get-buffer-window "*empc*"))) (with-selected-frame frame
(when bwindow (let ((bwindow (get-buffer-window "*empc*")))
(with-selected-window bwindow (when bwindow
(goto-char (point-min)) (with-selected-window bwindow
(forward-line (empc-status-get empc-object :song)) (goto-char (point-min))
(when (and (not buffer) empc-may-pulse) (forward-line (empc-status-get object :song))
(pulse-momentary-highlight-one-line (point)))) (when (and (not buffer) empc-may-pulse)
(setq buffer bwindow)))))) (pulse-momentary-highlight-one-line (point))))
(unless buffer (setq buffer bwindow))))))
(with-current-buffer "*empc*" (unless buffer
(goto-char (point-min)) (with-current-buffer "*empc*"
(forward-line (empc-status-get empc-object :song)) (goto-char (point-min))
(when (and (called-interactively-p) empc-may-pulse) (forward-line (empc-status-get object :song))
(pulse-momentary-highlight-one-line (point)))))))) (when (and (called-interactively-p) empc-may-pulse)
(pulse-momentary-highlight-one-line (point)))))))))
(defun empc-populate-playlist-buffer () (defun empc-populate-playlist-buffer ()
"Write playlist into the *empc* buffer." "Write playlist into the *empc* buffer."
(save-window-excursion (let ((object empc-object))
(empc-switch-to-playlist) (save-window-excursion
(let ((buffer-read-only nil)) (empc-switch-to-playlist)
(erase-buffer) (let ((buffer-read-only nil))
(when (empc-playlist-songs empc-object) (erase-buffer)
(dotimes (pos (length (empc-playlist empc-object))) (when (empc-playlist-songs object)
(let ((song (gethash (elt (empc-playlist empc-object) pos) (empc-playlist-songs empc-object)))) (dotimes (pos (length (empc-playlist object)))
(insert (if (and (plist-member song :artist) (plist-member song :title)) (let ((song (empc-song object pos)))
(concat (plist-get song :artist) " - " (plist-get song :title)) (insert (if (and (plist-member song :artist) (plist-member song :title))
(plist-get song :file)) "\n")))))) (concat (plist-get song :artist) " - " (plist-get song :title))
(empc-playlist-goto-current-song)) (plist-get song :file)) "\n"))))))
(empc-playlist-goto-current-song)))
(defun empc-response-get-playlist (data) (defun empc-response-get-playlist (data)
"Parse information regarding songs in current playlist and arrange it into a "Parse information regarding songs in current playlist and arrange it into a
hash table `empc-current-playlist-songs'sorted by songid. hash table `empc-current-playlist-songs'sorted by songid.
songs order is kept into an avector `empc-current-playlist'." songs order is kept into an avector `empc-current-playlist'."
;; (setq empc-current-playlist-songs (make-hash-table :rehash-threshold 1.0 :size (plist-get empc-current-status :playlistlength))) (let* ((object empc-object)
;; (setq empc-current-playlist (make-vector (plist-get empc-current-status :playlistlength) nil)) (playlist-songs (make-hash-table :rehash-threshold 1.0 :size (empc-status-get object :playlistlength)))
(let* ((playlist-songs (make-hash-table :rehash-threshold 1.0 :size (empc-status-get empc-object :playlistlength))) (playlist (make-vector (empc-status-get object :playlistlength) nil))
(playlist (make-vector (empc-status-get empc-object :playlistlength) nil))
(song nil) (song nil)
(index (- (length playlist) 1))) (index (- (length playlist) 1)))
(dolist (cell data) (dolist (cell data)
@ -355,7 +458,8 @@ songs order is kept into an avector `empc-current-playlist'."
(when (and song (>= index 0)) (when (and song (>= index 0))
(puthash (plist-get song :id) song playlist-songs) (puthash (plist-get song :id) song playlist-songs)
(aset playlist index (plist-get song :id))) (aset playlist index (plist-get song :id)))
(setq empc-object (plist-put (plist-put empc-object :playlist playlist) :playlist-songs playlist-songs))) (empc-playlist-set object playlist)
(empc-playlist-songs-set object playlist-songs))
(empc-populate-playlist-buffer)) (empc-populate-playlist-buffer))
(defun empc-response-idle (data) (defun empc-response-idle (data)
@ -376,7 +480,7 @@ songs order is kept into an avector `empc-current-playlist'."
as parameter." as parameter."
(when closures (when closures
(if (and (listp closures) (not (memq (car closures) '(quote lambda)))) (if (and (listp closures) (not (memq (car closures) '(quote lambda))))
(dolist (closure closures (reverse notifications)) (dolist (closure closures)
(funcall closure data)) (funcall closure data))
(funcall closures data)))) (funcall closures data))))
@ -409,11 +513,11 @@ ARG is nil."
(setq global-mode-string (append global-mode-string '(empc-mode-line-string))) (setq global-mode-string (append global-mode-string '(empc-mode-line-string)))
(setq global-mode-string (remove 'empc-mode-line-string global-mode-string)))) (setq global-mode-string (remove 'empc-mode-line-string global-mode-string))))
(defun empc-initialize () (defun empc-initialize (object)
"Initialize the client after connection. "Initialize the client after connection.
Send the password or retrieve available commands." Send the password or retrieve available commands."
(empc-send-list (when empc-server-password (empc-send-list object (when empc-server-password
`(,(concat "password " empc-server-password))) `(,(concat "password " empc-server-password)))
'("commands" . empc-response-get-commands) '("commands" . empc-response-get-commands)
'("status" . empc-response-get-status) '("status" . empc-response-get-status)
'("playlistinfo" . empc-response-get-playlist)) '("playlistinfo" . empc-response-get-playlist))
@ -427,14 +531,8 @@ Send the password or retrieve available commands."
(unless (and process (unless (and process
(processp process) (processp process)
(eq (process-status process) 'open)) (eq (process-status process) 'open))
(setq process (open-network-stream "empc" empc-buffer-name empc-server-host empc-server-port)) (setq empc-object (empc-create "empc" empc-buffer-name empc-server-host empc-server-port))
(set-process-sentinel process 'empc-process-sentinel) (empc-initialize empc-object))))
(if (fboundp 'set-process-query-on-exit-flag)
(set-process-query-on-exit-flag process nil)
(process-kill-without-query process))
(set-process-coding-system process 'utf-8-unix 'utf-8-unix)
(setq empc-object (plist-put (plist-put empc-object :process process) :queue (tq-create process)))
(empc-initialize))))
(defun empc-bury-buffers () (defun empc-bury-buffers ()
"Bury all empc related buffers." "Bury all empc related buffers."
@ -445,14 +543,14 @@ Send the password or retrieve available commands."
(defun empc-quit () (defun empc-quit ()
"Close connection between empc and mpd." "Close connection between empc and mpd."
(interactive) (interactive)
(let ((process (empc-process empc-object))) (let* ((process (empc-process empc-object)))
(when (and process (when (and process
(processp process) (processp process)
(eq (process-status process) 'open)) (eq (process-status process) 'open))
(empc-leave-idle-state) (empc-leave-idle-state)
(empc-send-close))) (empc-send-close)))
(when (empc-queue empc-object) (when empc-object
(tq-close (empc-queue empc-object))) (empc-close empc-object))
(empc-mode-line nil) (empc-mode-line nil)
(when (get-buffer "*empc*") (when (get-buffer "*empc*")
(kill-buffer "*empc*")) (kill-buffer "*empc*"))
@ -460,18 +558,18 @@ Send the password or retrieve available commands."
empc-idle-state nil empc-idle-state nil
empc-last-crossfade nil)) empc-last-crossfade nil))
(defun empc () (defun empc ()
"Emacs MPC (not really the most original name, but oh well…)." "Emacs MPC (not really the most original name, but oh well…)."
(interactive) (interactive)
(empc-ensure-connected) (let ((debug-on-error t))
(empc-switch-to-playlist)) (empc-ensure-connected)
(empc-switch-to-playlist)))
(defun empc-maybe-enter-idle-state () (defun empc-maybe-enter-idle-state ()
"If not already in idle state and there is no other commands pending, "If not already in idle state and there is no other commands pending,
enter idle state to accept notifications from the server." enter idle state to accept notifications from the server."
(unless (or empc-idle-state (unless (or empc-idle-state
(cdr (tq-queue (empc-queue empc-object)))) (cdr (empc-queue empc-object)))
(empc-send-idle) (empc-send-idle)
(setq empc-idle-state t))) (setq empc-idle-state t)))
@ -481,17 +579,17 @@ enter idle state to accept notifications from the server."
(process-send-string (empc-process empc-object) "noidle\n") (process-send-string (empc-process empc-object) "noidle\n")
(setq empc-idle-state nil))) (setq empc-idle-state nil)))
(defun empc-send (command &optional closure handler) (defun empc-send (object command &optional closure handler)
"Send COMMAND to the mpd server. "Send COMMAND to the mpd server.
CLOSURE will be called on the parsed response." CLOSURE will be called on the parsed response."
(empc-ensure-connected) (empc-ensure-connected)
(empc-leave-idle-state) (empc-leave-idle-state)
(unless (string= (substring command -1) "\n") (unless (string= (substring command -1) "\n")
(setq command (concat command "\n"))) (setq command (concat command "\n")))
(tq-enqueue (empc-queue empc-object) command empc-response-regexp (empc-queue-push object command closure
closure (if handler handler 'empc-handle-response) t)) (if handler handler 'empc-handle-response)))
(defun empc-send-list (&rest commands) (defun empc-send-list (object &rest commands)
"Send COMMANDS to the mpd server using command_list. "Send COMMANDS to the mpd server using command_list.
COMMANDS is a list of cons of the form: '(COMMAND . CLOSURE), COMMANDS is a list of cons of the form: '(COMMAND . CLOSURE),
where CLOSURE (may be a list of functions) will be called on the parsed response." where CLOSURE (may be a list of functions) will be called on the parsed response."
@ -501,17 +599,18 @@ where CLOSURE (may be a list of functions) will be called on the parsed response
(setq command (concat command (car cell) "\n")) (setq command (concat command (car cell) "\n"))
(setq closures (cons (cdr cell) closures)))) (setq closures (cons (cdr cell) closures))))
(setq command (concat command "command_list_end\n")) (setq command (concat command "command_list_end\n"))
(empc-send command closures 'empc-handle-response-list))) (empc-send object command closures 'empc-handle-response-list)))
(defun empc-stream-start () (defun empc-stream-start (object)
"Start the stream process if the command to mpd returned successfully. "Start the stream process if the command to mpd returned successfully.
If the stream process is killed for whatever the reason, pause mpd if possible." If the stream process is killed for whatever the reason, pause mpd if possible."
(let ((stream-process (empc-stream empc-object))) (let ((stream-process (empc-stream object)))
(when (and (not stream-process) (when (and (not stream-process)
empc-stream-url empc-stream-program) empc-stream-url empc-stream-program)
(setq stream-process (start-process "empc-stream" nil empc-stream-program empc-stream-url)) (setq stream-process (start-process "empc-stream" nil empc-stream-program empc-stream-url))
(set-process-sentinel stream-process 'empc-stream-process-sentinel) (set-process-sentinel stream-process `(lambda (proc event)
(setq empc-object (plist-put empc-object :stream stream-process))))) (empc-stream-process-sentinel ',object event)))
(setq empc-stream-process stream-process))))
(defun empc-playlist-mode () (defun empc-playlist-mode ()
"empc playlist mode." "empc playlist mode."
@ -529,39 +628,44 @@ If the stream process is killed for whatever the reason, pause mpd if possible."
(switch-to-buffer "*empc*"))) (switch-to-buffer "*empc*")))
(empc-playlist-mode)) (empc-playlist-mode))
(defmacro with-updated-status (&rest body) (defmacro with-updated-status (object &rest body)
"Update the status and execute the forms in BODY." "Update the status and execute the forms in BODY."
`(if (empc-status empc-object) `(if (empc-status empc-object)
,@body ,@body
(empc-send "status\n" '(empc-response-get-status (lambda (data) ,@body))))) (empc-send object "status\n" '(empc-response-get-status (lambda (data) ,@body)))))
(defmacro empc-define-simple-command (command &optional closure) (defmacro empc-define-simple-command (command &optional closure)
"Define a simple command that doesn't need an argument." "Define a simple command that doesn't need an argument."
`(defun ,(intern (concat "empc-send-" command)) (&optional arg) `(defun ,(intern (concat "empc-send-" command)) (&optional arg)
,(concat "Send " command " to the server.") ,(concat "Send " command " to the server.")
(interactive) (interactive)
(empc-leave-idle-state) (let ((debug-on-error t)
(empc-send (concat ,command (when arg (concat " " (if (stringp arg) arg (number-to-string arg)))) "\n") (object empc-object))
,closure))) (empc-leave-idle-state)
(empc-send object (concat ,command (when arg (concat " " (if (stringp arg)
arg (number-to-string arg)))) "\n")
,closure))))
(defmacro empc-define-toggle-command (command &optional state-name attr &rest body) (defmacro empc-define-toggle-command (command &optional state-name attr &rest body)
"Define a command that toggle a state." "Define a command that toggle a state."
`(defun ,(intern (concat "empc-toggle-" command)) (&optional state) `(defun ,(intern (concat "empc-toggle-" command)) (&optional state)
,(concat "Toggle " command ".") ,(concat "Toggle " command ".")
(interactive) (interactive)
(empc-leave-idle-state) (let ((debug-on-error t)
(if state (object empc-object))
(empc-send (concat ,(concat command " ") (int-to-string state) "\n")) (empc-leave-idle-state)
(with-updated-status (if state
(let ((,(if attr attr (empc-send object (concat ,(concat command " ") (int-to-string state) "\n"))
(intern command)) (with-updated-status object
(empc-status-get empc-object (quote ,(intern (concat ":" (if state-name (let ((,(if attr attr
state-name (intern command))
command))))))) (empc-status-get object (quote ,(intern (concat ":" (if state-name
,(if body state-name
`(progn ,@body) command)))))))
`(empc-send (concat ,command (if (= ,(if attr attr ,(if body
(intern command)) 1) " 0" " 1") "\n")))))))) `(progn ,@body)
`(empc-send object (concat ,command (if (= ,(if attr attr
(intern command)) 1) " 0" " 1") "\n")))))))))
(defmacro empc-define-command-with-pos (command &optional closure) (defmacro empc-define-command-with-pos (command &optional closure)
"Define a command that need a position either as a parameter or "Define a command that need a position either as a parameter or
@ -570,22 +674,26 @@ computed using point in buffer."
,(concat "Send " command " to the server together with an ID ,(concat "Send " command " to the server together with an ID
parameter computed using pos or cursor position.") parameter computed using pos or cursor position.")
(interactive) (interactive)
(empc-leave-idle-state) (let ((debug-on-error t)
(unless pos (object empc-object))
(setq pos (count-lines (point-min) (point)))) (empc-leave-idle-state)
(let ((id (elt (empc-playlist empc-object) pos))) (unless pos
(empc-send (concat ,(concat command "id ") (number-to-string id) "\n") ,closure)))) (setq pos (count-lines (point-min) (point))))
(let ((id (elt (empc-playlist object) pos)))
(empc-send object (concat ,(concat command "id ") (number-to-string id) "\n") ,closure)))))
(defmacro empc-define-command-with-current-id (command &optional closure) (defmacro empc-define-command-with-current-id (command &optional closure)
"Define a command that uses the current song as a parameter." "Define a command that uses the current song as a parameter."
`(defun ,(intern (concat "empc-send-" command)) (&optional arg) `(defun ,(intern (concat "empc-send-" command)) (&optional arg)
,(concat "Send " command " to the server with the ID of the currently playing song.") ,(concat "Send " command " to the server with the ID of the currently playing song.")
(interactive) (interactive)
(empc-leave-idle-state) (let ((debug-on-error t)
(empc-send (concat ,(concat command "id ") (object empc-object))
(number-to-string (empc-status-get empc-object :songid)) (empc-leave-idle-state)
(when arg (concat " " (if (stringp arg) arg (number-to-string arg)))) "\n") (empc-send object (concat ,(concat command "id ")
,closure))) (number-to-string (empc-status-get object :songid))
(when arg (concat " " (if (stringp arg) arg (number-to-string arg)))) "\n")
,closure))))
;; Querying MPD's status ;; Querying MPD's status
(empc-define-simple-command "clearerror") (empc-define-simple-command "clearerror")
@ -596,15 +704,15 @@ computed using point in buffer."
;; Playback options ;; Playback options
(empc-define-toggle-command "consume") (empc-define-toggle-command "consume")
(empc-define-simple-command "crossfade")
(empc-define-toggle-command "crossfade" "xfade" xfade (empc-define-toggle-command "crossfade" "xfade" xfade
(if (= xfade 0) (if (= xfade 0)
(empc-send (concat "crossfade " (empc-send-crossfade (if empc-last-crossfade
(int-to-string (if empc-last-crossfade empc-last-crossfade
empc-last-crossfade empc-default-crossfade))
empc-default-crossfade))))
(progn (progn
(setq empc-last-crossfade xfade) (setq empc-last-crossfade xfade)
(empc-send "crossfade 0")))) (empc-send-crossfade 0))))
(empc-define-toggle-command "random") (empc-define-toggle-command "random")
(empc-define-toggle-command "repeat") (empc-define-toggle-command "repeat")
(empc-define-simple-command "setvol") (empc-define-simple-command "setvol")
@ -612,12 +720,13 @@ computed using point in buffer."
;; Controlling playback ;; Controlling playback
(empc-define-simple-command "next") (empc-define-simple-command "next")
(empc-define-simple-command "pause")
(empc-define-toggle-command "pause" "state" state (empc-define-toggle-command "pause" "state" state
(cond (cond
((eq state 'play) ((eq state 'play)
(empc-send "pause 1")) (empc-send-pause 1))
((eq state 'pause) ((eq state 'pause)
(empc-send "pause 0")) (empc-send-pause 0))
(t (empc-send-play)))) (t (empc-send-play))))
(empc-define-command-with-pos "play") (empc-define-command-with-pos "play")
(empc-define-simple-command "previous") (empc-define-simple-command "previous")