Renaud Casenave-Péré
3962b7de8f
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.
761 lines
28 KiB
EmacsLisp
761 lines
28 KiB
EmacsLisp
(defgroup empc nil
|
|
"Customize group for empc."
|
|
:group 'external
|
|
:group 'applications
|
|
:group 'multimedia)
|
|
|
|
(defcustom empc-server-host (or (getenv "MPD_HOST") "localhost")
|
|
"The MPD server that we should connect to."
|
|
:type 'string
|
|
:group 'empc)
|
|
|
|
(defcustom empc-server-port (or (getenv "MPD_PORT") 6600)
|
|
"The port of the MPD server."
|
|
:type 'integer
|
|
:group 'empc)
|
|
|
|
(defcustom empc-server-password nil
|
|
"The password for the MPD server."
|
|
:type '(choice (const :tag "None" nil)
|
|
string)
|
|
:group 'empc)
|
|
|
|
(defcustom empc-stream-url nil
|
|
"The url of the stream to play when asking MPD to start."
|
|
:type '(choice (const :tag "None" nil)
|
|
string)
|
|
:group 'empc)
|
|
|
|
(defcustom empc-stream-program "mplayer"
|
|
"The program to launch to play the stream."
|
|
:type '(choice (const :tag "None" nil)
|
|
string)
|
|
:group 'empc)
|
|
|
|
(defcustom empc-default-crossfade 5
|
|
"The default crossfade to apply."
|
|
:type 'integer
|
|
:group 'empc)
|
|
|
|
(defgroup empc-debug nil
|
|
"Customize group for debugging empc."
|
|
:group 'empc)
|
|
|
|
(defcustom empc-verbose nil
|
|
"Whether to provide notifications for server connection events and errors."
|
|
:type 'boolean
|
|
:group 'empc-debug)
|
|
|
|
(defcustom empc-buffer-name nil
|
|
"The name of the buffer for server responses."
|
|
:type '(choice (const :tag "None" nil)
|
|
string)
|
|
:group 'empc-debug)
|
|
|
|
(defconst empc-buffer-name "*empc-process*"
|
|
"The name of the buffer receiving output from server.")
|
|
|
|
(defconst empc-response-regexp
|
|
"^\\(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.
|
|
The structure is of the form:
|
|
|
|
((queue . (process . commands)) . (status . (playlist . playlist-songs)))
|
|
|
|
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).
|
|
|
|
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.
|
|
|
|
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
|
|
in the playlist.")
|
|
|
|
;; Accessors for the empc object.
|
|
(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)
|
|
(define-key empc-playlist-map "j" 'forward-line)
|
|
(define-key empc-playlist-map "k" (lambda () (interactive) (forward-line -1)))
|
|
(define-key empc-playlist-map "P" 'empc-toggle-pause)
|
|
(define-key empc-playlist-map "s" 'empc-send-stop)
|
|
(define-key empc-playlist-map "<" 'empc-send-previous)
|
|
(define-key empc-playlist-map ">" 'empc-send-next)
|
|
(define-key empc-playlist-map "r" 'empc-toggle-repeat)
|
|
(define-key empc-playlist-map "R" 'empc-toggle-consume)
|
|
(define-key empc-playlist-map "y" 'empc-toggle-single)
|
|
(define-key empc-playlist-map "z" 'empc-toggle-random)
|
|
(define-key empc-playlist-map "x" 'empc-toggle-crossfade)
|
|
(define-key empc-playlist-map "o" 'empc-playlist-goto-current-song)
|
|
(define-key empc-playlist-map [return] 'empc-send-play)
|
|
(define-key empc-playlist-map "d" 'empc-send-delete)
|
|
|
|
(defun empc-process-sentinel (proc event)
|
|
"Process sentinel for `empc-process'."
|
|
(let ((status (process-status proc)))
|
|
(cond ((eq status 'closed)
|
|
(when empc-verbose
|
|
(message "empc: connection closed"))))))
|
|
|
|
(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 object)))
|
|
(when (and (eq (process-status proc) 'exit)
|
|
process
|
|
(processp process)
|
|
(eq (process-status process) 'open)
|
|
(eq (empc-status-get object :state) 'play))
|
|
(empc-toggle-pause 1)))
|
|
(setq empc-stream-process nil))
|
|
|
|
(defun empc-echo-minibuffer (msg)
|
|
"Print the response into the minibuffer if EMPC-VERBOSE is non nil."
|
|
(when empc-verbose
|
|
(message "empc: %s" (if (string= (substring msg -1) "\n")
|
|
(substring msg 0 -1)
|
|
msg))))
|
|
|
|
(defun empc-echo-notify (msg)
|
|
"Notify MSG using notification system if available, in echo area if not."
|
|
(when (eq window-system 'x)
|
|
(start-process "empc-notify" nil "notify-send" "Music Player Daemon" msg))
|
|
(message (concat "empc: " msg)))
|
|
|
|
(defun empc-echo-song (&optional song)
|
|
"Notify SONG in the echo area."
|
|
(interactive)
|
|
(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."
|
|
(setq empc-mode-line-string (concat " " msg))
|
|
(force-mode-line-update))
|
|
|
|
(defun empc-mode-line-song (&optional song)
|
|
"Notify SONG in the mode-line."
|
|
(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.
|
|
If the line is not of the form \"key: value\",
|
|
check if it matches \"list_OK\"."
|
|
(if (string-match "\\([^:\n]+\\):\\s-*\\(.+\\)" line)
|
|
(cons (downcase (match-string 1 line))
|
|
(match-string 2 line))
|
|
(string= line "list_OK")))
|
|
|
|
(defun empc-response-parse-message (msg)
|
|
"Check the result code and parse the response into an alist.
|
|
If the command resulted in an error, return a plist of the
|
|
form '('error (error-code . error-message))."
|
|
(save-match-data
|
|
(let* ((data (split-string msg "\n" t))
|
|
(status (car (last data))))
|
|
(when (and (stringp (car data))
|
|
(string-match "^OK\\( MPD \\)?" (car data)))
|
|
(setq data (cdr data)))
|
|
(if (and (stringp status)
|
|
(string-match "^ACK \\[\\([0-9]+\\)@[0-9]+\\] \\(.+\\)" status))
|
|
(cons 'error (cons (match-string 1 status)
|
|
(match-string 2 status)))
|
|
(let ((result nil)
|
|
(response nil))
|
|
(dolist (line data (if result (reverse result) response))
|
|
(let ((cell (empc-response-parse-line line)))
|
|
(when cell
|
|
(if (consp cell)
|
|
(setq response (cons cell response))
|
|
(setq result (cons response result)
|
|
response nil))))))))))
|
|
|
|
(defun empc-response-get-commands (data)
|
|
"Parse DATA to get the available commands."
|
|
(let ((object empc-object)
|
|
(commands))
|
|
(dolist (cell data)
|
|
(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."
|
|
(if (= (plist-get status key) 0) "off" "on"))
|
|
|
|
(defun empc-response-get-status (data)
|
|
"Parse DATA to get a diff with `empc-current-status'.
|
|
|
|
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 ((object empc-object)
|
|
(status-diff (empc-diff-status data))
|
|
(notify nil))
|
|
(when (plist-get status-diff :songid)
|
|
(setq notify '(lambda () (when (empc-playlist-songs object)
|
|
(empc-mode-line-song (gethash (plist-get status-diff :songid)
|
|
(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 object)
|
|
(empc-mode-line-song)))))
|
|
(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 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))))
|
|
|
|
(defun empc-parse-status-attr (attr value)
|
|
"Parse a single attribute from status."
|
|
(cond
|
|
((eq value nil) nil)
|
|
((memq attr '(:volume :repeat :random :single :consume :playlist :playlistlength
|
|
:song :songid :nextsong :nextsongid :bitrate :xfade :mixrampdb
|
|
:mixrampdelay :updating_db))
|
|
(string-to-number value))
|
|
((and (eq attr :state) (member value '("play" "pause" "stop")))
|
|
(intern value))
|
|
((and (eq attr :time) (string-match "^\\([0-9]*\\):\\([0-9]*\\)$" value))
|
|
(cons (string-to-number (match-string 1 value))
|
|
(string-to-number (match-string 2 value))))
|
|
(t value)))
|
|
|
|
(defun empc-diff-status (data)
|
|
"Get the diff from `empc-current-status' and server response."
|
|
(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)))
|
|
(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)
|
|
(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."
|
|
(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'."
|
|
(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)
|
|
(let ((field (intern (concat ":" (car cell)))))
|
|
(when (and (eq field :id) song)
|
|
(puthash (plist-get song :id) song playlist-songs)
|
|
(aset playlist index (plist-get song :id))
|
|
(setq song nil)
|
|
(decf index))
|
|
(cond
|
|
((memq field '(:time :track :date :pos :id))
|
|
(setq song (plist-put song field (string-to-number (cdr cell)))))
|
|
(t (if (plist-get song field)
|
|
(setq song (plist-put song field (concat (plist-get song field) ", " (cdr cell))))
|
|
(setq song (plist-put song field (cdr cell))))))))
|
|
(when (and song (>= index 0))
|
|
(puthash (plist-get song :id) song playlist-songs)
|
|
(aset playlist index (plist-get song :id)))
|
|
(empc-playlist-set object playlist)
|
|
(empc-playlist-songs-set object playlist-songs))
|
|
(empc-populate-playlist-buffer))
|
|
|
|
(defun empc-response-idle (data)
|
|
"React from idle interruption."
|
|
(setq empc-idle-state nil)
|
|
(dolist (cell data)
|
|
(when (string= (car cell) "changed")
|
|
(let ((changed (cdr cell)))
|
|
(cond
|
|
((member changed '("player" "options"))
|
|
(empc-send-status))
|
|
((string= changed "playlist")
|
|
(empc-send-status)
|
|
(empc-send-playlistinfo)))))))
|
|
|
|
(defun empc-handle-closure-call (closures data)
|
|
"If CLOSURES is a list of function, call them in turn with DATA
|
|
as parameter."
|
|
(when closures
|
|
(if (and (listp closures) (not (memq (car closures) '(quote lambda))))
|
|
(dolist (closure closures)
|
|
(funcall closure data))
|
|
(funcall closures data))))
|
|
|
|
(defun empc-handle-response (closures msg)
|
|
"Retrieve the response from the server.
|
|
Check the error code and process it using CLOSURES."
|
|
(let ((data (empc-response-parse-message msg)))
|
|
(if (eq (car data) 'error)
|
|
(empc-echo-notify (cdr data))
|
|
(empc-handle-closure-call closures data)))
|
|
(empc-maybe-enter-idle-state))
|
|
|
|
(defun empc-handle-response-list (closures msg)
|
|
"Retrieve the responses from the server.
|
|
Check the error code and process the different responses to the
|
|
commands send as command_list."
|
|
(let ((data (empc-response-parse-message msg)))
|
|
(if (eq (car data) 'error)
|
|
(empc-echo-notify (cddr data))
|
|
(dolist (closure closures)
|
|
(empc-handle-closure-call closure (car data))
|
|
(setq data (cdr data)))))
|
|
(empc-maybe-enter-idle-state))
|
|
|
|
(defun empc-mode-line (arg)
|
|
"Add empc info to the mode-line if ARG is non-nil, remove if
|
|
ARG is nil."
|
|
(interactive "p")
|
|
(if arg
|
|
(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 (object)
|
|
"Initialize the client after connection.
|
|
Send the password or retrieve available commands."
|
|
(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))
|
|
(empc-mode-line t)
|
|
(setq empc-idle-state nil
|
|
empc-last-crossfade nil))
|
|
|
|
(defun empc-ensure-connected ()
|
|
"Make sure empc is connected and ready to talk to mpd."
|
|
(let ((process (empc-process empc-object)))
|
|
(unless (and process
|
|
(processp process)
|
|
(eq (process-status process) 'open))
|
|
(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."
|
|
(interactive)
|
|
(while (member major-mode '(empc-playlist-mode))
|
|
(bury-buffer)))
|
|
|
|
(defun empc-quit ()
|
|
"Close connection between empc and mpd."
|
|
(interactive)
|
|
(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-object
|
|
(empc-close empc-object))
|
|
(empc-mode-line nil)
|
|
(when (get-buffer "*empc*")
|
|
(kill-buffer "*empc*"))
|
|
(setq empc-object nil
|
|
empc-idle-state nil
|
|
empc-last-crossfade nil))
|
|
|
|
(defun empc ()
|
|
"Emacs MPC (not really the most original name, but oh well…)."
|
|
(interactive)
|
|
(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 (empc-queue empc-object)))
|
|
(empc-send-idle)
|
|
(setq empc-idle-state t)))
|
|
|
|
(defun empc-leave-idle-state ()
|
|
"If in idle state, regain control."
|
|
(when empc-idle-state
|
|
(process-send-string (empc-process empc-object) "noidle\n")
|
|
(setq empc-idle-state nil)))
|
|
|
|
(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")))
|
|
(empc-queue-push object command closure
|
|
(if handler handler 'empc-handle-response)))
|
|
|
|
(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."
|
|
(let ((command "command_list_ok_begin\n")
|
|
(closures nil))
|
|
(setq closures (dolist (cell commands (reverse closures))
|
|
(setq command (concat command (car cell) "\n"))
|
|
(setq closures (cons (cdr cell) closures))))
|
|
(setq command (concat command "command_list_end\n"))
|
|
(empc-send object command closures 'empc-handle-response-list)))
|
|
|
|
(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 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 `(lambda (proc event)
|
|
(empc-stream-process-sentinel ',object event)))
|
|
(setq empc-stream-process stream-process))))
|
|
|
|
(defun empc-playlist-mode ()
|
|
"empc playlist mode."
|
|
(use-local-map empc-playlist-map)
|
|
(setq major-mode 'empc-playlist-mode)
|
|
(setq mode-name "Empc-Playlist")
|
|
(setq buffer-read-only t))
|
|
|
|
(defun empc-switch-to-playlist ()
|
|
"Switch to the playlist buffer."
|
|
(cond
|
|
((get-buffer-window "*empc*")
|
|
(select-window (get-buffer-window "*empc*")))
|
|
(t
|
|
(switch-to-buffer "*empc*")))
|
|
(empc-playlist-mode))
|
|
|
|
(defmacro with-updated-status (object &rest body)
|
|
"Update the status and execute the forms in BODY."
|
|
`(if (empc-status empc-object)
|
|
,@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)
|
|
(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)
|
|
(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
|
|
computed using point in buffer."
|
|
`(defun ,(intern (concat "empc-send-" command)) (&optional pos)
|
|
,(concat "Send " command " to the server together with an ID
|
|
parameter computed using pos or cursor position.")
|
|
(interactive)
|
|
(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)
|
|
(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")
|
|
(empc-define-simple-command "currentsong")
|
|
(empc-define-simple-command "idle" 'empc-response-idle)
|
|
(empc-define-simple-command "status" 'empc-response-get-status)
|
|
(empc-define-simple-command "stats")
|
|
|
|
;; Playback options
|
|
(empc-define-toggle-command "consume")
|
|
(empc-define-simple-command "crossfade")
|
|
(empc-define-toggle-command "crossfade" "xfade" xfade
|
|
(if (= xfade 0)
|
|
(empc-send-crossfade (if empc-last-crossfade
|
|
empc-last-crossfade
|
|
empc-default-crossfade))
|
|
(progn
|
|
(setq empc-last-crossfade xfade)
|
|
(empc-send-crossfade 0))))
|
|
(empc-define-toggle-command "random")
|
|
(empc-define-toggle-command "repeat")
|
|
(empc-define-simple-command "setvol")
|
|
(empc-define-toggle-command "single")
|
|
|
|
;; 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))
|
|
((eq state 'pause)
|
|
(empc-send-pause 0))
|
|
(t (empc-send-play))))
|
|
(empc-define-command-with-pos "play")
|
|
(empc-define-simple-command "previous")
|
|
(empc-define-command-with-current-id "seek")
|
|
(empc-define-simple-command "stop")
|
|
|
|
;; The current playlist
|
|
(empc-define-simple-command "clear")
|
|
(empc-define-command-with-pos "delete")
|
|
(empc-define-simple-command "playlistinfo" 'empc-response-get-playlist)
|
|
(empc-define-simple-command "shuffle")
|
|
|
|
;; Stored playlists
|
|
(empc-define-simple-command "listplaylists")
|
|
|
|
;; The music database
|
|
|
|
;; Stickers
|
|
|
|
;; Connection settings
|
|
(empc-define-simple-command "close")
|
|
(empc-define-simple-command "kill")
|
|
(empc-define-simple-command "ping")
|
|
|
|
;; Audio output devices
|
|
|
|
;; Reflection
|
|
(empc-define-simple-command "commands" 'empc-response-get-commands)
|
|
|
|
;; Client to client
|
|
|
|
(provide 'empc)
|