| 1 | ;;; emms-source-file.el --- EMMS sources from the filesystem. -*- lexical-binding: t; -*- |
| 2 | |
| 3 | ;; Copyright (C) 2003-2021 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Jorgen Schäfer <forcer@forcix.cx> |
| 6 | ;; Keywords: emms, mp3, mpeg, multimedia |
| 7 | |
| 8 | ;; This file is part of EMMS. |
| 9 | |
| 10 | ;; EMMS is free software; you can redistribute it and/or modify |
| 11 | ;; it under the terms of the GNU General Public License as published by |
| 12 | ;; the Free Software Foundation; either version 3, or (at your option) |
| 13 | ;; any later version. |
| 14 | ;; |
| 15 | ;; EMMS is distributed in the hope that it will be useful, |
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 18 | ;; GNU General Public License for more details. |
| 19 | ;; |
| 20 | ;; You should have received a copy of the GNU General Public License |
| 21 | ;; along with EMMS; see the file COPYING. If not, write to the |
| 22 | ;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, |
| 23 | ;; Boston, MA 02110-1301, USA. |
| 24 | |
| 25 | ;;; Commentary: |
| 26 | |
| 27 | ;; This file contains a track source for EMMS that is based on the |
| 28 | ;; file system. You can retrieve single files or whole directories. |
| 29 | ;; Also, this file offers the commands to play from these sources. |
| 30 | |
| 31 | ;;; Code: |
| 32 | |
| 33 | ;; Version control |
| 34 | (defvar emms-source-file-version "0.2 $Revision: 1.30 $" |
| 35 | "emms-source-file.el version string") |
| 36 | ;; $Id: emms-source-file.el,v 1.30 2005/08/11 06:16:15 yonirabkin Exp $ |
| 37 | |
| 38 | ;;; User Customization |
| 39 | |
| 40 | (require 'emms) |
| 41 | (require 'dired) |
| 42 | (require 'locate) |
| 43 | (eval-when-compile |
| 44 | (condition-case nil |
| 45 | (require 'locate) |
| 46 | (error nil))) |
| 47 | (require 'dired) |
| 48 | (require 'thingatpt) |
| 49 | |
| 50 | (defgroup emms-source-file nil |
| 51 | "*Sources for EMMS that use the file system." |
| 52 | :prefix "emms-source-file-" |
| 53 | :group 'emms-source) |
| 54 | |
| 55 | (defcustom emms-source-file-default-directory nil |
| 56 | "The default directory to look for media files." |
| 57 | :type '(choice (const :tag "None" nil) file)) |
| 58 | |
| 59 | (defcustom emms-source-file-gnu-find "find" |
| 60 | "The program name for GNU find." |
| 61 | :type 'string) |
| 62 | |
| 63 | (defcustom emms-source-file-directory-tree-function |
| 64 | (if (executable-find emms-source-file-gnu-find) |
| 65 | 'emms-source-file-directory-tree-find |
| 66 | 'emms-source-file-directory-tree-internal) |
| 67 | "*A function to call that searches in a given directory all files |
| 68 | that match a given regex. DIR and REGEX are the only arguments passed |
| 69 | to this function. |
| 70 | You have two build-in options: |
| 71 | `emms-source-file-directory-tree-internal' will work always, but might |
| 72 | be slow. |
| 73 | `emms-source-file-directory-tree-find' will work only if you have GNU |
| 74 | find, but it's faster." |
| 75 | :type 'function |
| 76 | :options '(emms-source-file-directory-tree-internal |
| 77 | emms-source-file-directory-tree-find)) |
| 78 | |
| 79 | (defcustom emms-source-file-exclude-regexp |
| 80 | (concat "\\`\\(#.*#\\|.*,v\\|.*~\\|\\.\\.?\\|\\.#.*\\|,.*\\)\\'\\|" |
| 81 | "/\\(CVS\\|RCS\\|\\.arch-ids\\|{arch}\\|,.*\\|\\.svn\\|" |
| 82 | "_darcs\\)\\(/\\|\\'\\)") |
| 83 | "A regexp matching files to be ignored when adding directories. |
| 84 | |
| 85 | You should set case-fold-search to nil before using this regexp |
| 86 | in code." |
| 87 | :type 'regexp) |
| 88 | |
| 89 | (defcustom emms-source-file-directory-hint-p t |
| 90 | "When non-nil, guess the directory based on a track at point." |
| 91 | :type 'boolean) |
| 92 | |
| 93 | ;; The `read-directory-name' function is not available in Emacs 21. |
| 94 | (defalias 'emms-read-directory-name |
| 95 | (if (fboundp 'read-directory-name) |
| 96 | #'read-directory-name |
| 97 | #'read-file-name)) |
| 98 | |
| 99 | (defun emms-source-file-directory-hint () |
| 100 | (if (and emms-source-file-directory-hint-p |
| 101 | emms-playlist-buffer-p |
| 102 | (emms-playlist-track-at)) |
| 103 | (let ((name (emms-track-get (emms-playlist-track-at) 'name)) |
| 104 | (type (emms-track-get (emms-playlist-track-at) 'type))) |
| 105 | (when (eq type 'file) |
| 106 | (file-name-directory name))) |
| 107 | emms-source-file-default-directory)) |
| 108 | |
| 109 | |
| 110 | ;;; Sources |
| 111 | |
| 112 | ;;;###autoload (autoload 'emms-play-file "emms-source-file" nil t) |
| 113 | ;;;###autoload (autoload 'emms-add-file "emms-source-file" nil t) |
| 114 | (define-emms-source file (file) |
| 115 | "An EMMS source for a single file - either FILE, or queried from the |
| 116 | user." |
| 117 | (interactive (list (read-file-name "Play file: " |
| 118 | (emms-source-file-directory-hint) |
| 119 | emms-source-file-default-directory |
| 120 | t))) |
| 121 | (if (file-directory-p file) |
| 122 | (emms-source-directory file) |
| 123 | (emms-playlist-insert-track |
| 124 | (emms-track 'file (expand-file-name file))))) |
| 125 | |
| 126 | ;;;###autoload (autoload 'emms-play-directory "emms-source-file" nil t) |
| 127 | ;;;###autoload (autoload 'emms-add-directory "emms-source-file" nil t) |
| 128 | (define-emms-source directory (dir) |
| 129 | "An EMMS source for a whole directory tree - either DIR, or queried |
| 130 | from the user." |
| 131 | (interactive (list |
| 132 | (emms-read-directory-name "Play directory: " |
| 133 | (emms-source-file-directory-hint) |
| 134 | emms-source-file-default-directory |
| 135 | t))) |
| 136 | (mapc (lambda (file) |
| 137 | (unless (or (let ((case-fold-search nil)) |
| 138 | (string-match emms-source-file-exclude-regexp file)) |
| 139 | (file-directory-p file)) |
| 140 | (emms-playlist-insert-track |
| 141 | (emms-track 'file (expand-file-name file))))) |
| 142 | (directory-files dir t (emms-source-file-regex)))) |
| 143 | |
| 144 | ;;;###autoload (autoload 'emms-play-directory-tree "emms-source-file" nil t) |
| 145 | ;;;###autoload (autoload 'emms-add-directory-tree "emms-source-file" nil t) |
| 146 | (define-emms-source directory-tree (dir) |
| 147 | "An EMMS source for multiple directory trees - either DIR, or the |
| 148 | value of `emms-source-file-default-directory'." |
| 149 | (interactive (list |
| 150 | (emms-read-directory-name "Play directory tree: " |
| 151 | (emms-source-file-directory-hint) |
| 152 | emms-source-file-default-directory |
| 153 | t))) |
| 154 | (let ((files (emms-source-file-directory-tree (expand-file-name dir) |
| 155 | (emms-source-file-regex))) |
| 156 | (case-fold-search nil)) |
| 157 | (emms-playlist-ensure-playlist-buffer) |
| 158 | (mapc (lambda (file) |
| 159 | (unless (string-match emms-source-file-exclude-regexp file) |
| 160 | (funcall emms-playlist-insert-track-function |
| 161 | (emms-track 'file file)))) |
| 162 | files))) |
| 163 | |
| 164 | ;;;###autoload (autoload 'emms-play-find "emms-source-file" nil t) |
| 165 | ;;;###autoload (autoload 'emms-add-find "emms-source-file" nil t) |
| 166 | (define-emms-source find (dir regex) |
| 167 | "An EMMS source that will find files in DIR or |
| 168 | `emms-source-file-default-directory' that match REGEX." |
| 169 | (interactive (list |
| 170 | (emms-read-directory-name "Find in directory: " |
| 171 | emms-source-file-default-directory |
| 172 | emms-source-file-default-directory |
| 173 | t) |
| 174 | (read-from-minibuffer "Find files matching: "))) |
| 175 | (mapc (lambda (file) |
| 176 | (unless (let ((case-fold-search nil)) |
| 177 | (string-match emms-source-file-exclude-regexp file)) |
| 178 | (emms-playlist-insert-track |
| 179 | (emms-track 'file file)))) |
| 180 | (emms-source-file-directory-tree (expand-file-name dir) regex))) |
| 181 | |
| 182 | ;;;###autoload (autoload 'emms-play-dired "emms-source-file" nil t) |
| 183 | ;;;###autoload (autoload 'emms-add-dired "emms-source-file" nil t) |
| 184 | (define-emms-source dired () |
| 185 | "Return all marked files of a dired buffer" |
| 186 | (interactive) |
| 187 | (mapc (lambda (file) |
| 188 | (if (file-directory-p file) |
| 189 | (emms-source-directory-tree file) |
| 190 | (emms-source-file file))) |
| 191 | (with-current-buffer emms-source-old-buffer |
| 192 | (dired-get-marked-files)))) |
| 193 | |
| 194 | |
| 195 | ;;; Helper functions |
| 196 | |
| 197 | ;;;###autoload |
| 198 | (defun emms-source-file-directory-tree (dir regex) |
| 199 | "Return a list of all files under DIR that match REGEX. |
| 200 | This function uses `emms-source-file-directory-tree-function'." |
| 201 | (message "Building playlist...") |
| 202 | (let ((pl (sort (funcall emms-source-file-directory-tree-function |
| 203 | dir |
| 204 | regex) |
| 205 | #'string<))) |
| 206 | (message "Building playlist...done") |
| 207 | pl)) |
| 208 | |
| 209 | (defun emms-source-file-directory-tree-internal (dir regex) |
| 210 | "Return a list of all files under DIR that match REGEX. |
| 211 | This function uses only emacs functions, so it might be a bit slow." |
| 212 | (let ((files '()) |
| 213 | (dirs (list dir))) |
| 214 | (while dirs |
| 215 | (cond |
| 216 | ((file-directory-p (car dirs)) |
| 217 | (if (or (string-match "/\\.\\.?$" (car dirs)) |
| 218 | (let ((symlink (file-symlink-p (car dirs)))) |
| 219 | (and symlink |
| 220 | (string-equal dir (substring symlink 0 (string-width dir)))))) |
| 221 | (setq dirs (cdr dirs)) |
| 222 | (setq dirs |
| 223 | (condition-case nil |
| 224 | (append (cdr dirs) |
| 225 | (directory-files (car dirs) |
| 226 | t nil t)) |
| 227 | (error |
| 228 | (cdr dirs)))))) |
| 229 | ((string-match regex (car dirs)) |
| 230 | (setq files (cons (car dirs) files) |
| 231 | dirs (cdr dirs))) |
| 232 | (t |
| 233 | (setq dirs (cdr dirs))))) |
| 234 | files)) |
| 235 | |
| 236 | (defun emms-source-file-directory-tree-find (dir regex) |
| 237 | "Return a list of all files under DIR that match REGEX. |
| 238 | This function uses the external find utility. The name for GNU find |
| 239 | may be supplied using `emms-source-file-gnu-find'." |
| 240 | (with-temp-buffer |
| 241 | (call-process emms-source-file-gnu-find |
| 242 | nil t nil |
| 243 | "-L" ; follow symlinks |
| 244 | (expand-file-name dir) |
| 245 | "-type" "f" |
| 246 | "-iregex" (concat ".*\\(" regex "\\).*")) |
| 247 | (delete "" |
| 248 | (split-string (buffer-substring (point-min) |
| 249 | (point-max)) |
| 250 | "\n")))) |
| 251 | |
| 252 | (defmacro emms-with-excluded-directories (directory-list &rest body) |
| 253 | "Run BODY while excluding DIRECTORY-LIST." |
| 254 | `(let ((emms-source-file-exclude-regexp |
| 255 | (concat (or ,emms-source-file-exclude-regexp "") |
| 256 | "\\|\\(" |
| 257 | (or (regexp-opt ,directory-list) "") |
| 258 | "\\)"))) |
| 259 | ,@body)) |
| 260 | |
| 261 | ;;;###autoload |
| 262 | (defun emms-source-file-regex () |
| 263 | "Return a regexp that matches everything any player (that supports |
| 264 | files) can play." |
| 265 | (mapconcat (lambda (player) |
| 266 | (or (emms-player-get player 'regex) |
| 267 | "")) |
| 268 | emms-player-list |
| 269 | "\\|")) |
| 270 | |
| 271 | ;; emms-locate should be part of a once to be emms-dired, with maybe |
| 272 | ;; file rename after tag functions and so on, but till then i park it |
| 273 | ;; here... :) |
| 274 | |
| 275 | ;;;###autoload |
| 276 | (defun emms-locate (regexp) |
| 277 | "Search for REGEXP and display the results in a locate buffer" |
| 278 | (interactive "sRegexp to search for: ") |
| 279 | (require 'locate) |
| 280 | (save-window-excursion |
| 281 | (set-buffer (get-buffer-create "*EMMS Find*")) |
| 282 | (locate-mode) |
| 283 | (erase-buffer) |
| 284 | (mapc (lambda (elt) (insert (cdr (assoc 'name elt)) "\n")) |
| 285 | (emms-source-find emms-source-file-default-directory regexp)) |
| 286 | (locate-do-setup regexp)) |
| 287 | (and (not (string-equal (buffer-name) "*EMMS Find*")) |
| 288 | (switch-to-buffer-other-window "*EMMS Find*")) |
| 289 | (run-hooks 'dired-mode-hook) |
| 290 | (dired-next-line 2)) |
| 291 | |
| 292 | ;; Strictly speaking, this does not belong in this file (URLs are not |
| 293 | ;; real files), but it's close enough :-) |
| 294 | |
| 295 | ;;;###autoload (autoload 'emms-play-url "emms-source-file" nil t) |
| 296 | ;;;###autoload (autoload 'emms-add-url "emms-source-file" nil t) |
| 297 | (define-emms-source url (url) |
| 298 | "An EMMS source for an URL - for example, for streaming." |
| 299 | (interactive (list (read-string "Play URL: " (thing-at-point-url-at-point)))) |
| 300 | (emms-playlist-insert-track (emms-track 'url url))) |
| 301 | |
| 302 | ;;;###autoload (autoload 'emms-play-streamlist "emms-source-file" nil t) |
| 303 | ;;;###autoload (autoload 'emms-add-streamlist "emms-source-file" nil t) |
| 304 | (define-emms-source streamlist (streamlist) |
| 305 | "An EMMS source for streaming playlists (usually URLs ending in .pls)." |
| 306 | (interactive "sPlay streamlist URL: ") |
| 307 | (emms-playlist-insert-track (emms-track 'streamlist streamlist))) |
| 308 | |
| 309 | |
| 310 | (provide 'emms-source-file) |
| 311 | ;;; emms-source-file.el ends here |