Fix indentation

This commit is contained in:
Renaud Casenave-Péré 2012-08-03 18:42:41 +09:00
parent b96930ddeb
commit 4005c3fc2c

482
empc.el
View file

@ -17,19 +17,19 @@
(defcustom empc-server-password nil (defcustom empc-server-password nil
"The password for the MPD server." "The password for the MPD server."
:type '(choice (const :tag "None" nil) :type '(choice (const :tag "None" nil)
string) string)
:group 'empc) :group 'empc)
(defcustom empc-stream-url nil (defcustom empc-stream-url nil
"The url of the stream to play when asking MPD to start." "The url of the stream to play when asking MPD to start."
:type '(choice (const :tag "None" nil) :type '(choice (const :tag "None" nil)
string) string)
:group 'empc) :group 'empc)
(defcustom empc-stream-program "mplayer" (defcustom empc-stream-program "mplayer"
"The program to launch to play the stream." "The program to launch to play the stream."
:type '(choice (const :tag "None" nil) :type '(choice (const :tag "None" nil)
string) string)
:group 'empc) :group 'empc)
(defcustom empc-default-crossfade 5 (defcustom empc-default-crossfade 5
@ -49,7 +49,7 @@
(defcustom empc-buffer-name nil (defcustom empc-buffer-name nil
"The name of the buffer for server responses." "The name of the buffer for server responses."
:type '(choice (const :tag "None" nil) :type '(choice (const :tag "None" nil)
string) string)
:group 'empc-debug) :group 'empc-debug)
(defconst empc-buffer-name "*empc-process*" (defconst empc-buffer-name "*empc-process*"
@ -110,22 +110,22 @@ Leave the idle state beforehand if necessary."
(when (empc-process object) (when (empc-process object)
(when command (when command
(with-current-buffer (empc-log object) (with-current-buffer (empc-log object)
(goto-char (point-max)) (goto-char (point-max))
(insert command))) (insert command)))
(if (empc-queue object) (if (empc-queue object)
(when (string= (empc-queue-head-command object) "idle\n") (when (string= (empc-queue-head-command object) "idle\n")
(setcar (caaar object) "noidle\n") (setcar (caaar object) "noidle\n")
(process-send-string (empc-process object) "noidle\n")) (process-send-string (empc-process object) "noidle\n"))
(when command (when command
(process-send-string (empc-process object) command)))) (process-send-string (empc-process object) command))))
(setcar (car object) (setcar (car object)
(nconc (empc-queue object) (nconc (empc-queue object)
(list (cons command (cons closure fn)))))) (list (cons command (cons closure fn))))))
(defun empc-queue-sync (object) (defun empc-queue-sync (object)
"Empty object's queue synchronously." "Empty object's queue synchronously."
(while (and (not (string= (empc-queue-head-command object) "idle\n")) (while (and (not (string= (empc-queue-head-command object) "idle\n"))
(accept-process-output (empc-process object) 10)))) (accept-process-output (empc-process object) 10))))
(defun empc-queue-pop (object) (defun empc-queue-pop (object)
"Pop the head of the queue then send the next command. "Pop the head of the queue then send the next command.
@ -133,19 +133,19 @@ If there is no command left to send, put the client in idle state."
(setcar (car object) (cdr (empc-queue object))) (setcar (car object) (cdr (empc-queue object)))
(if (empc-queue object) (if (empc-queue object)
(progn (progn
(when (> (length (empc-queue object)) 1) (when (> (length (empc-queue object)) 1)
(empc-queue-merge object)) (empc-queue-merge object))
(when (empc-queue-head-command object) (when (empc-queue-head-command object)
(process-send-string (empc-process object) (empc-queue-head-command object)))) (process-send-string (empc-process object) (empc-queue-head-command object))))
(empc-queue-push object "idle\n" 'empc-response-idle 'empc-handle-response))) (empc-queue-push object "idle\n" 'empc-response-idle 'empc-handle-response)))
(defun empc-queue-merge (object) (defun empc-queue-merge (object)
"Merge all commands in the queue as a single command_list." "Merge all commands in the queue as a single command_list."
(let ((command "command_list_ok_begin\n") (let ((command "command_list_ok_begin\n")
(closures nil)) (closures nil))
(setq closures (dolist (cell (empc-queue object) (reverse closures)) (setq closures (dolist (cell (empc-queue object) (reverse closures))
(setq command (concat command (car cell))) (setq command (concat command (car cell)))
(setq closures (cons (cadr cell) closures)))) (setq closures (cons (cadr cell) closures))))
(setq command (concat command "command_list_end\n")) (setq command (concat command "command_list_end\n"))
(setcar (car object) (list (cons command (cons closures 'empc-handle-response-list)))))) (setcar (car object) (list (cons command (cons closures 'empc-handle-response-list))))))
@ -166,18 +166,18 @@ If there is no command left to send, put the client in idle state."
(defun empc-update-playlistsongs (object) (defun empc-update-playlistsongs (object)
"Fix songs position in the playlist." "Fix songs position in the playlist."
(let ((i 0) (let ((i 0)
hash-items) hash-items)
(mapcar (lambda (id) (mapcar (lambda (id)
(puthash id (plist-put (empc-song-by-id object id) :pos i) (empc-playlist-songs object)) (puthash id (plist-put (empc-song-by-id object id) :pos i) (empc-playlist-songs object))
(incf i)) (incf i))
(empc-playlist object)) (empc-playlist object))
(let ((playlist-items (append (empc-playlist object) nil))) (let ((playlist-items (append (empc-playlist object) nil)))
(maphash (lambda (key value) (maphash (lambda (key value)
(unless (memq key playlist-items) (unless (memq key playlist-items)
(setq hash-items (cons key hash-items)))) (setq hash-items (cons key hash-items))))
(empc-playlist-songs object))) (empc-playlist-songs object)))
(mapcar (lambda (id) (mapcar (lambda (id)
(remhash id (empc-playlist-songs object))) hash-items))) (remhash id (empc-playlist-songs object))) hash-items)))
(defun empc-create (name buffer host service) (defun empc-create (name buffer host service)
"Create and return a new object for empc. The parameters are as follows: "Create and return a new object for empc. The parameters are as follows:
@ -192,15 +192,15 @@ SERVICE is the name of the service desired, or an integer specifying
a port number to connect to." a port number to connect to."
(let* ((process (open-network-stream name buffer host service)) (let* ((process (open-network-stream name buffer host service))
(object `((nil ,process ,(generate-new-buffer "*empc-log*") . ("password" "commands" "status" "playlistinfo" "idle")) nil nil))) ;; this weird form represents an empty object as described in empc-object (object `((nil ,process ,(generate-new-buffer "*empc-log*") . ("password" "commands" "status" "playlistinfo" "idle")) nil nil))) ;; this weird form represents an empty object as described in empc-object
; (empc-commands-set object '("password" "commands" "status" "playlistinfo" "idle")) ; (empc-commands-set object '("password" "commands" "status" "playlistinfo" "idle"))
(empc-queue-push object nil nil `(lambda (command closure msg) (empc-queue-push object nil nil `(lambda (command closure msg)
(message "Connection to %s established" ',host))) (message "Connection to %s established" ',host)))
(set-process-filter process `(lambda (proc string) (set-process-filter process `(lambda (proc string)
(empc-process-filter ',object string))) (empc-process-filter ',object string)))
(set-process-sentinel process 'empc-process-sentinel) (set-process-sentinel process 'empc-process-sentinel)
(if (fboundp 'set-process-query-on-exit-flag) (if (fboundp 'set-process-query-on-exit-flag)
(set-process-query-on-exit-flag process nil) (set-process-query-on-exit-flag process nil)
(process-kill-without-query process)) (process-kill-without-query process))
(set-process-coding-system process 'utf-8-unix 'utf-8-unix) (set-process-coding-system process 'utf-8-unix 'utf-8-unix)
(buffer-disable-undo (process-buffer process)) (buffer-disable-undo (process-buffer process))
@ -222,10 +222,10 @@ You can use the following already defined variables:
genre, composer, performer, disc, comment, pos, full-pos.") genre, composer, performer, disc, comment, pos, full-pos.")
(defvar empc-mode-line-format '((if (string= state "play") (defvar empc-mode-line-format '((if (string= state "play")
(concat " [" pos "/" playlistlength "] " (if (and artist title) (concat " [" pos "/" playlistlength "] " (if (and artist title)
(concat artist " - " title) (concat artist " - " title)
file)) file))
(concat " " state))) (concat " " state)))
"Format used to display empc state in mode-line. "Format used to display empc state in mode-line.
The construction is the same as `mode-line-format'. The construction is the same as `mode-line-format'.
You can use the following already defined variables: You can use the following already defined variables:
@ -247,19 +247,19 @@ For status:
"Return a string representing a song formatted for the playlist buffer." "Return a string representing a song formatted for the playlist buffer."
(when song (when song
(concat (empc-time-to-string (plist-get song :time)) "\t" (concat (empc-time-to-string (plist-get song :time)) "\t"
(if (and (plist-member song :artist) (plist-member song :title)) (if (and (plist-member song :artist) (plist-member song :title))
(concat (plist-get song :artist) " - " (plist-get song :title)) (concat (plist-get song :artist) " - " (plist-get song :title))
(plist-get song :file))))) (plist-get song :file)))))
(defun empc-mode-line-to-string () (defun empc-mode-line-to-string ()
"Return a string to write to the mode-line." "Return a string to write to the mode-line."
(if (eq (empc-status-get empc-object :state) 'play) (if (eq (empc-status-get empc-object :state) 'play)
(concat " [" (number-to-string (1+ (empc-status-get empc-object :song))) "/" (number-to-string (empc-status-get empc-object :playlistlength)) "] " (concat " [" (number-to-string (1+ (empc-status-get empc-object :song))) "/" (number-to-string (empc-status-get empc-object :playlistlength)) "] "
(if (and (plist-member (empc-current-song empc-object) :artist) (if (and (plist-member (empc-current-song empc-object) :artist)
(plist-member (empc-current-song empc-object) :title)) (plist-member (empc-current-song empc-object) :title))
(concat (plist-get (empc-current-song empc-object) :artist) (concat (plist-get (empc-current-song empc-object) :artist)
" - " (plist-get (empc-current-song empc-object) :title)) " - " (plist-get (empc-current-song empc-object) :title))
(plist-get (empc-current-song empc-object) :file))) (plist-get (empc-current-song empc-object) :file)))
(concat " " (symbol-name (empc-status-get empc-object :state))))) (concat " " (symbol-name (empc-status-get empc-object :state)))))
(defvar empc-last-crossfade nil) (defvar empc-last-crossfade nil)
@ -300,11 +300,11 @@ For status:
(defun empc-process-filter (object string) (defun empc-process-filter (object string)
"Append STRING to the process buffer then process the data." "Append STRING to the process buffer then process the data."
(let ((debug-on-error t) (let ((debug-on-error t)
(buffer (process-buffer (empc-process object)))) (buffer (process-buffer (empc-process object))))
(when (buffer-live-p buffer) (when (buffer-live-p buffer)
(with-current-buffer buffer (with-current-buffer buffer
(goto-char (point-max)) (goto-char (point-max))
(insert string)) (insert string))
(empc-process-buffer object)))) (empc-process-buffer object))))
(defun empc-process-buffer (object) (defun empc-process-buffer (object)
@ -313,39 +313,39 @@ For status:
stored at the head of the queue with the associated closure and stored at the head of the queue with the associated closure and
the output as parameters." the output as parameters."
(let ((buffer (process-buffer (empc-process object))) (let ((buffer (process-buffer (empc-process object)))
(complete-response)) (complete-response))
(when (buffer-live-p buffer) (when (buffer-live-p buffer)
(with-current-buffer buffer (with-current-buffer buffer
(unless (= 0 (buffer-size)) (unless (= 0 (buffer-size))
(if (not (empc-queue object)) (if (not (empc-queue object))
(let ((buf (generate-new-buffer "*spurious*"))) (let ((buf (generate-new-buffer "*spurious*")))
(copy-to-buffer buf (point-min) (point-max)) (copy-to-buffer buf (point-min) (point-max))
(delete-region (point-min) (point)) (delete-region (point-min) (point))
(pop-to-buffer buf nil) (pop-to-buffer buf nil)
(error "Spurious communication from process %s, see buffer %s" (error "Spurious communication from process %s, see buffer %s"
(process-name (empc-process object)) (process-name (empc-process object))
(buffer-name buf))) (buffer-name buf)))
(goto-char (point-min)) (goto-char (point-min))
(when (re-search-forward empc-response-regexp nil t) (when (re-search-forward empc-response-regexp nil t)
(setq complete-response (buffer-substring (point-min) (point))) (setq complete-response (buffer-substring (point-min) (point)))
(delete-region (point-min) (point))))))) (delete-region (point-min) (point)))))))
(when complete-response (when complete-response
(unwind-protect (unwind-protect
(funcall (empc-queue-head-fn object) (funcall (empc-queue-head-fn object)
(empc-queue-head-command object) (empc-queue-head-command object)
(empc-queue-head-closure object) complete-response) (empc-queue-head-closure object) complete-response)
(empc-queue-pop object)) (empc-queue-pop object))
(empc-process-buffer object)))) (empc-process-buffer object))))
(defun empc-stream-process-sentinel (proc event) (defun empc-stream-process-sentinel (proc event)
"Process sentinel for `empc-stream-process'." "Process sentinel for `empc-stream-process'."
(let ((debug-on-error t) (let ((debug-on-error t)
(process (empc-process empc-object))) (process (empc-process empc-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 empc-object :state) 'play))
(empc-toggle-pause 1))) (empc-toggle-pause 1)))
(setq empc-stream-process nil)) (setq empc-stream-process nil))
@ -353,8 +353,8 @@ For status:
"Print the response into the minibuffer if EMPC-VERBOSE is non nil." "Print the response into the minibuffer if EMPC-VERBOSE is non nil."
(when empc-verbose (when empc-verbose
(message "empc: %s" (if (string= (substring msg -1) "\n") (message "empc: %s" (if (string= (substring msg -1) "\n")
(substring msg 0 -1) (substring msg 0 -1)
msg)))) msg))))
(defun empc-echo-notify (msg) (defun empc-echo-notify (msg)
"Notify MSG using notification system if available, in echo area if not." "Notify MSG using notification system if available, in echo area if not."
@ -369,10 +369,10 @@ For status:
(setq song (empc-current-song empc-object))) (setq song (empc-current-song empc-object)))
(when song (when song
(empc-echo-notify (concat "[" (int-to-string (+ (plist-get song :pos) 1)) (empc-echo-notify (concat "[" (int-to-string (+ (plist-get song :pos) 1))
"/" (int-to-string (empc-status-get empc-object :playlistlength)) "] " "/" (int-to-string (empc-status-get empc-object :playlistlength)) "] "
(if (and (plist-get song :artist) (plist-get song :title)) (if (and (plist-get song :artist) (plist-get song :title))
(concat (plist-get song :artist) " - " (plist-get song :title)) (concat (plist-get song :artist) " - " (plist-get song :title))
(plist-get song :file)))))) (plist-get song :file))))))
(defun empc-mode-line-update () (defun empc-mode-line-update ()
"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."
@ -385,7 +385,7 @@ If the line is not of the form \"key: value\",
check if it matches \"list_OK\"." check if it matches \"list_OK\"."
(if (string-match "\\([^:\n]+\\):\\s-*\\(.+\\)" line) (if (string-match "\\([^:\n]+\\):\\s-*\\(.+\\)" line)
(cons (downcase (match-string 1 line)) (cons (downcase (match-string 1 line))
(match-string 2 line)) (match-string 2 line))
(string= line "list_OK"))) (string= line "list_OK")))
(defun empc-response-parse-message (msg) (defun empc-response-parse-message (msg)
@ -394,23 +394,23 @@ If the command resulted in an error, return a plist of the
form '('error (error-code . error-message))." form '('error (error-code . error-message))."
(save-match-data (save-match-data
(let* ((data (split-string msg "\n" t)) (let* ((data (split-string msg "\n" t))
(status (car (last data)))) (status (car (last data))))
(when (and (stringp (car data)) (when (and (stringp (car data))
(string-match "^OK\\( MPD \\)?" (car data))) (string-match "^OK\\( MPD \\)?" (car data)))
(setq data (cdr data))) (setq data (cdr data)))
(if (and (stringp status) (if (and (stringp status)
(string-match "^ACK \\[\\([0-9]+\\)@[0-9]+\\] \\(.+\\)" status)) (string-match "^ACK \\[\\([0-9]+\\)@[0-9]+\\] \\(.+\\)" status))
(cons 'error (cons (match-string 1 status) (cons 'error (cons (match-string 1 status)
(match-string 2 status))) (match-string 2 status)))
(let ((result nil) (let ((result nil)
(response nil)) (response nil))
(dolist (line data (if result (reverse result) response)) (dolist (line data (if result (reverse result) response))
(let ((cell (empc-response-parse-line line))) (let ((cell (empc-response-parse-line line)))
(when cell (when cell
(if (consp cell) (if (consp cell)
(setq response (cons cell response)) (setq response (cons cell response))
(setq result (cons response result) (setq result (cons response result)
response nil)))))))))) response nil))))))))))
(defun empc-response-get-commands (command data) (defun empc-response-get-commands (command data)
"Parse DATA to get the available commands." "Parse DATA to get the available commands."
@ -430,34 +430,34 @@ 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 ((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 () (setq notify '(lambda ()
(when (empc-playlist-songs empc-object) (when (empc-playlist-songs empc-object)
(empc-echo-song)) (empc-echo-song))
(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 empc-object)
(empc-echo-song))))) (empc-echo-song)))))
(empc-stream-start)) (empc-stream-start))
(setq notify '(lambda () (empc-echo-notify (symbol-name (plist-get status-diff :state))))))) (setq notify '(lambda () (empc-echo-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 empc-object) :repeat)
(empc-status-on/off-stringify (empc-status empc-object) :random) (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) :single)
(empc-status-on/off-stringify (empc-status empc-object) :consume) (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 empc-object) :xfade))))))
(while status-diff (while status-diff
(let ((attr (car status-diff)) (let ((attr (car status-diff))
(value (cadr status-diff))) (value (cadr status-diff)))
(setq status-diff (cddr status-diff)) (setq status-diff (cddr status-diff))
(empc-status-put empc-object attr value))) (empc-status-put empc-object attr value)))
(when (empc-playlist-songs empc-object) (when (empc-playlist-songs empc-object)
(empc-mode-line-update)) (empc-mode-line-update))
(when notify (when notify
@ -468,35 +468,35 @@ According to what is in the diff, several actions can be performed:
(cond (cond
((eq value nil) nil) ((eq value nil) nil)
((memq attr '(:volume :repeat :random :single :consume :playlist :playlistlength ((memq attr '(:volume :repeat :random :single :consume :playlist :playlistlength
:song :songid :nextsong :nextsongid :bitrate :xfade :mixrampdb :song :songid :nextsong :nextsongid :bitrate :xfade :mixrampdb
:mixrampdelay :updating_db)) :mixrampdelay :updating_db))
(string-to-number value)) (string-to-number value))
((and (eq attr :state) (member value '("play" "pause" "stop"))) ((and (eq attr :state) (member value '("play" "pause" "stop")))
(intern value)) (intern value))
((and (eq attr :time) (string-match "^\\([0-9]*\\):\\([0-9]*\\)$" value)) ((and (eq attr :time) (string-match "^\\([0-9]*\\):\\([0-9]*\\)$" value))
(cons (string-to-number (match-string 1 value)) (cons (string-to-number (match-string 1 value))
(string-to-number (match-string 2 value)))) (string-to-number (match-string 2 value))))
(t value))) (t value)))
(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 ((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)))
(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 empc-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)))))))
(defun empc-playlist-get-songs (begin &optional end) (defun empc-playlist-get-songs (begin &optional end)
"Retreive a list of songs' id between BEGIN and END." "Retreive a list of songs' id between BEGIN and END."
(when (eq major-mode 'empc-playlist-mode) (when (eq major-mode 'empc-playlist-mode)
(let* ((bpos (1- (line-number-at-pos begin))) (let* ((bpos (1- (line-number-at-pos begin)))
(epos (if end (count-lines begin end) 1)) (epos (if end (count-lines begin end) 1))
ids) ids)
(dotimes (i epos ids) (dotimes (i epos ids)
(setq ids (cons (empc-song-by-pos empc-object (+ bpos i)) ids)))))) (setq ids (cons (empc-song-by-pos empc-object (+ bpos i)) ids))))))
(defun empc-playlist-goto-current-song () (defun empc-playlist-goto-current-song ()
"Put point at currently playing song." "Put point at currently playing song."
@ -504,22 +504,22 @@ According to what is in the diff, several actions can be performed:
(when (get-buffer "*empc*") (when (get-buffer "*empc*")
(let ((buffer nil)) (let ((buffer nil))
(unless (called-interactively-p) (unless (called-interactively-p)
(dolist (frame (frame-list)) (dolist (frame (frame-list))
(with-selected-frame frame (with-selected-frame frame
(let ((bwindow (get-buffer-window "*empc*"))) (let ((bwindow (get-buffer-window "*empc*")))
(when bwindow (when bwindow
(with-selected-window bwindow (with-selected-window bwindow
(goto-char (point-min)) (goto-char (point-min))
(forward-line (empc-status-get empc-object :song)) (forward-line (empc-status-get empc-object :song))
(when (and (not buffer) empc-may-pulse) (when (and (not buffer) empc-may-pulse)
(pulse-momentary-highlight-one-line (point)))) (pulse-momentary-highlight-one-line (point))))
(setq buffer bwindow)))))) (setq buffer bwindow))))))
(unless buffer (unless buffer
(with-current-buffer "*empc*" (with-current-buffer "*empc*"
(goto-char (point-min)) (goto-char (point-min))
(forward-line (empc-status-get empc-object :song)) (forward-line (empc-status-get empc-object :song))
(when (and (called-interactively-p) empc-may-pulse) (when (and (called-interactively-p) empc-may-pulse)
(pulse-momentary-highlight-one-line (point)))))))) (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."
@ -528,9 +528,9 @@ According to what is in the diff, several actions can be performed:
(let ((buffer-read-only nil)) (let ((buffer-read-only nil))
(erase-buffer) (erase-buffer)
(when (empc-playlist-songs empc-object) (when (empc-playlist-songs empc-object)
(mapcar (lambda (id) (mapcar (lambda (id)
(empc-playlist-insert-song (empc-song-by-id empc-object id))) (empc-playlist-insert-song (empc-song-by-id empc-object id)))
(empc-playlist empc-object)))))) (empc-playlist empc-object))))))
(defmacro empc-with-current-playlist (&rest body) (defmacro empc-with-current-playlist (&rest body)
"Set the playlist buffer as the current one." "Set the playlist buffer as the current one."
@ -538,7 +538,7 @@ According to what is in the diff, several actions can be performed:
(empc-switch-to-playlist) (empc-switch-to-playlist)
(save-excursion (save-excursion
(let ((buffer-read-only nil)) (let ((buffer-read-only nil))
,@body)))) ,@body))))
(defmacro empc-with-song-at-point (song &rest body) (defmacro empc-with-song-at-point (song &rest body)
"Retreive the song at point if applicable." "Retreive the song at point if applicable."
@ -553,7 +553,7 @@ According to what is in the diff, several actions can be performed:
(let ((needed-lines (forward-line (plist-get song :pos)))) (let ((needed-lines (forward-line (plist-get song :pos))))
(when (or (> needed-lines 0) (eq (point) (point-max))) (when (or (> needed-lines 0) (eq (point) (point-max)))
(dotimes (i (1+ needed-lines)) (dotimes (i (1+ needed-lines))
(insert "\n")) (insert "\n"))
(forward-line -1))) (forward-line -1)))
(kill-region (line-beginning-position) (line-end-position)) (kill-region (line-beginning-position) (line-end-position))
(insert (empc-song-to-string song)))) (insert (empc-song-to-string song))))
@ -562,12 +562,12 @@ According to what is in the diff, several actions can be performed:
"Kill SONG from the playlist." "Kill SONG from the playlist."
(empc-with-current-playlist (empc-with-current-playlist
(let ((songs (if (listp (car song)) song (let ((songs (if (listp (car song)) song
(list song)))) (list song))))
(mapcar (lambda (song) (mapcar (lambda (song)
(goto-char (point-min)) (goto-char (point-min))
(forward-line (plist-get song :pos)) (forward-line (plist-get song :pos))
(kill-line 1)) (kill-line 1))
songs)))) songs))))
(defun empc-playlist-clean-after-playlist (pos) (defun empc-playlist-clean-after-playlist (pos)
"Kill all the songs appearing in the playlist buffer that are "Kill all the songs appearing in the playlist buffer that are
@ -582,19 +582,19 @@ According to what is in the diff, several actions can be performed:
active." active."
(interactive) (interactive)
(let (ids (let (ids
(songs (if (and mark-active (use-region-p)) (songs (if (and mark-active (use-region-p))
(call-interactively (lambda (begin end) (call-interactively (lambda (begin end)
(interactive "r") (interactive "r")
(empc-playlist-get-songs begin end))) (empc-playlist-get-songs begin end)))
(empc-playlist-get-songs (point))))) (empc-playlist-get-songs (point)))))
(when songs (when songs
(mapcar (lambda (song) (mapcar (lambda (song)
(empc-send-deleteid (plist-get song :id)) (empc-send-deleteid (plist-get song :id))
(empc-playlist-kill-song song) (empc-playlist-kill-song song)
(setq ids (cons (plist-get song :id) ids))) (setq ids (cons (plist-get song :id) ids)))
songs) songs)
(empc-playlist-set empc-object (delete-if (lambda (id) (memq id ids)) (empc-playlist-set empc-object (delete-if (lambda (id) (memq id ids))
(empc-playlist empc-object))) (empc-playlist empc-object)))
(empc-update-playlistsongs empc-object)))) (empc-update-playlistsongs empc-object))))
(defun empc-response-get-playlist (command data) (defun empc-response-get-playlist (command data)
@ -602,22 +602,22 @@ According to what is in the diff, several actions can be performed:
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'."
(let* ((playlist-songs (make-hash-table :rehash-threshold 1.0 :size (empc-status-get empc-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 empc-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)
(let ((field (intern (concat ":" (car cell))))) (let ((field (intern (concat ":" (car cell)))))
(when (and (eq field :id) song) (when (and (eq field :id) song)
(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 song nil) (setq song nil)
(decf index)) (decf index))
(cond (cond
((memq field '(:time :track :date :pos :id)) ((memq field '(:time :track :date :pos :id))
(setq song (plist-put song field (string-to-number (cdr cell))))) (setq song (plist-put song field (string-to-number (cdr cell)))))
(t (if (plist-get song field) (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 (concat (plist-get song field) ", " (cdr cell))))
(setq song (plist-put song field (cdr cell)))))))) (setq song (plist-put song field (cdr cell))))))))
(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)))
@ -630,12 +630,12 @@ songs order is kept into an avector `empc-current-playlist'."
(let (song) (let (song)
(dolist (cell data song) (dolist (cell data song)
(let ((field (intern (concat ":" (car cell))))) (let ((field (intern (concat ":" (car cell)))))
(cond (cond
((memq field '(:time :track :date :pos :id)) ((memq field '(:time :track :date :pos :id))
(setq song (plist-put song field (string-to-number (cdr cell))))) (setq song (plist-put song field (string-to-number (cdr cell)))))
(t (if (plist-get song field) (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 (concat (plist-get song field) ", " (cdr cell))))
(setq song (plist-put song field (cdr cell)))))))))) (setq song (plist-put song field (cdr cell))))))))))
(defun empc-response-get-playlistid (command data) (defun empc-response-get-playlistid (command data)
"Parse a single song and insert it into playlist-songs." "Parse a single song and insert it into playlist-songs."
@ -649,39 +649,39 @@ songs order is kept into an avector `empc-current-playlist'."
(empc-send command 'empc-response-get-plchangesposid) (empc-send command 'empc-response-get-plchangesposid)
(let ((new-pl (make-vector (empc-status-get empc-object :playlistlength) nil))) (let ((new-pl (make-vector (empc-status-get empc-object :playlistlength) nil)))
(dotimes (i (min (length new-pl) (length (empc-playlist empc-object)))) (dotimes (i (min (length new-pl) (length (empc-playlist empc-object))))
(aset new-pl i (aref (empc-playlist empc-object) i))) (aset new-pl i (aref (empc-playlist empc-object) i)))
(empc-playlist-clean-after-playlist (length new-pl)) (empc-playlist-clean-after-playlist (length new-pl))
(empc-playlist-set empc-object new-pl) (empc-playlist-set empc-object new-pl)
(while data (while data
(let ((id (string-to-number (cdar data))) (let ((id (string-to-number (cdar data)))
(cpos (string-to-number (cdadr data)))) (cpos (string-to-number (cdadr data))))
(setq data (cddr data)) (setq data (cddr data))
(let ((song (gethash id (empc-playlist-songs empc-object)))) (let ((song (gethash id (empc-playlist-songs empc-object))))
(if (not song) (if (not song)
(empc-send-playlistid id) (empc-send-playlistid id)
(puthash id (setq song (plist-put song :pos cpos)) (empc-playlist-songs empc-object)) (puthash id (setq song (plist-put song :pos cpos)) (empc-playlist-songs empc-object))
(empc-playlist-insert-song song))) (empc-playlist-insert-song song)))
(aset (empc-playlist empc-object) cpos id)))))) (aset (empc-playlist empc-object) cpos id))))))
(defun empc-response-idle (command data) (defun empc-response-idle (command data)
"React from idle interruption." "React from idle interruption."
(dolist (cell data) (dolist (cell data)
(when (string= (car cell) "changed") (when (string= (car cell) "changed")
(let ((changed (cdr cell))) (let ((changed (cdr cell)))
(cond (cond
((member changed '("player" "options")) ((member changed '("player" "options"))
(empc-send-status)) (empc-send-status))
((member changed '("playlist")) ((member changed '("playlist"))
(empc-send-status) (empc-send-status)
(empc-send-plchangesposid (empc-status-get empc-object :playlist)))))))) (empc-send-plchangesposid (empc-status-get empc-object :playlist))))))))
(defun empc-handle-closure-call (command closures data) (defun empc-handle-closure-call (command closures data)
"If CLOSURES is a list of function, call them in turn with DATA "If CLOSURES is a list of function, call them in turn with DATA
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) (dolist (closure closures)
(funcall closure command data)) (funcall closure command data))
(funcall closures command data)))) (funcall closures command data))))
(defun empc-handle-response (command closures msg) (defun empc-handle-response (command closures msg)
@ -689,7 +689,7 @@ songs order is kept into an avector `empc-current-playlist'."
Check the error code and process it using CLOSURES." Check the error code and process it using CLOSURES."
(let ((data (empc-response-parse-message msg))) (let ((data (empc-response-parse-message msg)))
(if (eq (car data) 'error) (if (eq (car data) 'error)
(empc-echo-notify (cdr data)) (empc-echo-notify (cdr data))
(empc-handle-closure-call command closures data)))) (empc-handle-closure-call command closures data))))
(defun empc-handle-response-list (command closures msg) (defun empc-handle-response-list (command closures msg)
@ -697,13 +697,13 @@ Check the error code and process it using CLOSURES."
Check the error code and process the different responses to the Check the error code and process the different responses to the
commands send as command_list." commands send as command_list."
(let ((data (empc-response-parse-message msg)) (let ((data (empc-response-parse-message msg))
(commands (cdr (split-string command "\n")))) (commands (cdr (split-string command "\n"))))
(if (eq (car data) 'error) (if (eq (car data) 'error)
(empc-echo-notify (cddr data)) (empc-echo-notify (cddr data))
(dolist (closure closures) (dolist (closure closures)
(empc-handle-closure-call (car commands) closure (car data)) (empc-handle-closure-call (car commands) closure (car data))
(setq commands (cdr commands)) (setq commands (cdr commands))
(setq data (cdr data)))))) (setq data (cdr data))))))
(defun empc-mode-line (arg) (defun empc-mode-line (arg)
"Add empc info to the mode-line if ARG is non-nil, remove if "Add empc info to the mode-line if ARG is non-nil, remove if
@ -728,8 +728,8 @@ Send the password or retrieve available commands."
"Make sure empc is connected and ready to talk to mpd." "Make sure empc is connected and ready to talk to mpd."
(let ((process (empc-process empc-object))) (let ((process (empc-process empc-object)))
(unless (and process (unless (and process
(processp process) (processp process)
(eq (process-status process) 'open)) (eq (process-status process) 'open))
(setq empc-object (empc-create "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))
(empc-initialize)))) (empc-initialize))))
@ -757,7 +757,7 @@ Send the password or retrieve available commands."
(when (get-buffer "*empc*") (when (get-buffer "*empc*")
(kill-buffer "*empc*")) (kill-buffer "*empc*"))
(setq empc-object nil (setq empc-object 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…)."
@ -772,17 +772,17 @@ CLOSURE will be called on the parsed response."
(empc-ensure-connected) (empc-ensure-connected)
(if (member (car (split-string command)) (empc-commands empc-object)) (if (member (car (split-string command)) (empc-commands empc-object))
(progn (progn
(unless (string= (substring command -1) "\n") (unless (string= (substring command -1) "\n")
(setq command (concat command "\n"))) (setq command (concat command "\n")))
(empc-queue-push empc-object command closure (empc-queue-push empc-object command closure
(if handler handler 'empc-handle-response))) (if handler handler 'empc-handle-response)))
(message "empc: Command `%s' is not available (not supported by the server or forbidden to you)" command))) (message "empc: Command `%s' is not available (not supported by the server or forbidden to you)" command)))
(defun empc-send-retry () (defun empc-send-retry ()
"Resend the last command." "Resend the last command."
(empc-send (empc-queue-head-command empc-object) (empc-send (empc-queue-head-command empc-object)
(empc-queue-head-closure empc-object) (empc-queue-head-closure empc-object)
(empc-queue-head-fn empc-object))) (empc-queue-head-fn empc-object)))
(defun empc-send-sync (command &optional closure handler) (defun empc-send-sync (command &optional closure handler)
"Send COMMAND synchronously. That means empc will push the "Send COMMAND synchronously. That means empc will push the
@ -801,7 +801,7 @@ CLOSURE will be called on the parsed response."
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 empc-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 'empc-stream-process-sentinel)
(setq empc-stream-process stream-process)))) (setq empc-stream-process stream-process))))
@ -820,7 +820,7 @@ If the stream process is killed for whatever the reason, pause mpd if possible."
(select-window (get-buffer-window "*empc*"))) (select-window (get-buffer-window "*empc*")))
(t (t
(switch-to-buffer "*empc*"))) (switch-to-buffer "*empc*")))
(empc-playlist-mode)) (empc-playlist-mode))
(defmacro empc-with-updated-status (&rest body) (defmacro empc-with-updated-status (&rest body)
"Update the status and execute the forms in BODY." "Update the status and execute the forms in BODY."
@ -835,8 +835,8 @@ If the stream process is killed for whatever the reason, pause mpd if possible."
(interactive) (interactive)
(let ((debug-on-error t)) (let ((debug-on-error t))
(empc-send (concat ,command (when arg (concat " " (if (stringp arg) (empc-send (concat ,command (when arg (concat " " (if (stringp arg)
arg (number-to-string arg))))) arg (number-to-string arg)))))
,closure)))) ,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."
@ -846,18 +846,18 @@ If the stream process is killed for whatever the reason, pause mpd if possible."
,(concat "Toggle " command ".") ,(concat "Toggle " command ".")
(interactive) (interactive)
(let ((debug-on-error t)) (let ((debug-on-error t))
(if state (if state
(,(intern (concat "empc-send-" command)) (int-to-string state)) (,(intern (concat "empc-send-" command)) (int-to-string state))
(empc-with-updated-status (empc-with-updated-status
(let ((,(if attr attr (let ((,(if attr attr
(intern command)) (intern command))
(empc-status-get empc-object ,(intern (concat ":" (if state-name (empc-status-get empc-object ,(intern (concat ":" (if state-name
state-name state-name
command)))))) command))))))
,(if body ,(if body
`(progn ,@body) `(progn ,@body)
`(,(intern (concat "empc-send-" command)) (% (1+ ,(if attr attr `(,(intern (concat "empc-send-" command)) (% (1+ ,(if attr attr
(intern command))) 2)))))))))) (intern command))) 2))))))))))
;; Querying MPD's status ;; Querying MPD's status
(empc-define-simple-command "clearerror") (empc-define-simple-command "clearerror")
@ -868,13 +868,13 @@ If the stream process is killed for whatever the reason, pause mpd if possible."
;; Playback options ;; Playback options
(empc-define-toggle-command "consume") (empc-define-toggle-command "consume")
(empc-define-toggle-command "crossfade" "xfade" xfade (empc-define-toggle-command "crossfade" "xfade" xfade
(if (= xfade 0) (if (= xfade 0)
(empc-send-crossfade (if empc-last-crossfade (empc-send-crossfade (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")
@ -883,12 +883,12 @@ If the stream process is killed for whatever the reason, pause mpd if possible."
;; Controlling playback ;; Controlling playback
(empc-define-simple-command "next") (empc-define-simple-command "next")
(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-simple-command "playid") (empc-define-simple-command "playid")
(empc-define-simple-command "previous") (empc-define-simple-command "previous")
(empc-define-simple-command "stop") (empc-define-simple-command "stop")