Emacs user interface for Music Player Daemon (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.

277 lines
10KB

  1. ;;; mpdel-browser.el --- Browsing MPD entities -*- lexical-binding: t; -*-
  2. ;; Copyright (c) 2019, 2020 Jose A Ortega Ruiz
  3. ;; Author: Jose A Ortega Ruiz <jao@gnu.org>
  4. ;; Keywords: multimedia
  5. ;; Url: https://gitlab.petton.fr/mpdel/mpdel
  6. ;; Package-requires: ((emacs "25.1"))
  7. ;; Version: 1.0.0
  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. ;; Executing `mpdel-browser-open' opens the entities browser, letting
  20. ;; users to navigate local directories or virtual collections such as
  21. ;; playlists offered by the MPD server, as well as search and jump to
  22. ;; the "all artists" and "all albums" colections.
  23. ;;; Code:
  24. (require 'libmpdel-directory)
  25. (require 'mpdel-core)
  26. (require 'mpdel-tablist)
  27. (require 'mpdel-playlist)
  28. ;;; Customization
  29. (defgroup mpdel-browser nil
  30. "Display and navigate listings of MPD entities."
  31. :group 'libmpdel)
  32. (defface mpdel-browser-directory-face
  33. '((t . (:inherit italic)))
  34. "Face for directories in browser.")
  35. (defcustom mpdel-browser-top-level-entries
  36. '(directories empty-line
  37. albums artists empty-line
  38. stored-playlists current-playlist empty-line
  39. search-album search-title search-artist search-filter)
  40. "A list of the entries to show in the browser's top level buffer.
  41. Each entry is shown as a selectable line with the entry's
  42. description; selecting it with the keyboard or mouse will list
  43. its contents in a new buffer."
  44. :type '(repeat (choice (const :tag "Directories" directories)
  45. (const :tag "All albums" albums)
  46. (const :tag "All artists" artists)
  47. (const :tag "Stored playlists" stored-playlists)
  48. (const :tag "Current playlist" current-playlist)
  49. (const :tag "Search by artist" search-artist)
  50. (const :tag "Search by album" search-album)
  51. (const :tag "Search by title" search-title)
  52. (const :tag "Search using filter" search-filter)
  53. (const :tag "Separator" empty-line))))
  54. (defcustom mpdel-browser-list-clean-up-function #'identity
  55. "Function called with the list of entries to be displayed, for clean-up.
  56. The function is called with the list of retreived entries, and
  57. should return a new list of entries, possibly modified and
  58. re-ordered. Use cases include elimination of duplicates (some
  59. backends accumulate renamed songs in their listings) or custom
  60. orderings."
  61. :type 'function)
  62. ;;; Formatting of directories in a tablist
  63. (defvar mpdel-browser--song-format (vector (list "Directory / Title" 30 t)
  64. (list "#" 6 nil)
  65. (list "Album" 30 t)
  66. (list "Disk" 4 t)
  67. (list "Date" 5 t)
  68. (list "Artist" 0 t)))
  69. (defun mpdel-browser--directory-format (parent)
  70. "Return the navigel column format for a directory that is a child of PARENT."
  71. (vector (list (or (libmpdel--directory-path parent) "") 60 t)))
  72. (defvar mpdel-browser--retrieving-format (vector (list "Retrieving ..." 60 t))
  73. "Format of the tablist before the children of an entity are known.")
  74. (defun mpdel-browser--includes-songs-p (children)
  75. "Check whether there is any song among CHILDREN."
  76. (cl-some #'libmpdel-song-p children))
  77. (defun mpdel-browser--format (parent-directory children)
  78. "Return format for a directory, given its PARENT-DIRECTORY and its CHILDREN."
  79. (if (mpdel-browser--includes-songs-p children)
  80. mpdel-browser--song-format
  81. (mpdel-browser--directory-format parent-directory)))
  82. (defun mpdel-browser--directory-columns (directory)
  83. "Return a column for DIRECTORY containing its name."
  84. (vector (propertize (or directory "") 'face 'mpdel-browser-directory-face)
  85. "" "" "" "" ""))
  86. (navigel-method mpdel navigel-tablist-format-children ((directory libmpdel-directory) children)
  87. (mpdel-browser--format directory children))
  88. (navigel-method mpdel navigel-tablist-format-children ((_e (eql directories)) _c)
  89. (vector (list "Directories" 60 t)))
  90. (navigel-method mpdel navigel-tablist-format ((_e libmpdel-directory))
  91. mpdel-browser--retrieving-format)
  92. (navigel-method mpdel navigel-tablist-format ((_e (eql directories)))
  93. mpdel-browser--retrieving-format)
  94. (navigel-method mpdel navigel-entity-to-columns ((directory libmpdel-directory))
  95. (mpdel-browser--directory-columns (libmpdel-entity-name directory)))
  96. (navigel-method mpdel navigel-entity-to-columns ((_e (eql directories)))
  97. (vector "Music directory"))
  98. ;;; Browser buffers
  99. (defun mpdel-browser--buffer-name (entity)
  100. "Return the name of a browser buffer displaying ENTITY."
  101. (format "* %s *"
  102. (cond ((stringp entity) entity)
  103. ((libmpdel-directory-p entity)
  104. (file-name-nondirectory (or (libmpdel--directory-path entity) "")))
  105. (t (libmpdel-entity-name entity)))))
  106. (navigel-method mpdel navigel-buffer-name ((_e (eql directories)))
  107. (mpdel-browser--buffer-name 'directories))
  108. (navigel-method mpdel navigel-buffer-name ((entity libmpdel-directory))
  109. (mpdel-browser--buffer-name entity))
  110. (navigel-method mpdel navigel-entity-buffer ((_e (eql directories)))
  111. (mpdel-browser--buffer-name 'directories))
  112. (navigel-method mpdel navigel-entity-buffer ((entity libmpdel-directory))
  113. (mpdel-browser--buffer-name entity))
  114. (navigel-method mpdel navigel-children
  115. (entity callback &context (major-mode mpdel-browser-mode))
  116. (libmpdel-list entity
  117. (lambda (c)
  118. (funcall callback
  119. (funcall mpdel-browser-list-clean-up-function c)))))
  120. ;;; Browser top level
  121. (cl-defmethod libmpdel-entity-name ((_e (eql empty-line)))
  122. "The empty line has an empty name."
  123. "")
  124. (navigel-method mpdel navigel-open ((_e (eql empty-line)) _t)
  125. nil)
  126. (defmacro mpdel-browser--defsearch (thing)
  127. "An utility macro for defining methods associated with a search for THING."
  128. (let* ((entity (intern (format "search-%s" thing)))
  129. (name (format "Search by %s" thing))
  130. (prompt (format "%s: " name))
  131. (type (symbol-name thing)))
  132. `(progn
  133. (cl-defmethod libmpdel-entity-name ((_e (eql ,entity))) ,name)
  134. (navigel-method mpdel navigel-open ((_e (eql ,entity)) _t)
  135. (let ((what (read-from-minibuffer ,prompt)))
  136. (navigel-open (libmpdel-search-criteria-create :type ,type
  137. :what what)
  138. nil))))))
  139. (mpdel-browser--defsearch album)
  140. (mpdel-browser--defsearch artist)
  141. (mpdel-browser--defsearch title)
  142. (mpdel-browser--defsearch filter)
  143. (cl-defmethod libmpdel-entity-name ((_e (eql browser)))
  144. "The name of the top level browser entity."
  145. "Browser")
  146. (cl-defmethod libmpdel-list ((_e (eql browser)) callback)
  147. "Listing of the top level browser, passed to CALLBACK.
  148. This listing is constructed using `mpdel-browser-top-level-entries'."
  149. (funcall callback mpdel-browser-top-level-entries))
  150. (cl-defmethod libmpdel-entity-parent ((_e (eql directories)))
  151. "The new parent of directories is the browser."
  152. 'browser)
  153. (navigel-method mpdel navigel-buffer-name ((_e (eql browser)))
  154. (format "* MPDel - %s:%d *" libmpdel-hostname libmpdel-port))
  155. (navigel-method mpdel navigel-entity-buffer ((_e (eql browser)))
  156. (navigel-buffer-name 'browser))
  157. (navigel-method mpdel navigel-tablist-format ((_e (eql browser)))
  158. (vector (list "MPDel Browser" 60 t)))
  159. (navigel-method mpdel navigel-entity-to-columns ((_e (eql browser)))
  160. (vector "Top level"))
  161. (navigel-method mpdel navigel-parent ((_e (eql artists))) 'browser)
  162. (navigel-method mpdel navigel-parent ((_e (eql albums))) 'browser)
  163. (navigel-method mpdel navigel-parent ((_e (eql directories))) 'browser)
  164. (navigel-method mpdel navigel-parent ((_e (eql stored-playlists))) 'browser)
  165. (navigel-method mpdel navigel-parent ((_e (eql current-playlist))) 'browser)
  166. (navigel-method mpdel navigel-children ((_e (eql directories)) callback)
  167. (libmpdel-list 'directories
  168. (lambda (children)
  169. (funcall callback (cons 'browser children)))))
  170. ;;;###autoload
  171. (defun mpdel-browser-open ()
  172. "Open the top level MPDel browser buffer."
  173. (interactive)
  174. (mpdel-core-open 'browser))
  175. ;;; Major mode
  176. (define-derived-mode mpdel-browser-mode mpdel-tablist-mode "MPDel Browser"
  177. "Mode for browsing directories and their contents")
  178. (navigel-method mpdel navigel-entity-tablist-mode ((_e (eql browser)))
  179. (mpdel-browser-mode))
  180. (navigel-method mpdel navigel-entity-tablist-mode ((_e (eql directories)))
  181. (mpdel-browser-mode))
  182. (navigel-method mpdel navigel-entity-tablist-mode ((_e libmpdel-directory))
  183. (mpdel-browser-mode))
  184. (navigel-method mpdel navigel-entity-tablist-mode ((_e (eql stored-playlists)))
  185. (mpdel-browser-mode))
  186. (defun mpdel-browser--entry-is-parent-directory-p (entity)
  187. "Check whether the given ENTITY is a parent directory."
  188. (let ((name (when (libmpdel-directory-p entity)
  189. (libmpdel-entity-name entity))))
  190. ;; Browser buffers showing children of 'directories or the point
  191. ;; to their parent via a tablist entry called "Music directory",
  192. ;; while real directory children use the conventional "..".
  193. (or (eql 'directories entity)
  194. (eql 'browser entity)
  195. (string= ".." name)
  196. (string= "Music directory" name))))
  197. (cl-defmethod navigel-parent-to-open (entity &context (major-mode mpdel-browser-mode))
  198. "Find parent of ENTITY when in a buffer with MAJOR-MODE `mpdel-browser-mode'."
  199. (cons (car (cl-find-if #'mpdel-browser--entry-is-parent-directory-p
  200. tabulated-list-entries
  201. :key #'car-safe))
  202. entity))
  203. (define-key mpdel-core-map (kbd ":") #'mpdel-browser-open)
  204. (provide 'mpdel-browser)
  205. ;;; mpdel-browser.el ends here