Rewrite the transfert queue #2/2: rewrite the transfert queue as part of empc.
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:
parent
730902179e
commit
3962b7de8f
2 changed files with 275 additions and 161 deletions
9
TODO
9
TODO
|
|
@ -30,9 +30,12 @@
|
|||
* DONE Display the playlist in a buffer
|
||||
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
|
||||
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
|
||||
Need to keep data shown in buffers separated from data given by the server to
|
||||
|
|
@ -40,6 +43,8 @@
|
|||
|
||||
* TODO Better notification system
|
||||
|
||||
* TODO Sync transfert when required
|
||||
|
||||
* TODO Allow tampering the playlist
|
||||
|
||||
* TODO Display the music database in another buffer
|
||||
|
|
|
|||
427
empc.el
427
empc.el
|
|
@ -1,5 +1,3 @@
|
|||
(require 'tq)
|
||||
|
||||
(defgroup empc nil
|
||||
"Customize group for empc."
|
||||
:group 'external
|
||||
|
|
@ -58,58 +56,116 @@
|
|||
"The name of the buffer receiving output from server.")
|
||||
|
||||
(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
|
||||
return at the end of a request.")
|
||||
|
||||
(defvar empc-object nil
|
||||
"Structure containing data for empc as a Property list.
|
||||
The structure has the following fields:
|
||||
"Structure containing data for empc.
|
||||
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
|
||||
pass to the function together with the response.
|
||||
This structure has the following type:
|
||||
(command closure . fn).
|
||||
|
||||
:stream keeps the process playing the stream.
|
||||
|
||||
:available-commands keeps the commands available to the
|
||||
commands keeps the commands available to the
|
||||
user. There is no need to send a command to the server if we
|
||||
know already this command is unavailable due to restricted
|
||||
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.
|
||||
|
||||
: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.")
|
||||
|
||||
;; Accessors for the empc object.
|
||||
(defun empc-process (object) (plist-get object :process))
|
||||
(defun empc-queue (object) (plist-get object :queue))
|
||||
(defun empc-stream (object) (plist-get object :stream))
|
||||
(defun empc-available-commands (object) (plist-get object :available-commands))
|
||||
(defun empc-status (object) (plist-get object :status))
|
||||
(defun empc-playlist-songs (object) (plist-get object :playlist-songs))
|
||||
(defun empc-playlist (object) (plist-get object :playlist))
|
||||
(defun empc-process (object) (cadar object))
|
||||
(defun empc-queue (object) (caar object))
|
||||
(defun empc-stream (object) empc-stream-process)
|
||||
(defun empc-commands (object) (cddar object))
|
||||
(defun empc-status (object) (cadr object))
|
||||
(defun empc-playlist-songs (object) (cdddr object))
|
||||
(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-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-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-last-crossfade nil)
|
||||
(defvar empc-mode-line-string "")
|
||||
(defvar empc-stream-process nil)
|
||||
(defvar empc-may-pulse nil)
|
||||
(when (require 'pulse nil t)
|
||||
(setq empc-may-pulse t))
|
||||
|
||||
|
||||
|
||||
(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-quit)
|
||||
|
|
@ -135,14 +191,58 @@ The structure has the following fields:
|
|||
(when empc-verbose
|
||||
(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'."
|
||||
(let ((process (empc-process empc-object)))
|
||||
(let ((process (empc-process object)))
|
||||
(when (and (eq (process-status proc) 'exit)
|
||||
process
|
||||
(processp process)
|
||||
(eq (process-status process) 'open)
|
||||
(eq (empc-status-get empc-object :state) 'play))
|
||||
(eq (empc-status-get object :state) 'play))
|
||||
(empc-toggle-pause 1)))
|
||||
(setq empc-stream-process nil))
|
||||
|
||||
|
|
@ -162,13 +262,14 @@ The structure has the following fields:
|
|||
(defun empc-echo-song (&optional song)
|
||||
"Notify SONG in the echo area."
|
||||
(interactive)
|
||||
(unless song
|
||||
(setq song (empc-current-song empc-object)))
|
||||
(empc-echo-notify (concat "[" (int-to-string (+ (plist-get song :pos) 1))
|
||||
"/" (int-to-string (empc-status-get empc-object :playlistlength)) "] "
|
||||
(if (and (plist-get song :artist) (plist-get song :title))
|
||||
(concat (plist-get song :artist) " - " (plist-get song :title))
|
||||
(plist-get song :file)))))
|
||||
(let ((object empc-object))
|
||||
(unless song
|
||||
(setq song (empc-current-song object)))
|
||||
(empc-echo-notify (concat "[" (int-to-string (+ (plist-get song :pos) 1))
|
||||
"/" (int-to-string (empc-status-get object :playlistlength)) "] "
|
||||
(if (and (plist-get song :artist) (plist-get song :title))
|
||||
(concat (plist-get song :artist) " - " (plist-get song :title))
|
||||
(plist-get song :file))))))
|
||||
|
||||
(defun empc-mode-line-notify (msg)
|
||||
"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)
|
||||
"Notify SONG in the mode-line."
|
||||
(unless song
|
||||
(setq song (empc-current-song empc-object)))
|
||||
(empc-mode-line-notify (concat "[" (int-to-string (+ (plist-get song :pos) 1))
|
||||
"/" (int-to-string (empc-status-get empc-object :playlistlength)) "] "
|
||||
(if (and (plist-get song :artist) (plist-get song :title))
|
||||
(concat (plist-get song :artist) " - " (plist-get song :title))
|
||||
(plist-get song :file)))))
|
||||
(let ((object empc-object))
|
||||
(unless song
|
||||
(setq song (empc-current-song object)))
|
||||
(empc-mode-line-notify (concat "[" (int-to-string (+ (plist-get song :pos) 1))
|
||||
"/" (int-to-string (empc-status-get object :playlistlength)) "] "
|
||||
(if (and (plist-get song :artist) (plist-get song :title))
|
||||
(concat (plist-get song :artist) " - " (plist-get song :title))
|
||||
(plist-get song :file))))))
|
||||
|
||||
(defun empc-response-parse-line (line)
|
||||
"Turn the given line into a cons cell.
|
||||
|
|
@ -220,10 +322,11 @@ form '('error (error-code . error-message))."
|
|||
|
||||
(defun empc-response-get-commands (data)
|
||||
"Parse DATA to get the available commands."
|
||||
(let ((available-commands))
|
||||
(let ((object empc-object)
|
||||
(commands))
|
||||
(dolist (cell data)
|
||||
(setq available-commands (cons (cdr cell) available-commands)))
|
||||
(setq empc-object (plist-put empc-object :available-commands available-commands))))
|
||||
(setq commands (cons (cdr cell) commands)))
|
||||
(empc-commands-set object commands)))
|
||||
|
||||
(defun empc-status-on/off-stringify (status key)
|
||||
"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:
|
||||
if :state or :songid is changed, report it to the user,
|
||||
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))
|
||||
(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-playlist-songs empc-object))))))
|
||||
(empc-playlist-songs object))))))
|
||||
(empc-playlist-goto-current-song))
|
||||
(when (plist-get status-diff :state)
|
||||
(if (eq (plist-get status-diff :state) 'play)
|
||||
(progn
|
||||
(unless notify
|
||||
(setq notify '(lambda () (when (empc-playlist-songs empc-object)
|
||||
(setq notify '(lambda () (when (empc-playlist-songs object)
|
||||
(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)))))))
|
||||
(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 :xfade))
|
||||
(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 empc-object) :random)
|
||||
(empc-status-on/off-stringify (empc-status empc-object) :single)
|
||||
(empc-status-on/off-stringify (empc-status empc-object) :consume)
|
||||
(empc-status-on/off-stringify (empc-status empc-object) :xfade))))))
|
||||
(empc-status-on/off-stringify (empc-status object) :repeat)
|
||||
(empc-status-on/off-stringify (empc-status object) :random)
|
||||
(empc-status-on/off-stringify (empc-status object) :single)
|
||||
(empc-status-on/off-stringify (empc-status object) :consume)
|
||||
(empc-status-on/off-stringify (empc-status object) :xfade))))))
|
||||
(when notify
|
||||
(funcall notify))))
|
||||
|
||||
|
|
@ -279,64 +383,63 @@ According to what is in the diff, several actions can be performed:
|
|||
|
||||
(defun empc-diff-status (data)
|
||||
"Get the diff from `empc-current-status' and server response."
|
||||
(let ((status-diff nil)
|
||||
(new-status (empc-status empc-object))
|
||||
(let ((object empc-object)
|
||||
(status-diff nil)
|
||||
(attributes '(:volume :repeat :random :single :consume :playlist :playlistlength :state
|
||||
:song :songid :nextsong :nextsongid :time :elapsed :bitrate :xfade
|
||||
:mixrampdb :mixrampdelay :audio :updating_db :error)))
|
||||
(prog1
|
||||
(dolist (attr attributes status-diff)
|
||||
(let ((value (empc-parse-status-attr attr (cdr (assoc (substring (symbol-name attr) 1) data)))))
|
||||
(unless (equal (empc-status-get empc-object attr) value)
|
||||
(setq status-diff (plist-put status-diff attr value))
|
||||
(setq new-status (plist-put new-status attr value)))))
|
||||
(setq empc-object (plist-put empc-object :status new-status)))))
|
||||
(dolist (attr attributes status-diff)
|
||||
(let ((value (empc-parse-status-attr attr (cdr (assoc (substring (symbol-name attr) 1) data)))))
|
||||
(unless (equal (empc-status-get object attr) value)
|
||||
(setq status-diff (plist-put status-diff attr value))
|
||||
(empc-status-put object attr value))))))
|
||||
|
||||
(defun empc-playlist-goto-current-song ()
|
||||
"Put point at currently playing song."
|
||||
(interactive)
|
||||
(when (get-buffer "*empc*")
|
||||
(let ((buffer nil))
|
||||
(unless (called-interactively-p)
|
||||
(dolist (frame (frame-list))
|
||||
(with-selected-frame frame
|
||||
(let ((bwindow (get-buffer-window "*empc*")))
|
||||
(when bwindow
|
||||
(with-selected-window bwindow
|
||||
(goto-char (point-min))
|
||||
(forward-line (empc-status-get empc-object :song))
|
||||
(when (and (not buffer) empc-may-pulse)
|
||||
(pulse-momentary-highlight-one-line (point))))
|
||||
(setq buffer bwindow))))))
|
||||
(unless buffer
|
||||
(with-current-buffer "*empc*"
|
||||
(goto-char (point-min))
|
||||
(forward-line (empc-status-get empc-object :song))
|
||||
(when (and (called-interactively-p) empc-may-pulse)
|
||||
(pulse-momentary-highlight-one-line (point))))))))
|
||||
(let ((object empc-object))
|
||||
(when (get-buffer "*empc*")
|
||||
(let ((buffer nil))
|
||||
(unless (called-interactively-p)
|
||||
(dolist (frame (frame-list))
|
||||
(with-selected-frame frame
|
||||
(let ((bwindow (get-buffer-window "*empc*")))
|
||||
(when bwindow
|
||||
(with-selected-window bwindow
|
||||
(goto-char (point-min))
|
||||
(forward-line (empc-status-get object :song))
|
||||
(when (and (not buffer) empc-may-pulse)
|
||||
(pulse-momentary-highlight-one-line (point))))
|
||||
(setq buffer bwindow))))))
|
||||
(unless buffer
|
||||
(with-current-buffer "*empc*"
|
||||
(goto-char (point-min))
|
||||
(forward-line (empc-status-get object :song))
|
||||
(when (and (called-interactively-p) empc-may-pulse)
|
||||
(pulse-momentary-highlight-one-line (point)))))))))
|
||||
|
||||
(defun empc-populate-playlist-buffer ()
|
||||
"Write playlist into the *empc* buffer."
|
||||
(save-window-excursion
|
||||
(empc-switch-to-playlist)
|
||||
(let ((buffer-read-only nil))
|
||||
(erase-buffer)
|
||||
(when (empc-playlist-songs empc-object)
|
||||
(dotimes (pos (length (empc-playlist empc-object)))
|
||||
(let ((song (gethash (elt (empc-playlist empc-object) pos) (empc-playlist-songs empc-object))))
|
||||
(insert (if (and (plist-member song :artist) (plist-member song :title))
|
||||
(concat (plist-get song :artist) " - " (plist-get song :title))
|
||||
(plist-get song :file)) "\n"))))))
|
||||
(empc-playlist-goto-current-song))
|
||||
(let ((object empc-object))
|
||||
(save-window-excursion
|
||||
(empc-switch-to-playlist)
|
||||
(let ((buffer-read-only nil))
|
||||
(erase-buffer)
|
||||
(when (empc-playlist-songs object)
|
||||
(dotimes (pos (length (empc-playlist object)))
|
||||
(let ((song (empc-song object pos)))
|
||||
(insert (if (and (plist-member song :artist) (plist-member song :title))
|
||||
(concat (plist-get song :artist) " - " (plist-get song :title))
|
||||
(plist-get song :file)) "\n"))))))
|
||||
(empc-playlist-goto-current-song)))
|
||||
|
||||
(defun empc-response-get-playlist (data)
|
||||
"Parse information regarding songs in current playlist and arrange it into a
|
||||
hash table `empc-current-playlist-songs'sorted by songid.
|
||||
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)))
|
||||
;; (setq empc-current-playlist (make-vector (plist-get empc-current-status :playlistlength) nil))
|
||||
(let* ((playlist-songs (make-hash-table :rehash-threshold 1.0 :size (empc-status-get empc-object :playlistlength)))
|
||||
(playlist (make-vector (empc-status-get empc-object :playlistlength) nil))
|
||||
(let* ((object empc-object)
|
||||
(playlist-songs (make-hash-table :rehash-threshold 1.0 :size (empc-status-get object :playlistlength)))
|
||||
(playlist (make-vector (empc-status-get object :playlistlength) nil))
|
||||
(song nil)
|
||||
(index (- (length playlist) 1)))
|
||||
(dolist (cell data)
|
||||
|
|
@ -355,7 +458,8 @@ songs order is kept into an avector `empc-current-playlist'."
|
|||
(when (and song (>= index 0))
|
||||
(puthash (plist-get song :id) song playlist-songs)
|
||||
(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))
|
||||
|
||||
(defun empc-response-idle (data)
|
||||
|
|
@ -376,7 +480,7 @@ songs order is kept into an avector `empc-current-playlist'."
|
|||
as parameter."
|
||||
(when closures
|
||||
(if (and (listp closures) (not (memq (car closures) '(quote lambda))))
|
||||
(dolist (closure closures (reverse notifications))
|
||||
(dolist (closure closures)
|
||||
(funcall closure 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 (remove 'empc-mode-line-string global-mode-string))))
|
||||
|
||||
(defun empc-initialize ()
|
||||
(defun empc-initialize (object)
|
||||
"Initialize the client after connection.
|
||||
Send the password or retrieve available commands."
|
||||
(empc-send-list (when empc-server-password
|
||||
`(,(concat "password " empc-server-password)))
|
||||
(empc-send-list object (when empc-server-password
|
||||
`(,(concat "password " empc-server-password)))
|
||||
'("commands" . empc-response-get-commands)
|
||||
'("status" . empc-response-get-status)
|
||||
'("playlistinfo" . empc-response-get-playlist))
|
||||
|
|
@ -427,14 +531,8 @@ Send the password or retrieve available commands."
|
|||
(unless (and process
|
||||
(processp process)
|
||||
(eq (process-status process) 'open))
|
||||
(setq process (open-network-stream "empc" empc-buffer-name empc-server-host empc-server-port))
|
||||
(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)
|
||||
(setq empc-object (plist-put (plist-put empc-object :process process) :queue (tq-create process)))
|
||||
(empc-initialize))))
|
||||
(setq empc-object (empc-create "empc" empc-buffer-name empc-server-host empc-server-port))
|
||||
(empc-initialize empc-object))))
|
||||
|
||||
(defun empc-bury-buffers ()
|
||||
"Bury all empc related buffers."
|
||||
|
|
@ -445,14 +543,14 @@ Send the password or retrieve available commands."
|
|||
(defun empc-quit ()
|
||||
"Close connection between empc and mpd."
|
||||
(interactive)
|
||||
(let ((process (empc-process empc-object)))
|
||||
(let* ((process (empc-process empc-object)))
|
||||
(when (and process
|
||||
(processp process)
|
||||
(eq (process-status process) 'open))
|
||||
(empc-leave-idle-state)
|
||||
(empc-send-close)))
|
||||
(when (empc-queue empc-object)
|
||||
(tq-close (empc-queue empc-object)))
|
||||
(when empc-object
|
||||
(empc-close empc-object))
|
||||
(empc-mode-line nil)
|
||||
(when (get-buffer "*empc*")
|
||||
(kill-buffer "*empc*"))
|
||||
|
|
@ -460,18 +558,18 @@ Send the password or retrieve available commands."
|
|||
empc-idle-state nil
|
||||
empc-last-crossfade nil))
|
||||
|
||||
|
||||
(defun empc ()
|
||||
"Emacs MPC (not really the most original name, but oh well…)."
|
||||
(interactive)
|
||||
(empc-ensure-connected)
|
||||
(empc-switch-to-playlist))
|
||||
(let ((debug-on-error t))
|
||||
(empc-ensure-connected)
|
||||
(empc-switch-to-playlist)))
|
||||
|
||||
(defun empc-maybe-enter-idle-state ()
|
||||
"If not already in idle state and there is no other commands pending,
|
||||
enter idle state to accept notifications from the server."
|
||||
(unless (or empc-idle-state
|
||||
(cdr (tq-queue (empc-queue empc-object))))
|
||||
(cdr (empc-queue empc-object)))
|
||||
(empc-send-idle)
|
||||
(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")
|
||||
(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.
|
||||
CLOSURE will be called on the parsed response."
|
||||
(empc-ensure-connected)
|
||||
(empc-leave-idle-state)
|
||||
(unless (string= (substring command -1) "\n")
|
||||
(setq command (concat command "\n")))
|
||||
(tq-enqueue (empc-queue empc-object) command empc-response-regexp
|
||||
closure (if handler handler 'empc-handle-response) t))
|
||||
(empc-queue-push object command closure
|
||||
(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.
|
||||
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."
|
||||
|
|
@ -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 closures (cons (cdr cell) closures))))
|
||||
(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.
|
||||
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)
|
||||
empc-stream-url empc-stream-program)
|
||||
(setq stream-process (start-process "empc-stream" nil empc-stream-program empc-stream-url))
|
||||
(set-process-sentinel stream-process 'empc-stream-process-sentinel)
|
||||
(setq empc-object (plist-put empc-object :stream stream-process)))))
|
||||
(set-process-sentinel stream-process `(lambda (proc event)
|
||||
(empc-stream-process-sentinel ',object event)))
|
||||
(setq empc-stream-process stream-process))))
|
||||
|
||||
(defun 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*")))
|
||||
(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."
|
||||
`(if (empc-status empc-object)
|
||||
,@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)
|
||||
"Define a simple command that doesn't need an argument."
|
||||
`(defun ,(intern (concat "empc-send-" command)) (&optional arg)
|
||||
,(concat "Send " command " to the server.")
|
||||
(interactive)
|
||||
(empc-leave-idle-state)
|
||||
(empc-send (concat ,command (when arg (concat " " (if (stringp arg) arg (number-to-string arg)))) "\n")
|
||||
,closure)))
|
||||
(let ((debug-on-error t)
|
||||
(object empc-object))
|
||||
(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)
|
||||
"Define a command that toggle a state."
|
||||
`(defun ,(intern (concat "empc-toggle-" command)) (&optional state)
|
||||
,(concat "Toggle " command ".")
|
||||
(interactive)
|
||||
(empc-leave-idle-state)
|
||||
(if state
|
||||
(empc-send (concat ,(concat command " ") (int-to-string state) "\n"))
|
||||
(with-updated-status
|
||||
(let ((,(if attr attr
|
||||
(intern command))
|
||||
(empc-status-get empc-object (quote ,(intern (concat ":" (if state-name
|
||||
state-name
|
||||
command)))))))
|
||||
,(if body
|
||||
`(progn ,@body)
|
||||
`(empc-send (concat ,command (if (= ,(if attr attr
|
||||
(intern command)) 1) " 0" " 1") "\n"))))))))
|
||||
(let ((debug-on-error t)
|
||||
(object empc-object))
|
||||
(empc-leave-idle-state)
|
||||
(if state
|
||||
(empc-send object (concat ,(concat command " ") (int-to-string state) "\n"))
|
||||
(with-updated-status object
|
||||
(let ((,(if attr attr
|
||||
(intern command))
|
||||
(empc-status-get object (quote ,(intern (concat ":" (if state-name
|
||||
state-name
|
||||
command)))))))
|
||||
,(if body
|
||||
`(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)
|
||||
"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
|
||||
parameter computed using pos or cursor position.")
|
||||
(interactive)
|
||||
(empc-leave-idle-state)
|
||||
(unless pos
|
||||
(setq pos (count-lines (point-min) (point))))
|
||||
(let ((id (elt (empc-playlist empc-object) pos)))
|
||||
(empc-send (concat ,(concat command "id ") (number-to-string id) "\n") ,closure))))
|
||||
(let ((debug-on-error t)
|
||||
(object empc-object))
|
||||
(empc-leave-idle-state)
|
||||
(unless pos
|
||||
(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)
|
||||
"Define a command that uses the current song as a parameter."
|
||||
`(defun ,(intern (concat "empc-send-" command)) (&optional arg)
|
||||
,(concat "Send " command " to the server with the ID of the currently playing song.")
|
||||
(interactive)
|
||||
(empc-leave-idle-state)
|
||||
(empc-send (concat ,(concat command "id ")
|
||||
(number-to-string (empc-status-get empc-object :songid))
|
||||
(when arg (concat " " (if (stringp arg) arg (number-to-string arg)))) "\n")
|
||||
,closure)))
|
||||
(let ((debug-on-error t)
|
||||
(object empc-object))
|
||||
(empc-leave-idle-state)
|
||||
(empc-send object (concat ,(concat command "id ")
|
||||
(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
|
||||
(empc-define-simple-command "clearerror")
|
||||
|
|
@ -596,15 +704,15 @@ computed using point in buffer."
|
|||
|
||||
;; Playback options
|
||||
(empc-define-toggle-command "consume")
|
||||
(empc-define-simple-command "crossfade")
|
||||
(empc-define-toggle-command "crossfade" "xfade" xfade
|
||||
(if (= xfade 0)
|
||||
(empc-send (concat "crossfade "
|
||||
(int-to-string (if empc-last-crossfade
|
||||
empc-last-crossfade
|
||||
empc-default-crossfade))))
|
||||
(empc-send-crossfade (if empc-last-crossfade
|
||||
empc-last-crossfade
|
||||
empc-default-crossfade))
|
||||
(progn
|
||||
(setq empc-last-crossfade xfade)
|
||||
(empc-send "crossfade 0"))))
|
||||
(empc-send-crossfade 0))))
|
||||
(empc-define-toggle-command "random")
|
||||
(empc-define-toggle-command "repeat")
|
||||
(empc-define-simple-command "setvol")
|
||||
|
|
@ -612,12 +720,13 @@ computed using point in buffer."
|
|||
|
||||
;; Controlling playback
|
||||
(empc-define-simple-command "next")
|
||||
(empc-define-simple-command "pause")
|
||||
(empc-define-toggle-command "pause" "state" state
|
||||
(cond
|
||||
((eq state 'play)
|
||||
(empc-send "pause 1"))
|
||||
(empc-send-pause 1))
|
||||
((eq state 'pause)
|
||||
(empc-send "pause 0"))
|
||||
(empc-send-pause 0))
|
||||
(t (empc-send-play))))
|
||||
(empc-define-command-with-pos "play")
|
||||
(empc-define-simple-command "previous")
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue