mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-08 15:35:02 +00:00
Code Issues Releases Activity

* lisp/mpc.el: Avoid (implicit) eval; prefer #' to quote function names

Browse Source 
(mpc-format): Compose functions instead of constructing
source-code expressions at run time.
Rename `mpc-pred` property to `mpc--uptodate-p`.
(mpc-status-buffer-refresh): Adjust to the new property name.
This commit is contained in:
Stefan Monnier 2021-04-24 15:57:22 -04:00
parent d398eca44e
commit 48b6cec61c
1 changed files with 82 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

158
lisp/mpc.el
View File

@ -183,7 +183,7 @@ numerically rather than lexicographically."
(abs res)) (abs res))
res)))))))) res))))))))
(define-obsolete-function-alias 'mpc-string-prefix-p 'string-prefix-p "24.3") (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 ;; 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 ;; very large, tho. It's only bounded by the fact that it gets flushed
@ -291,11 +291,11 @@ defaults to 6600 and HOST defaults to localhost."
(let ((plist (process-plist mpc-proc))) (let ((plist (process-plist mpc-proc)))
(while plist (process-put proc (pop plist) (pop plist))))) (while plist (process-put proc (pop plist) (pop plist)))))
(mpc-proc-buffer proc 'mpd-commands (current-buffer)) (mpc-proc-buffer proc 'mpd-commands (current-buffer))
(process-put proc 'callback 'ignore) (process-put proc 'callback #'ignore)
(process-put proc 'ready nil) (process-put proc 'ready nil)
(clrhash mpc--find-memoize) (clrhash mpc--find-memoize)
(set-process-filter proc 'mpc--proc-filter) (set-process-filter proc #'mpc--proc-filter)
(set-process-sentinel proc 'ignore) (set-process-sentinel proc #'ignore)
(set-process-query-on-exit-flag proc nil) (set-process-query-on-exit-flag proc nil)
;; This may be called within a process filter ;-( ;; This may be called within a process filter ;-(
(with-local-quit (mpc-proc-sync proc)) (with-local-quit (mpc-proc-sync proc))
@ -376,7 +376,7 @@ which will be concatenated with proper quoting before passing them to MPD."
(mpc--debug "Send \"%s\"" cmd) (mpc--debug "Send \"%s\"" cmd)
(process-send-string (process-send-string
proc (concat (if (stringp cmd) cmd proc (concat (if (stringp cmd) cmd
(mapconcat 'mpc--proc-quote-string cmd " ")) (mapconcat #'mpc--proc-quote-string cmd " "))
"\n"))) "\n")))
(if callback (if callback
;; (let ((buf (current-buffer))) ;; (let ((buf (current-buffer)))
@ -388,7 +388,7 @@ which will be concatenated with proper quoting before passing them to MPD."
;; (set-buffer buf))))) ;; (set-buffer buf)))))
) )
;; If `callback' is nil, we're executing synchronously. ;; If `callback' is nil, we're executing synchronously.
(process-put proc 'callback 'ignore) (process-put proc 'callback #'ignore)
;; This returns the process's buffer. ;; This returns the process's buffer.
(mpc-proc-sync proc))))) (mpc-proc-sync proc)))))
@ -398,7 +398,7 @@ which will be concatenated with proper quoting before passing them to MPD."
(concat "command_list_begin\n" (concat "command_list_begin\n"
(mapconcat (lambda (cmd) (mapconcat (lambda (cmd)
(if (stringp cmd) cmd (if (stringp cmd) cmd
(mapconcat 'mpc--proc-quote-string cmd " "))) (mapconcat #'mpc--proc-quote-string cmd " ")))
cmds cmds
"\n") "\n")
"\ncommand_list_end")) "\ncommand_list_end"))
@ -488,9 +488,9 @@ to call FUN for any change whatsoever.")
(defvar mpc--status-timer nil) (defvar mpc--status-timer nil)
(defun mpc--status-timer-start () (defun mpc--status-timer-start ()
(add-hook 'pre-command-hook 'mpc--status-timer-stop) (add-hook 'pre-command-hook #'mpc--status-timer-stop)
(unless mpc--status-timer (unless mpc--status-timer
(setq mpc--status-timer (run-with-timer 1 1 'mpc--status-timer-run)))) (setq mpc--status-timer (run-with-timer 1 1 #'mpc--status-timer-run))))
(defun mpc--status-timer-stop () (defun mpc--status-timer-stop ()
(when mpc--status-timer (when mpc--status-timer
(cancel-timer mpc--status-timer) (cancel-timer mpc--status-timer)
@ -510,7 +510,7 @@ to call FUN for any change whatsoever.")
;; Turn it off even if we'll start it again, in case it changes the delay. ;; Turn it off even if we'll start it again, in case it changes the delay.
(cancel-timer mpc--status-idle-timer)) (cancel-timer mpc--status-idle-timer))
(setq mpc--status-idle-timer (setq mpc--status-idle-timer
(run-with-idle-timer 1 t 'mpc--status-idle-timer-run)) (run-with-idle-timer 1 t #'mpc--status-idle-timer-run))
;; Typically, the idle timer is started from the mpc--status-callback, ;; Typically, the idle timer is started from the mpc--status-callback,
;; which is run asynchronously while we're already idle (we typically ;; which is run asynchronously while we're already idle (we typically
;; just started idling), so the timer itself will only be run the next ;; just started idling), so the timer itself will only be run the next
@ -525,7 +525,7 @@ to call FUN for any change whatsoever.")
(unless really (unless really
;; We don't completely stop the timer, so that if some other MPD ;; We don't completely stop the timer, so that if some other MPD
;; client starts playback, we may get a chance to notice it. ;; client starts playback, we may get a chance to notice it.
(run-with-idle-timer 10 t 'mpc--status-idle-timer-run)))) (run-with-idle-timer 10 t #'mpc--status-idle-timer-run))))
(defun mpc--status-idle-timer-run () (defun mpc--status-idle-timer-run ()
(mpc--status-timer-start) (mpc--status-timer-start)
(mpc--status-timer-run)) (mpc--status-timer-run))
@ -596,7 +596,7 @@ Any call to `mpc-status-refresh' may cause it to be restarted."
;; (dotimes (i (string-to-number pos)) (mpc--queue-pop)) ;; (dotimes (i (string-to-number pos)) (mpc--queue-pop))
;; (mpc-proc-cmd (mpc-proc-cmd-list ;; (mpc-proc-cmd (mpc-proc-cmd-list
;; (make-list (string-to-number pos) "delete 0")) ;; (make-list (string-to-number pos) "delete 0"))
;; 'ignore) ;; #'ignore)
;; (if (not (equal (cdr (assq 'file mpc-status)) ;; (if (not (equal (cdr (assq 'file mpc-status))
;; (mpc--queue-head))) ;; (mpc--queue-head)))
;; (message "MPC's queue is out of sync")))))) ;; (message "MPC's queue is out of sync"))))))
@ -683,7 +683,7 @@ The songs are returned as alists."
(let ((plsongs (mpc-cmd-find 'Playlist pl))) (let ((plsongs (mpc-cmd-find 'Playlist pl)))
(if (not (mpc-cmd-special-tag-p other-tag)) (if (not (mpc-cmd-special-tag-p other-tag))
(when (member (cons other-tag value) (when (member (cons other-tag value)
(apply 'append plsongs)) (apply #'append plsongs))
(push pl pls)) (push pl pls))
;; Problem N°2: we compute the intersection whereas all ;; Problem N°2: we compute the intersection whereas all
;; we care about is whether it's empty. So we could ;; we care about is whether it's empty. So we could
@ -694,15 +694,15 @@ The songs are returned as alists."
;; good enough because this is only used with "search", which ;; good enough because this is only used with "search", which
;; doesn't pay attention to playlists and URLs anyway. ;; doesn't pay attention to playlists and URLs anyway.
(let* ((osongs (mpc-cmd-find other-tag value)) (let* ((osongs (mpc-cmd-find other-tag value))
(ofiles (mpc-assq-all 'file (apply 'append osongs))) (ofiles (mpc-assq-all 'file (apply #'append osongs)))
(plfiles (mpc-assq-all 'file (apply 'append plsongs)))) (plfiles (mpc-assq-all 'file (apply #'append plsongs))))
(when (seq-intersection plfiles ofiles) (when (seq-intersection plfiles ofiles)
(push pl pls))))))) (push pl pls)))))))
pls)) pls))
((eq tag 'Directory) ((eq tag 'Directory)
(if (null other-tag) (if (null other-tag)
(apply 'nconc (apply #'nconc
(mpc-assq-all 'directory (mpc-assq-all 'directory
(mpc-proc-buf-to-alist (mpc-proc-buf-to-alist
(mpc-proc-cmd "lsinfo"))) (mpc-proc-cmd "lsinfo")))
@ -725,7 +725,7 @@ The songs are returned as alists."
;; If there's an other-tag, then just extract the dir info from the ;; If there's an other-tag, then just extract the dir info from the
;; list of other-tag's songs. ;; list of other-tag's songs.
(let* ((other-songs (mpc-cmd-find other-tag value)) (let* ((other-songs (mpc-cmd-find other-tag value))
(files (mpc-assq-all 'file (apply 'append other-songs))) (files (mpc-assq-all 'file (apply #'append other-songs)))
(dirs '())) (dirs '()))
(dolist (file files) (dolist (file files)
(let ((dir (file-name-directory file))) (let ((dir (file-name-directory file)))
@ -759,7 +759,7 @@ The songs are returned as alists."
((null other-tag) ((null other-tag)
(condition-case nil (condition-case nil
(mapcar 'cdr (mpc-proc-cmd-to-alist (list "list" (symbol-name tag)))) (mapcar #'cdr (mpc-proc-cmd-to-alist (list "list" (symbol-name tag))))
(mpc-proc-error (mpc-proc-error
;; If `tag' is not one of the expected tags, MPD burps about not ;; If `tag' is not one of the expected tags, MPD burps about not
;; having the relevant table. ;; having the relevant table.
@ -770,7 +770,7 @@ The songs are returned as alists."
(condition-case nil (condition-case nil
(if (mpc-cmd-special-tag-p other-tag) (if (mpc-cmd-special-tag-p other-tag)
(signal 'mpc-proc-error "Not implemented") (signal 'mpc-proc-error "Not implemented")
(mapcar 'cdr (mapcar #'cdr
(mpc-proc-cmd-to-alist (mpc-proc-cmd-to-alist
(list "list" (symbol-name tag) (list "list" (symbol-name tag)
(symbol-name other-tag) value)))) (symbol-name other-tag) value))))
@ -781,7 +781,7 @@ The songs are returned as alists."
(mpc-assq-all tag (mpc-assq-all tag
;; Don't use `nconc' now that mpc-cmd-find may ;; Don't use `nconc' now that mpc-cmd-find may
;; return a memoized result. ;; return a memoized result.
(apply 'append other-songs)))))))) (apply #'append other-songs))))))))
(defun mpc-cmd-stop (&optional callback) (defun mpc-cmd-stop (&optional callback)
(mpc-proc-cmd "stop" callback)) (mpc-proc-cmd "stop" callback))
@ -847,7 +847,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
;; Sort them from last to first, so the renumbering ;; Sort them from last to first, so the renumbering
;; caused by the earlier deletions don't affect ;; caused by the earlier deletions don't affect
;; later ones. ;; later ones.
(sort (copy-sequence song-poss) '>)))) (sort (copy-sequence song-poss) #'>))))
(if (stringp playlist) (if (stringp playlist)
(puthash (cons 'Playlist playlist) nil mpc--find-memoize))) (puthash (cons 'Playlist playlist) nil mpc--find-memoize)))
@ -871,7 +871,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
;; Sort them from last to first, so the renumbering ;; Sort them from last to first, so the renumbering
;; caused by the earlier deletions affect ;; caused by the earlier deletions affect
;; later ones a bit less. ;; later ones a bit less.
(sort (copy-sequence song-poss) '>)))) (sort (copy-sequence song-poss) #'>))))
(if (stringp playlist) (if (stringp playlist)
(puthash (cons 'Playlist playlist) nil mpc--find-memoize)))) (puthash (cons 'Playlist playlist) nil mpc--find-memoize))))
@ -882,7 +882,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(unless callback (mpc-proc-sync)))) (unless callback (mpc-proc-sync))))
(defun mpc-cmd-tagtypes () (defun mpc-cmd-tagtypes ()
(mapcar 'cdr (mpc-proc-cmd-to-alist "tagtypes"))) (mapcar #'cdr (mpc-proc-cmd-to-alist "tagtypes")))
;; This was never integrated into MPD. ;; This was never integrated into MPD.
;; (defun mpc-cmd-download (file) ;; (defun mpc-cmd-download (file)
@ -998,7 +998,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(cond (cond
((>= col 0) (insert str)) ((>= col 0) (insert str))
(t (insert (substring str (min (length str) (- col)))))))) (t (insert (substring str (min (length str) (- col))))))))
(pred nil)) (pred #'always))
(while (string-match "%\\(?:%\\|\\(-\\)?\\([0-9]+\\)?{\\([[:alpha:]][[:alnum:]]*\\)\\(?:-\\([^}]+\\)\\)?}\\)" format-spec pos) (while (string-match "%\\(?:%\\|\\(-\\)?\\([0-9]+\\)?{\\([[:alpha:]][[:alnum:]]*\\)\\(?:-\\([^}]+\\)\\)?}\\)" format-spec pos)
(let ((pre-text (substring format-spec pos (match-beginning 0)))) (let ((pre-text (substring format-spec pos (match-beginning 0))))
(funcall insert pre-text) (funcall insert pre-text)
@ -1017,7 +1017,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(pcase tag (pcase tag
((or 'Time 'Duration) ((or 'Time 'Duration)
(let ((time (cdr (or (assq 'time info) (assq 'Time info))))) (let ((time (cdr (or (assq 'time info) (assq 'Time info)))))
(setq pred (list nil)) ;Just assume it's never eq. (setq pred #'ignore) ;Just assume it's never eq.
(when time (when time
(mpc-secs-to-time (if (and (eq tag 'Duration) (mpc-secs-to-time (if (and (eq tag 'Duration)
(string-match ":" time)) (string-match ":" time))
@ -1026,7 +1026,11 @@ If PLAYLIST is t or nil or missing, use the main playlist."
('Cover ('Cover
(let ((dir (file-name-directory (cdr (assq 'file info))))) (let ((dir (file-name-directory (cdr (assq 'file info)))))
;; (debug) ;; (debug)
(push `(equal ',dir (file-name-directory (cdr (assq 'file info)))) pred) (setq pred
(lambda (info)
(and (funcall pred info)
(equal dir (file-name-directory
(cdr (assq 'file info)))))))
(if-let* ((covers '(".folder.png" "cover.jpg" "folder.jpg")) (if-let* ((covers '(".folder.png" "cover.jpg" "folder.jpg"))
(cover (cl-loop for file in (directory-files (mpc-file-local-copy dir)) (cover (cl-loop for file in (directory-files (mpc-file-local-copy dir))
if (member (downcase file) covers) if (member (downcase file) covers)
@ -1043,7 +1047,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(setq size nil) (setq size nil)
(propertize dir 'display image)) (propertize dir 'display image))
;; Make sure we return something on which we can ;; Make sure we return something on which we can
;; place the `mpc-pred' property, as ;; place the `mpc--uptodate-p' property, as
;; a negative-cache. We could also use ;; a negative-cache. We could also use
;; a default cover. ;; a default cover.
(progn (setq size nil) " ")))) (progn (setq size nil) " "))))
@ -1052,7 +1056,10 @@ If PLAYLIST is t or nil or missing, use the main playlist."
;; than the URL in `file'. Pretend it's in `Title'. ;; than the URL in `file'. Pretend it's in `Title'.
(when (and (null val) (eq tag 'Title)) (when (and (null val) (eq tag 'Title))
(setq val (cdr (assq 'file info)))) (setq val (cdr (assq 'file info))))
(push `(equal ',val (cdr (assq ',tag info))) pred) (setq pred
(lambda (info)
(and (funcall pred info)
(equal val (cdr (assq ',tag info))))))
(cond (cond
((not (and (eq tag 'Date) (stringp val))) val) ((not (and (eq tag 'Date) (stringp val))) val)
;; For "date", only keep the year! ;; For "date", only keep the year!
@ -1080,11 +1087,11 @@ If PLAYLIST is t or nil or missing, use the main playlist."
'follow-link t 'follow-link t
'keymap `(keymap 'keymap `(keymap
(mouse-2 (mouse-2
. (lambda () . ,(lambda ()
(interactive) (interactive)
(mpc-constraints-push 'noerror) (mpc-constraints-push 'noerror)
(mpc-constraints-restore (mpc-constraints-restore
',(list (list tag text))))))))) ',(list (list tag text)))))))))
(funcall insert (funcall insert
(concat (when size (concat (when size
(propertize " " 'display (propertize " " 'display
@ -1097,35 +1104,34 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(if (null size) (setq col (+ col textwidth postwidth)) (if (null size) (setq col (+ col textwidth postwidth))
(insert space) (insert space)
(setq col (+ col size)))))) (setq col (+ col size))))))
(put-text-property start (point) 'mpc-pred (put-text-property start (point) 'mpc--uptodate-p pred)))
`(lambda (info) (and ,@(nreverse pred))))))
;;; The actual UI code ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; The actual UI code ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar mpc-mode-map (defvar mpc-mode-map
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
;; (define-key map "\e" 'mpc-stop) ;; (define-key map "\e" #'mpc-stop)
(define-key map "q" 'mpc-quit) (define-key map "q" #'mpc-quit)
(define-key map "\r" 'mpc-select) (define-key map "\r" #'mpc-select)
(define-key map [(shift return)] 'mpc-select-toggle) (define-key map [(shift return)] #'mpc-select-toggle)
(define-key map [mouse-2] 'mpc-select) (define-key map [mouse-2] #'mpc-select)
(define-key map [S-mouse-2] 'mpc-select-extend) (define-key map [S-mouse-2] #'mpc-select-extend)
(define-key map [C-mouse-2] 'mpc-select-toggle) (define-key map [C-mouse-2] #'mpc-select-toggle)
(define-key map [drag-mouse-2] 'mpc-drag-n-drop) (define-key map [drag-mouse-2] #'mpc-drag-n-drop)
;; We use `always' because a binding to t is like a binding to nil. ;; 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 ;; But follow-link doesn't apply blindly to header-line and
;; mode-line clicks. ;; mode-line clicks.
(define-key map [header-line follow-link] 'ignore) (define-key map [header-line follow-link] #'ignore)
(define-key map [mode-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 ;; Doesn't work because the first click changes the buffer, so the second
;; is applied elsewhere :-( ;; is applied elsewhere :-(
;; (define-key map [(double mouse-2)] 'mpc-play-at-point) ;; (define-key map [(double mouse-2)] #'mpc-play-at-point)
(define-key map "p" 'mpc-pause) (define-key map "p" #'mpc-pause)
(define-key map "s" 'mpc-toggle-play) (define-key map "s" #'mpc-toggle-play)
(define-key map ">" 'mpc-next) (define-key map ">" #'mpc-next)
(define-key map "<" 'mpc-prev) (define-key map "<" #'mpc-prev)
(define-key map "g" 'mpc-seek-current) (define-key map "g" #'mpc-seek-current)
map)) map))
(easy-menu-define mpc-mode-menu mpc-mode-map (easy-menu-define mpc-mode-menu mpc-mode-map
@ -1217,7 +1223,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(when (assq 'file mpc-status) (when (assq 'file mpc-status)
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(dolist (spec mpc-status-buffer-format) (dolist (spec mpc-status-buffer-format)
(let ((pred (get-text-property (point) 'mpc-pred))) (let ((pred (get-text-property (point) 'mpc--uptodate-p)))
(if (and pred (funcall pred mpc-status)) (if (and pred (funcall pred mpc-status))
(forward-line) (forward-line)
(delete-region (point) (line-beginning-position 2)) (delete-region (point) (line-beginning-position 2))
@ -1277,7 +1283,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
;; Restore the selection. I.e. move the overlays back to their ;; Restore the selection. I.e. move the overlays back to their
;; corresponding location. Actually which overlay is used for what ;; corresponding location. Actually which overlay is used for what
;; doesn't matter. ;; doesn't matter.
(mapc 'delete-overlay mpc-select) (mapc #'delete-overlay mpc-select)
(setq mpc-select nil) (setq mpc-select nil)
(dolist (elem selection) (dolist (elem selection)
;; After an update, some elements may have disappeared. ;; After an update, some elements may have disappeared.
@ -1302,7 +1308,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(interactive (list last-nonmenu-event)) (interactive (list last-nonmenu-event))
(mpc-event-set-point event) (mpc-event-set-point event)
(if (and (bolp) (eobp)) (forward-line -1)) (if (and (bolp) (eobp)) (forward-line -1))
(mapc 'delete-overlay mpc-select) (mapc #'delete-overlay mpc-select)
(setq mpc-select nil) (setq mpc-select nil)
(if (mpc-tagbrowser-all-p) (if (mpc-tagbrowser-all-p)
nil nil
@ -1662,7 +1668,7 @@ Return non-nil if a selection was deactivated."
;; (unless (equal constraints mpc-constraints) ;; (unless (equal constraints mpc-constraints)
;; (setq-local mpc-constraints constraints) ;; (setq-local mpc-constraints constraints)
(dolist (cst constraints) (dolist (cst constraints)
(let ((vals (apply 'mpc-union (let ((vals (apply #'mpc-union
(mapcar (lambda (val) (mapcar (lambda (val)
(mpc-cmd-list mpc-tag (car cst) val)) (mpc-cmd-list mpc-tag (car cst) val))
(cdr cst))))) (cdr cst)))))
@ -1681,7 +1687,7 @@ Return non-nil if a selection was deactivated."
(setq mpc--changed-selection t)) (setq mpc--changed-selection t))
(unless nodeactivate (unless nodeactivate
(setq selection nil) (setq selection nil)
(mapc 'delete-overlay mpc-select) (mapc #'delete-overlay mpc-select)
(setq mpc-select nil) (setq mpc-select nil)
(mpc-tagbrowser-all-select)))) (mpc-tagbrowser-all-select))))
@ -1726,7 +1732,7 @@ Return non-nil if a selection was deactivated."
(defvar mpc-tagbrowser-dir-mode-map (defvar mpc-tagbrowser-dir-mode-map
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
(set-keymap-parent map mpc-tagbrowser-mode-map) (set-keymap-parent map mpc-tagbrowser-mode-map)
(define-key map [?\M-\C-m] 'mpc-tagbrowser-dir-toggle) (define-key map [?\M-\C-m] #'mpc-tagbrowser-dir-toggle)
map)) map))
;; (defvar mpc-tagbrowser-dir-keywords ;; (defvar mpc-tagbrowser-dir-keywords
@ -1838,12 +1844,12 @@ A value of t means the main playlist.")
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
;; Bind the up-events rather than the down-event, so the ;; Bind the up-events rather than the down-event, so the
;; `message' isn't canceled by the subsequent up-event binding. ;; `message' isn't canceled by the subsequent up-event binding.
(define-key map [down-mouse-1] 'ignore) (define-key map [down-mouse-1] #'ignore)
(define-key map [mouse-1] 'mpc-volume-mouse-set) (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 mouse-1] #'mpc-volume-mouse-set)
(define-key map [header-line down-mouse-1] 'ignore) (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 mouse-1] #'mpc-volume-mouse-set)
(define-key map [mode-line down-mouse-1] 'ignore) (define-key map [mode-line down-mouse-1] #'ignore)
map)) map))
(defvar mpc-volume nil) (put 'mpc-volume 'risky-local-variable t) (defvar mpc-volume nil) (put 'mpc-volume 'risky-local-variable t)
@ -1876,7 +1882,7 @@ A value of t means the main playlist.")
(progn (progn
(message "MPD volume already at %s%%" newvol) (message "MPD volume already at %s%%" newvol)
(ding)) (ding))
(mpc-proc-cmd (list "setvol" newvol) 'mpc-status-refresh) (mpc-proc-cmd (list "setvol" newvol) #'mpc-status-refresh)
(message "Set MPD volume to %s%%" newvol)))) (message "Set MPD volume to %s%%" newvol))))
(defun mpc-volume-widget (vol &optional size) (defun mpc-volume-widget (vol &optional size)
@ -1913,7 +1919,7 @@ A value of t means the main playlist.")
(defvar mpc-songs-mode-map (defvar mpc-songs-mode-map
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
(define-key map [remap mpc-select] 'mpc-songs-jump-to) (define-key map [remap mpc-select] #'mpc-songs-jump-to)
map)) map))
(defvar mpc-songpointer-set-visible nil) (defvar mpc-songpointer-set-visible nil)
@ -1961,7 +1967,7 @@ This is used so that they can be compared with `eq', which is needed for
(setq mpc-songs-playlist (cadr cst))) (setq mpc-songs-playlist (cadr cst)))
;; We don't do anything really special here for playlists, ;; We don't do anything really special here for playlists,
;; because it's unclear what's a correct "union" of playlists. ;; because it's unclear what's a correct "union" of playlists.
(let ((vals (apply 'mpc-union (let ((vals (apply #'mpc-union
(mapcar (lambda (val) (mapcar (lambda (val)
(mpc-cmd-find (car cst) val)) (mpc-cmd-find (car cst) val))
(cdr cst))))) (cdr cst)))))
@ -2335,7 +2341,7 @@ This is used so that they can be compared with `eq', which is needed for
"Quit Music Player Daemon." "Quit Music Player Daemon."
(interactive) (interactive)
(let* ((proc mpc-proc) (let* ((proc mpc-proc)
(bufs (mapcar 'cdr (if proc (process-get proc 'buffers)))) (bufs (mapcar #'cdr (if proc (process-get proc 'buffers))))
(wins (mapcar (lambda (buf) (get-buffer-window buf 0)) bufs)) (wins (mapcar (lambda (buf) (get-buffer-window buf 0)) bufs))
(song-buf (mpc-songs-buf)) (song-buf (mpc-songs-buf))
frames) frames)
@ -2356,7 +2362,7 @@ This is used so that they can be compared with `eq', which is needed for
(unless (memq (window-buffer win) bufs) (setq delete nil))) (unless (memq (window-buffer win) bufs) (setq delete nil)))
(if delete (ignore-errors (delete-frame frame)))))) (if delete (ignore-errors (delete-frame frame))))))
;; Then kill the buffers. ;; Then kill the buffers.
(mapc 'kill-buffer bufs) (mapc #'kill-buffer bufs)
(mpc-status-stop) (mpc-status-stop)
(if proc (delete-process proc)))) (if proc (delete-process proc))))
@ -2519,7 +2525,7 @@ If stopped, start playback."
(setq mpc-last-seek-time (setq mpc-last-seek-time
(cons currenttime (setq time (+ time step)))) (cons currenttime (setq time (+ time step))))
(mpc-proc-cmd (list "seekid" songid time) (mpc-proc-cmd (list "seekid" songid time)
'mpc-status-refresh)))) #'mpc-status-refresh))))
(let ((status (mpc-cmd-status))) (let ((status (mpc-cmd-status)))
(let* ((songid (cdr (assq 'songid status))) (let* ((songid (cdr (assq 'songid status)))
(time (if songid (string-to-number (time (if songid (string-to-number
@ -2529,7 +2535,7 @@ If stopped, start playback."
(lambda () (lambda ()
(mpc-proc-cmd (list "seekid" songid (mpc-proc-cmd (list "seekid" songid
(setq time (+ time step))) (setq time (+ time step)))
'mpc-status-refresh))))) #'mpc-status-refresh)))))
(while (mouse-movement-p (while (mouse-movement-p
(event-basic-type (setq event (read-event))))) (event-basic-type (setq event (read-event)))))
(cancel-timer timer))))))) (cancel-timer timer)))))))
@ -2584,7 +2590,7 @@ If stopped, start playback."
((and (>= songtime songduration) mpc--faster-toggle-forward) ((and (>= songtime songduration) mpc--faster-toggle-forward)
;; Skip to the beginning of the next song. ;; Skip to the beginning of the next song.
(if (not (equal (cdr (assq 'state mpc-status)) "play")) (if (not (equal (cdr (assq 'state mpc-status)) "play"))
(mpc-proc-cmd "next" 'mpc-status-refresh) (mpc-proc-cmd "next" #'mpc-status-refresh)
;; If we're playing, this is done automatically, so we ;; If we're playing, this is done automatically, so we
;; don't need to do anything, or rather we *shouldn't* ;; don't need to do anything, or rather we *shouldn't*
;; do anything otherwise there's a race condition where ;; do anything otherwise there's a race condition where
@ -2616,7 +2622,7 @@ If stopped, start playback."
(condition-case nil (condition-case nil
(mpc-proc-cmd (mpc-proc-cmd
(list "seekid" songid songtime) (list "seekid" songid songtime)
'mpc-status-refresh) #'mpc-status-refresh)
(mpc-proc-error (mpc-status-refresh))))))))))) (mpc-proc-error (mpc-status-refresh)))))))))))
(setq mpc--faster-toggle-forward (> step 0)) (setq mpc--faster-toggle-forward (> step 0))
(funcall fun) ;Initialize values. (funcall fun) ;Initialize values.
@ -2700,7 +2706,7 @@ If stopped, start playback."
(error "Not a playlist") (error "Not a playlist")
(buffer-substring (line-beginning-position) (buffer-substring (line-beginning-position)
(line-end-position))))) (line-end-position)))))
(mpc-cmd-add (mapcar 'car songs) playlist) (mpc-cmd-add (mapcar #'car songs) playlist)
(message "Added %d songs to %s" (length songs) playlist) (message "Added %d songs to %s" (length songs) playlist)
(if (member playlist (if (member playlist
(cdr (assq 'Playlist (mpc-constraints-get-current)))) (cdr (assq 'Playlist (mpc-constraints-get-current))))
@ -2712,7 +2718,7 @@ If stopped, start playback."
((eq start-buf end-buf) ((eq start-buf end-buf)
;; Moving songs within the shown playlist. ;; Moving songs within the shown playlist.
(let ((dest-pos (get-text-property (point) 'mpc-file-pos))) (let ((dest-pos (get-text-property (point) 'mpc-file-pos)))
(mpc-cmd-move (mapcar 'cdr songs) dest-pos mpc-songs-playlist) (mpc-cmd-move (mapcar #'cdr songs) dest-pos mpc-songs-playlist)
(message "Moved %d songs" (length songs)))) (message "Moved %d songs" (length songs))))
(t (t
;; Adding songs to the shown playlist. ;; Adding songs to the shown playlist.
@ -2723,10 +2729,10 @@ If stopped, start playback."
;; MPD's protocol does not let us add songs at a particular ;; MPD's protocol does not let us add songs at a particular
;; position in a playlist, so we first have to add them to the ;; position in a playlist, so we first have to add them to the
;; end, and then move them to their final destination. ;; end, and then move them to their final destination.
(mpc-cmd-add (mapcar 'car songs) mpc-songs-playlist) (mpc-cmd-add (mapcar #'car songs) mpc-songs-playlist)
(mpc-cmd-move (let ((poss '())) (mpc-cmd-move (let ((poss '()))
(dotimes (i (length songs)) (dotimes (i (length songs))
(push (+ i (length pl)) poss)) (push (+ i (length pl)) poss))
(nreverse poss)) (nreverse poss))
dest-pos mpc-songs-playlist) dest-pos mpc-songs-playlist)
(message "Added %d songs" (length songs))))) (message "Added %d songs" (length songs)))))