X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/2b0c7330457b8ca42375c92ada7dc7cefb0fa9fb..40ba43b4b71df1d51954bdad071e74243c4aea7c:/lisp/mpc.el diff --git a/lisp/mpc.el b/lisp/mpc.el index 8feddf8829..6c2556b1f3 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -1,4 +1,4 @@ -;;; mpc.el --- A client for the Music Player Daemon -*- coding: utf-8 -*- +;;; mpc.el --- A client for the Music Player Daemon -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2006-2011 Free Software Foundation, Inc. @@ -246,11 +246,12 @@ and HOST defaults to localhost." (process-put proc 'ready t) (unless (eq (match-end 0) (point-max)) (error "Unexpected trailing text")) - (let ((error (match-string 1))) + (let ((error-text (match-string 1))) (delete-region (point) (point-max)) (let ((callback (process-get proc 'callback))) (process-put proc 'callback nil) - (if error (signal 'mpc-proc-error error)) + (if error-text + (process-put proc 'mpc-proc-error error-text)) (funcall callback))))))))) (defun mpc--proc-connect (host) @@ -314,19 +315,23 @@ and HOST defaults to localhost." mpc-proc) (setq mpc-proc (mpc--proc-connect mpc-host)))) +(defun mpc-proc-check (proc) + (let ((error-text (process-get proc 'mpc-proc-error))) + (when error-text + (process-put proc 'mpc-proc-error nil) + (signal 'mpc-proc-error error-text)))) + (defun mpc-proc-sync (&optional proc) "Wait for MPC process until it is idle again. Return the buffer in which the process is/was running." (unless proc (setq proc (mpc-proc))) (unwind-protect - (condition-case err - (progn - (while (and (not (process-get proc 'ready)) - (accept-process-output proc))) - (if (process-get proc 'ready) (process-buffer proc) - ;; (delete-process proc) - (error "No response from MPD"))) - (error (message "MPC: %s" err) (signal (car err) (cdr err)))) + (progn + (while (and (not (process-get proc 'ready)) + (accept-process-output proc))) + (mpc-proc-check proc) + (if (process-get proc 'ready) (process-buffer proc) + (error "No response from MPD"))) (unless (process-get proc 'ready) ;; (debug) (message "Killing hung process") @@ -341,9 +346,7 @@ CMD can be a string which is passed as-is to MPD or a list of strings which will be concatenated with proper quoting before passing them to MPD." (let ((proc (mpc-proc))) (if (and callback (not (process-get proc 'ready))) - (lexical-let ((old (process-get proc 'callback)) - (callback callback) - (cmd cmd)) + (let ((old (process-get proc 'callback))) (process-put proc 'callback (lambda () (funcall old) @@ -359,15 +362,14 @@ which will be concatenated with proper quoting before passing them to MPD." (mapconcat 'mpc--proc-quote-string cmd " ")) "\n"))) (if callback - (lexical-let ((buf (current-buffer)) - (callback callback)) - (process-put proc 'callback - callback - ;; (lambda () - ;; (funcall callback - ;; (prog1 (current-buffer) - ;; (set-buffer buf)))) - )) + ;; (let ((buf (current-buffer))) + (process-put proc 'callback + callback + ;; (lambda () + ;; (funcall callback + ;; (prog1 (current-buffer) + ;; (set-buffer buf))))) + ) ;; If `callback' is nil, we're executing synchronously. (process-put proc 'callback 'ignore) ;; This returns the process's buffer. @@ -402,8 +404,7 @@ which will be concatenated with proper quoting before passing them to MPD." (defun mpc-proc-cmd-to-alist (cmd &optional callback) (if callback - (lexical-let ((buf (current-buffer)) - (callback callback)) + (let ((buf (current-buffer))) (mpc-proc-cmd cmd (lambda () (funcall callback (prog1 (mpc-proc-buf-to-alist (current-buffer)) @@ -522,7 +523,7 @@ to call FUN for any change whatsoever.") (defun mpc-status-refresh (&optional callback) "Refresh `mpc-status'." - (lexical-let ((cb callback)) + (let ((cb callback)) (mpc-proc-cmd (mpc-proc-cmd-list '("status" "currentsong")) (lambda () (mpc--status-callback) @@ -604,7 +605,7 @@ The songs are returned as alists." (cond ((eq tag 'Playlist) ;; Special case for pseudo-tag playlist. - (let ((l (condition-case err + (let ((l (condition-case nil (mpc-proc-buf-to-alists (mpc-proc-cmd (list "listplaylistinfo" value))) (mpc-proc-error @@ -637,7 +638,7 @@ The songs are returned as alists." (mpc-union (mpc-cmd-find tag1 value) (mpc-cmd-find tag2 value)))) (t - (condition-case err + (condition-case nil (mpc-proc-buf-to-alists (mpc-proc-cmd (list "find" (symbol-name tag) value))) (mpc-proc-error @@ -775,7 +776,7 @@ The songs are returned as alists." (defun mpc-cmd-pause (&optional arg callback) "Pause or resume playback of the queue of songs." - (lexical-let ((cb callback)) + (let ((cb callback)) (mpc-proc-cmd (list "pause" arg) (lambda () (mpc-status-refresh) (if cb (funcall cb)))) (unless callback (mpc-proc-sync)))) @@ -839,7 +840,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." (puthash (cons 'Playlist playlist) nil mpc--find-memoize)))) (defun mpc-cmd-update (&optional arg callback) - (lexical-let ((cb callback)) + (let ((cb callback)) (mpc-proc-cmd (if arg (list "update" arg) "update") (lambda () (mpc-status-refresh) (if cb (funcall cb)))) (unless callback (mpc-proc-sync)))) @@ -939,7 +940,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." (defun mpc-tempfiles-clean () (let ((live ())) - (maphash (lambda (k v) (push v live)) mpc-tempfiles-reftable) + (maphash (lambda (_k v) (push v live)) mpc-tempfiles-reftable) (dolist (f mpc-tempfiles) (unless (member f live) (ignore-errors (delete-file f)))) (setq mpc-tempfiles live))) @@ -1088,10 +1089,12 @@ If PLAYLIST is t or nil or missing, use the main playlist." (defvar mpc-tool-bar-map (let ((map (make-sparse-keymap))) (tool-bar-local-item "mpc/prev" 'mpc-prev 'prev map - :enable '(not (equal (cdr (assq 'state mpc-status)) "stop"))) + :enable '(not (equal (cdr (assq 'state mpc-status)) "stop")) + :label "Prev" :vert-only t) ;; FIXME: how can we bind it to the down-event? (tool-bar-local-item "mpc/rewind" 'mpc-rewind 'rewind map :enable '(not (equal (cdr (assq 'state mpc-status)) "stop")) + :label "Rew" :vert-only t :button '(:toggle . (and mpc--faster-toggle-timer (not mpc--faster-toggle-forward)))) ;; We could use a single toggle command for pause/play, with 2 different @@ -1099,20 +1102,26 @@ If PLAYLIST is t or nil or missing, use the main playlist." ;; to be a toggle-button, thus displayed depressed in one of the ;; two states :-( (tool-bar-local-item "mpc/pause" 'mpc-pause 'pause map + :label "Pause" :vert-only t :visible '(equal (cdr (assq 'state mpc-status)) "play") :help "Pause/play") (tool-bar-local-item "mpc/play" 'mpc-play 'play map + :label "Play" :vert-only t :visible '(not (equal (cdr (assq 'state mpc-status)) "play")) :help "Play/pause") ;; FIXME: how can we bind it to the down-event? (tool-bar-local-item "mpc/ffwd" 'mpc-ffwd 'ffwd map :enable '(not (equal (cdr (assq 'state mpc-status)) "stop")) + :label "Ffwd" :vert-only t :button '(:toggle . (and mpc--faster-toggle-timer mpc--faster-toggle-forward))) (tool-bar-local-item "mpc/next" 'mpc-next 'next map + :label "Next" :vert-only t :enable '(not (equal (cdr (assq 'state mpc-status)) "stop"))) - (tool-bar-local-item "mpc/stop" 'mpc-stop 'stop map) + (tool-bar-local-item "mpc/stop" 'mpc-stop 'stop map + :label "Stop" :vert-only t) (tool-bar-local-item "mpc/add" 'mpc-playlist-add 'add map + :label "Add" :vert-only t :help "Append to the playlist") map)) @@ -1163,7 +1172,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." (mpc-status-mode)) (mpc-proc-buffer (mpc-proc) 'status buf)) (if (null songs-win) (pop-to-buffer buf) - (let ((win (split-window songs-win 20 t))) + (let ((_win (split-window songs-win 20 t))) (set-window-dedicated-p songs-win nil) (set-window-buffer songs-win buf) (set-window-dedicated-p songs-win 'soft))))) @@ -1322,7 +1331,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." (setq count before) (setq dir -1)) (goto-char start) - (dotimes (i (1+ (or count 0))) + (dotimes (_i (1+ (or count 0))) (mpc-select-make-overlay) (forward-line dir)))))) (when mpc-tag @@ -1348,6 +1357,16 @@ when constructing the set of constraints." (push (cons tag select) constraints))) constraints)) +(defun mpc-constraints-tag-lookup (buffer-tag constraints) + (let (res) + (dolist (constraint constraints) + (when (or (eq (car constraint) buffer-tag) + (and (string-match "|" (symbol-name buffer-tag)) + (member (symbol-name (car constraint)) + (split-string (symbol-name buffer-tag) "|")))) + (setq res (cdr constraint)))) + res)) + (defun mpc-constraints-restore (constraints) (let ((search (assq 'Search constraints))) (setq mpc--song-search (cadr search)) @@ -1356,10 +1375,10 @@ when constructing the set of constraints." (setq buf (cdr buf)) (when (buffer-live-p buf) (let* ((tag (buffer-local-value 'mpc-tag buf)) - (constraint (assq tag constraints))) + (constraint (mpc-constraints-tag-lookup tag constraints))) (when tag (with-current-buffer buf - (mpc-select-restore (cdr constraint))))))) + (mpc-select-restore constraint)))))) (mpc-selection-refresh)) ;; I don't get the ring.el code. I think it doesn't do what I need, but @@ -1570,7 +1589,7 @@ when constructing the set of constraints." (defvar mpc--changed-selection) (defun mpc-reorder (&optional nodeactivate) - "Reorder entries based on thre currently active selections. + "Reorder entries based on the currently active selections. I.e. split the current browser buffer into a first part containing the entries included in the selection, then a separator, and then the entries not included in the selection. @@ -1977,12 +1996,14 @@ This is used so that they can be compared with `eq', which is needed for (list (get-text-property (point) 'mpc-file) posn)))) (let* ((plbuf (mpc-proc-cmd "playlist")) - (re (concat "^\\([0-9]+\\):" (regexp-quote song-file) "$")) + (re (if song-file + (concat "^\\([0-9]+\\):" (regexp-quote song-file) "$"))) (sn (with-current-buffer plbuf (goto-char (point-min)) - (when (re-search-forward re nil t) + (when (and re (re-search-forward re nil t)) (match-string 1))))) (cond + ((null re) (posn-set-point posn)) ((null sn) (error "This song is not in the playlist")) ((null (with-current-buffer plbuf (re-search-forward re nil t))) ;; song-file only appears once in the playlist: no ambiguity, @@ -2118,12 +2139,12 @@ This is used so that they can be compared with `eq', which is needed for (let ((context-before '()) (context-after '())) (save-excursion - (dotimes (i size) + (dotimes (_i size) (when (re-search-backward "^[0-9]+:\\(.*\\)" nil t) (push (mpc-songs-hashcons (match-string 1)) context-before)))) ;; Skip the actual current song. (forward-line 1) - (dotimes (i size) + (dotimes (_i size) (when (re-search-forward "^[0-9]+:\\(.*\\)" nil t) (push (mpc-songs-hashcons (match-string 1)) context-after))) ;; If there isn't `size' context, then return nil. @@ -2337,7 +2358,7 @@ This is used so that they can be compared with `eq', which is needed for (let* ((currenttime (float-time)) (last-time (- currenttime (car mpc-last-seek-time)))) (if (< last-time (* 0.9 repeat-delay)) - nil ;; Trottle + nil ;; Throttle (let* ((status (if (< last-time 1.0) mpc-status (mpc-cmd-status))) (songid (cdr (assq 'songid status))) @@ -2351,8 +2372,7 @@ This is used so that they can be compared with `eq', which is needed for (mpc-proc-cmd (list "seekid" songid time) 'mpc-status-refresh)))) (let ((status (mpc-cmd-status))) - (lexical-let* ((songid (cdr (assq 'songid status))) - (step step) + (let* ((songid (cdr (assq 'songid status))) (time (if songid (string-to-number (cdr (assq 'time status)))))) (let ((timer (run-with-timer @@ -2389,17 +2409,14 @@ This is used so that they can be compared with `eq', which is needed for (if mpc--faster-toggle-timer (mpc--faster-stop) (mpc-status-refresh) (mpc-proc-sync) - (lexical-let* ((speedup speedup) - songid ;The ID of the currently ffwd/rewinding song. - songnb ;The position of that song in the playlist. - songduration ;The duration of that song. - songtime ;The time of the song last time we ran. - oldtime ;The timeoftheday last time we ran. - prevsongid) ;The song we're in the process leaving. + (let* (songid ;The ID of the currently ffwd/rewinding song. + songduration ;The duration of that song. + songtime ;The time of the song last time we ran. + oldtime ;The timeoftheday last time we ran. + prevsongid) ;The song we're in the process leaving. (let ((fun (lambda () - (let ((newsongid (cdr (assq 'songid mpc-status))) - (newsongnb (cdr (assq 'song mpc-status)))) + (let ((newsongid (cdr (assq 'songid mpc-status)))) (if (and (equal prevsongid newsongid) (not (equal prevsongid songid))) @@ -2450,8 +2467,7 @@ This is used so that they can be compared with `eq', which is needed for (mpc-proc-cmd (list "seekid" songid songtime) 'mpc-status-refresh) - (mpc-proc-error (mpc-status-refresh))))))) - (setq songnb newsongnb))))) + (mpc-proc-error (mpc-status-refresh))))))))))) (setq mpc--faster-toggle-forward (> step 0)) (funcall fun) ;Initialize values. (setq mpc--faster-toggle-timer @@ -2461,13 +2477,13 @@ This is used so that they can be compared with `eq', which is needed for (defvar mpc-faster-speedup 8) -(defun mpc-ffwd (event) +(defun mpc-ffwd (_event) "Fast forward." (interactive (list last-nonmenu-event)) ;; (mpc--faster event 4.0 1) (mpc--faster-toggle mpc-faster-speedup 1)) -(defun mpc-rewind (event) +(defun mpc-rewind (_event) "Fast rewind." (interactive (list last-nonmenu-event)) ;; (mpc--faster event 4.0 -1)