X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/810ef6bcdf43f657e8f40ff5439fe684173c4b24..015b3b3e8ec1330a0bbe3981e7070df8e17c9399:/lisp/mpc.el diff --git a/lisp/mpc.el b/lisp/mpc.el index 5319ea4389..e07511c4f1 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -1,6 +1,6 @@ ;;; mpc.el --- A client for the Music Player Daemon -*- coding: utf-8; lexical-binding: t -*- -;; Copyright (C) 2006-2011 Free Software Foundation, Inc. +;; Copyright (C) 2006-2013 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: multimedia @@ -92,10 +92,10 @@ ;; UI-commands : mpc- ;; internal : mpc-- -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defgroup mpc () - "A Client for the Music Player Daemon." + "Client for the Music Player Daemon (mpd)." :prefix "mpc-" :group 'multimedia :group 'applications) @@ -184,10 +184,7 @@ numerically rather than lexicographically." (abs res)) res)))))))) -(defun mpc-string-prefix-p (str1 str2) - ;; FIXME: copied from pcvs-util.el. - "Tell whether STR1 is a prefix of STR2." - (eq t (compare-strings str2 nil (length str1) str1 nil nil))) +(define-obsolete-function-alias 'mpc-string-prefix-p 'string-prefix-p "24.3") ;; This can speed up mpc--song-search significantly. The table may grow ;; very large, tho. It's only bounded by the fact that it gets flushed @@ -195,24 +192,24 @@ numerically rather than lexicographically." ;; to the fact that MPD tends to disconnect fairly often, although our ;; constant polling often prevents disconnection. (defvar mpc--find-memoize (make-hash-table :test 'equal)) ;; :weakness t -(defvar mpc-tag nil) (make-variable-buffer-local 'mpc-tag) +(defvar-local mpc-tag nil) ;;; Support for the actual connection and MPD command execution ;;;;;;;;;;;; (defcustom mpc-host (concat (or (getenv "MPD_HOST") "localhost") (if (getenv "MPD_PORT") (concat ":" (getenv "MPD_PORT")))) - "Host (and port) where the Music Player Daemon is running. -The format is \"HOST\" or \"HOST:PORT\" where PORT defaults to 6600 -and HOST defaults to localhost." + "Host (and port) where the Music Player Daemon is running. The +format is \"HOST\", \"HOST:PORT\", \"PASSWORD@HOST\" or +\"PASSWORD@HOST:PORT\" where PASSWORD defaults to no password, PORT +defaults to 6600 and HOST defaults to localhost." :type 'string) (defvar mpc-proc nil) (defconst mpc--proc-end-re "^\\(?:OK\\(?: MPD .*\\)?\\|ACK \\(.*\\)\\)\n") -(put 'mpc-proc-error 'error-conditions '(mpc-proc-error error)) -(put 'mpc-proc-error 'error-message "MPD error") +(define-error 'mpc-proc-error "MPD error") (defun mpc--debug (format &rest args) (if (get-buffer "*MPC-debug*") @@ -246,31 +243,44 @@ 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) - (mpc--debug "Connecting to %s..." host) - (with-current-buffer (get-buffer-create (format " *mpc-%s*" host)) - ;; (pop-to-buffer (current-buffer)) - (let (proc) - (while (and (setq proc (get-buffer-process (current-buffer))) - (progn ;; (debug) - (delete-process proc))))) - (erase-buffer) - (let ((port 6600)) - (when (string-match ":[^.]+\\'" host) - (setq port (substring host (1+ (match-beginning 0)))) - (setq host (substring host 0 (match-beginning 0))) - (unless (string-match "[^[:digit:]]" port) - (setq port (string-to-number port)))) + (let ((port 6600) + pass) + + (when (string-match "\\`\\(?:\\(.*\\)@\\)?\\(.*?\\)\\(?::\\(.*\\)\\)?\\'" + host) + (let ((v (match-string 1 host))) + (when (and (stringp v) (not (string= "" v))) + (setq pass v))) + (let ((v (match-string 3 host))) + (setq host (match-string 2 host)) + (when (and (stringp v) (not (string= "" v))) + (setq port + (if (string-match "[^[:digit:]]" v) + (string-to-number v) + v))))) + + (mpc--debug "Connecting to %s:%s..." host port) + (with-current-buffer (get-buffer-create (format " *mpc-%s:%s*" host port)) + ;; (pop-to-buffer (current-buffer)) + (let (proc) + (while (and (setq proc (get-buffer-process (current-buffer))) + (progn ;; (debug) + (delete-process proc))))) + (erase-buffer) (let* ((coding-system-for-read 'utf-8-unix) (coding-system-for-write 'utf-8-unix) - (proc (open-network-stream "MPC" (current-buffer) host port))) + (proc (condition-case err + (open-network-stream "MPC" (current-buffer) host port) + (error (user-error (error-message-string err)))))) (when (processp mpc-proc) ;; Inherit the properties of the previous connection. (let ((plist (process-plist mpc-proc))) @@ -284,7 +294,9 @@ and HOST defaults to localhost." (set-process-query-on-exit-flag proc nil) ;; This may be called within a process filter ;-( (with-local-quit (mpc-proc-sync proc)) - proc)))) + (setq mpc-proc proc) + (when pass + (mpc-proc-cmd (list "password" pass) nil)))))) (defun mpc--proc-quote-string (s) (if (numberp s) (number-to-string s) @@ -294,7 +306,7 @@ and HOST defaults to localhost." (defconst mpc--proc-alist-to-alists-starters '(file directory)) (defun mpc--proc-alist-to-alists (alist) - (assert (or (null alist) + (cl-assert (or (null alist) (memq (caar alist) mpc--proc-alist-to-alists-starters))) (let ((starter (caar alist)) (alists ()) @@ -307,26 +319,31 @@ and HOST defaults to localhost." (if tmp (push (nreverse tmp) alists)) (nreverse alists))) -(defun mpc-proc () - (or (and mpc-proc - (buffer-live-p (process-buffer mpc-proc)) - (not (memq (process-status mpc-proc) '(closed))) - mpc-proc) - (setq mpc-proc (mpc--proc-connect mpc-host)))) +(defun mpc-proc (&optional restart) + (unless (and mpc-proc + (buffer-live-p (process-buffer mpc-proc)) + (not (and restart + (memq (process-status mpc-proc) '(closed))))) + (mpc--proc-connect mpc-host)) + mpc-proc) + +(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") @@ -339,7 +356,7 @@ otherwise return immediately and call CALLBACK with no argument when the command terminates. 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))) + (let ((proc (mpc-proc 'restart))) (if (and callback (not (process-get proc 'ready))) (let ((old (process-get proc 'callback))) (process-put proc 'callback @@ -358,13 +375,13 @@ which will be concatenated with proper quoting before passing them to MPD." "\n"))) (if callback ;; (let ((buf (current-buffer))) - (process-put proc 'callback - callback - ;; (lambda () - ;; (funcall callback - ;; (prog1 (current-buffer) - ;; (set-buffer buf))))) - ) + (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. @@ -404,7 +421,7 @@ which will be concatenated with proper quoting before passing them to MPD." (funcall callback (prog1 (mpc-proc-buf-to-alist (current-buffer)) (set-buffer buf)))))) - ;; (lexical-let ((res nil)) + ;; (let ((res nil)) ;; (mpc-proc-cmd-to-alist cmd (lambda (alist) (setq res alist))) ;; (mpc-proc-sync) ;; res) @@ -455,7 +472,7 @@ to call FUN for any change whatsoever.") (let ((old-status mpc-status)) ;; Update the alist. (setq mpc-status (mpc-proc-buf-to-alist)) - (assert mpc-status) + (cl-assert mpc-status) (unless (equal old-status mpc-status) ;; Run the relevant refresher functions. (dolist (pair mpc-status-callbacks) @@ -474,10 +491,9 @@ to call FUN for any change whatsoever.") (cancel-timer mpc--status-timer) (setq mpc--status-timer nil))) (defun mpc--status-timer-run () - (when (process-get (mpc-proc) 'ready) - (condition-case err - (with-local-quit (mpc-status-refresh)) - (error (message "MPC: %s" err))))) + (with-demoted-errors "MPC: %s" + (when (process-get (mpc-proc) 'ready) + (with-local-quit (mpc-status-refresh))))) (defvar mpc--status-idle-timer nil) (defun mpc--status-idle-timer-start () @@ -503,9 +519,8 @@ to call FUN for any change whatsoever.") (run-with-idle-timer 10 t 'mpc--status-idle-timer-run)))) (defun mpc--status-idle-timer-run () (when (process-get (mpc-proc) 'ready) - (condition-case err - (with-local-quit (mpc-status-refresh)) - (error (message "MPC: %s" err)))) + (with-demoted-errors "MPC: %s" + (with-local-quit (mpc-status-refresh)))) (mpc--status-timer-start)) (defun mpc--status-timers-refresh () @@ -542,7 +557,7 @@ Any call to `mpc-status-refresh' may cause it to be restarted." ;; (defun mpc--queue-pop () ;; (when mpc-queue ;Can be nil if out of sync. ;; (let ((song (car mpc-queue))) -;; (assert song) +;; (cl-assert song) ;; (push (if (and (consp song) (cddr song)) ;; ;; The queue's first element is itself a list of ;; ;; songs, where the first element isn't itself a song @@ -551,7 +566,7 @@ Any call to `mpc-status-refresh' may cause it to be restarted." ;; (prog1 (if (consp song) (cadr song) song) ;; (setq mpc-queue (cdr mpc-queue)))) ;; mpc-queue-back) -;; (assert (stringp (car mpc-queue-back)))))) +;; (cl-assert (stringp (car mpc-queue-back)))))) ;; (defun mpc--queue-refresh () ;; ;; Maintain the queue. @@ -609,7 +624,7 @@ The songs are returned as alists." (i 0)) (mapcar (lambda (s) (prog1 (cons (cons 'Pos (number-to-string i)) s) - (incf i))) + (cl-incf i))) l))) ((eq tag 'Search) (mpc-proc-buf-to-alists @@ -825,8 +840,8 @@ If PLAYLIST is t or nil or missing, use the main playlist." (list "move" song-pos dest-pos)) (if (< song-pos dest-pos) ;; This move has shifted dest-pos by 1. - (decf dest-pos)) - (incf i))) + (cl-decf dest-pos)) + (cl-incf i))) ;; Sort them from last to first, so the renumbering ;; caused by the earlier deletions affect ;; later ones a bit less. @@ -970,8 +985,8 @@ If PLAYLIST is t or nil or missing, use the main playlist." (right-align (match-end 1)) (text (if (eq info 'self) (symbol-name tag) - (case tag - ((Time Duration) + (pcase tag + ((or `Time `Duration) (let ((time (cdr (or (assq 'time info) (assq 'Time info))))) (setq pred (list nil)) ;Just assume it's never eq. (when time @@ -979,12 +994,11 @@ If PLAYLIST is t or nil or missing, use the main playlist." (string-match ":" time)) (substring time (match-end 0)) time))))) - (Cover + (`Cover (let* ((dir (file-name-directory (cdr (assq 'file info)))) (cover (concat dir "cover.jpg")) - (file (condition-case err - (mpc-file-local-copy cover) - (error (message "MPC: %s" err)))) + (file (with-demoted-errors "MPC: %s" + (mpc-file-local-copy cover))) image) ;; (debug) (push `(equal ',dir (file-name-directory (cdr (assq 'file info)))) pred) @@ -1002,7 +1016,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." (mpc-tempfiles-add image tempfile))) (setq size nil) (propertize dir 'display image)))) - (t (let ((val (cdr (assq tag info)))) + (_ (let ((val (cdr (assq tag info)))) ;; For Streaming URLs, there's no other info ;; than the URL in `file'. Pretend it's in `Title'. (when (and (null val) (eq tag 'Title)) @@ -1019,11 +1033,8 @@ If PLAYLIST is t or nil or missing, use the main playlist." (let ((display (if (and size (> (+ postwidth textwidth) size)) - ;; This doesn't even obey double-width chars :-( (propertize - (if (zerop (- size postwidth 1)) - (substring text 0 1) - (concat (substring text 0 (- size postwidth textwidth 1)) "…")) + (truncate-string-to-width text size nil nil "…") 'help-echo text) text))) (when (memq tag '(Artist Album Composer)) ;FIXME: wrong list. @@ -1067,7 +1078,11 @@ If PLAYLIST is t or nil or missing, use the main playlist." (define-key map [C-mouse-2] 'mpc-select-toggle) (define-key map [drag-mouse-2] 'mpc-drag-n-drop) ;; We use `always' because a binding to t is like a binding to nil. - (define-key map [follow-link] 'always) + (define-key map [follow-link] :always) + ;; But follow-link doesn't apply blindly to header-line and + ;; mode-line clicks. + (define-key map [header-line follow-link] 'ignore) + (define-key map [mode-line follow-link] 'ignore) ;; Doesn't work because the first click changes the buffer, so the second ;; is applied elsewhere :-( ;; (define-key map [(double mouse-2)] 'mpc-play-at-point) @@ -1084,10 +1099,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 @@ -1095,20 +1112,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)) @@ -1116,17 +1139,19 @@ If PLAYLIST is t or nil or missing, use the main playlist." "Major mode for the features common to all buffers of MPC." (buffer-disable-undo) (setq buffer-read-only t) - (set (make-local-variable 'tool-bar-map) mpc-tool-bar-map) - (set (make-local-variable 'truncate-lines) t)) + (if (boundp 'tool-bar-map) ; not if --without-x + (setq-local tool-bar-map mpc-tool-bar-map)) + (setq-local truncate-lines t)) ;;; The mpc-status-mode buffer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-derived-mode mpc-status-mode mpc-mode "MPC-Status" "Major mode to display MPC status info." - (set (make-local-variable 'mode-line-format) - '("%e" mode-line-frame-identification mode-line-buffer-identification)) - (set (make-local-variable 'window-area-factor) 3) - (set (make-local-variable 'header-line-format) '("MPC " mpc-volume))) + (setq-local mode-line-format + '("%e" mode-line-frame-identification + mode-line-buffer-identification)) + (setq-local window-area-factor 3) + (setq-local header-line-format '("MPC " mpc-volume))) (defvar mpc-status-buffer-format '("%-5{Time} / %{Duration} %2{Disc--}%4{Track}" "%{Title}" "%{Album}" "%{Artist}" "%128{Cover}")) @@ -1150,14 +1175,15 @@ If PLAYLIST is t or nil or missing, use the main playlist." (defun mpc-status-buffer-show () (interactive) - (let* ((buf (mpc-proc-buffer (mpc-proc) 'status)) - (songs-buf (mpc-proc-buffer (mpc-proc) 'songs)) + (let* ((proc (mpc-proc)) + (buf (mpc-proc-buffer proc 'status)) + (songs-buf (mpc-proc-buffer proc 'songs)) (songs-win (if songs-buf (get-buffer-window songs-buf 0)))) (unless (buffer-live-p buf) (setq buf (get-buffer-create "*MPC-Status*")) (with-current-buffer buf (mpc-status-mode)) - (mpc-proc-buffer (mpc-proc) 'status buf)) + (mpc-proc-buffer proc 'status buf)) (if (null songs-win) (pop-to-buffer buf) (let ((_win (split-window songs-win 20 t))) (set-window-dedicated-p songs-win nil) @@ -1168,8 +1194,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." (defvar mpc-separator-ol nil) -(defvar mpc-select nil) -(make-variable-buffer-local 'mpc-select) +(defvar-local mpc-select nil) (defmacro mpc-select-save (&rest body) "Execute BODY and restore the selection afterwards." @@ -1212,7 +1237,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." (beginning-of-line)) (defun mpc-select-make-overlay () - (assert (not (get-char-property (point) 'mpc-select))) + (cl-assert (not (get-char-property (point) 'mpc-select))) (let ((ol (make-overlay (line-beginning-position) (line-beginning-position 2)))) (overlay-put ol 'mpc-select t) @@ -1248,7 +1273,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." (> (overlay-end ol) (point))) (delete-overlay ol) (push ol ols))) - (assert (= (1+ (length ols)) (length mpc-select))) + (cl-assert (= (1+ (length ols)) (length mpc-select))) (setq mpc-select ols))) ;; We're trying to select *ALL* additionally to others. ((mpc-tagbrowser-all-p) nil) @@ -1276,12 +1301,12 @@ If PLAYLIST is t or nil or missing, use the main playlist." (while (and (zerop (forward-line 1)) (get-char-property (point) 'mpc-select)) (setq end (1+ (point))) - (incf after)) + (cl-incf after)) (goto-char mid) (while (and (zerop (forward-line -1)) (get-char-property (point) 'mpc-select)) (setq start (point)) - (incf before)) + (cl-incf before)) (if (and (= after 0) (= before 0)) ;; Shortening an already minimum-size region: do nothing. nil @@ -1305,13 +1330,13 @@ If PLAYLIST is t or nil or missing, use the main playlist." (start (line-beginning-position))) (while (and (zerop (forward-line 1)) (not (get-char-property (point) 'mpc-select))) - (incf count)) + (cl-incf count)) (unless (get-char-property (point) 'mpc-select) (setq count nil)) (goto-char start) (while (and (zerop (forward-line -1)) (not (get-char-property (point) 'mpc-select))) - (incf before)) + (cl-incf before)) (unless (get-char-property (point) 'mpc-select) (setq before nil)) (when (and before (or (null count) (< before count))) @@ -1344,6 +1369,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)) @@ -1352,10 +1387,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 @@ -1390,27 +1425,25 @@ when constructing the set of constraints." ;;; The TagBrowser mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst mpc-tagbrowser-all-name (propertize "*ALL*" 'face 'italic)) -(defvar mpc-tagbrowser-all-ol nil) -(make-variable-buffer-local 'mpc-tagbrowser-all-ol) -(defvar mpc-tag-name nil) (make-variable-buffer-local 'mpc-tag-name) +(defvar-local mpc-tagbrowser-all-ol nil) +(defvar-local mpc-tag-name nil) (defun mpc-tagbrowser-all-p () (and (eq (point-min) (line-beginning-position)) (equal mpc-tagbrowser-all-name (buffer-substring (point-min) (line-end-position))))) (define-derived-mode mpc-tagbrowser-mode mpc-mode '("MPC-" mpc-tag-name) - (set (make-local-variable 'mode-line-process) '("" mpc-tag-name)) - (set (make-local-variable 'mode-line-format) nil) - (set (make-local-variable 'header-line-format) '("" mpc-tag-name ;; "s" - )) - (set (make-local-variable 'buffer-undo-list) t) + (setq-local mode-line-process '("" mpc-tag-name)) + (setq-local mode-line-format nil) + (setq-local header-line-format '("" mpc-tag-name)) ;; "s" + (setq-local buffer-undo-list t) ) (defun mpc-tagbrowser-refresh () (mpc-select-save (widen) (goto-char (point-min)) - (assert (looking-at (regexp-quote mpc-tagbrowser-all-name))) + (cl-assert (looking-at (regexp-quote mpc-tagbrowser-all-name))) (forward-line 1) (let ((inhibit-read-only t)) (delete-region (point) (point-max)) @@ -1477,7 +1510,7 @@ when constructing the set of constraints." (let* ((newbuf (mpc-tagbrowser-buf tag)) (win (get-buffer-window newbuf 0))) (if win (select-window win) - (if (with-current-buffer (window-buffer (selected-window)) + (if (with-current-buffer (window-buffer) (derived-mode-p 'mpc-tagbrowser-mode)) (setq win (selected-window)) ;; Find a tagbrowser-mode buffer. @@ -1509,14 +1542,14 @@ when constructing the set of constraints." (let ((ol (make-overlay (point) (line-beginning-position 2)))) (overlay-put ol 'face 'region) (overlay-put ol 'evaporate t) - (set (make-local-variable 'mpc-tagbrowser-all-ol) ol)))))) + (setq-local mpc-tagbrowser-all-ol ol)))))) ;; (defvar mpc-constraints nil) (defun mpc-separator (active) ;; Place a separator mark. (unless mpc-separator-ol - (set (make-local-variable 'mpc-separator-ol) - (make-overlay (point) (point))) + (setq-local mpc-separator-ol + (make-overlay (point) (point))) (overlay-put mpc-separator-ol 'after-string (propertize "\n" 'face '(:height 0.05 :inverse-video t)))) @@ -1566,7 +1599,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. @@ -1575,7 +1608,7 @@ Return non-nil if a selection was deactivated." (let ((constraints (mpc-constraints-get-current (current-buffer))) (active 'all)) ;; (unless (equal constraints mpc-constraints) - ;; (set (make-local-variable 'mpc-constraints) constraints) + ;; (setq-local mpc-constraints constraints) (dolist (cst constraints) (let ((vals (apply 'mpc-union (mapcar (lambda (val) @@ -1628,7 +1661,7 @@ Return non-nil if a selection was deactivated." ;;; Hierarchical tagbrowser ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Todo: ;; - Add a button on each dir to open/close it (?) -;; - add the parent dir on the previous line, greyed-out, if it's not +;; - add the parent dir on the previous line, grayed-out, if it's not ;; present (because we're in the non-selected part and the parent is ;; in the selected part). @@ -1642,7 +1675,7 @@ Return non-nil if a selection was deactivated." ;; '(mpc-tagbrowser-dir-hide-prefix)) (define-derived-mode mpc-tagbrowser-dir-mode mpc-tagbrowser-mode '("MPC-" mpc-tag-name) - ;; (set (make-local-variable 'font-lock-defaults) + ;; (setq-local font-lock-defaults ;; '(mpc-tagbrowser-dir-keywords t)) ) @@ -1658,16 +1691,17 @@ Return non-nil if a selection was deactivated." (mpc-event-set-point event) (let ((name (buffer-substring (line-beginning-position) (line-end-position))) - (prop (intern mpc-tag))) - (if (not (member name (process-get (mpc-proc) prop))) - (process-put (mpc-proc) prop - (cons name (process-get (mpc-proc) prop))) - (let ((new (delete name (process-get (mpc-proc) prop)))) + (prop (intern mpc-tag)) + (proc (mpc-proc))) + (if (not (member name (process-get proc prop))) + (process-put proc prop + (cons name (process-get proc prop))) + (let ((new (delete name (process-get proc prop)))) (setq name (concat name "/")) - (process-put (mpc-proc) prop + (process-put proc prop (delq nil (mapcar (lambda (x) - (if (mpc-string-prefix-p name x) + (if (string-prefix-p name x) nil x)) new))))) (mpc-tagbrowser-refresh))) @@ -1675,10 +1709,9 @@ Return non-nil if a selection was deactivated." ;;; Playlist management ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar mpc-songs-playlist nil +(defvar-local mpc-songs-playlist nil "Name of the currently selected playlist, if any. A value of t means the main playlist.") -(make-variable-buffer-local 'mpc-songs-playlist) (defun mpc-playlist-create (name) "Save current playlist under name NAME." @@ -1745,12 +1778,14 @@ A value of t means the main playlist.") (defvar mpc-volume-map (let ((map (make-sparse-keymap))) - (define-key map [down-mouse-1] 'mpc-volume-mouse-set) - (define-key map [mouse-1] 'ignore) - (define-key map [header-line down-mouse-1] 'mpc-volume-mouse-set) - (define-key map [header-line mouse-1] 'ignore) - (define-key map [mode-line down-mouse-1] 'mpc-volume-mouse-set) - (define-key map [mode-line mouse-1] 'ignore) + ;; Bind the up-events rather than the down-event, so the + ;; `message' isn't canceled by the subsequent up-event binding. + (define-key map [down-mouse-1] 'ignore) + (define-key map [mouse-1] 'mpc-volume-mouse-set) + (define-key map [header-line mouse-1] 'mpc-volume-mouse-set) + (define-key map [header-line down-mouse-1] 'ignore) + (define-key map [mode-line mouse-1] 'mpc-volume-mouse-set) + (define-key map [mode-line down-mouse-1] 'ignore) map)) (defvar mpc-volume nil) (put 'mpc-volume 'risky-local-variable t) @@ -1896,7 +1931,7 @@ This is used so that they can be compared with `eq', which is needed for (cdr (assq 'file song1)) (cdr (assq 'file song2))))) (and (integerp cmp) (< cmp 0))))))) - (incf totaltime (string-to-number (or (cdr (assq 'Time song)) "0"))) + (cl-incf totaltime (string-to-number (or (cdr (assq 'Time song)) "0"))) (mpc-format mpc-songs-format song) (delete-char (- (skip-chars-backward " "))) ;Remove trailing space. (insert "\n") @@ -1915,9 +1950,9 @@ This is used so that they can be compared with `eq', which is needed for (search-backward (cdr curline) nil t)) (beginning-of-line) (goto-char (point-min))) - (set (make-local-variable 'mpc-songs-totaltime) - (unless (zerop totaltime) - (list " " (mpc-secs-to-time totaltime)))) + (setq-local mpc-songs-totaltime + (unless (zerop totaltime) + (list " " (mpc-secs-to-time totaltime)))) )))) (let ((mpc-songpointer-set-visible t)) (mpc-songpointer-refresh))) @@ -1973,12 +2008,16 @@ 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 + ;; Newer MPCs apparently include "file: " in the buffer. + (concat "^\\([0-9]+\\):\\(?:file: \\)?" + (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, @@ -2018,52 +2057,53 @@ This is used so that they can be compared with `eq', which is needed for (- (point) (car prev))) next prev) (or next prev))))) - (assert sn) + (cl-assert sn) (mpc-proc-cmd (concat "play " sn)))))))))) (define-derived-mode mpc-songs-mode mpc-mode "MPC-song" (setq mpc-songs-format-description (with-temp-buffer (mpc-format mpc-songs-format 'self) (buffer-string))) - (set (make-local-variable 'header-line-format) - ;; '("MPC " mpc-volume " " mpc-current-song) - (list (propertize " " 'display '(space :align-to 0)) - ;; 'mpc-songs-format-description - '(:eval - (let ((hscroll (window-hscroll))) - (with-temp-buffer - (mpc-format mpc-songs-format 'self hscroll) - ;; That would be simpler than the hscroll handling in - ;; mpc-format, but currently move-to-column does not - ;; recognize :space display properties. - ;; (move-to-column hscroll) - ;; (delete-region (point-min) (point)) - (buffer-string)))))) - (set (make-local-variable 'mode-line-format) - '("%e" mode-line-frame-identification mode-line-buffer-identification - #(" " 0 3 - (help-echo "mouse-1: Select (drag to resize)\nmouse-2: Make current window occupy the whole frame\nmouse-3: Remove current window from display")) - mode-line-position - #(" " 0 2 - (help-echo "mouse-1: Select (drag to resize)\nmouse-2: Make current window occupy the whole frame\nmouse-3: Remove current window from display")) - mpc-songs-totaltime - mpc-current-updating - #(" " 0 2 - (help-echo "mouse-1: Select (drag to resize)\nmouse-2: Make current window occupy the whole frame\nmouse-3: Remove current window from display")) - (mpc--song-search - (:propertize - ("Search=\"" mpc--song-search "\"") - help-echo "mouse-2: kill this search" - follow-link t - mouse-face mode-line-highlight - keymap (keymap (mode-line keymap - (mouse-2 . mpc-songs-kill-search)))) - (:propertize "NoSearch" - help-echo "mouse-2: set a search restriction" - follow-link t - mouse-face mode-line-highlight - keymap (keymap (mode-line keymap (mouse-2 . mpc-songs-search))))))) - - ;; (set (make-local-variable 'mode-line-process) + (setq-local header-line-format + ;; '("MPC " mpc-volume " " mpc-current-song) + (list (propertize " " 'display '(space :align-to 0)) + ;; 'mpc-songs-format-description + '(:eval + (let ((hscroll (window-hscroll))) + (with-temp-buffer + (mpc-format mpc-songs-format 'self hscroll) + ;; That would be simpler than the hscroll handling in + ;; mpc-format, but currently move-to-column does not + ;; recognize :space display properties. + ;; (move-to-column hscroll) + ;; (delete-region (point-min) (point)) + (buffer-string)))))) + (setq-local + mode-line-format + '("%e" mode-line-frame-identification mode-line-buffer-identification + #(" " 0 3 + (help-echo "mouse-1: Select (drag to resize)\nmouse-2: Make current window occupy the whole frame\nmouse-3: Remove current window from display")) + mode-line-position + #(" " 0 2 + (help-echo "mouse-1: Select (drag to resize)\nmouse-2: Make current window occupy the whole frame\nmouse-3: Remove current window from display")) + mpc-songs-totaltime + mpc-current-updating + #(" " 0 2 + (help-echo "mouse-1: Select (drag to resize)\nmouse-2: Make current window occupy the whole frame\nmouse-3: Remove current window from display")) + (mpc--song-search + (:propertize + ("Search=\"" mpc--song-search "\"") + help-echo "mouse-2: kill this search" + follow-link t + mouse-face mode-line-highlight + keymap (keymap (mode-line keymap + (mouse-2 . mpc-songs-kill-search)))) + (:propertize "NoSearch" + help-echo "mouse-2: set a search restriction" + follow-link t + mouse-face mode-line-highlight + keymap (keymap (mode-line keymap (mouse-2 . mpc-songs-search))))))) + + ;; (setq-local mode-line-process ;; '("" ;; mpc-volume " " ;; mpc-songs-totaltime ;; mpc-current-updating)) @@ -2079,7 +2119,7 @@ This is used so that they can be compared with `eq', which is needed for (<= (window-start win) overlay-arrow-position) (< overlay-arrow-position (window-end win))))))) (unless (local-variable-p 'overlay-arrow-position) - (set (make-local-variable 'overlay-arrow-position) (make-marker))) + (setq-local overlay-arrow-position (make-marker))) (move-marker overlay-arrow-position pos) ;; If the arrow was visible, try to keep it that way. (if (and visible pos @@ -2133,12 +2173,12 @@ This is used so that they can be compared with `eq', which is needed for (dolist (song (car context)) (and (zerop (forward-line -1)) (eq (get-text-property (point) 'mpc-file) song) - (incf count))) + (cl-incf count))) (goto-char pos) (dolist (song (cdr context)) (and (zerop (forward-line 1)) (eq (get-text-property (point) 'mpc-file) song) - (incf count))) + (cl-incf count))) count)) (defun mpc-songpointer-refresh-hairy () @@ -2179,13 +2219,13 @@ This is used so that they can be compared with `eq', which is needed for ((< score context-size) nil) (t ;; Score is equal and increasing context might help: try it. - (incf context-size) + (cl-incf context-size) (let ((new-context (mpc-songpointer-context context-size plbuf))) (if (null new-context) ;; There isn't more context: choose one arbitrarily ;; and keep looking for a better match elsewhere. - (decf context-size) + (cl-decf context-size) (setq context new-context) (setq score (mpc-songpointer-score context pos)) (save-excursion @@ -2333,7 +2373,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))) @@ -2387,7 +2427,7 @@ This is used so that they can be compared with `eq', which is needed for (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. + oldtime ;The time of day last time we ran. prevsongid) ;The song we're in the process leaving. (let ((fun (lambda () @@ -2577,12 +2617,11 @@ This is used so that they can be compared with `eq', which is needed for (song-win (get-buffer-window song-buf 0))) (if song-win (select-window song-win) - (if (or (window-dedicated-p (selected-window)) - (window-minibuffer-p)) + (if (or (window-dedicated-p) (window-minibuffer-p)) (ignore-errors (select-frame (make-frame mpc-frame-alist))) (with-current-buffer song-buf - (set (make-local-variable 'mpc-previous-window-config) - (current-window-configuration)))) + (setq-local mpc-previous-window-config + (current-window-configuration)))) (let* ((win1 (selected-window)) (win2 (split-window)) (tags mpc-browser-tags))