Emacs library to communicate with Music Player Daemon (MPD, https://www.musicpd.org/), a flexible, powerful, server-side application for playing music.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

1124 lines
39KB

  1. ;;; libmpdel.el --- Communication with an MPD server -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2017-2018 Damien Cassou
  3. ;; Author: Damien Cassou <damien@cassou.me>
  4. ;; Keywords: multimedia
  5. ;; Url: https://gitlab.petton.fr/mpdel/libmpdel
  6. ;; Package-requires: ((emacs "25.1"))
  7. ;; Version: 1.1.1
  8. ;; This program is free software; you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation, either version 3 of the License, or
  11. ;; (at your option) any later version.
  12. ;; This program is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. ;; GNU General Public License for more details.
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
  18. ;;; Commentary:
  19. ;; The package libmpdel is an Emacs library client to communicate with
  20. ;; Music Player Daemon (MPD), a flexible, powerful, server-side
  21. ;; application for playing music. For a user interface, please check
  22. ;; the mpdel project instead (which depends on this one).
  23. ;;; Code:
  24. (require 'time-stamp)
  25. (require 'tq)
  26. (require 'cl-lib)
  27. ;;; Customization
  28. (defgroup libmpdel nil
  29. "Communication with an MPD server."
  30. :group 'comm)
  31. (defcustom libmpdel-hostname "localhost"
  32. "MPD server location to connect to. Also see `libmpdel-port'."
  33. :type 'string)
  34. (defcustom libmpdel-port 6600
  35. "MPD server port to connect to. Also see `libmpdel-hostname'."
  36. :type 'integer)
  37. (defcustom libmpdel-profiles (list (list "Local server" libmpdel-hostname libmpdel-port))
  38. "List of (HOST . PORT) when using several MPD servers."
  39. :type '(repeat (list
  40. :tag "Profile"
  41. :value ("Local server" "localhost" 6600)
  42. (string :tag "name")
  43. (string :tag "host")
  44. (integer :tag "port"))))
  45. (defcustom libmpdel-music-directory "~/Music"
  46. "MPD `music_directory' variable's value.
  47. This is used to map MPD's music files to the filesystem."
  48. :type 'directory)
  49. (defcustom libmpdel-current-playlist-changed-hook nil
  50. "Functions to call when the current playlist is modified."
  51. :type 'hook
  52. :group 'libmpdel)
  53. (defcustom libmpdel-stored-playlist-changed-hook nil
  54. "Functions to call when a stored playlist is modified."
  55. :type 'hook
  56. :group 'libmpdel)
  57. (defcustom libmpdel-player-changed-hook nil
  58. "Functions to call when the player status changes.
  59. This includes starting, stopping and seeking music."
  60. :type 'hook
  61. :group 'libmpdel)
  62. (defcustom libmpdel-current-song-changed-hook nil
  63. "Functions to call when the current song changes.
  64. See `libmpdel-current-song-id'."
  65. :type 'hook
  66. :group 'libmpdel)
  67. ;;; Global private variables
  68. (defvar libmpdel--connection nil
  69. "Current connection to the MPD server.
  70. The logs of this connection are accessible in the *mpd* buffer.")
  71. (defconst libmpdel--response-regexp
  72. (rx line-start
  73. (or
  74. (and "OK" (? " MPD " (one-or-more not-newline)))
  75. (and "ACK ["
  76. (one-or-more (any digit)) "@" (one-or-more (any digit))
  77. "] " (one-or-more not-newline)))
  78. "\n")
  79. "Regexp matching the responses sent by the MPD server.")
  80. (defconst libmpdel--msgfield-regexp
  81. (rx line-start
  82. (group (+? (not (any ?:))))
  83. ": "
  84. (group (* not-newline))
  85. line-end)
  86. "Regexp matching a line consisting of a key and a value.
  87. The key is stored in group 1 and the value in group 2.")
  88. (defvar libmpdel--msghandlers nil
  89. "Current commands sent to the server.
  90. Each element in the list is of the form (COMMAND HANDLER BUFFER).
  91. COMMAND is the query sent to the server. Even though this
  92. information is not necessary, it is useful to better understand
  93. the log.
  94. HANDLER is a function executed when the answers to COMMAND comes
  95. back. The function must accept one parameter (usually named
  96. MESSAGE) that will contain the answer.
  97. BUFFER is a buffer that was active when COMMAND was sent. This
  98. buffer is made active again while executing HANDLER.
  99. An invariant of this MPD client is that there is always an IDLE
  100. command sent to the server (and its corresponding handler in this
  101. variable). This means our client is always registered to
  102. notifications in the server. When we want to send a command to
  103. the server (for example to change the current song), we always
  104. have to (1) cancel the IDLE first (with a \"noidle\"
  105. command), (2) send the command we want, and (3) send the IDLE
  106. command again. Cancelling the current \"idle\" command is done
  107. in `mpdel-send-command'. Sending \"idle\" again is done in the
  108. handler for \"idle\" that will be triggered when the empty answer
  109. for the cancelled \"idle\" arrives.
  110. Because MPD answers in the order the commands are sent, we know
  111. that the first handler is the one to execute when we receive a
  112. message from the server.")
  113. ;;; Data structures
  114. (cl-defstruct (libmpdel-artist
  115. (:constructor libmpdel--artist-create)
  116. (:conc-name libmpdel--artist-))
  117. (name nil :read-only t))
  118. (cl-defstruct (libmpdel-album
  119. (:constructor libmpdel--album-create)
  120. (:conc-name libmpdel--album-))
  121. (name nil :read-only t)
  122. (artist nil :read-only t))
  123. (cl-defstruct (libmpdel-song
  124. (:constructor libmpdel--song-create)
  125. (:conc-name libmpdel--song-))
  126. (name nil :read-only t)
  127. (track nil :read-only t)
  128. (file nil :read-only t)
  129. (album nil :read-only t)
  130. (disc nil :read-only t)
  131. (date nil :read-only t)
  132. (id nil :read-only t)
  133. (pos nil :read-only t))
  134. (cl-defstruct (libmpdel-stored-playlist
  135. (:constructor libmpdel--stored-playlist-create)
  136. (:conc-name libmpdel--stored-playlist-))
  137. (name nil :read-only t))
  138. (cl-defstruct (libmpdel-search-criteria
  139. (:constructor libmpdel-search-criteria-create)
  140. (:conc-name libmpdel--search-criteria-))
  141. (type nil :read-only t)
  142. (what nil :read-only t))
  143. (cl-defstruct (libmpdel-filter
  144. (:constructor libmpdel-filter-create)
  145. (:conc-name libmpdel--filter-))
  146. (text nil :read-only t))
  147. (defun libmpdel-artist-name (entity)
  148. "Return artist name of ENTITY."
  149. (libmpdel--artist-name (libmpdel-artist entity)))
  150. (cl-defgeneric libmpdel-artist (entity)
  151. "Return artist of ENTITY.")
  152. (cl-defmethod libmpdel-artist ((artist libmpdel-artist))
  153. artist)
  154. (cl-defmethod libmpdel-artist ((album libmpdel-album))
  155. (libmpdel--album-artist album))
  156. (cl-defmethod libmpdel-artist ((song libmpdel-song))
  157. (libmpdel-artist (libmpdel--song-album song)))
  158. (defun libmpdel-album-name (entity)
  159. "Return album name of ENTITY."
  160. (libmpdel--album-name (libmpdel-album entity)))
  161. (cl-defgeneric libmpdel-album (entity)
  162. "Return album of ENTITY.")
  163. (cl-defmethod libmpdel-album ((album libmpdel-album))
  164. album)
  165. (cl-defmethod libmpdel-album ((song libmpdel-song))
  166. (libmpdel--song-album song))
  167. (cl-defgeneric libmpdel-entity-name (entity)
  168. "Return basename of ENTITY.")
  169. (cl-defmethod libmpdel-entity-name ((artist libmpdel-artist))
  170. (libmpdel--artist-name artist))
  171. (cl-defmethod libmpdel-entity-name ((album libmpdel-album))
  172. (libmpdel--album-name album))
  173. (cl-defmethod libmpdel-entity-name ((song libmpdel-song))
  174. (libmpdel--song-name song))
  175. (cl-defmethod libmpdel-entity-name ((_entity (eql artists)))
  176. "All artists")
  177. (cl-defmethod libmpdel-entity-name ((_entity (eql current-playlist)))
  178. "Current playlist")
  179. (cl-defmethod libmpdel-entity-name ((stored-playlist libmpdel-stored-playlist))
  180. (libmpdel--stored-playlist-name stored-playlist))
  181. (cl-defmethod libmpdel-entity-name ((search-criteria libmpdel-search-criteria))
  182. (format "search %s: \"%s\""
  183. (libmpdel--search-criteria-type search-criteria)
  184. (libmpdel--search-criteria-what search-criteria)))
  185. (cl-defmethod libmpdel-entity-name ((filter libmpdel-filter))
  186. (format "filter %s" (libmpdel--filter-text filter)))
  187. (cl-defgeneric libmpdel-entity-parent (_entity)
  188. "Return parent of ENTITY."
  189. nil)
  190. (cl-defmethod libmpdel-entity-parent ((song libmpdel-song))
  191. (libmpdel-album song))
  192. (cl-defmethod libmpdel-entity-parent ((album libmpdel-album))
  193. (libmpdel-artist album))
  194. (cl-defmethod libmpdel-entity-parent ((_artist libmpdel-artist))
  195. 'artists)
  196. (cl-defmethod libmpdel-entity-parent ((_stored-playlist libmpdel-stored-playlist))
  197. 'stored-playlists)
  198. (cl-defgeneric libmpdel-entity-id (entity)
  199. "Return an identifier string for ENTITY."
  200. entity)
  201. (cl-defmethod libmpdel-entity-id ((song libmpdel-song))
  202. ;; Override of default implementation to ignore changing ids and
  203. ;; position.
  204. (libmpdel--song-file song))
  205. (defun libmpdel-song-file (song)
  206. "Return the filename of SONG."
  207. (libmpdel--song-file song))
  208. (defun libmpdel-song-track (song)
  209. "Return the track number of SONG within its album."
  210. (or (libmpdel--song-track song) ""))
  211. (defun libmpdel-entity-date (song)
  212. "Return the date of SONG."
  213. (or (libmpdel--song-date song) ""))
  214. (defun libmpdel-song-disc (song)
  215. "Return the disc number of SONG within its album."
  216. (or (libmpdel--song-disc song) ""))
  217. (defun libmpdel-song-id (song)
  218. "Return SONG id within the current playlist, nil if none."
  219. (libmpdel--song-id song))
  220. (defun libmpdel-song-position (song)
  221. "Return position of SONG in playlist, nil if not in playlist."
  222. (let ((pos (libmpdel--song-pos song)))
  223. (when (and (stringp pos) (not (string= pos "")))
  224. (string-to-number pos))))
  225. (defun libmpdel--create-song-from-data (song-data)
  226. "Return a song from SONG-DATA, a server's response."
  227. (libmpdel--song-create
  228. :name (cdr (assq 'Title song-data))
  229. :track (cdr (assq 'Track song-data))
  230. :file (cdr (assq 'file song-data))
  231. :album (libmpdel--album-create
  232. :name (cdr (assq 'Album song-data))
  233. :artist (libmpdel--artist-create :name (cdr (assq 'Artist song-data))))
  234. :date (cdr (assq 'Date song-data))
  235. :disc (cdr (assq 'Disc song-data))
  236. :id (cdr (assq 'Id song-data))
  237. :pos (cdr (assq 'Pos song-data))))
  238. (defun libmpdel--create-songs-from-data (data)
  239. "Return a list of songs from DATA, a server's response."
  240. (mapcar #'libmpdel--create-song-from-data (libmpdel-group-data data)))
  241. (defun libmpdel-current-playlist-p (entity)
  242. "Return non-nil if ENTITY is the current playlist."
  243. (eq entity 'current-playlist))
  244. ;;; Helper functions
  245. (defun libmpdel--process ()
  246. "Return the process communicating with the MPD server."
  247. (tq-process libmpdel--connection))
  248. (defun libmpdel--process-buffer ()
  249. "Return the buffer associated with the connection process."
  250. (process-buffer (libmpdel--process)))
  251. (defun libmpdel--connect ()
  252. "Create a new connection with the MPD server."
  253. ;; The *mpd* buffer will contain all the communication logs
  254. (when (libmpdel-connected-p)
  255. (user-error "A connection is already opened"))
  256. (with-current-buffer (get-buffer-create "*mpd*")
  257. (setq-local buffer-read-only t)
  258. (let ((inhibit-read-only t))
  259. (erase-buffer)))
  260. (setq libmpdel--connection (tq-create (open-network-stream
  261. "mpd" "*mpd*"
  262. libmpdel-hostname
  263. libmpdel-port
  264. :type 'plain)))
  265. (set-process-coding-system (libmpdel--process) 'utf-8-unix 'utf-8-unix)
  266. (set-process-query-on-exit-flag (libmpdel--process) nil)
  267. ;; Take care of the initial welcome message from server that we
  268. ;; don't ask for:
  269. (setq libmpdel--msghandlers '(("welcome" libmpdel--msghandler-ignore nil)))
  270. (tq-queue-add libmpdel--connection nil libmpdel--response-regexp nil #'libmpdel--message-filter)
  271. (libmpdel-refresh-status)
  272. ;; As an invariant of the MPD client, there is always an "idle"
  273. ;; command sent to the server. This acts like a registration to the
  274. ;; server's notifications. See `libmpdel--msghandlers' for more
  275. ;; information.
  276. (libmpdel--raw-send-command-with-handler "idle" #'libmpdel--msghandler-idle))
  277. ;;;###autoload
  278. (defun libmpdel-connect-profile (profile)
  279. "Connect to MPD server defined in PROFILE.
  280. Interactively, let the user choose PROFILE from `libmpdel-profiles'.
  281. If a connection already exists, terminate it first."
  282. (interactive (list (libmpdel--select-profile)))
  283. (let* ((libmpdel-hostname (cl-second profile))
  284. (libmpdel-port (cl-third profile)))
  285. (when (libmpdel-connected-p)
  286. (libmpdel-disconnect))
  287. (libmpdel--connect)))
  288. (defun libmpdel--raw-send-command (command)
  289. "Send COMMAND, a string, to the server and log that."
  290. (libmpdel--log command "->")
  291. (tq-enqueue
  292. libmpdel--connection
  293. (format "%s\n" command)
  294. libmpdel--response-regexp
  295. nil
  296. #'libmpdel--message-filter))
  297. (defun libmpdel--raw-send-command-with-handler (command &optional handler)
  298. "Send COMMAND to MPD server and set HANDLER for the response.
  299. If HANDLER is nil, response will be ignored.
  300. If command is a string, send that. Otherwise, it must be a list
  301. that will be passed to `format' before being sent."
  302. (let ((command (if (listp command)
  303. (apply #'format command)
  304. command)))
  305. (setq libmpdel--msghandlers
  306. (append libmpdel--msghandlers
  307. `((,command
  308. ,(or handler #'libmpdel--msghandler-ignore)
  309. ,(current-buffer)))))
  310. (libmpdel--raw-send-command command)))
  311. (defun libmpdel--message-filter (_ message)
  312. "Take care of the MESSAGE sent by the server.
  313. The first parameter is ignored. MESSAGE contains a string
  314. representing the answer from the server."
  315. ;; Because errors in handlers are not raised by Emacs, we log them.
  316. (condition-case-unless-debug error
  317. (progn
  318. ;; because answers arrive in the same order we sent the
  319. ;; commands, we are sure that the first handler is the one to
  320. ;; use.
  321. (cl-destructuring-bind (command handler buffer) (pop libmpdel--msghandlers)
  322. (libmpdel--log (format "\"%s\" (as answer to \"%s\")" message command)
  323. "<-")
  324. ;; if answer is a ACK, then there was a problem. We log it as such.
  325. (if (string= (substring message 0 3) "ACK")
  326. (libmpdel--log "ACK message" "ko")
  327. (with-current-buffer (if (buffer-live-p buffer) buffer (current-buffer))
  328. (funcall handler (libmpdel--extract-data message))))))
  329. (error (libmpdel--log error "ko"))))
  330. (defun libmpdel--log (string type-string)
  331. "Add STRING at end of *mpd* buffer.
  332. TYPE-STRING is a two-letter string classifying the kind of
  333. message to log."
  334. (with-current-buffer (libmpdel--process-buffer)
  335. (let ((inhibit-read-only t)
  336. (moving (= (point) (process-mark (libmpdel--process)))))
  337. (save-excursion
  338. ;; Insert the text, advancing the process marker.
  339. (goto-char (process-mark (libmpdel--process)))
  340. (insert "-------------------------\n")
  341. (insert (format "%s [%s] %s\n" type-string (time-stamp-string) string))
  342. (set-marker (process-mark (libmpdel--process)) (point)))
  343. (if moving (goto-char (process-mark (libmpdel--process)))))))
  344. (defun libmpdel--msghandler-idle (data)
  345. "Handler for the response DATA to the \"idle\" command.
  346. This handler is responsible for sending another \"idle\"
  347. command."
  348. ;; Because "idle" only informs about what changed (e.g., "the
  349. ;; playback state changed") without telling the new state (e.g.,
  350. ;; "the player is now stopped"), we have to ask for the details:
  351. (when data
  352. (libmpdel-refresh-status))
  353. ;; Each time an "idle" is finished, we start a new one:
  354. (libmpdel--raw-send-command-with-handler "idle" #'libmpdel--msghandler-idle)
  355. (mapc (lambda (changed-subsystem)
  356. (cl-case (intern (cdr changed-subsystem))
  357. ;; At this point, libmpdel has only been informed that
  358. ;; something changed (e.g., "the current playlist has been
  359. ;; changed"). We don't have the details (e.g., "the
  360. ;; current playlist contains these songs"). As a result,
  361. ;; hook functions will have to fetch the details by
  362. ;; themselves if they need to. On the contrary, for hook
  363. ;; functions requiring libmpdel to have new data, use
  364. ;; `libmpdel--msghandler-status'.
  365. (playlist (run-hooks 'libmpdel-current-playlist-changed-hook))
  366. (stored_playlist (run-hooks 'libmpdel-stored-playlist-changed-hook))))
  367. data))
  368. (defun libmpdel--msghandler-status (data)
  369. "Handler for the response DATA to the \"status\" command."
  370. (dolist (status-pair data)
  371. (let ((status-key (car status-pair))
  372. (status-value (cdr status-pair)))
  373. (cl-case status-key
  374. (state (libmpdel--set-play-state status-value))
  375. (songid (libmpdel--set-current-song status-value))
  376. (playlistlength (libmpdel--set-playlist-length status-value))
  377. (volume (libmpdel--set-volume status-value))
  378. (random (libmpdel--set-random status-value))
  379. (repeat (libmpdel--set-repeat status-value))
  380. (single (libmpdel--set-single status-value)))))
  381. ;; When no song is being played, 'songid is not in DATA. If that's
  382. ;; the case, we have to set current song to nil:
  383. (unless (cl-member 'songid data :key #'car)
  384. (libmpdel--set-current-song nil)))
  385. (defun libmpdel--msghandler-ignore (_)
  386. "No handler was associated to last response."
  387. ;; nothing to do
  388. nil)
  389. (defun libmpdel--extract-data (message)
  390. "Return MESSAGE."
  391. (save-match-data
  392. (with-temp-buffer
  393. (insert message)
  394. (let ((end-of-message (point-at-bol))
  395. (data nil))
  396. (goto-char (point-min))
  397. (while (re-search-forward libmpdel--msgfield-regexp end-of-message t)
  398. (push (cons (intern (match-string 1)) (match-string 2)) data))
  399. (reverse data)))))
  400. (defun libmpdel--string<-ignore-case (str1 str2)
  401. "Compare the contents of STR1 and STR2, ignoring case."
  402. (let ((comp (compare-strings str1 nil nil str2 nil nil t)))
  403. (or (eq comp t) (< comp 0))))
  404. (defmacro libmpdel--define-state (name value-desc &rest set-body)
  405. "Generate code to set and get state for NAME.
  406. Name is a symbol (e.g., `volume' or `play-state') naming the
  407. state to generate code for.
  408. VALUE-DESC is a string describing the kind of value accepted for
  409. this state.
  410. SET-BODY is a list of forms to put in the generated setter
  411. function. During executiong of SET-BODY, a variable NEW-VALUE is
  412. bound containing the value to set."
  413. (declare (indent 1))
  414. `(progn
  415. (defvar ,(intern (format "libmpdel--%s" name)) nil
  416. ,(format "Current %s of MPD server.\n%s" name value-desc))
  417. (defun ,(intern (format "libmpdel--set-%s" name)) (new-value)
  418. ,(format "Save NEW-VALUE as current %s.\n%s" name value-desc)
  419. ,@set-body)
  420. (defun ,(intern (format "libmpdel-%s" name)) ()
  421. ,(format "Return current value of %s.\n%s" name value-desc)
  422. ,(intern (format "libmpdel--%s" name)))))
  423. (libmpdel--define-state play-state
  424. "Value is `play', `pause' or `stop'."
  425. (let ((new-state (intern new-value))
  426. (old-state libmpdel--play-state))
  427. (unless (equal old-state new-state)
  428. (setq libmpdel--play-state new-state)
  429. (run-hooks 'libmpdel-player-changed-hook))))
  430. (defun libmpdel-stopped-p ()
  431. "Return non-nil if player is stopped, nil otherwise."
  432. (eq 'stop (libmpdel-play-state)))
  433. (libmpdel--define-state current-song
  434. "An entity representing currently played song."
  435. (when (libmpdel--new-current-song-p new-value)
  436. (libmpdel-send-command
  437. "currentsong"
  438. (lambda (data)
  439. (setq libmpdel--current-song (and data (libmpdel--create-song-from-data data)))
  440. (run-hooks 'libmpdel-current-song-changed-hook)))))
  441. (defun libmpdel--new-current-song-p (song-id)
  442. "Return non-nil if SONG-ID differs from `libmpdel--current-song'."
  443. (let ((current-song-id (and libmpdel--current-song (libmpdel-song-id libmpdel--current-song))))
  444. (not (equal song-id current-song-id))))
  445. (libmpdel--define-state playlist-length
  446. "Number of songs in current playlist."
  447. (setq libmpdel--playlist-length (string-to-number new-value)))
  448. (libmpdel--define-state volume
  449. "Value is a string representing a number between 0 and 100."
  450. (setq libmpdel--volume new-value))
  451. (libmpdel--define-state random
  452. "Boolean indicating if songs are played randomly or in order."
  453. (setq libmpdel--random (string= new-value "1")))
  454. (libmpdel--define-state repeat
  455. "Boolean indicating if current playlist or song is repeated after it ends."
  456. (setq libmpdel--repeat (string= new-value "1")))
  457. (libmpdel--define-state single
  458. "Symbol indicating if current song is repeated `forever', only `once' or `never'."
  459. (setq libmpdel--single
  460. (cond
  461. ((string= new-value "oneshot") 'once)
  462. ((string= new-value "1") 'forever)
  463. (t 'never))))
  464. (defun libmpdel-time-to-string (time)
  465. "Return a string represeting TIME, a number in a string."
  466. (if (not time)
  467. "0"
  468. (let* ((time (string-to-number time))
  469. (seconds (mod time 60))
  470. (minutes (/ (- time seconds) 60)))
  471. (format "%02d:%02d" (truncate minutes) (truncate seconds)))))
  472. (defun libmpdel-completing-read (prompt entities &optional transformer)
  473. "PROMPT user to select one entity among ENTITIES.
  474. Transform each entity to a string with TRANSFORMER,
  475. `libmpdel-entity-name' if nil."
  476. (let* ((transformer (or transformer #'libmpdel-entity-name))
  477. (map (make-hash-table :test 'equal :size (length entities)))
  478. (entity-strings (mapcar (lambda (entity) (funcall transformer entity)) entities)))
  479. (cl-mapcar (lambda (entity entity-string)
  480. (puthash entity-string entity map))
  481. entities entity-strings)
  482. (let ((entity-string (completing-read prompt entity-strings nil t)))
  483. (gethash entity-string map))))
  484. (defun libmpdel-completing-read-entity (function prompt entity &optional transformer)
  485. "Call FUNCTION after prompting for an element of ENTITY.
  486. Pass PROMPT, the elements of ENTITY and TRANSFORMER to
  487. `libmpdel-completing-read'."
  488. (libmpdel-list
  489. entity
  490. (lambda (entities)
  491. (funcall function
  492. (libmpdel-completing-read prompt entities transformer)))))
  493. (defun libmpdel-funcall-on-stored-playlist (function)
  494. "Pass a stored playlist as parameter to FUNCTION.
  495. The user is asked to choose for a stored playlist first."
  496. (libmpdel-completing-read-entity
  497. function
  498. "Stored playlist: "
  499. 'stored-playlists))
  500. (defun libmpdel-current-playlist-add (entity)
  501. "Add ENTITY to a current playlist.
  502. ENTITY can also be a list of entities to add."
  503. (libmpdel-playlist-add entity 'current-playlist))
  504. (defun libmpdel-current-playlist-replace (entity)
  505. "Replace current playlist with ENTITY.
  506. ENTITY can also be a list of entities to replace with."
  507. (libmpdel-playlist-replace entity 'current-playlist))
  508. (defun libmpdel-stored-playlist-add (entity)
  509. "Add ENTITY to a stored playlist.
  510. The user is asked to choose for a stored playlist first.
  511. ENTITY can also be a list of entities to add."
  512. (libmpdel-funcall-on-stored-playlist
  513. (apply-partially #'libmpdel-playlist-add entity)))
  514. (defun libmpdel-stored-playlist-replace (entity)
  515. "Replace a stored playlist with ENTITY.
  516. The user is asked to choose for a stored playlist first.
  517. ENTITY can also be a list of entities to replace with."
  518. (libmpdel-funcall-on-stored-playlist
  519. (apply-partially #'libmpdel-playlist-replace entity)))
  520. (defun libmpdel-current-playlist-insert (entity)
  521. "Insert ENTITY after currently-played song and play it.
  522. ENTITY can also be a list of entities in which case all entities
  523. are added and the first one is played."
  524. (libmpdel-list-songs
  525. entity
  526. (lambda (songs)
  527. (libmpdel-send-commands
  528. (mapcar (lambda (song) (format "addid %S" (libmpdel-song-file song))) songs)
  529. (lambda (data)
  530. (let ((song-ids (mapcar (lambda (song-data) (cdr song-data)) data))
  531. ;; Add after current song if possible:
  532. (target-index (if (libmpdel-current-song) "-1" "0")))
  533. (libmpdel-send-commands
  534. ;; The reverse is important to get the songs in the same
  535. ;; order as in the selection:
  536. (mapcar
  537. (lambda (song-id) (format "moveid %s %s" song-id target-index))
  538. (reverse song-ids))
  539. (lambda (_) (libmpdel-send-command `("playid %s" ,(car song-ids)))))))))))
  540. (defun libmpdel-async-mapcar (list mapfn callback)
  541. "Apply MAPFN to each element of LIST and pass result to CALLBACK.
  542. MAPFN is a function taking 2 arguments: the element to map and a
  543. callback to call when the mapping is done."
  544. (if (not list)
  545. (funcall callback nil)
  546. (funcall ; transform the first element
  547. mapfn
  548. (car list)
  549. (lambda (first-mapped)
  550. (libmpdel-async-mapcar ; transform the rest
  551. (cdr list)
  552. mapfn
  553. (lambda (latter-elements)
  554. (funcall callback
  555. (cons first-mapped
  556. latter-elements))))))))
  557. (defun libmpdel-async-mapcan (list mapfn callback)
  558. "Apply MAPFN to each element of LIST.
  559. Concatenate the results and pass that to CALLBACK.
  560. MAPFN is a function taking 2 arguments: the element to map and a
  561. callback to call when the mapping is done."
  562. (libmpdel-async-mapcar
  563. list
  564. mapfn
  565. (lambda (groups)
  566. (funcall
  567. callback
  568. (apply #'cl-concatenate 'list groups)))))
  569. (defun libmpdel--get-profile-from-name (name)
  570. "Return an element of `libmpdel-profiles' matching NAME."
  571. (cl-find name libmpdel-profiles :test #'string= :key #'car))
  572. (defun libmpdel--select-profile ()
  573. "Ask the user to select a profile among `libmpdel-profiles' and return it."
  574. (unless (consp libmpdel-profiles)
  575. (user-error "Add profiles to `libmpdel-profiles'"))
  576. (if (= 1 (length libmpdel-profiles))
  577. (progn
  578. (message "Only 1 profile defined in `libmpdel-profiles'")
  579. (car libmpdel-profiles))
  580. (let* ((profile-names (mapcar #'car libmpdel-profiles))
  581. (profile-name (completing-read "Choose an MPD profile"
  582. profile-names nil t)))
  583. (libmpdel--get-profile-from-name profile-name))))
  584. ;;; Public functions
  585. (defun libmpdel-connected-p ()
  586. "Return non-nil if there is a connection to MPD server."
  587. (and libmpdel--connection
  588. (process-live-p (libmpdel--process))))
  589. (defun libmpdel-ensure-connection ()
  590. "Make sure there is an active connection to the MPD server."
  591. (unless (libmpdel-connected-p)
  592. (libmpdel--connect)))
  593. (defun libmpdel-disconnect ()
  594. "Close connection to the MPD server."
  595. (when (not (libmpdel-connected-p))
  596. (user-error "There is no connection to MPD"))
  597. (tq-close libmpdel--connection)
  598. (setq libmpdel--connection nil))
  599. (defun libmpdel-send-command (command &optional handler)
  600. "Send COMMAND to server and register HANDLER for the answer.
  601. If HANDLER is nil, ignore response."
  602. (libmpdel-ensure-connection)
  603. ;; if current command is IDLE, we have to cancel it. See
  604. ;; `mpdel-msghandlers' for more information.
  605. (when (eql (elt (car (last libmpdel--msghandlers)) 1) #'libmpdel--msghandler-idle)
  606. (libmpdel--raw-send-command "noidle"))
  607. (libmpdel--raw-send-command-with-handler command handler))
  608. (defun libmpdel-send-commands (commands &optional handler)
  609. "Send several COMMANDS at once and execute HANDLER once with result."
  610. (libmpdel-send-command
  611. (with-temp-buffer
  612. (insert "command_list_begin\n")
  613. (mapc (lambda (command) (insert command "\n")) commands)
  614. (insert "command_list_end")
  615. (buffer-substring-no-properties (point-min) (point-max)))
  616. handler))
  617. (defun libmpdel-entries (data key)
  618. "Collect DATA entries matching KEY."
  619. (mapcar #'cdr (cl-remove-if-not (apply-partially #'eq key) data :key #'car)))
  620. (defun libmpdel-sorted-entries (data key)
  621. "Sort and collect DATA entries matching KEY."
  622. (sort (libmpdel-entries data key) #'libmpdel--string<-ignore-case))
  623. (defun libmpdel-group-data (data)
  624. "Find repeating fields in DATA and group them."
  625. (when data
  626. (let ((first-key (caar data))
  627. result group)
  628. (mapc (lambda (key-value)
  629. (when (and
  630. (eq (car key-value) first-key)
  631. group)
  632. (push (reverse group) result)
  633. (setq group nil))
  634. (push key-value group))
  635. data)
  636. (push (reverse group) result)
  637. (reverse result))))
  638. (cl-defgeneric libmpdel-dired (entity)
  639. "Open `dired' on ENTITY.")
  640. (eval-when-compile
  641. (declare-function dired-jump "dired-x"))
  642. (cl-defmethod libmpdel-dired ((song libmpdel-song))
  643. (require 'dired-x)
  644. (dired-jump t (expand-file-name (libmpdel-song-file song) libmpdel-music-directory)))
  645. (defun libmpdel-equal (entity1 entity2)
  646. "Return non-nil if ENTITY1 and ENTITY2 represent the same entity."
  647. (equal (libmpdel-entity-id entity1) (libmpdel-entity-id entity2)))
  648. ;;; Helper queries
  649. (cl-defgeneric libmpdel-entity-to-criteria (entity)
  650. "Return search criteria matching ENTITY.")
  651. (cl-defmethod libmpdel-entity-to-criteria ((query string))
  652. query)
  653. (cl-defmethod libmpdel-entity-to-criteria ((artist libmpdel-artist))
  654. (format "artist %S" (libmpdel-entity-name artist)))
  655. (cl-defmethod libmpdel-entity-to-criteria ((album libmpdel-album))
  656. (format "%s album %S"
  657. (libmpdel-entity-to-criteria (libmpdel-artist album))
  658. (libmpdel-entity-name album)))
  659. (cl-defmethod libmpdel-entity-to-criteria ((song libmpdel-song))
  660. (format "%s title %S"
  661. (libmpdel-entity-to-criteria (libmpdel-album song))
  662. (libmpdel-entity-name song)))
  663. (cl-defgeneric libmpdel-list (entity function)
  664. "Call FUNCTION with all entries matching ENTITY."
  665. (libmpdel-list-songs entity function))
  666. (cl-defmethod libmpdel-list ((_entity (eql artists)) function)
  667. (libmpdel-send-command
  668. "list artist"
  669. (lambda (data)
  670. (funcall function
  671. (mapcar
  672. (lambda (artist-name) (libmpdel--artist-create :name artist-name))
  673. (libmpdel-sorted-entries data 'Artist))))))
  674. (cl-defmethod libmpdel-list ((_entity (eql albums)) function)
  675. (libmpdel-list
  676. 'artists
  677. (lambda (artists) (libmpdel-async-mapcan artists #'libmpdel-list function))))
  678. (cl-defmethod libmpdel-list ((_entity (eql stored-playlists)) function)
  679. "Call FUNCTION with all stored playlists as parameters."
  680. (libmpdel-send-command
  681. "listplaylists"
  682. (lambda (data)
  683. (funcall function
  684. (mapcar
  685. (lambda (playlist-name) (libmpdel--stored-playlist-create :name playlist-name))
  686. (libmpdel-sorted-entries data 'playlist))))))
  687. (cl-defmethod libmpdel-list ((artist libmpdel-artist) function)
  688. (libmpdel-send-command
  689. `("list album %s" ,(libmpdel-entity-to-criteria artist))
  690. (lambda (data)
  691. (funcall function
  692. (mapcar
  693. (lambda (album-name) (libmpdel--album-create :name album-name :artist artist))
  694. (libmpdel-sorted-entries data 'Album))))))
  695. (cl-defgeneric libmpdel-list-songs (entity function)
  696. "Call FUNCTION with all songs matching ENTITY."
  697. (libmpdel-send-command
  698. `("find %s" ,(libmpdel-entity-to-criteria entity))
  699. (lambda (data)
  700. (funcall function (libmpdel--create-songs-from-data data)))))
  701. (cl-defmethod libmpdel-list-songs ((stored-playlist libmpdel-stored-playlist) function)
  702. (libmpdel-send-command
  703. `("listplaylistinfo %S" ,(libmpdel-entity-name stored-playlist))
  704. (lambda (data)
  705. (funcall function (libmpdel--create-songs-from-data data)))))
  706. (cl-defmethod libmpdel-list-songs ((_ (eql current-playlist)) function)
  707. (libmpdel-send-command
  708. "playlistinfo"
  709. (lambda (data)
  710. (funcall function (libmpdel--create-songs-from-data data)))))
  711. (cl-defmethod libmpdel-list-songs ((search-criteria libmpdel-search-criteria) function)
  712. (libmpdel-send-command
  713. `("search %s %S"
  714. ,(libmpdel--search-criteria-type search-criteria)
  715. ,(libmpdel--search-criteria-what search-criteria))
  716. (lambda (data)
  717. (funcall function (libmpdel--create-songs-from-data data)))))
  718. (cl-defmethod libmpdel-list-songs ((filter libmpdel-filter) function)
  719. (libmpdel-send-command
  720. `("search %S" ,(libmpdel--filter-text filter))
  721. (lambda (data)
  722. (funcall function (libmpdel--create-songs-from-data data)))))
  723. (cl-defmethod libmpdel-list-songs ((song libmpdel-song) function)
  724. (funcall function (list song)))
  725. (cl-defmethod libmpdel-list-songs ((entities list) function)
  726. "Apply FUNCTION only once for every song in ENTITIES."
  727. (libmpdel-async-mapcan entities #'libmpdel-list-songs function))
  728. ;;; Playlist queries
  729. (cl-defgeneric libmpdel-playlist-add (entity playlist)
  730. "Add ENTITY to PLAYLIST.
  731. ENTITY can also be a list of entities to add.")
  732. (cl-defmethod libmpdel-playlist-add (entity (_ (eql current-playlist)))
  733. (libmpdel-send-command `("findadd %s" ,(libmpdel-entity-to-criteria entity))))
  734. (cl-defmethod libmpdel-playlist-add (entity (stored-playlist libmpdel-stored-playlist))
  735. (libmpdel-send-command
  736. `("searchaddpl %S %s"
  737. ,(libmpdel-entity-name stored-playlist)
  738. ,(libmpdel-entity-to-criteria entity))))
  739. (cl-defmethod libmpdel-playlist-add ((stored-playlist libmpdel-stored-playlist) (_ (eql current-playlist)))
  740. "Add content of STORED-PLAYLIST to the current playlist."
  741. (libmpdel-send-command `("load %S" ,(libmpdel-entity-name stored-playlist))))
  742. (cl-defmethod libmpdel-playlist-add ((entities list) playlist)
  743. (mapcar (lambda (entity) (libmpdel-playlist-add entity playlist))
  744. entities))
  745. (defun libmpdel-playlist-replace (entity playlist)
  746. "Clear PLAYLIST and add ENTITY to it."
  747. (libmpdel-playlist-clear playlist)
  748. (libmpdel-playlist-add entity playlist))
  749. (cl-defgeneric libmpdel-playlist-clear (playlist)
  750. "Remove all songs from PLAYLIST.")
  751. (cl-defmethod libmpdel-playlist-clear ((_ (eql current-playlist)))
  752. (libmpdel-send-command "clear"))
  753. (cl-defmethod libmpdel-playlist-clear ((playlist libmpdel-stored-playlist))
  754. (libmpdel-send-command `("playlistclear %S" ,(libmpdel-entity-name playlist))))
  755. (cl-defgeneric libmpdel-playlist-delete (songs playlist)
  756. "Remove SONGS from PLAYLIST.")
  757. (cl-defmethod libmpdel-playlist-delete (songs (_ (eql current-playlist)))
  758. (libmpdel-send-commands
  759. (mapcar (lambda (song) (format "deleteid %s" (libmpdel-song-id song)))
  760. songs)))
  761. (cl-defmethod libmpdel-playlist-delete (songs (stored-playlist libmpdel-stored-playlist))
  762. (libmpdel-list
  763. stored-playlist
  764. (lambda (all-playlist-songs)
  765. (let ((song-positions (cl-sort (mapcar (lambda (song)
  766. (cl-position song all-playlist-songs :test #'equal))
  767. songs)
  768. #'>)))
  769. (libmpdel-send-commands
  770. (mapcar
  771. (lambda (song-position)
  772. (format "playlistdelete %S %s"
  773. (libmpdel-entity-name stored-playlist)
  774. song-position))
  775. song-positions))))))
  776. (defun libmpdel-playlist-move-up (songs)
  777. "Move up SONGS in current playlist."
  778. ;; We should move up from first in playlist to last
  779. (let* ((songs (cl-sort (cl-copy-seq songs) #'< :key #'libmpdel-song-position)))
  780. ;; Don't move up if first song is selected
  781. (unless (= (libmpdel-song-position (car songs)) 0)
  782. (libmpdel-send-commands
  783. (mapcar (lambda (song)
  784. (format "moveid %s %s" (libmpdel-song-id song) (1- (libmpdel-song-position song))))
  785. songs)))))
  786. (defun libmpdel-playlist-move-down (songs)
  787. "Move down SONGS in current playlist."
  788. ;; We should move down from last in playlist to first
  789. (let* ((songs (cl-sort (cl-copy-seq songs) #'> :key #'libmpdel-song-position)))
  790. ;; Don't move down if last song is selected
  791. (unless (= (libmpdel-song-position (car songs)) (1- libmpdel--playlist-length))
  792. (libmpdel-send-commands
  793. (mapcar (lambda (song)
  794. (format "moveid %s %s" (libmpdel-song-id song) (1+ (libmpdel-song-position song))))
  795. songs)))))
  796. (defun libmpdel-playlist-save (name)
  797. "Save current playlist as new stored playlist named NAME."
  798. (interactive (list (read-from-minibuffer "Enter a new playlist name: ")))
  799. (libmpdel-send-command
  800. `("save %S" ,name)
  801. (lambda (_data) (message "Current playlist saved to %S" name))))
  802. ;;; Playback queries
  803. ;;;###autoload
  804. (defun libmpdel-playback-set-volume (volume)
  805. "Set volume to VOLUME."
  806. (interactive (list
  807. (read-string (format "Current volume is %s. New volume [0-100]: "
  808. (libmpdel-volume)))))
  809. (libmpdel-send-command `("setvol %s" ,volume)))
  810. ;;;###autoload
  811. (defun libmpdel-playback-next ()
  812. "Play next song in the playlist."
  813. (interactive)
  814. (libmpdel-send-command "next"))
  815. ;;;###autoload
  816. (defun libmpdel-playback-previous ()
  817. "Play previous song in the playlist."
  818. (interactive)
  819. (libmpdel-send-command "previous"))
  820. ;;;###autoload
  821. (defun libmpdel-play ()
  822. "Start playing."
  823. (interactive)
  824. (libmpdel-send-command "play"))
  825. ;;;###autoload
  826. (defun libmpdel-stop ()
  827. "Stop playing. See also `libmpdel-playback-play-pause'."
  828. (interactive)
  829. (libmpdel-send-command "stop"))
  830. (defun libmpdel-play-song (song)
  831. "Start playing SONG."
  832. (let ((song-id (libmpdel-song-id song)))
  833. (if song-id
  834. (libmpdel-send-command `("playid %s" ,song-id))
  835. (libmpdel-current-playlist-insert song))))
  836. ;;;###autoload
  837. (defun libmpdel-playback-play-pause ()
  838. "Toggle between play and pause.
  839. See also `libmpdel-playback-stop'."
  840. (interactive)
  841. (libmpdel-send-command
  842. (cl-case libmpdel--play-state
  843. (play "pause 1")
  844. (pause "pause 0")
  845. (stop "play"))))
  846. ;;;###autoload
  847. (defun libmpdel-playback-seek (time &optional handler)
  848. "Seeks to the position TIME within the current song.
  849. TIME is a string indicating a number of seconds, fractions
  850. allowed. If prefixed by + or -, then the time is relative to
  851. the current playing position.
  852. If HANDLER is non-nil, execute it with no parameter when seek
  853. succeeds."
  854. (interactive (list (read-string "New position (e.g., 67, -23, +12): ")
  855. (lambda (_) (message "Seek done."))))
  856. (libmpdel-send-command
  857. `("seekcur %S" ,time)
  858. (when handler (lambda (_) (funcall handler)))))
  859. ;;;###autoload
  860. (defun libmpdel-playback-set-random ()
  861. "Set playback mode to random."
  862. (interactive)
  863. (libmpdel-send-command `("random 1")))
  864. ;;;###autoload
  865. (defun libmpdel-playback-unset-random ()
  866. "Set playback mode to sequential (not random)."
  867. (interactive)
  868. (libmpdel-send-command `("random 0")))
  869. ;;;###autoload
  870. (defun libmpdel-playback-set-repeat ()
  871. "Set playback mode to repeat."
  872. (interactive)
  873. (libmpdel-send-command `("repeat 1")))
  874. ;;;###autoload
  875. (defun libmpdel-playback-unset-repeat ()
  876. "Set playback mode to sequential (not repeat)."
  877. (interactive)
  878. (libmpdel-send-command `("repeat 0")))
  879. ;;;###autoload
  880. (defun libmpdel-playback-set-single-forever ()
  881. "Set playback single mode to forever.
  882. This will repeat the current song forever."
  883. (interactive)
  884. (libmpdel-send-command `("single 1")))
  885. ;;;###autoload
  886. (defun libmpdel-playback-set-single-never ()
  887. "Set playback single mode to never.
  888. This will not repeat the current song."
  889. (interactive)
  890. (libmpdel-send-command `("single 0")))
  891. ;;;###autoload
  892. (defun libmpdel-playback-set-single-once ()
  893. "Set playback single mode to once.
  894. This will repeat the current song only once and then keep playing
  895. the current playlist."
  896. (interactive)
  897. (libmpdel-send-command `("single oneshot")))
  898. ;;; Status queries
  899. (defun libmpdel-refresh-status ()
  900. "Ask the server for its current status."
  901. (libmpdel-send-command "status" #'libmpdel--msghandler-status))
  902. ;;; Database queries
  903. ;;;###autoload
  904. (defun libmpdel-database-update (&optional uri)
  905. "Update the music database for URI, everything if nil.
  906. Updates the music database: find new files, remove deleted files,
  907. update modified files.
  908. URI is a particular directory or song/file to update. If you do
  909. not specify it, everything is updated."
  910. (interactive "i")
  911. (libmpdel-send-command
  912. (if uri `("update %S" ,uri) "update")))
  913. (provide 'libmpdel)
  914. ;;; libmpdel.el ends here
  915. ;; Local Variables:
  916. ;; checkdoc-arguments-in-order-flag: nil
  917. ;; End: