├── .gitignore ├── README.markdown ├── mingus-stays-home.el └── mingus.el /.gitignore: -------------------------------------------------------------------------------- 1 | HISTORY 2 | /TAGS 3 | /gist-* 4 | *patch 5 | *elc 6 | -------------------------------------------------------------------------------- /README.markdown: -------------------------------------------------------------------------------- 1 | Mingus is a frontend for GNU Emacs to the Music Player daemon. The 2 | interface closely, though not strictly, resembles that of ncmpc, which 3 | I had been using before (the main drawback of ncmpc for me was it’s 4 | apparent lack of support for unicode). It has some advantages over 5 | other clients, mainly in the field of playlist editing. This is 6 | achieved through marking and regions as you are used too in emacs and 7 | in dired. Mingus also provides a point-of-insertion for inserting new 8 | songs. This can be handy to drop a song after the currently playing 9 | one (enqueue), but is more flexible. Mingus is distributed under the 10 | GPL. 11 | 12 | w3m 13 | === 14 | Another plus is its integration with emacs-w3m , in the sense that, 15 | when bumping into a sexy podcast or radio-stream while browsing in 16 | the browser of browsers, you have the ability to add any stream at 17 | point (and play it directly, if so desired). 18 | 19 | Dired 20 | ===== 21 | Jump from Mingus to song at point in Dired, and, vice versa, add songs 22 | from Dired to the playlist. 23 | 24 | Autocompletion on queries 25 | ========================= 26 | Mingus has kind of autocompletion on queries. The browser can show 27 | either the song results or their parent directories. This lets you go 28 | easy on the tagging, and make good use of a simple file-system 29 | structured song collection. Mingus can be configured to use ido-mode 30 | completion. 31 | 32 | Bookmarking 33 | =========== 34 | Mingus with version >= 0.32 (Fleurette Africaine) has bookmarks to 35 | remember filename and position. This can be very useful with 36 | audiobooks or working with language courses. 37 | 38 | Global bookmarking shortcuts C-x r b and C-x r m are overwritten in 39 | Mingus' global map to have alike functionality, and C-x r d is set to 40 | mingus-bookmark-delete. The function mingus-bookmark-set (C-x r b) 41 | takes currently playing file + its current elapsed time. Buffer 42 | position is ignored. Mingus-bookmark-jump will jump to a bookmark. It 43 | inserts the file into the current playlist when it is not yet there. 44 | 45 | Mingus stays home 46 | ================= 47 | If mingus stays home, i.e. the daemon mpd is run from the same 48 | computer as the client, mingus-stays-home.el provides an experimental 49 | cd-burning tool (mingus-burns). When you have 50 | [taggit.el](https://github.com/pft/elisp-assorted/blob/master/taggit.el) 51 | and the command-line [taggit program](https://github.com/ft/taggit) 52 | mingus can call that with a selection of songs to perform (batch) tag 53 | editing. 54 | 55 | Prerequisites 56 | ============= 57 | libmpdee.el by R. Ramkumar. Currently mingus runs on GNU Emacs22 and 58 | GNU Emacs 23. If you also want to use mingus-stays-home.el, cdrecord (or 59 | any other command-line cd-burning tool taking files as arguments) might 60 | be needed. 61 | 62 | ToDo 63 | ==== 64 | mingus.el 65 | --------- 66 | - Add text-properties (fringe-bitmap?) for point-of-insertion 67 | - Add a search buffer In this search buffer, you would be able to 68 | filter songs by their attributes. It would have a tabular layout, 69 | and you could safe-sort the songs. Maybe as-you-type, maybe not. 70 | -------------------------------------------------------------------------------- /mingus-stays-home.el: -------------------------------------------------------------------------------- 1 | ;;; mingus-stays-home.el --- Interface for local MPD server 2 | 3 | ;; _ _ 4 | ;; _ __ ___ ___| |_ __ _ _ _ ___ | |__ ___ _ __ ___ ___ 5 | ;; | '_ ` _ \ / __| __/ _` | | | / __| | '_ \ / _ \| '_ ` _ \ / _ \ 6 | ;; | | | | | |_ \__ \ || (_| | |_| \__ \ | | | | (_) | | | | | | __/ 7 | ;; |_| |_| |_(_) |___/\__\__,_|\__, |___/ |_| |_|\___/|_| |_| |_|\___| 8 | ;; |___/ 9 | 10 | ;; Copyright (C) 2006-2011, 2015 Niels Giesen 12 | 13 | ;; Author: Niels Giesen 14 | 15 | ;; Contributors (with patches and bug reports): Jeremie Lasalle 16 | ;; Ratelle, "Lexa12", Marc Zonzon, Mark Taylor, Drew Adams and Alec 17 | ;; Heller 18 | 19 | ;; Version: Open Letter to Duke, or: 0.33 20 | ;; Latest version can be found at http://github.com/pft/mingus/ 21 | ;; For Changes, please view http://github.com/pft/mingus/commits/master 22 | 23 | ;; In version 0.33 id3-related stuff has been removed, in favour if 24 | ;; the more general taggit.el to be found at 25 | ;; http://github.com/pft/elisp-assorted. When taggit has been loaded 26 | ;; before will be require'd and some keys bound to it. 27 | 28 | ;; NEW in 0.23: 29 | 30 | ;; Removed silly dependencies for calculating time of song (mpd already knows 31 | ;; about them: RTFM afore thou proggest pft!). 32 | 33 | ;; Substituted sentinels for timers. 34 | 35 | ;; NEW in 0.22: 36 | 37 | ;; Added ogg and flac support for metadata (the mingus-id3-* functions) 38 | 39 | ;; Added flac and wav support for `mingus-burn-it' 40 | 41 | ;; Fixed a shitload of bugs; introduced just as many (hopefully not). 42 | 43 | ;; Increased number of dependencies to do all this (see below under 'Further 44 | ;; requirements'). 45 | 46 | ;; NOTE (at version 0.21) : Version 0.21 is actually the first published version 47 | ;; of mingus-stays-home. To provide easy checking whether the versions of 48 | ;; mingus.el and mingus-stays-home (should) work together, it was decided to 49 | ;; give them concurrent version numbers. 50 | 51 | ;; Keywords: multimedia, elisp, music, mpd 52 | 53 | ;; This file is *NOT* part of GNU Emacs 54 | 55 | ;; This program is free software; you can redistribute it and/or 56 | ;; modify it under the terms of the GNU General Public License 57 | ;; as published by the Free Software Foundation; either version 2 58 | ;; of the License, or (at your option) any later version. 59 | 60 | ;; This program is distributed in the hope that it will be useful, 61 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 62 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 63 | ;; GNU General Public License for more details. 64 | 65 | ;; You should have received a copy of the GNU General Public License 66 | ;; along with this program; if not, write to the Free Software 67 | ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 68 | ;; 02111-1307, USA. 69 | 70 | ;;; COMMENTARY: 71 | 72 | ;; INSTALLATION INSTRUCTIONS: 73 | 74 | ;; Byte-compile, IN ORDER, repeat: IN ORDER, the files mingus.el and 75 | ;; mingus-stays-home.el 76 | 77 | ;; Then put the following in your .emacs: 78 | 79 | ;; (add-to-list 'load-path "/path/where/mingus-and-mingus-stays-home-reside") 80 | ;; (autoload 'mingus "mingus-stays-home" nil t) 81 | 82 | ;; Make sure you have a version of mingus.el of the same version number 83 | ;; available in your load-path. 84 | 85 | ;; FUNCTIONALITY 86 | 87 | ;;; Goal: provide extra functionality to mingus that is only possible when mpd 88 | ;;; is run locally, i.e. the frontend has full access to the configuration file 89 | ;;; and the filesystem used by mpd. 90 | 91 | ;;; Extent: currently undecided, but at least: 92 | 93 | ;;; * integration with other emacs-modes: 94 | 95 | ;;; ** MINIBUFFER COMPLETION: 96 | 97 | ;;; using the minibuffer in a better way to add songs or directories, than 98 | ;;; mingus-insert previously did. This is done with the function 99 | ;;; `mingus-dwim-add'. `mingus-insert' keeps its old behaviour. 100 | 101 | ;;; ** BURNING CD'S with `mingus-burns'! In DEVELOPMENT stage, but nonetheless 102 | ;;; ** usable. 103 | 104 | ;;; Make sure the directory referred to by the variable 105 | ;;; `mingus-burns-tmp-wav-dir' (default: "~/.mingus/tmp") exists. This is where 106 | ;;; the intermediate files in the burning process will go. 107 | 108 | ;;; NOTE mingus-burns currently does NOT check for the capacity of the inserted 109 | ;;; disk, nor whether it is writable. You are left to your own devices for 110 | ;;; this. The green-redness if the indication bar displays just what is usually 111 | ;;; encountered. 112 | 113 | ;;; INFO: mingus-burns records cd's with the contents of the current 114 | ;;; playlist of mpd. It can also just be used to see what the duration 115 | ;;; of a playlist and its respective songs is. The playlist-editing 116 | ;;; functions are *not* as wide as in the normal playlist buffer 117 | ;;; (tagged `*Mingus*'). However, basic support for deletion of song 118 | ;;; at point and of songs in region does exist, with respect for the 119 | ;;; variables `*mingus-point-of-insertion*' and 120 | ;;; `*mingus-marked-list*'. You can add songs without leaving the 121 | ;;; *Mingus Burns* buffer as well, by use of `mingus-dwim-add'. Adding 122 | ;;; songs leads to a complete recomputation of song duration, which 123 | ;;; may take a while, so the fastest way to achieve nice contents for 124 | ;;; your CD is to first add a bunch of songs (but not way to much of 125 | ;;; course), and then delete the ones you can do without. It looks 126 | ;;; more attractive than the default playlist buffer, but because of 127 | ;;; the slowness inherent in computing duration, it is not planned to 128 | ;;; be a full substitute for it, at least not in the near future. 129 | 130 | ;;; REQUIREMENTS: 131 | 132 | ;;; version 0.22 required too much, glad to be able to trim it down again in 133 | ;;; version 0.23 after having read some documentation: 134 | 135 | ;;; decoding: 136 | 137 | ;;; sox -- for decoding songs to the .wav format. 138 | 139 | ;;; flac -- for decoding flacs to the .wav format. Must get flac into sox... 140 | 141 | ;;; burning: 142 | 143 | ;;; cdrecord (or: wodim, if you stick to Debian guidelines) -- for burning the 144 | ;;; cd. Actually, this can be customized with the variables 145 | ;;; `mingus-blank-string' and `mingus-burns-format-string' 146 | 147 | ;;; ** VIEW COVER ART (ach, why not?) 148 | 149 | ;;; when available, you can use `thumbs' to view cover art from within Mingus: 150 | ;;; see `mingus-thumbs' (key: "T") 151 | 152 | ;;; known bugs: sometimes unicode strings in tags can lead to errors. 153 | 154 | ;;; For any questions, suggestions and so forth, contact me at the address 155 | ;;; stated at the top of this file. 156 | 157 | ;;; ( use dto's --already deprecated-- golisp-mode to make use of the indexing 158 | ;;; in this file: find it at http://dto.freeshell.org/notebook/GoLisp.html ) 159 | 160 | ;;; Code: 161 | (require 'mingus) 162 | ;; Even though Mingus already requires cl, in Emacs23 we have to silence the 163 | ;; compiler (this might be a regression): 164 | (require 'cl-lib) 165 | (require 'url) 166 | (require 'taggit nil t) 167 | ;;;; {{Update Help Text}} 168 | 169 | (setq mingus-help-text 170 | (replace-regexp-in-string 171 | "MORE ELABORATE INSTRUCTIONS:" 172 | "BURNER KEYS: 173 | 174 | B mingus-burn-it 175 | D mingus-burns-decode-playlist 176 | E mingus-blank-disk 177 | 178 | MORE ELABORATE INSTRUCTIONS:" 179 | (replace-regexp-in-string 180 | "U mingus-unmark-all" 181 | (format 182 | "U mingus-unmark-all%s" 183 | (if (featurep 'taggit) 184 | " 185 | # taggit-interactive 186 | e taggit (edit buffer)" "")) 187 | (replace-regexp-in-string 188 | "mingus-browser: 3" 189 | "mingus-browser: 3 190 | mingus-burns: 4\n" mingus-help-text t) t) t)) 191 | 192 | 193 | ;;;; {{Update *mingus-header-when-empty*}} 194 | (setq *mingus-header-when-empty* "Press ? for help, 3 for Mingus Browser, 4 195 | for Mingus Burns and 0 for dired\n\nPress 2 to come back here from within 196 | Mingus buffers, M-x mingus from elsewhere.") 197 | 198 | (defgroup mingus-stays-home nil 199 | "Group for customization of variables used when mpd is run on 200 | the same computer as mingus" 201 | :group 'mingus) 202 | 203 | (eval-when (load) 204 | (unless (string-match "GNU Emacs 21" (version)) 205 | ;;fixme: make this work in emacs21 too 206 | (when (featurep 'taggit) 207 | (define-key-after mingus-playlist-map [menu-bar mingus taggit-interactive] 208 | '("Set tags" . taggit-interactive) 'dired) 209 | (define-key-after mingus-playlist-map [menu-bar mingus taggit] 210 | '("Visit edit buffer for tags" . taggit) 'taggit-interactive) 211 | (define-key mingus-playlist-map "#" 'taggit-interactive) 212 | (define-key mingus-playlist-map "e" 'taggit)))) 213 | 214 | ;;;; {{Thumbs}} 215 | (eval-when (compile) 216 | (when (featurep 'thumbs) 217 | (defun mingus-thumbs () 218 | "In mingus, open a buffer with cover art found in the directory of song at point." 219 | (interactive) 220 | (thumbs (_mingus-get-parent-dir))) 221 | 222 | (define-key mingus-playlist-map "T" 'mingus-thumbs) 223 | (define-key mingus-browse-map "T" 'mingus-thumbs))) 224 | 225 | ;;;; {{Customization}} 226 | (defgroup mingus-burns nil 227 | "Customization group for recording cd's with `mingus'" 228 | :group 'mingus) 229 | 230 | (defcustom mingus-burns-tmp-wav-dir "~/.mingus/tmp" 231 | "Directory to hold temporary .wav files for a recording session. 232 | 233 | This directory will be created when it does not exist." 234 | :group 'mingus-burns 235 | :type '(file)) 236 | 237 | (defcustom mingus-burns-format-string 238 | "wodim dev=%s -eject -pad -audio -speed=%s -fix" 239 | "Format string for the burning process. 240 | This string can be fed, in order: 241 | 242 | mingus-burns-device 243 | mingus-burns-speed 244 | 245 | However, you can just as well specify it directly in this string." 246 | :group 'mingus-burns 247 | :type '(string)) 248 | 249 | (defcustom mingus-burns-device "/dev/cdrom" 250 | "Device name to use for recording" 251 | :group 'mingus-burns 252 | :type '(choice (file :tag "File (such as /dev/cdrom)") 253 | (string :tag "Description (such as ATA:1,0,0)"))) 254 | 255 | (defcustom mingus-burns-speed 2 256 | "Speed of cd-recording device" 257 | :group 'mingus-burns 258 | :type 'number) 259 | 260 | (defcustom mingus-blank-string 261 | "wodim -eject blank=all" 262 | "Command with which to blank a cd." 263 | :group 'mingus-burns 264 | :type 'string) 265 | 266 | 267 | ;;;; {{Keymap}} 268 | (defvar mingus-burn-mode-map (copy-keymap mingus-global-map) 269 | "Burnin keymap for `mingus'") 270 | 271 | (define-key mingus-burn-mode-map " " 'scroll-up) 272 | (define-key mingus-burn-mode-map "\C-m" 'mingus-burns-play) 273 | (define-key mingus-burn-mode-map "d" 'mingus-burns-del) 274 | 275 | (define-key mingus-burn-mode-map "B" 'mingus-burn-it) 276 | (define-key mingus-burn-mode-map "D" 'mingus-burns-decode-playlist) 277 | (define-key mingus-burn-mode-map "E" 'mingus-blank-disk) 278 | 279 | (define-key mingus-burn-mode-map [menu-bar mingus sep-playlist-editing] 280 | '(menu-item "--")) 281 | (define-key mingus-burn-mode-map [menu-bar mingus unset] 282 | '("Unset Insertion Point" . mingus-unset-insertion-point)) 283 | (define-key mingus-burn-mode-map [menu-bar mingus sep4] 284 | '(menu-item "--")) 285 | (define-key mingus-burn-mode-map [menu-bar mingus burn] 286 | '(menu-item "Burn CD" mingus-burn-it :burnin "Burn a cd with current contents of the playlist")) 287 | (define-key mingus-burn-mode-map [menu-bar mingus decode] 288 | '(menu-item "Decode Playlist" mingus-burns-decode-playlist :burnin "Decode current contents of the playlist to .wav files")) 289 | (define-key mingus-burn-mode-map [menu-bar mingus blank] 290 | '(menu-item "Blank Disk" mingus-blank-disk :burnin "Blank disk")) 291 | (define-key mingus-burn-mode-map [menu-bar mingus sep3] 292 | '(menu-item "--")) 293 | 294 | (define-key mingus-burn-mode-map [menu-bar mingus browser] 295 | '(menu-item "Browser" mingus-browse :burnin "go to browser")) 296 | (define-key mingus-burn-mode-map [menu-bar mingus playlist] 297 | '(menu-item "Playlist" mingus :burnin "go to playlist")) 298 | 299 | (define-key mingus-burn-mode-map "0" 'mingus-dired-file) 300 | (define-key mingus-burn-mode-map [menu-bar mingus dired] 301 | '(menu-item "Dired" mingus-dired-file :burnin "look song up in dired")) 302 | 303 | (define-key mingus-playlist-map "4" 'mingus-burns) 304 | 305 | (define-key mingus-playlist-map [menu-bar mingus burner] 306 | '(menu-item "Burner" mingus-burns)) 307 | 308 | (define-key mingus-browse-map "4" 'mingus-burns) 309 | (define-key mingus-help-map [menu-bar mingus burner] 310 | '(menu-item "Burner" mingus-burns)) 311 | 312 | (define-key mingus-help-map "4" 'mingus-burns) 313 | (define-key mingus-browse-map [menu-bar mingus burner] 314 | '(menu-item "Burner" mingus-burns)) 315 | 316 | ;;;; {{Generic Functions}} 317 | ;; Replace with: (?) 318 | (defun mingus-read-entire-metadata () 319 | (mpd-get-songs mpd-inter-conn "playlistinfo") 320 | ;; (mapcar (lambda (sublist) 321 | ;; (mapcar (lambda (item) 322 | ;; (cond 323 | ;; ((eq item 'Pos) 'Pos) 324 | ;; ((symbolp item) 325 | ;; (intern-soft (concat ":" (downcase (symbol-name item))))) 326 | ;; (t item))) 327 | ;; sublist)) 328 | ;; (mpd-get-songs mpd-inter-conn "playlistinfo")) 329 | ) 330 | 331 | (defun mingus-what-type (string) 332 | "Return symbol, based on extension" 333 | (string-match "\\.\\([^.]*\\)$" string) 334 | (intern-soft (downcase (match-string 1 string)))) 335 | 336 | (defun mingus-burns-get-name-for-shell () 337 | (shell-quote-argument 338 | (mingus-burns-get-name))) 339 | 340 | (defun mingus-burns-get-name () 341 | (format "%s%s" mingus-mpd-root 342 | (getf (mingus-get-details) 'file))) 343 | 344 | ;; keep me 345 | (defun mingus-burns-color-bar (pos-beg-from-bol pos-end-from-bol color) 346 | (put-text-property (+ pos-beg-from-bol (point-at-bol)) 347 | (+ pos-end-from-bol (point-at-bol)) 348 | 'face `( ;(background-color . "#000000") 349 | (foreground-color . ,color) 350 | (weight . "bold")))) 351 | 352 | ;; (defun mingus-burns-remove-non-local-files (contents) 353 | ;; (mapconcat 'identity (remove-if (lambda (item) (string-match "^#[0-9]+) http://" item)) (split-string contents "\n")) "\n")) 354 | 355 | ;; STILL NEED TO GET SOMETHING FROM THIS 356 | ;; (defun mingus-burns () 357 | ;; "Go to the buffer in `mingus' where recording takes place." 358 | ;; (interactive) 359 | ;; (switch-to-buffer "*Mingus Burns*") 360 | ;; (setq major-mode 'mingus-burns) 361 | ;; (setq mode-name "Mingus-burns") 362 | ;; (use-local-map mingus-burn-mode-map) 363 | ;; (let ((buffer-read-only nil) 364 | ;; (new-contents (shell-command-to-string "mpc --format \"%file%\" playlist"))) 365 | ;; (if (string-match "^#[0-9]+) http://" new-contents) 366 | ;; (message "There is a non-local file (a stream) in the playlist. Please remove before using mingus-burns.") 367 | ;; (when (or (= (point-max) (point-min)) ;if there's an empty-buffer or the playlist has changed in the mean time 368 | ;; (not (equal new-contents *mingus-buffer-contents*))) 369 | ;; (erase-buffer) 370 | ;; (cond ((< 1 (length new-contents)) 371 | ;; (message "Computing lengths, this may take a while") 372 | ;; (insert (setq *mingus-buffer-contents* new-contents)) 373 | ;; (mingus-burns-invisible) 374 | ;; (mingus-compute-buffer-length)) 375 | ;; (t (insert "Press ? for help, 2 for Mingus Playlist, 3 for Mingus Browser and 0 for Dit.red\n\nPress 4 from within Mingus buffers to come back here, M-x mingus-burns from elsewhere.\n\nPlaylist is empty, please add some songs.\n\nYou can do so with either mingus-dwim-add, with mingus-browse or from within dired.") 376 | ;; (goto-char (point-min))))))) 377 | ;; (setq buffer-read-only t)) 378 | 379 | ;; throw me away 380 | (defun mingus-burns-del () 381 | "Delete song at point." 382 | (interactive) 383 | (block nil 384 | (save-excursion 385 | (let* ((buffer-read-only nil) 386 | (length-of-song-at-p (getf (mingus-get-details) 'Time)) 387 | (min:secs (mingus-sec->min:sec (or length-of-song-at-p (return nil))))) 388 | (if (null min:secs) (message "Nothing to delete") 389 | (mpd-delete mpd-inter-conn (1- (mingus-line-number-at-pos))) 390 | (mingus-reset-point-of-insertion) 391 | (delete-region (point-at-bol) (point-at-bol 2)) 392 | (decf (get '*mingus-b-session* :total-time) length-of-song-at-p) 393 | (mingus-goto-line (- (mingus-line-number-at-pos (point-max)) 2)) 394 | (delete-region (point) (point-max)) 395 | (mingus-2-burns-bar (get '*mingus-b-session* :total-time)))) 396 | (forward-line -1)))) 397 | 398 | (defun mingus-burns-play () 399 | (interactive) 400 | (mingus-play (plist-get (get-text-property (point-at-bol) 'metadata) 'Pos))) 401 | 402 | ;;;; {{Recording}} 403 | (defvar *mingus-b-session* nil) 404 | 405 | (defun mingus-b-the-cd () 406 | "Perfom the act of burning a cd from mpd playlist 407 | Use M-x mingus-decode-playlist if you just want to decode the files." 408 | (message "Mingus-a-Burning... C-x b *Mingus-Output* to watch the process.") 409 | (set-process-sentinel 410 | (apply 'start-process-shell-command "mingburn" "*Mingus-Output*" 411 | (format mingus-burns-format-string mingus-burns-device mingus-burns-speed) 412 | (mapcar 413 | (lambda (item) 414 | (shell-quote-argument (mingus-dec-transl-src->dest (getf item 'file)))) 415 | *mingus-b-session*)) 416 | 'mingus-b-ask-to-keep-session)) 417 | 418 | (defun mingus-b-ask-to-keep-session (&optional process event) ;a sentinel 419 | (when 420 | (string-match "^exited abnormally with code " event) 421 | (switch-to-buffer "*Mingus-Output*") 422 | (and (not (eq (process-status process) 'exit)) 423 | (stop-process process)) 424 | (error "Something happened that should not have. Inspect *Mingus-Output* buffer for any hints")) 425 | (put '*mingus-b-session* :burn nil) ;always reset to not go burning! 426 | (if (y-or-n-p "Remove temporary wave files?") 427 | (mapc 'delete-file 428 | (mapcar (lambda (item) 429 | (mingus-dec-transl-src->dest (getf item 'file))) 430 | *mingus-b-session*))) 431 | (unless (y-or-n-p "Keep session data? ") 432 | (setq *mingus-b-session* nil))) 433 | 434 | (defun mingus-burn-it () 435 | "Burn a disk from current sessiondata" 436 | (interactive) 437 | (unless (and *mingus-b-session* 438 | (y-or-n-p "Still got an old session lying, do you want to use this? ")) 439 | (setq *mingus-b-session* (mingus-read-entire-metadata))) 440 | (put '*mingus-b-session* :burn t) 441 | (mingus-dec-list)) 442 | 443 | (defun mingus-burns-decode-playlist () 444 | "Decode current playlist and put the resulting wave files in the directory `mingus-tmp-wav-dir'" 445 | (interactive) 446 | (setq *mingus-b-session* (mingus-read-entire-metadata)) 447 | (put '*mingus-b-session* :burn nil) 448 | (mingus-dec-list)) 449 | 450 | (defun mingus-dec-list (&optional process event) 451 | "Decode contents referred to by *mingus-b-session* and put the resulting wave files in the directory `mingus-tmp-wav-dir'." 452 | (when 453 | (and event 454 | (string-match "^exited abnormally with code " event)) 455 | (switch-to-buffer "*Mingus-Output*") 456 | (error "Something happened that should not have. Inspect *Mingus-Output* buffer for any hints")) 457 | (let* ((data *mingus-b-session*) 458 | (file (mingus-cdr-down-sessiondata data))) 459 | (message "Abort with M-x mingus-dec-abort") 460 | (sit-for 2) ;so people can see the message above 461 | (cond 462 | (file 463 | (mingus-dec-file-rel-to-mpd-root file) 464 | (set-process-sentinel (get-process "mingdec") 465 | 'mingus-dec-list)) 466 | (t (message "Decoding finished!") 467 | (if (get '*mingus-b-session* :burn) 468 | (mingus-b-the-cd)))))) 469 | 470 | (defun mingus-dec-abort () 471 | "Abort a decoding session." 472 | (interactive) 473 | (let ((sessiondata *mingus-b-session*)) 474 | (setq *mingus-b-session* nil) 475 | (kill-process (get-process "mingdec")) 476 | (message "Aborting decoding process...") 477 | (sit-for 2) 478 | (put '*mingus-b-session* :burnp nil) 479 | (if (y-or-n-p "Keep session data? ") 480 | (setq *mingus-b-session* sessiondata)))) 481 | 482 | (defun mingus-cdr-down-sessiondata (data) 483 | "Recursively find the first non-existing destination pathname from DATA." 484 | (cond ((null data) nil) 485 | (t (if (file-exists-p (mingus-dec-transl-src->dest (getf (car data) 'file))) 486 | (mingus-cdr-down-sessiondata (cdr data)) 487 | (getf (car data) 'file))))) 488 | 489 | ;; translation functions 490 | (defun mingus-transl-mpd->realroot (file) 491 | "Return absolute path of FILE, which is a file in de mpd database in filesystem." 492 | (expand-file-name (format "%s%s" mingus-mpd-root file))) 493 | 494 | (defun mingus-dec-transl-src->dest (name) 495 | "Return NAME, stripped of its parent and concatenated to `mingus-burns-tmp-wav-dir'" 496 | (concat (expand-file-name mingus-burns-tmp-wav-dir) "/" 497 | (replace-regexp-in-string "^.*/" "" 498 | (replace-regexp-in-string "\\.\\([^.]*\\)$" "wav" name nil nil 1)))) 499 | 500 | (defun mingus-dec-file-rel-to-mpd-root (file) 501 | "Take FILE, which is relative to the mingus-mpd-root, and decode it into `mingus-tmp-wav-dir'." 502 | (let ((src (mingus-transl-mpd->realroot file)) 503 | (dest (mingus-dec-transl-src->dest file))) 504 | (mingus-dec src dest))) 505 | 506 | (defun mingus-dec (src dest &optional p) 507 | "Decode music file SRC to DEST. 508 | Both filename are absolute paths in the filesystem" 509 | (interactive p) 510 | (when (not (file-exists-p mingus-burns-tmp-wav-dir)) 511 | (make-directory mingus-burns-tmp-wav-dir t)) 512 | (unless (and (not p)(file-exists-p dest)) 513 | (case (mingus-what-type src) 514 | (flac (message "Decoding %s to %s" src dest) 515 | (start-process "mingdec" "*Mingus-Output*" "flac" "-sd" src "-o" dest)) 516 | (wav (make-symbolic-link src dest) 517 | (start-process "mingdec" "*Mingus-Output*" "flac")) ;just a dummy so we will have a process! 518 | (t (message "Decoding %s to %s" src dest) 519 | (start-process "mingdec" "*Mingus-Output*" "sox" "-V" src "-t" ".wav" dest))))) 520 | 521 | (define-derived-mode mingus-burn-mode special-mode "Mingus-burns" 522 | "Mingus burning mode. 523 | 524 | \\{mingus-burn-mode-map}" 525 | (setq buffer-undo-list t) 526 | (setq buffer-read-only t)) 527 | 528 | ;;;###autoload 529 | (defun mingus-burns () 530 | (interactive) 531 | (switch-to-buffer "*Mingus Burns*") 532 | (mingus-burn-mode) 533 | (let* ((data (mingus-read-entire-metadata)) 534 | (total-time 0) 535 | buffer-read-only 536 | (httpp (member* nil data :test (lambda (elt item) 537 | (null (getf item 'Time)))))) 538 | (if httpp 539 | (progn 540 | (message "There is a non-local file in the playlist (%s);\nPlease remove it as I am (still) too stupid to handle this situation " (getf (car httpp) 'file)) 541 | (bury-buffer "*Mingus Burns*")) 542 | 543 | (put '*mingus-b-session* :total-time total-time) 544 | (erase-buffer) 545 | (mapc 546 | (lambda (item) 547 | (insert (format "%5s %s\n" (mingus-sec->min:sec (getf item 'Time)) 548 | (truncate-string-to-width 549 | (replace-regexp-in-string "\\(.*/\\)+" "" 550 | (or 551 | (getf item 'Title) 552 | (getf item 'file)) 553 | t t 1) 554 | (- (window-width) 7) nil 32 "…"))) 555 | (forward-line -1) 556 | (mingus-burns-color-bar 0 5 "orange") 557 | (mingus-burns-color-bar 5 (- (point-at-eol) (point-at-bol)) "lightblue") 558 | (put-text-property (point-at-bol) (point-at-eol) 'details item) 559 | 560 | (incf total-time (getf item 'Time)) 561 | ; (incf total-time (min:sec->secs (getf item 'Time))) 562 | (forward-line)) 563 | data) 564 | (put '*mingus-b-session* :total-time total-time) 565 | (mingus-2-burns-bar total-time))) 566 | (goto-char (point-min))) 567 | 568 | (defun mingus-2-burns-bar (seconds) 569 | "Make a time-line bar at the bottom of the *Mingus Burns* buffer." 570 | (let* ((total-seconds seconds) 571 | (buffer-read-only nil) 572 | (border (format "%s30%s50%s70%s75%s80%s" 573 | (make-string 29 ?\-) 574 | (make-string 18 ?\-) 575 | (make-string 18 ?\-) 576 | (make-string 3 ?\-) 577 | (make-string 3 ?\-) 578 | (make-string (max (- (window-width) 82) 0) ?\-))) 579 | (window-width (window-width)) 580 | (string (format "%s\n%s %s \n%s" 581 | border ;bar representing total cd time 582 | (make-string (min (/ total-seconds 60) (- window-width 9)) ?|) 583 | ;bar representing percentage filled 584 | (multiple-value-bind (min sec) 585 | (floor* total-seconds 60) 586 | (format "%d:%s" min (if (< sec 10) 587 | (format "0%d" sec) 588 | (format "%d" sec)))) 589 | (make-string (- window-width 1) ?\-)))) 590 | ;bar representing total cd time 591 | (insert string) 592 | (mingus-goto-line (- (mingus-line-number-at-pos (point-max)) 2)) 593 | ;;(goto-line (+ (mingus-playlist-length) 1)) 594 | (dotimes (foo 3) 595 | (mingus-burns-color-bar 0 35 "darkgreen") 596 | (mingus-burns-color-bar 35 75 "green") 597 | (mingus-burns-color-bar 75 80 "orange") 598 | (mingus-burns-color-bar 80 (- (point-at-eol) (point-at-bol)) "red") 599 | (forward-line 1)))) 600 | 601 | (defun mingus-blank-disk () 602 | (interactive) 603 | (start-process-shell-command "mingblank" "*Mingus-Output*" mingus-blank-string) 604 | (message "Blanking disk") 605 | (set-process-sentinel (get-process "mingblank") 'mingus-blank-sentinel)) 606 | 607 | (defun mingus-blank-sentinel (process event) 608 | (when (null (process-status "mingblank")) 609 | (message "Disk blanked"))) 610 | 611 | ;;;; Drag 'n' Drop 612 | ;; These functions should return the action done (move, copy, link or 613 | ;; private); for now, simply return action unaltered. 614 | (defun mingus-add-url (url action) 615 | (mingus-add (mingus-url-to-relative-file url)) 616 | action) 617 | 618 | (defun mingus-url-to-relative-file (url) 619 | (mingus-abs->rel (url-unhex-string (mingus-url-to-absolute-file url)))) 620 | 621 | (defun mingus-url-to-absolute-file (url) 622 | (string-match "^file://\\(.*\\)\\'" url) 623 | (match-string 1 url)) 624 | 625 | (defun mingus-inject-dnd-action (action) 626 | (set (make-local-variable 'dnd-protocol-alist) 627 | (delete (assoc "^file:///" dnd-protocol-alist) dnd-protocol-alist)) 628 | (push `("^file:///" . ,action) dnd-protocol-alist)) 629 | 630 | (defadvice mingus (after mingus-dnd-injection activate) 631 | (mingus-inject-dnd-action 'mingus-add-url)) 632 | 633 | (defun mingus-browse-url (url action) 634 | (let* ((file (url-unhex-string (mingus-url-to-absolute-file url))) 635 | (file-relative (mingus-abs->rel file))) 636 | (if (file-directory-p file) 637 | (mingus-browse-to-dir file-relative) 638 | (mingus-browse-to-file file-relative)) 639 | action)) 640 | 641 | (defadvice mingus-browse (after mingus-dnd-injection activate) 642 | (mingus-inject-dnd-action 'mingus-browse-url)) 643 | 644 | (provide 'mingus-stays-home) 645 | ;;; mingus-stays-home ends here 646 | -------------------------------------------------------------------------------- /mingus.el: -------------------------------------------------------------------------------- 1 | ;;; mingus.el --- MPD Interface 2 | 3 | ;; _ 4 | ;; _ __ ___ (_)_ __ __ _ _ _ ___ 5 | ;; | '_ ` _ \| | '_ \ / _` | | | / __| 6 | ;; | | | | | | | | | | (_| | |_| \__ \ 7 | ;; |_| |_| |_|_|_| |_|\__, |\__,_|___/ 8 | ;; |___/ 9 | ;; ----------------------------------------------------------- 10 | ;; MPD Interface that's No Garbage, but (just) Utterly Stylish 11 | ;; ----------------------------------------------------------- 12 | ;; ....................but actually named after a man so named 13 | ;; 14 | 15 | ;; Copyright (C) 2006-2011, 2015, 2016 Niels Giesen 17 | 18 | ;; Author: Niels Giesen 19 | ;; URL: https://github.com/pft/mingus 20 | ;; Package-Requires: ((libmpdee "2.2")) 21 | 22 | ;; Contributors (with patches and bug reports): Jeremie Lasalle 23 | ;; Ratelle, "Lexa12", Marc Zonzon, Mark Taylor, Drew Adams, Alec 24 | ;; Heller, "death" (github.com/death), Александр Цамутали, Maximilian 25 | ;; Gass, Dan King, Vincent Zhang, and Ben Metzger 26 | 27 | ;; Version: 0.34 28 | ;; Or Alice's Wonderland 29 | ;; Latest version can be found at http://github.com/pft/mingus/ 30 | ;; For Changes, please view http://github.com/pft/mingus/commits/master 31 | 32 | ;; Keywords: multimedia, elisp, music, mpd 33 | 34 | ;; This file is *NOT* part of GNU Emacs 35 | 36 | ;; This program is free software; you can redistribute it and/or 37 | ;; modify it under the terms of the GNU General Public License 38 | ;; as published by the Free Software Foundation; either version 2 39 | ;; of the License, or (at your option) any later version. 40 | 41 | ;; This program is distributed in the hope that it will be useful, 42 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 43 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 44 | ;; GNU General Public License for more details. 45 | 46 | ;; You should have received a copy of the GNU General Public License 47 | ;; along with this program; if not, write to the Free Software 48 | ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 49 | ;; 02111-1307, USA. 50 | 51 | ;;; Commentary: 52 | ;; Mingus is a client for the Music Player Daemon (MPD). It provides an 53 | ;; interactive interface, where most emphasis lies on on-screen display/editing 54 | ;; of the playlist, and browsing in a buffer. However, minibuffer operations are 55 | ;; becoming more intelligent with each version (with completive browsing 56 | ;; somewhat like in `find-file', and searching on multiple fields, also with 57 | ;; auto-completion). 58 | 59 | ;; Installation (Melpa) 60 | ;; ==================== 61 | 62 | ;; Mingus is now installable from Melpa, and this is the preferred method. 63 | 64 | ;; NOTE if you want to use the mingus-stays-home library (see below), 65 | ;; you still will have to put 66 | 67 | ;; (require 'mingus-stays-home) 68 | 69 | ;; in your init file. 70 | 71 | ;; For non-Melpa installs, see below. 72 | 73 | ;; Usage 74 | ;; ===== 75 | 76 | ;; After installation the following commands will be available: 77 | 78 | ;; 1) M-x mingus-help shows the Mingus help buffer; 79 | ;; 2) M-x mingus will show the playlist; 80 | ;; 3) M-x mingus-browse navigates your music collection. 81 | 82 | ;; You can switch between these buffers with keys 1: help, 2: playlist, 3: browser. 83 | 84 | ;; For other key bindings, see M-x mingus-help. 85 | 86 | ;; Mingus-stays-home 87 | ;; ================= 88 | 89 | ;; When the computer running the mpd service is the same as the one from which 90 | ;; mingus is being run, you may use the library mingus-stays-home. 91 | ;; This library can provide stuff such as: 92 | 93 | ;; - id3 tagging 94 | ;; - cd-burning 95 | ;; - integration with dired and the shell 96 | 97 | ;; Check the file mingus-stays-home.el itself if you want to know 98 | ;; more. 99 | 100 | ;; Non-Melpa Installation 101 | ;; ====================== 102 | 103 | ;; Make sure you have libmpdee.el in your load-path. NOTE for old-time users: 104 | ;; mpc is not required anymore. Everything is done in lisp. This also means that 105 | ;; mingus has become multi-platform (in an easy way). 106 | 107 | ;; 1. When you install both the main mingus AND mingus-stays-home: 108 | 109 | ;; byte-compile, IN ORDER, repeat: IN ORDER, the files mingus.el and 110 | ;; mingus-stays-home.el 111 | 112 | ;; Add the following to your .emacs: 113 | 114 | ;; (add-to-list 'load-path "/path/where/mingus-and-mingus-stays-home-reside") 115 | ;; (autoload 'mingus "mingus-stays-home" nil t) 116 | 117 | ;; 2. Mingus only (so NO mingus-stays-home) : 118 | 119 | ;; byte-compile the file mingus.el 120 | 121 | ;; Add the following to your .emacs: 122 | 123 | ;; (add-to-list 'load-path "/path/where/mingus/resides") 124 | ;; (autoload 'mingus "mingus" nil t) 125 | 126 | ;; Design Issues 127 | ;; ============= 128 | 129 | ;; No editing of metadata tags is provided in mingus itself. This is because mpd is 130 | ;; designed to be run in a network as a server (although it can be used on a single 131 | ;; system, which, in fact, is what I do); as such, clients to mpd are unaware of mpd's 132 | ;; root dir, and possibly/probably do not have write permissions on the music 133 | ;; files. 134 | 135 | ;; If you DO use mingus-stays-home, rough metadata-editing IS provided. `mingus-id3-set' 136 | ;; tries to guess the values for artist, song, track number, and album from the name 137 | ;; encountered in the playlist. Use it with caution though, as as I said, it is still 138 | ;; rough, e.g. having to abstract away from differences between the various tagging 139 | ;; formats. I AM looking into taglib for an elegant solution. But that will take some 140 | ;; time. So be patient. 141 | 142 | ;; The interface is roughly based on that on ncmpc. Many keybindings are alike, 143 | ;; except for some notoriously vi-style-ones. Some significant features (main 144 | ;; reasons to write this stuff) : 145 | 146 | ;; MARKING Notice specifically the possibility to mark multiple songs in the playlist 147 | ;; for movement or deletion (by pressing the spacebar one toggles the mark at the 148 | ;; current line; if there is a region, it marks all songs in the region.) Pressing 'y' 149 | ;; asks for a regular expression against which to match the songs. Pressing 'Y' unmarks 150 | ;; alike. If a song matches, it is marked. Unmarking all marks happens with a single 151 | ;; capital "U". 152 | 153 | ;; INSERTION POINT Another nice feature is "mingus-set-insertion-point" (Key: 154 | ;; "i") : mark a song after which you would like your next insertions to take 155 | ;; place. Then go inserting. Unset this behaviour with "u" 156 | ;; (mingus-unset-insertion-point), and songs will be added to 3the end of the 157 | ;; playlist again. As of version 0.24 this is NOT time-consuming. Yeah! 158 | 159 | ;; NOTE: right now these two functions are mutually exclusive. 160 | 161 | ;; Dired 162 | ;; ===== 163 | 164 | ;; Ability to snap to the file location of a song instantly in `dired', so as 165 | ;; to perform file management or other actions on these files easily (such as 166 | ;; removal, movement or renaming), or just to check wtfs '3.ogg' actually 167 | ;; refers to. 168 | 169 | ;; You might want to change the `dired-mode-map' so that it will play well with 170 | ;; Mingus. If you want to, you can set the variable `mingus-dired-add-keys' to 171 | ;; t; this can be done with `mingus-customize'. It will set "SPC" to 172 | ;; `mingus-dired-add', "C-u SPC" to `mingus-dired-add-and-play' and add an item 173 | ;; for `mingus-dired-add' to the menu-bar in dired. `mingus-dwim-add' and 174 | ;; `mingus-dwim-add-and-play' (see below) calls mingus-dired-add when in dired, 175 | ;; so binding this to a global key might be a nice solution too. 176 | 177 | ;; For those already familiar with mpd, and have set that up, you're done now. 178 | 179 | ;; If you get a message like 180 | 181 | ;; MPD_HOST and/or MPD_PORT environment variables are not set message: problems 182 | ;; getting a response from "localhost" on port 6600 : Connection refused 183 | 184 | ;; there are two options: 185 | 186 | ;; 1. you want to run locally, so run mpd 187 | ;; first. Do so from somewhere else or simply evaluate (mingus-start-daemon). 188 | ;; On some configurations of mpd this must be done as root. 189 | 190 | ;; For those unfamiliar with mpd, to set it up, put something like the following 191 | ;; in ~/.mpdconf (this is for when run a user) 192 | 193 | ;; port "6600" 194 | ;; music_directory "/your/music/directory" 195 | ;; playlist_directory "~/playlists" 196 | ;; log_file "~/.mpd.log" 197 | ;; message_file "~/.mpd.err" 198 | ;; 199 | ;; then run mpd 200 | 201 | ;; 2. you want to connect to a remote host, but have not set the 202 | ;; environment variables MPD_HOST and/or MPD_PORT. Do so by calling 203 | ;; (mingus-set-variables-interactively) (settings lost when emacs 204 | ;; restarted) or by means of customization (mingus-customize) or 205 | ;; (customize-group 'mingus). 206 | 207 | ;; NEW in mingus 0.21: `mingus-wake-up-call'; fixed the lisp-max-eval-depth 208 | ;; error message when leaving mingus-info on for a while; allowing spaces in 209 | ;; minibuffer operations, such as loading and saving of playlists, radio-streams 210 | ;; and the like, but most of all: inclusion of mingus-stays-home, which provides 211 | ;; nice integration features. See that file for more information. Emacs21 212 | ;; compatablity, except for parts of mingus-stays-home. 213 | 214 | ;; Known bugs 215 | ;; ========== 216 | 217 | ;; * a file name cannot have a double quotes (") or a backtick (`) in it. Do not 218 | ;; know how to fix that, so if anyone feels so inclined... You CAN query your 219 | ;; database (M-x mingus-query-regexp " RET) to know if you are in the possession 220 | ;; of such files, so you can adjust their names (with mingus-stays-home 221 | ;; installed: press 0 (zero) to go to dired to do so). The only way to insert 222 | ;; such files currently is by inserting their parent directory. 223 | 224 | ;; point-of-insertion only works with one file or directory at a time 225 | 226 | ;;; Code: 227 | ;; (@> "requirements") 228 | (require 'cl-lib) 229 | (require 'subr-x) 230 | 231 | (require 'dired) 232 | (require 'thingatpt) 233 | (require 'url) 234 | 235 | (require 'libmpdee) 236 | 237 | ;; (@> "globals") 238 | (defvar mingus-header-height 0) 239 | (defvar mingus-marked-list nil) 240 | (defvar mingus-wake-up-call nil) 241 | (defvar mingus-timer nil) 242 | (defvar mingus-status nil 243 | "Current status of the connection to MPD (nil or t).") 244 | (defvar mingus-browse-command-history nil 245 | "Stack of commands issued to obtain a listing in Mingus Browse buffer. 246 | 247 | This is used by `mingus-refresh'.") 248 | (make-variable-buffer-local 'mingus-browse-command-history) 249 | (defvar mingus-marked-list nil 250 | "List of marked songs, identified by songid") 251 | (defvar *mingus-point-of-insertion* nil "Insertion point for mingus") 252 | (defvar *mingus-positions* nil "Cursor positions retained in *Mingus Browser*") 253 | (defvar *mingus-header-when-empty* "Press ? for help, 3 for Mingus Browser, 0 for dired." 254 | "Header to show when the playlist is empty") 255 | (defvar mingus-propertized-song-strings 256 | (make-hash-table :test 'eq 257 | :size 1000) 258 | "Song string cache formatted according to `mingus-playlist-format'. 259 | 260 | Songs are hashed by their MPD ids.") 261 | (defvar mingus-song-strings 262 | (make-hash-table :test 'eq 263 | :size 1000) 264 | "Cache for song strings according to `mingus-playlist-format', 265 | 266 | Songs are hashed by their MPD ids") 267 | 268 | (defun mingus-clear-cache () 269 | "Clear Mingus' caches." 270 | (interactive) 271 | (mapcar 272 | #'clrhash 273 | (list mingus-propertized-song-strings 274 | mingus-song-strings))) 275 | 276 | (cl-defstruct (mingus-data) 277 | (playlist -1) 278 | (song nil)) 279 | (defvar mingus-data (make-mingus-data)) 280 | (defvar *mingus-NP-mark* nil) 281 | (defvar *mingus-pausing-mark* nil) 282 | ;; (@> "faces") 283 | (defgroup mingus-faces () 284 | "Customization group for faces in Mingus" 285 | :prefix "mingus-" 286 | :group 'mingus) 287 | 288 | (defface mingus-directory-face 289 | '((default) 290 | (((background light)) (:foreground "#a0606d")) 291 | (((background dark)) (:foreground "#ffa500"))) 292 | "Face for displaying directories" 293 | :group 'mingus-faces) 294 | 295 | (defface mingus-artist-face 296 | '((((background light)) (:foreground "#7560a0")) 297 | (((background dark)) (:foreground "#b7a6da"))) 298 | "Face for displaying song files" 299 | :group 'mingus-faces) 300 | 301 | (defface mingus-album-face 302 | '((default (:underline t)) 303 | (((background light)) (:foreground "#ba6746")) 304 | (((background dark)) (:foreground "#ce5c32"))) 305 | "Face for displaying song files" 306 | :group 'mingus-faces) 307 | 308 | (defface mingus-album-stale-face 309 | '((default) 310 | (((background light)) (:foreground "#ba6746")) 311 | (((background dark)) (:foreground "#ce5c32"))) 312 | "Face for displaying song files" 313 | :group 'mingus-faces) 314 | 315 | (defface mingus-song-file-face 316 | '((default) 317 | (((background light)) (:foreground "#616fa2")) 318 | (((background dark)) (:foreground "lightgreen"))) 319 | "Face for displaying song files" 320 | :group 'mingus-faces) 321 | 322 | (defface mingus-playlist-face 323 | '((default) 324 | (((background light)) (:foreground "#918e2d")) 325 | (((background dark)) (:foreground "yellow"))) 326 | "Face for displaying playlist files" 327 | :group 'mingus-faces) 328 | 329 | (defface mingus-mark-face 330 | '((t :bold t :foreground "pink")) 331 | "Mingus face for marking." 332 | :group 'mingus-faces) 333 | 334 | (defface mingus-playing-face 335 | '((default) 336 | (((background light)) (:foreground "#c3be3d")) 337 | (((background dark)) (:foreground "#cac655"))) 338 | "Face for playing mark" 339 | :group 'mingus-faces) 340 | 341 | (defface mingus-pausing-face 342 | '((default) 343 | (((background light)) (:foreground "#979797")) 344 | (((background dark)) (:foreground "#d2d2d2"))) 345 | "Face for playing mark" 346 | :group 'mingus-faces) 347 | 348 | (defface mingus-stopped-face 349 | '((default) 350 | (((background light)) (:foreground "#902d2d")) 351 | (((background dark)) (:foreground "#df9797"))) 352 | "Face for playing mark" 353 | :group 'mingus-faces) 354 | 355 | (defcustom mingus-current-song-props 356 | '(:weight bold) 357 | "Extra properties added to the faces used for the current song" 358 | :group 'mingus-faces 359 | :type '(set 360 | (list :inline t :tag "Weight" 361 | (const :weight) 362 | (choice :tag "Weight" 363 | :help-echo "Font weight." 364 | :value bold ; default 365 | (const :tag "black" ultra-bold) 366 | (const :tag "bold" bold) 367 | (const :tag "book" semi-light) 368 | (const :tag "demibold" semi-bold) 369 | (const :tag "extralight" extra-light) 370 | (const :tag "extrabold" extra-bold) 371 | (const :tag "heavy" extra-bold) 372 | (const :tag "light" light) 373 | (const :tag "medium" normal) 374 | (const :tag "normal" normal) 375 | (const :tag "regular" normal) 376 | (const :tag "semibold" semi-bold) 377 | (const :tag "semilight" semi-light) 378 | (const :tag "ultralight" ultra-light) 379 | (const :tag "ultrabold" ultra-bold) 380 | (const :tag "thin" thin))) 381 | (list :inline t :tag "Background" 382 | (const :background) 383 | (color 384 | :help-echo "Set background color (name or #RRGGBB hex spec).")))) 385 | 386 | (defun mingus-exec (string) 387 | (mpd-execute-command mpd-inter-conn string)) 388 | 389 | ;; (@> "currentsongdata") 390 | (defun mingus-get-song-pos () 391 | "Return position in playlist of current song." 392 | (cl-getf (mingus-data-song mingus-data) 'pos)) 393 | 394 | (defun mingus-set-song-pos (&optional pos) 395 | (setf (cl-getf (mingus-data-song mingus-data) 'pos) 396 | (or pos (cl-getf (mpd-get-status mpd-inter-conn) 'song)))) 397 | 398 | ;; (@> "playlist versioning") 399 | (defun mingus-set-playlist-version (&optional to) 400 | "Set internal playlist version to TO or to true current version." 401 | (setf (mingus-data-playlist mingus-data) 402 | (or to (cl-getf (mpd-get-status mpd-inter-conn) 'playlist)))) 403 | 404 | (defun mingus-get-old-playlist-version () 405 | "Get old internal playlist version" 406 | (mingus-data-playlist mingus-data)) 407 | 408 | (defun mingus-get-new-playlist-version () 409 | "Get current playlist version" 410 | (cl-getf (mpd-get-status mpd-inter-conn) 'playlist)) 411 | 412 | ;; configuration 413 | (defun mingus-get-config-option (file option) 414 | (if (file-exists-p file) 415 | (with-temp-buffer 416 | (insert-file-contents file) 417 | (or 418 | (and 419 | (re-search-forward (format "^[[:blank:]]*%s[[:blank:]]+\"\\(.+?\\)\"[[:blank:]]*$" option) nil t) 420 | (match-string 1)) 421 | )) 422 | nil)) 423 | 424 | (defgroup mingus nil "Group customization for mingus mpd interface" 425 | :group 'external 426 | :group 'multimedia 427 | :group 'applications) 428 | 429 | (defcustom mingus-timer-interval 1 430 | "The interval for executing `mingus-timer-handler', in seconds." 431 | :group 'mingus 432 | :type '(number)) 433 | 434 | (defcustom mingus-use-caching nil 435 | "Whether or not to use caching. 436 | 437 | It appears caching does not help a lot, and easily leads to 438 | out-of-date stuff. That's why it has been turned off for now by 439 | default." 440 | :group 'mingus 441 | :type '(boolean)) 442 | 443 | (defcustom mingus-mpd-config-file "~/.mpdconf" 444 | "File used by mpd as a configuration file" 445 | :group 'mingus 446 | :type '(string)) 447 | 448 | (defcustom mingus-mpd-playlist-dir 449 | (expand-file-name 450 | (concat (mingus-get-config-option 451 | mingus-mpd-config-file "playlist_directory") 452 | "/")) 453 | "Directory where MPD puts its playlists" 454 | :group 'mingus 455 | :type '(string)) 456 | 457 | (defcustom mingus-fold-case t 458 | "Sort case-insensitive? 459 | 460 | Mingus sort functions should take this variable into account." 461 | :group 'mingus 462 | :type '(boolean)) 463 | 464 | (defgroup mingus-mode-line nil 465 | "Customization group to control the modeline for `mingus'" 466 | :group 'mingus) 467 | 468 | (defcustom mingus-mode-line-separator " + " 469 | "Separator for fields (artist, song, genre etc.) in Mingus mode-line. 470 | 471 | You might want to put something like the following in your .emacs: 472 | 473 | (setq mingus-mode-line-separator 474 | (if window-system 475 | \" ● \" 476 | \" + \")) 477 | 478 | Or, you might show me how to use a function/string choice in customize ;)" 479 | :group 'mingus 480 | :type '(string)) 481 | 482 | (make-obsolete-variable 'mingus-playlist-separator 483 | 'mingus-mode-line-separator 484 | "2015-11-18") 485 | 486 | (defcustom mingus-use-ido-mode-p nil 487 | "Whether to use ido-mode fuzzy completion when searching artists, tracks, etc. 488 | Do not use ido-mode completion when nil. 489 | Do use ido-mode completion when t. 490 | Default: nil." 491 | :group 'mingus 492 | :type '(boolean)) 493 | 494 | (defcustom mingus-use-mouse-p t 495 | "Use mouse to play/insert/pause etc. songs in Playlist and Browser buffer?" 496 | :group 'mingus 497 | :type '(boolean)) 498 | 499 | (defcustom mingus-mpd-env-set-p nil 500 | "Whether to set environment variables from emacs. 501 | Do not set when nil. 502 | Do set when t. 503 | Default: nil. 504 | These variables are set when loading mingus or callinge `mingus-set-variables'." 505 | :group 'mingus 506 | :type '(boolean)) 507 | 508 | (defun mingus-set-host (sym host) 509 | (let ((mpd-interactive-connection-parameters 510 | (list host 511 | (or (and 512 | (boundp 'mingus-mpd-port) 513 | mingus-mpd-port) 514 | (or (and (getenv "MPD_PORT") 515 | (string-to-number (getenv "MPD_PORT"))) 516 | 6600)) 517 | 10.0))) 518 | (when (processp (aref mpd-inter-conn 1)) 519 | (stop-process (aref mpd-inter-conn 1))) 520 | (mingus-clear-cache) 521 | (setq mpd-inter-conn 522 | (apply 'mpd-conn-new `(,@(mpd-connection-tidy 523 | mpd-interactive-connection-parameters) 524 | nil)))) 525 | (set-default sym host) 526 | (save-window-excursion 527 | (when (get-buffer "*Mingus*") 528 | (mingus)) 529 | (when (get-buffer "*Mingus Browser*") 530 | (mingus-ls "")))) 531 | 532 | (defun mingus-set-port (sym port) 533 | (let ((mpd-interactive-connection-parameters 534 | (list 535 | (or (and 536 | (boundp 'mingus-mpd-host) 537 | mingus-mpd-host) 538 | (or (getenv "MPD_HOST") "localhost")) 539 | port 10.0))) 540 | (when (processp (aref mpd-inter-conn 1)) 541 | (stop-process (aref mpd-inter-conn 1))) 542 | (mingus-clear-cache) 543 | (setq mpd-inter-conn 544 | (apply 'mpd-conn-new `(,@(mpd-connection-tidy 545 | mpd-interactive-connection-parameters) 546 | nil)))) 547 | (set-default sym port) 548 | (save-window-excursion 549 | (when (get-buffer "*Mingus*") 550 | (mingus)) 551 | (when (get-buffer "*Mingus Browser*") 552 | (mingus-ls "")))) 553 | 554 | (defcustom mingus-mpd-host (or (getenv "MPD_HOST") "127.0.0.1") 555 | "Setting for environment variable MPD_HOST" 556 | :group 'mingus 557 | :type '(string) 558 | :set 'mingus-set-host) 559 | 560 | (defcustom mingus-mpd-port (if (getenv "MPD_PORT") 561 | (string-to-number (getenv "MPD_PORT")) 562 | 6600) 563 | "Setting for environment variable MPD_PORT" 564 | :group 'mingus 565 | :type '(integer) 566 | :set 'mingus-set-port) 567 | 568 | (defcustom mingus-mpd-root 569 | (expand-file-name 570 | (concat (mingus-get-config-option 571 | mingus-mpd-config-file 572 | "music_directory") "/")) 573 | "Music directory used by MPD. 574 | 575 | Note that you can use tramp, as in 576 | 577 | \"/ssh:username@host:/var/lib/mpd/music/\" 578 | 579 | \(don't forget the trailing slash)" 580 | :group 'mingus 581 | :type '(string)) 582 | 583 | (defcustom mingus-playlist-directory 584 | nil 585 | "Playlist directory to save playlists to. 586 | 587 | This is just in case the MPD implementation does not allow to 588 | save playlists. 589 | 590 | Note that you can use tramp, as in 591 | 592 | \"/ssh:username@host:/var/lib/mpd/music/\" 593 | 594 | \(don't forget the trailing slash)" 595 | :group 'mingus 596 | :type '(string)) 597 | 598 | (defcustom mingus-seek-amount 10 599 | "Default amount of seconds or percents to seek by when using `mingus-seek'." 600 | :group 'mingus 601 | :type '(integer)) 602 | 603 | (when mingus-mpd-env-set-p 604 | (setenv "MPD_HOST" mingus-mpd-host) 605 | (setenv "MPD_PORT" (number-to-string mingus-mpd-port))) 606 | 607 | (defcustom mingus-mode-always-modeline nil 608 | "Behaviour of modeline: NIL shows current mpd status only in 609 | mingus buffers; Current mpd status is shown in all buffers when 610 | set to t." 611 | :group 'mingus-mode-line 612 | :type '(boolean)) 613 | 614 | ;; (defcustom mingus-mode-line-string "[[%artist% - ]%title%]|[%file%]" 615 | ;; "Format-string to display in modeline; 616 | ;; `mingus-mode-line-show-elapsed-time' and 617 | ;; `mingus-mode-line-show-elapsed-percentage'." 618 | ;; :group 'mingus-mode-line 619 | ;; :type '(string)) 620 | ;; FIXME: add customization widget. 621 | (defcustom mingus-mode-line-string-max 40 622 | "Maximum length for (result of) `mingus-mode-line-string'." 623 | :group 'mingus-mode-line 624 | :type '(integer)) 625 | 626 | (defcustom mingus-mode-line-show-elapsed-time t 627 | "Whether or not to display elapsed time in the mode-line." 628 | :group 'mingus-mode-line 629 | :type '(boolean)) 630 | 631 | (defcustom mingus-mode-line-show-elapsed-percentage nil 632 | "Whether or not to display elapsed time in the mode-line." 633 | :group 'mingus-mode-line 634 | :type '(boolean)) 635 | 636 | (defcustom mingus-mode-line-show-status t 637 | "Display status information on volume, repeat and random in mode-line? 638 | See also the variables `mingus-mode-line-show-volume' and 639 | `mingus-mode-line-show-random-and-repeat-status'" 640 | :group 'mingus-mode-line 641 | :type '(boolean)) 642 | 643 | (defcustom mingus-mode-line-show-volume t 644 | "Display volume information in the mode-line? 645 | 646 | Set `mingus-mode-line-show-status' to non-`nil' value for this variable to 647 | have effect" 648 | :group 'mingus-mode-line 649 | :type '(boolean)) 650 | 651 | (defcustom mingus-mode-line-show-random-and-repeat-status t 652 | "Display random and repeat status in the mode-line? 653 | 654 | If random is shown, a letter z is shown, if repeat is on, a letter r is shown 655 | too. Set the variable `mingus-mode-line-show-status' to a non-`nil' value for 656 | this variable to have effect." 657 | :group 'mingus-mode-line 658 | :type '(boolean)) 659 | 660 | (defcustom mingus-mode-line-show-consume-and-single-status t 661 | "Display consume and single status in the mode-line? 662 | 663 | If single is shown, the letter s is shown, if consume is on, the 664 | letter c is shown. Set the variable 665 | `mingus-mode-line-show-status' to a non-`nil' value for this 666 | variable to have effect. 667 | 668 | Note: consume and single statuses are available with MPD versions 669 | > 0.16" 670 | :group 'mingus-mode-line 671 | :type '(boolean)) 672 | 673 | ;; (@> "emacs21") some emacs21 compatibility: 674 | (if (not (fboundp 'read-number)) 675 | (defun read-number (prompt &optional default) 676 | (let ((n nil)) 677 | (when default 678 | (setq prompt 679 | (if (string-match "\\(\\):[ \t]*\\'" prompt) 680 | (replace-match (format " (default %s)" default) 681 | t t prompt 1) 682 | (replace-regexp-in-string "[ \t]*\\'" 683 | (format " (default %s) " default) 684 | prompt t t)))) 685 | (while 686 | (progn 687 | (let ((str (read-from-minibuffer 688 | prompt nil nil nil nil 689 | (and default 690 | (number-to-string default))))) 691 | (setq n (cond 692 | ((zerop (length str)) default) 693 | ((stringp str) (read str))))) 694 | (unless (numberp n) 695 | (message "Please enter a number.") 696 | (sit-for 1) 697 | t))) n))) 698 | 699 | ;; fixme: use `mpd-inter-conn' directly. Doc this and get rid of these vars. 700 | ' (defun mingus-set-variables-interactively () 701 | "Set environment variables for mpd connection. 702 | 703 | Default to `mingus-mpd-host' and `mingus-mpd-port'. Do not use this for 704 | customizing these values; use `mingus-customize' for that" 705 | (interactive) 706 | (setenv "MPD_HOST" (read-string "MPD_HOST: " mingus-mpd-host)) 707 | (setenv "MPD_PORT" 708 | (number-to-string (read-number "MPD_PORT: " mingus-mpd-port)))) 709 | 710 | (defun mingus-set-variables-interactively () 711 | "Set environment variables for mpd connection. 712 | 713 | Default to `mingus-mpd-host' and `mingus-mpd-port'. Do not use this for 714 | customizing these values; use `mingus-customize' for that." 715 | (interactive) 716 | (let ((mpd-interactive-connection-parameters 717 | (list (completing-read 718 | "MPD_HOST: " 719 | (remove nil (list mingus-mpd-host "localhost")) 720 | nil 721 | nil 722 | mingus-mpd-host) 723 | (read-number "MPD_PORT: " mingus-mpd-port) 724 | (read-number "Timeout: " 10.0)))) 725 | ;; clean up for new connection - bit too low level actually 726 | (when (processp (aref mpd-inter-conn 1)) 727 | (stop-process (aref mpd-inter-conn 1))) 728 | (mingus-clear-cache) 729 | ;; make new connection and process 730 | (setq mpd-inter-conn 731 | (apply 'mpd-conn-new `(,@(mpd-connection-tidy 732 | mpd-interactive-connection-parameters) 733 | nil))) 734 | ;; update views immediately 735 | (when (get-buffer "*Mingus*") 736 | (mingus-playlist)) 737 | (when (get-buffer "*Mingus Browser*") 738 | (with-current-buffer 739 | (get-buffer "*Mingus Browser*") 740 | (mingus-ls ""))))) 741 | 742 | (defun mingus-customize () 743 | "Call the customize function with mingus as argument." 744 | (interactive) 745 | (customize-group 'mingus)) 746 | 747 | (defvar mingus-version "Alice's Wonderland or: 0.34") 748 | 749 | (defun mingus-version () 750 | "Echo `mingus-version' in minibuffer." 751 | (interactive) 752 | (message "Version: %s" mingus-version)) 753 | 754 | (defvar mingus-stream-regexp 755 | "http:[^<>'\"?{}() ]+\.\\([Mm][Pp]3\\|[Oo][Gg][Gg]\\|[fF][lL][aA][cC]\\|[wW][aA][vV]\\|[0-9]{4}\\)") 756 | 757 | (defvar mingus-last-query-results nil 758 | "Variable to hold last results of mingus-query") 759 | 760 | (defvar mingus-last-query nil) 761 | 762 | (make-variable-buffer-local 'mingus-last-query-results) 763 | 764 | (defvar mingus-help-text "" 765 | "Text to display in mingus-help") 766 | 767 | (setq mingus-help-text 768 | (format 769 | " _ 770 | _ __ ___ (_)_ __ __ _ _ _ ___ 771 | | '_ ` _ \\| | '_ \\ / _` | | | / __| 772 | | | | | | | | | | | (_| | |_| \\__ \\ 773 | |_| |_| |_|_|_| |_|\\__, |\\__,_|___/ 774 | |___/ 775 | ===================================================== 776 | MPD Interface, Nice, GPL'ed, User-friendly and Simple 777 | ===================================================== 778 | .........but actually just named after Charles Mingus 779 | 780 | Version: %s 781 | 782 | REFCARD: (see further down for more elaborate instructions) 783 | 784 | Those familiar with dired-mode should find themselves at home; 785 | those familiar with ncmpc too, AMAP that is 786 | 787 | MAIN CONTROLS: 788 | 789 | mingus-help: 1 790 | mingus-playlist: 2 791 | mingus-browser: 3 792 | mingus-dired-file: 0 793 | 794 | Global keys: 795 | 796 | p mingus-toggle (toggle play/pause) 797 | > mingus-next 798 | < mingus-prev 799 | q mingus-git-out 800 | s mingus-stop 801 | ?,1,H mingus-help 802 | +,right,*, C- mingus-vol-up 803 | -,left,/, C- mingus-vol-down 804 | a mingus-insert 805 | ~ mingus-add-stream 806 | ` mingus-add-podcast 807 | b,S- mingus-seek-backward 808 | f,S- mingus-seek-forward 809 | %% mingus-seek-percents 810 | $ mingus-seek-from-start 811 | c mingus-crop 812 | C mingus-clear 813 | L mingus-load-all 814 | z mingus-random 815 | Z mingus-shuffle 816 | r mingus-repeat 817 | . mingus-single 818 | , mingus-consume 819 | C-x C-s mingus-save-playlist 820 | R mingus-remove-playlist 821 | l mingus-load-playlist 822 | o mingus-open-playlist 823 | Q mingus-query 824 | e mingus-query-dir 825 | M-%% mingus-query-regexp 826 | \\ mingus-last-query-results 827 | k forward-line -1 828 | j forward-line 829 | v mingus-show-version 830 | C-x-r-b mingus-bookmark-jump 831 | C-x-r-m mingus-bookmark-set 832 | C-x-r-d mingus-bookmark-delete 833 | @ mingus-update 834 | U mingus-update-thing-at-p 835 | g mingus-redraw-buffer 836 | G mingus-refresh 837 | 838 | Playlist keys: 839 | 840 | d,C-d, 841 | , C-w mingus-del 842 | D mingus-del-marked 843 | O mingus-del-other-songs 844 | M mingus-move-all 845 | C-l mingus-goto-current-song 846 | C-k mingus-move-up 847 | C-j mingus-move-down 848 | RET,[mouse-3] mingus-play 849 | SPC,m,[mouse-2] mingus-mark 850 | * %%, y mingus-mark-regexp 851 | C-u * %%, Y mingus-unmark-regexp 852 | *! mingus-unmark-all 853 | * * mingus-vol-up 854 | ! run a command on the marked songs 855 | 856 | Browser keys: 857 | 858 | mingus-browse-top-level 859 | RET, [mouse-1] mingus-down-dir-or-play-song 860 | :,^, [mouse-3] mingus-open-parent 861 | SPC [mouse-2] mingus-insert 862 | P mingus-insert-and-play 863 | S mingus-browse-sort 864 | 865 | MORE ELABORATE INSTRUCTIONS: 866 | 867 | Requirements: 868 | 869 | - cl-macs.el 870 | - dired.el (included in emacs) 871 | - the program symlinks (for dired) 872 | - access to a connection with an mpd server, either locally or on another 873 | server. 874 | 875 | - Emacs22 876 | 877 | - Issues with emacs21: 878 | 879 | although the function line-number-at-pos is replaced with a 880 | custom mingus-line-number-at-pos, and the call to 881 | `while-no-input' is left out when running emacs21, and whereas 882 | for the previously unsupported read-number, I simply replicated 883 | its function definition from the emacs22 subr.el, annoying issues 884 | now have crept up so that you have to call C-g whenever switching 885 | to and fro the mingus-buffers. The rest /seems/ to work somewhat 886 | now. 887 | 888 | Getting started: 889 | 890 | This help is always available with the command mingus-help, or 891 | the keys ? or 1 from the buffers *Mingus* or *Mingus 892 | Browser* 893 | 894 | When mpd is already playing a playlist, the command M-x mingus 895 | will show this playlist; when not so, load a playlist with l, 896 | or make a new one with M-x mingus-browse (default key: 3). 897 | 898 | Starting mpd: mingus-start-mpd-daemon 899 | Providing environment variables: mingus-set-variables-interactively 900 | (see also mingus-customize) 901 | 902 | SELECTION OF SONGS: 903 | 904 | Browsing: command: mingus-browse key: 3 905 | 906 | movement and insertion: 907 | 908 | SPACEBAR always inserts everything under point or region 909 | 910 | P same as SPACEBAR, and plays the inserted song(s) instantly 911 | 912 | RET same as SPACEBAR, except on a dir and no mark, then descend into dir. 913 | 914 | ^ or : go up a directory 915 | 916 | Minibuffer browsing: 917 | 918 | a insert a file or directory through the use of the minibuffer; 919 | follow instructions there provided 920 | 921 | Playlist loading: 922 | 923 | l load playlist 924 | 925 | Streaming audio: 926 | 927 | Mpd supports streaming audio. Aside from the fact that one can 928 | always save a link in a playlist, this provides a way to take 929 | one's own presets with you as a client, as streaming audio does 930 | not require storage of songs on the server. Mingus takes 931 | advantage of this fact by providing the customizable variables 932 | `mingus-stream-alist' and `mingus-podcast-alist': alists of 933 | conses whose key is a pretty name, and whose value is the url of 934 | the respective radio stream or podcast file. 935 | 936 | ~ load an audio stream, read from minibuffer, with completion 937 | from the customizable variable `mingus-stream-alist'; 938 | 939 | defaults to link (in w3m and possibly in gnus html mail buffers) 940 | or url under point. 941 | 942 | ` same as ~, but loads all podcasts found in a link. 943 | Completion provided by the customizable variable 944 | `mingus-podcast-alist'. 945 | 946 | Actually ~ will load a podcast too if a podcast is under point. 947 | However, to provide two separate variables for completion, 948 | this option is provided separately. 949 | 950 | Making sure an insertion is instantly played: 951 | 952 | If any of the insertion commands is prefinged, they will play the insertion 953 | instantly after insertion. 954 | 955 | C-u a mingus-insert-and-play 956 | C-u l mingus-load-playlist-and-play 957 | C-u ~ mingus-add-stream-and-play 958 | C-u ` mingus-add-podcast-and-play 959 | 960 | Querying: 961 | 962 | Q query the mpd database for artist, album, filename, title, 963 | or regexp on filename (type read from minibuffer) 964 | M-%% query for regexp on filename 965 | \\ show last query results again 966 | 967 | 968 | Results are shown in the *Mingus Browser* buffer, 969 | where all commands for browsing are available 970 | 971 | PLAYING CONTROLS: 972 | 973 | see the refcard, and documentation of various commands, just try 974 | them out. They should be quite self-evident, but let me know when 975 | they are not. Not every command is (already) mapped to a 976 | key, so M-x mingus- TAB to your delight to find everything. 977 | 978 | PLAYLIST EDITING: 979 | 980 | Deletion: 981 | 982 | on marked songs: see section `Marking' 983 | 984 | C-d, d, C-w or DEL 985 | 986 | delete single file, or region when there is a region; 987 | 988 | NB: this leaves the marking of other songs intact. As such it can 989 | be slow, esp. when the region is large; it is then highly 990 | recommended to mark the songs first, and then issue the command 991 | mingus-del-marked (until I rewrite this function :]) 992 | 993 | Movement: 994 | 995 | of marked songs: see section `Marking' 996 | 997 | of single song: 998 | 999 | C-k Move song up one position 1000 | C-j Move song up down position 1001 | 1002 | Marking: 1003 | 1004 | Marking songs is useful for movement or deletion of multiple songs in or from 1005 | the playlist; first mark them, then delete or move them (to point). 1006 | 1007 | m or SPACEBAR (un)mark a song, or region, when there is a region 1008 | D (upcased) delete marked songs (this will have the same effect as 1009 | mingus-del when there are no marked songs) 1010 | M move marked songs to point 1011 | ! get prompted for an operation on the marked songs 1012 | 1013 | Point of insertion: 1014 | 1015 | Use mingus-set-insertion-point to specify where new insertions from the 1016 | insertion commands from the *Mingus Browser* buffer or from 1017 | minibuffer-insertion will take place. If *mingus-point-of-insertion* is 1018 | unset (nil), insertions will take place at the end of the playlist. 1019 | 1020 | i set insertion point 1021 | u unset insertion point (available from everywhere) 1022 | C-u i show current insertion point and move point there 1023 | 1024 | Saving your playlist: 1025 | 1026 | what about C-x C-s, can you memorize that? 1027 | 1028 | 1029 | ================================================= 1030 | AUTHOR: Niels Giesen 1031 | CONTACT: nielsDINOSAURgiesen@gmailDODOcom, but with the extinct creatures replaced with dots. 1032 | WEBSITE: http://github.com/pft/mingus 1033 | " mingus-version)) 1034 | 1035 | ;; regexps 1036 | 1037 | (defmacro mingus-define-color-line-or-region (name params) 1038 | `(defun ,name (&optional beg end) 1039 | (let (buffer-read-only) 1040 | (put-text-property (or beg (line-beginning-position)) (or end (line-beginning-position 2)) 1041 | 'face ,params)))) 1042 | 1043 | (mingus-define-color-line-or-region mingus-mark-line 'mingus-mark-face) 1044 | (mingus-define-color-line-or-region mingus-unmark-line 'default) 1045 | 1046 | ;; fixme: delete this (remove help) 1047 | (defconst mingus-help-font-lock-keywords 1048 | (list 1049 | '("mingus[a-zA-Z 0-9-]*" . font-lock-function-name-face) 1050 | '("^[A-Z ]+:" . font-lock-warning-face) 1051 | '("^[A-Z][a-z ]+:" . font-lock-constant-face) 1052 | '("=" . font-lock-variable-name-face) 1053 | '("`.+'"))) 1054 | 1055 | ;; keys 1056 | 1057 | (defvar mingus-global-map (make-keymap) "Global keymap for `mingus'.") 1058 | 1059 | (define-key mingus-global-map "k" (lambda () (interactive) (forward-line -1))) 1060 | 1061 | ;; add some keys to the various modes for dired look-ups 1062 | (define-key mingus-global-map "0" 'mingus-dired-file) 1063 | (define-key mingus-global-map [home] 'mingus-browse-top-level) 1064 | (define-key mingus-global-map "q" 'mingus-git-out) 1065 | (define-key mingus-global-map "." 'mingus-single) 1066 | (define-key mingus-global-map "," 'mingus-consume) 1067 | (define-key mingus-global-map "Q" 'mingus-query) 1068 | (define-key mingus-global-map "E" 'mingus-query-dir) 1069 | (define-key mingus-global-map "\M-%" 'mingus-query-regexp) 1070 | (define-key mingus-global-map "\\" 'mingus-last-query-results) 1071 | (define-key mingus-global-map "j" 'forward-line) 1072 | (define-key mingus-global-map "s" 'mingus-stop) 1073 | (define-key mingus-global-map "@" 'mingus-update) 1074 | (define-key mingus-global-map "p" 'mingus-toggle) 1075 | (define-key mingus-global-map "%" 'mingus-seek-percents) 1076 | (define-key mingus-global-map ">" 'mingus-next) 1077 | (define-key mingus-global-map "<" 'mingus-prev) 1078 | 1079 | (define-key mingus-global-map "\C-xrb" 'mingus-bookmark-jump) 1080 | (define-key mingus-global-map "\C-xrm" 'mingus-bookmark-set) 1081 | (define-key mingus-global-map "\C-xrd" 'mingus-bookmark-delete) 1082 | 1083 | (mapc (lambda (key) (define-key mingus-global-map key 'mingus-vol-up)) 1084 | '("+" [(right)] "=")) 1085 | (mapc (lambda (key) (define-key mingus-global-map key 'mingus-vol-down)) 1086 | '("-" [(left)] "/" "_")) 1087 | (define-key mingus-global-map "b" 'mingus-seek-backward) 1088 | (define-key mingus-global-map "f" 'mingus-seek) 1089 | (define-key mingus-global-map "$" 'mingus-seek-from-start) 1090 | (define-key mingus-global-map "x" 'mingus-crossfade) 1091 | (define-key mingus-global-map "C" 'mingus-clear) 1092 | (define-key mingus-global-map "c" 'mingus-crop) 1093 | (define-key mingus-global-map "L" 'mingus-load-all) 1094 | (define-key mingus-global-map "v" 'mingus-show-version) 1095 | (define-key mingus-global-map "z" 'mingus-random) 1096 | (define-key mingus-global-map "Z" 'mingus-shuffle) 1097 | (define-key mingus-global-map "r" 'mingus-repeat) 1098 | (define-key mingus-global-map "u" 'mingus-unset-insertion-point) 1099 | (define-key mingus-global-map "l" 'mingus-load-playlist) 1100 | (define-key mingus-global-map "R" 'mingus-remove-playlist) 1101 | (mapc (lambda (key) (define-key mingus-global-map key 'mingus-help)) 1102 | '("H" "?" "1")) 1103 | (define-key mingus-global-map "a" 'mingus-insert) 1104 | (define-key mingus-global-map "P" 'mingus-insert-and-play) 1105 | (define-key mingus-global-map "~" 'mingus-add-stream) 1106 | (define-key mingus-global-map "`" 'mingus-add-podcast) 1107 | (define-key mingus-global-map "\C-x\C-s" 'mingus-save-playlist) 1108 | (define-key mingus-global-map "2" 'mingus) 1109 | (define-key mingus-global-map "3" 'mingus-browse) 1110 | (define-key mingus-global-map "w" 'mingus-wake-up-call) 1111 | (define-key mingus-global-map "]" 'mingus-enable-output) 1112 | (define-key mingus-global-map "[" 'mingus-disable-output) 1113 | (define-key mingus-global-map "I" 'mingus-inspect) 1114 | (define-key mingus-global-map 1115 | (if (featurep 'xemacs)[(control button5)][C-mouse-5]) 'mingus-vol-down) 1116 | (define-key mingus-global-map 1117 | (if (featurep 'xemacs)[(control button4)][C-mouse-4]) 'mingus-vol-up) 1118 | (define-key mingus-global-map 1119 | (if (featurep 'xemacs)[(shift button5)][S-mouse-5]) 'mingus-seek-backward) 1120 | (define-key mingus-global-map 1121 | (if (featurep 'xemacs)[(shift button4)][S-mouse-4]) 'mingus-seek) 1122 | 1123 | (define-key mingus-global-map "A" 1124 | (lambda () 1125 | (interactive) 1126 | (mingus-query-dir "artist"))) 1127 | 1128 | (define-key mingus-global-map "B" 1129 | (lambda () 1130 | (interactive) 1131 | (mingus-query-dir "album"))) 1132 | 1133 | (define-key mingus-global-map "F" 1134 | (lambda () 1135 | (interactive) 1136 | (mingus-query-dir "filename"))) 1137 | 1138 | (define-key mingus-global-map "T" 1139 | (lambda () 1140 | (interactive) 1141 | (mingus-query-dir "title"))) 1142 | 1143 | ;; build the menu 1144 | (define-key mingus-global-map [menu-bar mingus] 1145 | (cons "Mingus" (make-sparse-keymap "mingus"))) 1146 | 1147 | (define-key mingus-global-map [menu-bar mingus customization] 1148 | (cons "Customization" (make-sparse-keymap "mingus customization"))) 1149 | 1150 | ;; fixme : HOST & PORT unnecessary after libmpdee.el 1151 | (define-key mingus-global-map [menu-bar mingus customization port] 1152 | '(menu-item "MPD PORT" 1153 | (lambda () (interactive) (customize-variable 'mingus-mpd-port)) 1154 | :help "Port for connecting to mpd server")) 1155 | 1156 | (define-key mingus-global-map [menu-bar mingus customization host] 1157 | '(menu-item "MPD HOST" 1158 | (lambda () (interactive) (customize-variable 'mingus-mpd-host)) 1159 | :help "Host to connect to")) 1160 | 1161 | (define-key mingus-global-map [menu-bar mingus customization seek-amount] 1162 | '("Seek Amount" . 1163 | (lambda () (interactive) (customize-variable 'mingus-seek-amount)))) 1164 | 1165 | (define-key mingus-global-map [menu-bar mingus customization mode-line] 1166 | '("Mode-line" . (lambda () 1167 | (interactive) 1168 | (customize-group 'mingus-mode-line)))) 1169 | 1170 | (define-key mingus-global-map [menu-bar mingus customization stream-alist] 1171 | '(menu-item "Streams" 1172 | (lambda () 1173 | (interactive) 1174 | (customize-variable 'mingus-stream-alist)) 1175 | :help "Customize stream presets")) 1176 | 1177 | (define-key mingus-global-map [menu-bar mingus customization podcast-alist] 1178 | '(menu-item "Podcasts" 1179 | (lambda () 1180 | (interactive) 1181 | (customize-variable 'mingus-podcast-alist)) 1182 | :help "Customize podcast presets")) 1183 | 1184 | (define-key mingus-global-map [menu-bar mingus customization all] 1185 | '(menu-item "All" mingus-customize 1186 | :help "customize all mingus variables")) 1187 | 1188 | (define-key mingus-global-map [menu-bar mingus sep1] 1189 | '(menu-item "--")) 1190 | 1191 | (define-key mingus-global-map [menu-bar mingus query-regexp] 1192 | '(menu-item "Query regexp" mingus-query-regexp 1193 | :help "Query the mpd database with a regexp")) 1194 | 1195 | (define-key mingus-global-map [menu-bar mingus query] 1196 | '(menu-item "Query" mingus-query 1197 | :help "Query the mpd database")) 1198 | 1199 | (define-key mingus-global-map [menu-bar mingus query-dircd ] 1200 | '(menu-item "Query, list dirs" mingus-query-dir 1201 | :help "Query the mpd database, return directories containing a match")) 1202 | 1203 | (define-key mingus-global-map [menu-bar mingus update] 1204 | '(menu-item "Update" mingus-update 1205 | :help "Update the mpd database")) 1206 | 1207 | (define-key mingus-global-map [menu-bar mingus sep-above-query] 1208 | '(menu-item "--")) 1209 | 1210 | (define-key mingus-global-map [menu-bar mingus bookmark-delete] 1211 | '(menu-item "Delete a bookmark" mingus-bookmark-delete 1212 | :help "Delete a saved bookmark")) 1213 | 1214 | (define-key mingus-global-map [menu-bar mingus bookmark-jump] 1215 | '(menu-item "Jump to a bookmark" mingus-bookmark-jump 1216 | :help "Jump to a bookmark")) 1217 | 1218 | (define-key mingus-global-map [menu-bar mingus bookmark-set] 1219 | '(menu-item "Set bookmark" mingus-bookmark-set 1220 | :help "Set a bookmark for current position")) 1221 | 1222 | (define-key mingus-global-map [menu-bar mingus sep-above-bookmarks] 1223 | '(menu-item "--")) 1224 | 1225 | (define-key mingus-global-map [menu-bar mingus streams] 1226 | (cons "Streams and Podcasts" (make-sparse-keymap "mingus streams"))) 1227 | 1228 | (define-key mingus-global-map [menu-bar mingus streams podcast-alist] 1229 | '(menu-item "Customize Podcasts" 1230 | (lambda () 1231 | (interactive) 1232 | (customize-variable 'mingus-podcast-alist)) 1233 | :help "Customize podcast presets")) 1234 | 1235 | (define-key mingus-global-map [menu-bar mingus streams stream-alist] 1236 | '(menu-item "Customize Streams" 1237 | (lambda () 1238 | (interactive) 1239 | (customize-variable 'mingus-stream-alist)) 1240 | :help "Customize stream presets")) 1241 | 1242 | (define-key mingus-global-map [menu-bar mingus streams sep] 1243 | '(menu-item "--")) 1244 | 1245 | (define-key mingus-global-map [menu-bar mingus streams podcast-and-play] 1246 | '("Add Podcast and Play" . mingus-add-podcast-and-play)) 1247 | 1248 | 1249 | (define-key mingus-global-map [menu-bar mingus streams podcast] 1250 | '("Add Podcast" . mingus-add-podcast)) 1251 | 1252 | 1253 | (define-key mingus-global-map [menu-bar mingus streams stream-and-play] 1254 | '("Add Stream and Play" . mingus-add-stream-and-play)) 1255 | 1256 | 1257 | (define-key mingus-global-map [menu-bar mingus streams stream] 1258 | '("Add Stream" . mingus-add-stream)) 1259 | 1260 | (define-key mingus-global-map [menu-bar mingus playlists] 1261 | (cons "Playlist loading/saving/removing" 1262 | (make-sparse-keymap "mingus playlists"))) 1263 | 1264 | (define-key mingus-global-map [menu-bar mingus playlists remove] 1265 | '("Remove" . mingus-remove-playlist)) 1266 | 1267 | (define-key mingus-global-map [menu-bar mingus playlists save] 1268 | '("Save" . mingus-save-playlist)) 1269 | 1270 | (define-key mingus-global-map [menu-bar mingus playlists load-and-play] 1271 | '("Load entire database" . mingus-load-all)) 1272 | 1273 | (define-key mingus-global-map [menu-bar mingus playlists load-all] 1274 | '("Load and Play" . mingus-load-playlist-and-play)) 1275 | 1276 | (define-key mingus-global-map [menu-bar mingus playlists load] 1277 | '("Load" . mingus-load-playlist)) 1278 | 1279 | (define-key mingus-global-map [menu-bar mingus sep-above-playlists-and-streams] 1280 | '(menu-item "--")) 1281 | 1282 | (define-key mingus-global-map [menu-bar mingus consume] 1283 | '("Toggle consume mode" . mingus-consume)) 1284 | 1285 | (define-key mingus-global-map [menu-bar mingus single] 1286 | '("Toggle single mode" . mingus-single)) 1287 | 1288 | (define-key mingus-global-map [menu-bar mingus repeat] 1289 | '("Repeat (toggle)" . mingus-repeat)) 1290 | 1291 | (define-key mingus-global-map [menu-bar mingus shuffle] 1292 | '("Shuffle" . mingus-shuffle)) 1293 | 1294 | (define-key mingus-global-map [menu-bar mingus random] 1295 | '("Random (toggle)" . mingus-random)) 1296 | 1297 | (define-key mingus-global-map [menu-bar mingus clear] 1298 | '("Clear Playlist" . mingus-clear)) 1299 | 1300 | (define-key mingus-global-map [menu-bar mingus crop] 1301 | '(menu-item "Crop Playlist" mingus-crop 1302 | :help "Delete all but the playing song")) 1303 | 1304 | (define-key mingus-global-map [menu-bar mingus vol-up] 1305 | '("Vol up" . mingus-vol-up)) 1306 | 1307 | (define-key mingus-global-map [menu-bar mingus vol-down] 1308 | '("Vol down" . mingus-vol-down)) 1309 | 1310 | (define-key mingus-global-map [menu-bar mingus seek] 1311 | '("Seek Forward" . mingus-seek)) 1312 | 1313 | (define-key mingus-global-map [menu-bar mingus seek-back] 1314 | '("Seek Backward" . mingus-seek-backward)) 1315 | 1316 | (define-key mingus-global-map [menu-bar mingus next] 1317 | '("Next" . mingus-next)) 1318 | 1319 | (define-key mingus-global-map [menu-bar mingus previous] 1320 | '("Previous" . mingus-prev)) 1321 | 1322 | (define-key mingus-global-map [menu-bar mingus stop] 1323 | '("Stop" . mingus-stop)) 1324 | 1325 | (define-key mingus-global-map [menu-bar mingus play] 1326 | '("Play" . mingus-play)) 1327 | 1328 | (define-key mingus-global-map [menu-bar mingus toggle] 1329 | '("Toggle play/pause" . mingus-toggle)) 1330 | 1331 | (defvar mingus-help-mode-map (copy-keymap mingus-global-map) 1332 | "Help keymap for `mingus'") 1333 | 1334 | (define-key mingus-help-mode-map "0" (lambda () 1335 | (interactive) 1336 | (dired mingus-mpd-root))) 1337 | 1338 | (define-key mingus-help-mode-map " " 'scroll-up) 1339 | 1340 | (define-key mingus-help-mode-map [menu-bar mingus sep-playlist-editing] 1341 | '(menu-item "--")) 1342 | 1343 | (define-key mingus-help-mode-map [menu-bar mingus unset] 1344 | '("Unset Insertion Point" . mingus-unset-insertion-point)) 1345 | 1346 | (define-key mingus-help-mode-map [menu-bar mingus sep3] 1347 | '(menu-item "--")) 1348 | 1349 | (define-key mingus-help-mode-map [menu-bar mingus browser] 1350 | '(menu-item "Browser" mingus-browse :help "go to browser")) 1351 | 1352 | (define-key mingus-help-mode-map [menu-bar mingus playlist] 1353 | '(menu-item "Playlist" mingus :help "go to playlist")) 1354 | 1355 | (defvar mingus-playlist-mode-map (copy-keymap mingus-global-map) 1356 | "Playlist keymap for `mingus'.") 1357 | 1358 | ;;deletion keys 1359 | (defun mingus-del-dwim () 1360 | "Delete either songs in region or marked songs" 1361 | (interactive) 1362 | (if (mingus-mark-active) 1363 | (call-interactively 'mingus-del-region) 1364 | (mingus-del-marked))) 1365 | 1366 | (mapc (lambda (key) (define-key mingus-playlist-mode-map key 1367 | 'mingus-del-dwim)) '("D" "\C-w")) 1368 | 1369 | (defun mingus-del-dwim2 () 1370 | "Delete either songs in region or song at point" 1371 | (interactive) 1372 | (if (mingus-mark-active) 1373 | (call-interactively 'mingus-del-region) 1374 | (mingus-del))) 1375 | 1376 | (mapc (lambda (key) (define-key mingus-playlist-mode-map key 'mingus-del-dwim2)) 1377 | '("d" "\C-d")) 1378 | 1379 | (define-key mingus-playlist-mode-map "O" 'mingus-del-other-songs) 1380 | 1381 | ;;movement keys 1382 | (define-key mingus-playlist-mode-map "M" 'mingus-move-all) 1383 | 1384 | (define-key mingus-playlist-mode-map "\C-k" 'mingus-move-up) 1385 | 1386 | (define-key mingus-playlist-mode-map "\C-j" 'mingus-move-down) 1387 | 1388 | ;;marking keys 1389 | (define-key mingus-playlist-mode-map "*!" 'mingus-unmark-all) 1390 | 1391 | (defvar mingus-*-map 1392 | (let ((m (make-sparse-keymap))) 1393 | (define-key m "!" 'mingus-unmark-all) 1394 | (define-key m "%" 'mingus-mark-regexp) 1395 | (define-key m "*" 'mingus-vol-up) 1396 | (define-key m "(" 'mingus-mark-sexp) 1397 | m)) 1398 | 1399 | (define-key mingus-playlist-mode-map "*" mingus-*-map) 1400 | 1401 | (mapc (lambda (key) 1402 | (define-key mingus-playlist-mode-map key 1403 | 'mingus-mark-dwim)) 1404 | '("m" " ")) 1405 | 1406 | (define-key mingus-playlist-mode-map "n" 'mingus-unmark-region) 1407 | 1408 | (define-key mingus-playlist-mode-map "y" 'mingus-mark-regexp) 1409 | 1410 | (define-key mingus-playlist-mode-map "Y" 'mingus-unmark-regexp) 1411 | 1412 | (define-key mingus-playlist-mode-map "i" 'mingus-set-insertion-point) 1413 | 1414 | (define-key mingus-playlist-mode-map "t" 'mingus-toggle-marked) 1415 | 1416 | (define-key mingus-playlist-mode-map "U" 'mingus-update-thing-at-p) 1417 | 1418 | (define-key mingus-playlist-mode-map "g" 'mingus-redraw-buffer) 1419 | 1420 | (define-key mingus-playlist-mode-map "G" 'mingus-refresh) 1421 | 1422 | (define-key mingus-playlist-mode-map "!" 1423 | (lambda () 1424 | (interactive) 1425 | (if (or mingus-marked-list) 1426 | (progn 1427 | (let ((command (read-key-sequence 1428 | "(D)elete, (M)ove here, delete (O)thers? " ))) 1429 | (cond ((string-match "d\\|D" command) 1430 | (mingus-del-marked)) 1431 | ((string-match "m\\|M" command) 1432 | (mingus-move-all)) 1433 | ((string-match "o\\|O" command) 1434 | (mingus-del-other-songs)) 1435 | (t nil)))) 1436 | (message "No marked songs")))) 1437 | 1438 | ;; miscellaneous keys 1439 | (define-key mingus-playlist-mode-map "\r" 'mingus-play) 1440 | (define-key mingus-playlist-mode-map "o" 'mingus-browse-to-song-at-p) 1441 | (define-key mingus-playlist-mode-map "\C-l" 'mingus-goto-current-song) 1442 | 1443 | ;; menu keys 1444 | (define-key mingus-playlist-mode-map 1445 | [menu-bar mingus sep-playlist-editing] 1446 | '("---" . separador)) 1447 | 1448 | (define-key mingus-playlist-mode-map 1449 | [menu-bar mingus playlist-editing] 1450 | (cons "Playlist Editing" (make-sparse-keymap "mingus playlist editing"))) 1451 | 1452 | (define-key mingus-playlist-mode-map 1453 | [menu-bar mingus playlist-editing mingus-toggle-marked] 1454 | '("Toggle Marked Songs" . mingus-toggle-marked)) 1455 | 1456 | (define-key mingus-playlist-mode-map 1457 | [menu-bar mingus playlist-editing mingus-unmark-all] 1458 | '("Unmark All Songs" . mingus-unmark-all)) 1459 | 1460 | (define-key mingus-playlist-mode-map 1461 | [menu-bar mingus playlist-editing del-other] 1462 | '("Delete Unmarked Songs" . mingus-del-other-songs)) 1463 | 1464 | (define-key mingus-playlist-mode-map 1465 | [menu-bar mingus playlist-editing del-marked] 1466 | '("Delete Marked Songs or Song at Point" . mingus-del-marked)) 1467 | 1468 | (define-key mingus-playlist-mode-map 1469 | [menu-bar mingus playlist-editing move] 1470 | '("Move Marked Songs" . mingus-move-all)) 1471 | 1472 | (define-key mingus-playlist-mode-map 1473 | [menu-bar mingus playlist-editing mark] 1474 | '("Mark Region or (un)Mark Line" . 1475 | (lambda () (interactive) (if (mingus-mark-active) 1476 | (call-interactively 'mingus-mark-region) 1477 | (mingus-mark))))) 1478 | 1479 | (define-key mingus-playlist-mode-map 1480 | [menu-bar mingus playlist-editing unmark] 1481 | '("Unmark Region" . 'unmark-region)) 1482 | 1483 | (define-key mingus-playlist-mode-map 1484 | [menu-bar mingus playlist-editing uns-ins-point] 1485 | '("Unset Point of Insertion" . mingus-unset-insertion-point)) 1486 | 1487 | (define-key mingus-playlist-mode-map 1488 | [menu-bar mingus playlist-editing ins-point] 1489 | '("Set Point of Insertion" . mingus-set-insertion-point)) 1490 | 1491 | (define-key mingus-playlist-mode-map 1492 | [menu-bar mingus playlist-editing del-region] 1493 | '("Delete Region" . mingus-del-region)) 1494 | 1495 | (define-key mingus-playlist-mode-map 1496 | [menu-bar mingus sep3] 1497 | '(menu-item "--")) 1498 | 1499 | (define-key mingus-playlist-mode-map 1500 | [menu-bar mingus help] 1501 | '(menu-item "Help" mingus-help 1502 | :help "go to help")) 1503 | 1504 | (define-key mingus-playlist-mode-map 1505 | [menu-bar mingus browser] 1506 | '(menu-item "Browser" mingus-browse 1507 | :help "go to browser")) 1508 | 1509 | (define-key mingus-playlist-mode-map 1510 | [menu-bar mingus dired] 1511 | '(menu-item "Dired file" mingus-dired-file 1512 | :help "find file in dired")) 1513 | 1514 | ;; mouse keys 1515 | (define-key mingus-playlist-mode-map 1516 | (if (featurep 'xemacs) [button1] [mouse-1]) 1517 | (lambda (ev) 1518 | (interactive "e") 1519 | (when mingus-use-mouse-p 1520 | (if (not (eolp)) 1521 | (progn (mouse-set-point ev) 1522 | (mingus-play)))))) 1523 | 1524 | (define-key mingus-playlist-mode-map 1525 | (if (featurep 'xemacs) [button2] [mouse-2]) 1526 | (lambda (ev) 1527 | (interactive "e") 1528 | (when mingus-use-mouse-p 1529 | (if (mingus-mark-active) 1530 | (call-interactively (quote mingus-mark-region)) 1531 | (mouse-set-point ev) 1532 | (mingus-mark))))) 1533 | 1534 | (define-key mingus-playlist-mode-map 1535 | (if (featurep 'xemacs) [button3] [mouse-3]) 1536 | (lambda (ev) 1537 | (interactive "e") 1538 | (when mingus-use-mouse-p 1539 | (mouse-set-point ev) 1540 | (mingus-dired-file)))) 1541 | 1542 | (defvar mingus-browse-mode-map (copy-keymap mingus-global-map) 1543 | "Browse keymap for `mingus'.") 1544 | 1545 | (define-key mingus-browse-mode-map "\r" 'mingus-down-dir-or-play-song) 1546 | (define-key mingus-browse-mode-map "S" 'mingus-browse-sort) 1547 | (define-key mingus-browse-mode-map "U" 'mingus-update-thing-at-p) 1548 | (define-key mingus-browse-mode-map "g" 'mingus-redraw-buffer) 1549 | (define-key mingus-browse-mode-map "G" 'mingus-refresh) 1550 | 1551 | (define-key mingus-browse-mode-map 1552 | [(down-mouse-1)] 1553 | (lambda (event) 1554 | (interactive "e") 1555 | (when mingus-use-mouse-p 1556 | (mouse-set-point event) 1557 | (if (cddr event) 1558 | (mingus-insert) 1559 | (mingus-down-dir-or-play-song))))) 1560 | 1561 | (define-key mingus-browse-mode-map 1562 | (if (featurep 'xemacs) [button2] [mouse-2]) 1563 | 'mingus-insert-at-mouse) 1564 | 1565 | (define-key mingus-browse-mode-map 1566 | (if (featurep 'xemacs) [button3] [mouse-3]) 1567 | 'mingus-open-parent) 1568 | 1569 | (mapc (lambda (key) 1570 | (define-key mingus-browse-mode-map key 'mingus-open-parent)) 1571 | '(":" "^" "\C-x\C-j")) 1572 | 1573 | (define-key mingus-browse-mode-map 1574 | [menu-bar mingus sep-playlist-editing] 1575 | '("---" . separador)) 1576 | 1577 | (define-key mingus-browse-mode-map 1578 | [menu-bar mingus unset] 1579 | '("Unset Insertion Point" . mingus-unset-insertion-point)) 1580 | 1581 | (define-key mingus-browse-mode-map 1582 | [menu-bar mingus sep3] 1583 | '(menu-item "--")) 1584 | 1585 | (define-key mingus-browse-mode-map 1586 | [menu-bar mingus help] 1587 | '(menu-item "Help" mingus-help :help "go to help")) 1588 | 1589 | (define-key mingus-browse-mode-map 1590 | [menu-bar mingus playlist] 1591 | '(menu-item "Playlist" mingus :help "go to playlist")) 1592 | 1593 | (define-key mingus-browse-mode-map " " 'mingus-insert) 1594 | 1595 | ;;;some generic functions: 1596 | 1597 | ;;;; {{xemacs compatibility}} 1598 | (when (featurep 'xemacs) 1599 | (defun mingus-line-number-at-pos () 1600 | (line-number))) 1601 | 1602 | (defun mingus-remove-dupes (list) 1603 | (let (tmp-list head) 1604 | (while list 1605 | (setq head (pop list)) 1606 | (unless (member head tmp-list) 1607 | (push head tmp-list))) 1608 | tmp-list)) 1609 | 1610 | (defun mingus-goto-line (n) 1611 | (goto-char (point-min)) 1612 | (forward-line (1- n))) 1613 | 1614 | (defmacro mingus-save-excursion (&rest body) 1615 | "Execute BODY, and \"restore\" point to line-number and column." 1616 | (let ((line (gensym)) 1617 | (col (gensym))) 1618 | `(let ((,line (mingus-line-number-at-pos)) 1619 | (,col (- (point) (line-beginning-position)))) 1620 | ,@body 1621 | (mingus-goto-line ,line) 1622 | (move-to-column ,col)))) 1623 | 1624 | (defun mingus-format-plist (plist) 1625 | (let* ((len 0) 1626 | odd 1627 | (plist 1628 | (mapcar 1629 | (lambda (x) 1630 | (setq odd (not odd)) 1631 | (when (symbolp x) 1632 | (setq x (symbol-name x))) 1633 | (when odd 1634 | (setq len (max len (length x)))) 1635 | x) 1636 | plist)) 1637 | (key-template 1638 | (format "\n%%%ds : " len))) 1639 | (concat 1640 | (mapconcat 1641 | (lambda (x) 1642 | (setq odd (not odd)) 1643 | (if odd 1644 | (format key-template x) 1645 | (format "%S" x))) 1646 | plist "") 1647 | ""))) 1648 | 1649 | (defun mingus-inspect () 1650 | (interactive) 1651 | (when (mingus-buffer-p) 1652 | (let ((info (mingus-format-plist (mingus-get-details))) 1653 | (buffer (current-buffer))) 1654 | (switch-to-buffer-other-window 1655 | (get-buffer-create "*Mingus Inspect*")) 1656 | (erase-buffer) 1657 | (insert info) 1658 | (goto-char (point-min)) 1659 | (switch-to-buffer-other-window buffer)))) 1660 | 1661 | ;;;; {{Generic Functions}} 1662 | (defun _mingus-bol-at (pos) 1663 | "Return the position at beginning of line relative to POS." 1664 | (save-excursion (goto-char pos) 1665 | (line-beginning-position))) 1666 | 1667 | (defun _mingus-eol-at (pos) 1668 | "Return the position at end of line relative to POS." 1669 | (save-excursion (goto-char pos) 1670 | (line-end-position))) 1671 | ;; List processing 1672 | (defun mingus-make-alist (list) 1673 | "Make an alist out of a flat list (plist-style list)." 1674 | (if (cl-endp list) 1675 | nil 1676 | (cons (cons (car list) (cadr list)) 1677 | (mingus-make-alist (cddr list))))) 1678 | 1679 | (defun mingus-make-alist-reversed (list) 1680 | "Make an alist out of a flat list, whereby every pair is reversed." 1681 | (if (cl-endp list) 1682 | nil 1683 | (cons (cons (cadr list) (car list)) 1684 | (mingus-make-alist-reversed (cddr list))))) 1685 | 1686 | (defun mingus-pretext (string) 1687 | "Return part of STRING before first numeric occurence or nil otherwise." 1688 | (if (string-match "\\(^[^[:digit:]]*\\)\\([[:digit:]]+\\)" string) 1689 | (match-string 1 string) 1690 | nil)) 1691 | 1692 | (defun mingus-logically-less-p (s1 s2) 1693 | "Compare S1 and S2 logically, or numerically. 1694 | 1695 | E.g.: \"Artist 3 my beautiful song\" is logically less than \"Artist 11 blue sea\"." 1696 | (let ((p1 (mingus-pretext s1)) 1697 | (end1 (match-end 1)) 1698 | (end2 (match-end 2))) 1699 | (if (and p1 (string= p1 (mingus-pretext s2))) 1700 | (let ((n1 (string-to-number (substring s1 end1))) 1701 | (n2 (string-to-number (substring s2 end1)))) 1702 | (if (= n1 n2) 1703 | (mingus-logically-less-p (substring s1 end2) 1704 | (substring s2 (match-end 2))) 1705 | (< n1 n2))) 1706 | (apply #'string< 1707 | (let ((args (list s1 s2))) 1708 | (if mingus-fold-case 1709 | (mapcar #'downcase args) 1710 | args)))))) 1711 | 1712 | (defun mingus-keywordify-plist (list) 1713 | "Turn a nasty looking plist into a nice one, with lower-cased keywords." 1714 | (mapcar (lambda (item) 1715 | (cl-typecase item 1716 | (symbol (intern-soft 1717 | (format ":%s" (downcase (symbol-name item))))) 1718 | (t item))) list)) 1719 | 1720 | (defun mingus-mark-active () 1721 | (if (featurep 'xemacs) 1722 | (mark) 1723 | mark-active)) 1724 | 1725 | (defun mingus-min:sec->secs (min:secs) 1726 | "Convert MIN:SECS (a string) to seconds (an integer)." 1727 | (cond ((string-match "^[0-9]*:[0-9]*$" min:secs) 1728 | (cl-multiple-value-bind (min sec) 1729 | (mapcar 'string-to-number (split-string min:secs ":")) 1730 | (+ (* 60 min) sec))) 1731 | ((string-match "^[0-9]+$" min:secs) (string-to-number min:secs)) 1732 | (t (error "Not a valid value entered (expected: [min:]secs )")))) 1733 | 1734 | (defun mingus-sec->min:sec (sec) 1735 | "Convert SEC (as integer or string) to MIN:SEC (a string)." 1736 | (cl-multiple-value-bind (min sec) (cl-floor sec 60) 1737 | (format "%02d:%02d" min sec))) 1738 | 1739 | (defun mingus-line-number-at-pos (&optional pos) 1740 | "Return (narrowed) buffer line number at position POS. 1741 | If POS is nil, use current buffer location. 1742 | This is an exact copy of line-number-at-pos for use in emacs21." 1743 | (let ((opoint (or pos (point))) start) 1744 | (save-excursion 1745 | (goto-char (point-min)) 1746 | (setq start (point)) 1747 | (goto-char opoint) 1748 | (forward-line 0) 1749 | (1+ (count-lines start (point)))))) 1750 | 1751 | ;; Thanks to piyo-w3m--read-query-smart and offby1 1752 | (defun mingus-completing-read-allow-spaces (prompt table &optional predicate 1753 | require-match initial-input 1754 | hist def inherit-input-method) 1755 | "`completing-read', allowing space input and ignoring case." 1756 | (let* ((completion-ignore-case t) 1757 | (former-function (cdr (assoc 32 minibuffer-local-completion-map)))) 1758 | ;save former function of space character 1759 | (setcdr (assoc 32 minibuffer-local-completion-map) 'self-insert-command) 1760 | ; change space character to simply 1761 | ; insert a space 1762 | (unwind-protect 1763 | (if (and mingus-use-ido-mode-p 1764 | (fboundp 'ido-completing-read) 1765 | (listp table)) 1766 | (ido-completing-read prompt 1767 | ; this lists every song in the song db 1768 | table 1769 | predicate 1770 | require-match initial-input 1771 | hist def) 1772 | (completing-read prompt table predicate 1773 | require-match initial-input 1774 | hist def inherit-input-method)) 1775 | (setcdr (assoc 32 minibuffer-local-completion-map) former-function)))) 1776 | ;change back the space character to its 1777 | ;former value 1778 | 1779 | (defun mingus-delete-line () 1780 | "Delete line at point." 1781 | (delete-region (line-beginning-position 1) (line-beginning-position 2)) 1782 | (when (eobp) 1783 | (delete-region (line-beginning-position) (line-end-position 0)) 1784 | (beginning-of-line))) 1785 | 1786 | (defun mingus-strip-last-line () 1787 | (let (pos (point)) 1788 | (goto-char (point-max)) 1789 | (delete-region (line-beginning-position) (line-end-position 0)) 1790 | (goto-char pos))) 1791 | 1792 | ;; {{basic mpd functions}} 1793 | 1794 | (defun mingus-get-last-db-update () 1795 | (string-to-number (cdr (assoc "db_update" (cdr (mingus-exec "stats")))))) 1796 | 1797 | (defun mingus-get-songs (cmd &optional foreach) 1798 | "Get songs for CMD. 1799 | 1800 | Call function FOREACH as in `mpd-get-songs'." 1801 | (mpd-get-songs mpd-inter-conn cmd foreach)) 1802 | 1803 | (defun mingus-get-songs-with-smart-cache (cmd &optional foreach) 1804 | "Get songs for CMD. 1805 | 1806 | Call function FOREACH as in `mpd-get-songs'. 1807 | 1808 | This differs from `mingus-get-songs' in that it only requests MPD 1809 | for the information when the database has another version number. 1810 | 1811 | If versions differ, the cached response is used. 1812 | 1813 | NOTE that the playlist may differ while the database may not, so 1814 | do not use this function for stuff concerning the playlist. 1815 | 1816 | This function may fail on the off chance servers are switched and 1817 | their latest update time happen to be exactly the same. In that 1818 | rare case, running a single `mingus-update' to regenerate the 1819 | database may work." 1820 | (let* ((last-update (mingus-get-last-db-update)) 1821 | (old-results (get 'mingus-get-songs (intern cmd)))) 1822 | (or (and old-results 1823 | (= (car old-results) last-update) 1824 | (cdr old-results)) 1825 | (let ((new-results 1826 | (mpd-get-songs mpd-inter-conn cmd foreach))) 1827 | (put 'mingus-get-songs (intern cmd) 1828 | (cons 1829 | last-update 1830 | new-results)))))) 1831 | 1832 | (defun mingus-pos->id (pos) 1833 | (cl-getf (car (mingus-get-songs (format "playlistinfo %d" pos))) 'Id)) 1834 | 1835 | (defun mingus-id->pos (id) 1836 | (cl-getf (car (mingus-get-songs (format "playlistid %d" id))) 'Pos)) 1837 | 1838 | (defun mingus-id->filename (id) 1839 | (cl-getf (car (mingus-get-songs (format "playlistid %d" id))) 'file)) 1840 | 1841 | (defun mingus-idlist->poslist (list) 1842 | (mapcar 'mingus-id->pos list)) 1843 | 1844 | ;; {{mingus-marked-list}} 1845 | 1846 | 1847 | (defun mingus-pos->mlist (pos) 1848 | (add-to-list 'mingus-marked-list (mingus-pos->id pos))) 1849 | 1850 | (defun mingus-pos-mlist-> (pos) 1851 | (setf mingus-marked-list (remove (mingus-pos->id pos) mingus-marked-list))) 1852 | 1853 | (defun mingus-pos<->mlist (pos) 1854 | (if (member (mingus-pos->id pos) mingus-marked-list) 1855 | (mingus-pos-mlist-> pos) 1856 | (mingus-pos->mlist pos))) 1857 | 1858 | (defun mingus-toggle-mark (pos) 1859 | (mingus-pos<->mlist pos)) 1860 | 1861 | ;; do me in color and bold!! And in a single function 1862 | 1863 | (defalias 'mingus-toggle-mark-at-p 'mingus-mark) 1864 | 1865 | (defun mingus-mark () 1866 | "In Mingus, mark a song for movement or deletion. 1867 | Unmark song when already marked. 1868 | To mark a region, use mingus-mark-region." 1869 | (interactive) 1870 | (mingus-toggle-mark (1- (mingus-line-number-at-pos))) 1871 | (beginning-of-line) 1872 | (let (buffer-read-only) 1873 | (if (member (mingus-pos->id (1- (mingus-line-number-at-pos))) 1874 | mingus-marked-list) 1875 | (mingus-mark-line) 1876 | (mingus-unmark-line) 1877 | (mingus-redraw-line))) 1878 | (forward-line 1) 1879 | (when (= (point-max) 1880 | (point)) 1881 | (forward-line 0))) 1882 | 1883 | (defun mingus-mark-dwim () 1884 | (interactive) 1885 | (if (mingus-mark-active) 1886 | (call-interactively 'mingus-mark-region) 1887 | (mingus-mark))) 1888 | 1889 | (defun mingus-mark-regexp (re) 1890 | "In Mingus, mark all songs containing regexp RE." 1891 | (interactive 1892 | (list 1893 | (when (null current-prefix-arg) 1894 | (read-string "Mark containing regexp: ")))) 1895 | (if (null re) (call-interactively 'mingus-unmark-regexp) 1896 | (save-excursion 1897 | (let (buffer-read-only) 1898 | (goto-char (point-min)) 1899 | (while (re-search-forward re nil t) 1900 | (mingus-pos->mlist (1- (mingus-line-number-at-pos))) 1901 | (mingus-mark-line)))))) 1902 | 1903 | (defun mingus-unmark-regexp (re) 1904 | "In Mingus, mark all songs containing regexp RE." 1905 | (interactive "sUnmark containing regexp: ") 1906 | (save-excursion 1907 | (let (buffer-read-only) 1908 | (goto-char (point-min)) 1909 | (while (re-search-forward re nil t) 1910 | (mingus-unmark-line) 1911 | (mingus-pos-mlist-> (1- (mingus-line-number-at-pos))))))) 1912 | 1913 | (defun mingus-merge-maps (map1 map2) 1914 | "Merge keymaps MAP1 and MAP2 1915 | 1916 | Merge all keybindings of MAP2 that aren't yet bound in MAP1 1917 | plus all bound keys of MAP1 in a fresh keymap." 1918 | (let ((m (copy-keymap map1))) 1919 | (dolist (key (copy-keymap map2) m) 1920 | (when (and (consp key) 1921 | (not (assoc (car key) m))) 1922 | (set 'm 1923 | (append m (list key))))))) 1924 | 1925 | (defvar mingus-sexp-map () 1926 | "Keymap for editing sexp expressions in the minibuffer.") 1927 | 1928 | (cl-eval-when (load) 1929 | (when (and (featurep 'paredit) (boundp 'paredit-mode-map)) 1930 | (setq mingus-sexp-map (mingus-merge-maps minibuffer-local-map paredit-mode-map)))) 1931 | 1932 | (defun mingus-mark-sexp (predicate) 1933 | "In Mingus, mark all songs matching PREDICATE. 1934 | 1935 | The following symbols are bound during the evaluation of PREDICATE: 1936 | 1937 | file 1938 | title 1939 | artist 1940 | album 1941 | date 1942 | genre 1943 | track 1944 | last-modified 1945 | 1946 | These probably speak for themselves. 1947 | 1948 | details : the car of the `details' text property. 1949 | " 1950 | (interactive 1951 | (list (read-from-minibuffer 1952 | (if current-prefix-arg 1953 | "Unmark if (lisp expr): " 1954 | "Mark if (lisp expr): ") nil mingus-sexp-map t))) 1955 | (save-excursion 1956 | (let (buffer-read-only any) 1957 | (goto-char (point-min)) 1958 | (while (not (eobp)) 1959 | (let* ((details (get-text-property (point) 'details)) 1960 | (file (cl-getf details 'file)) 1961 | (title (cl-getf details 'Title)) 1962 | (artist (cl-getf details 'Artist)) 1963 | (album (cl-getf details 'Album)) 1964 | (date (cl-getf details 'Date)) 1965 | (genre (cl-getf details 'Genre)) 1966 | (track (cl-getf details 'Track)) 1967 | (last-modified (cl-getf details 'Last-Modified))) 1968 | (when (eval predicate) 1969 | (setq any t) 1970 | (if current-prefix-arg 1971 | (progn 1972 | (mingus-unmark-line) 1973 | (mingus-pos-mlist-> (1- (mingus-line-number-at-pos)))) 1974 | (mingus-pos->mlist (1- (mingus-line-number-at-pos))) 1975 | (mingus-mark-line))) 1976 | (forward-line))) 1977 | (unless any 1978 | (message "No match for sexp: %S" predicate))))) 1979 | 1980 | (defun mingus-set-marks () 1981 | (let (buffer-read-only) 1982 | (mapcar (lambda (pos) 1983 | (mingus-goto-line (1+ pos)) 1984 | (beginning-of-line) 1985 | (mingus-mark-line) 1986 | (forward-line 2)) 1987 | (mingus-idlist->poslist mingus-marked-list)))) 1988 | 1989 | (defun mingus-clr-mlist () 1990 | (interactive) 1991 | (setq mingus-marked-list nil) 1992 | (put 'mingus-marked-list :changed t)) 1993 | 1994 | ;; this one is old 1995 | (defun mingus-mark-operation () 1996 | (interactive) 1997 | (if (or mingus-marked-list) 1998 | (progn 1999 | (let ((command (read-key-sequence "(D)elete or (M)ove here?"))) 2000 | (cond ((string-match "d\\|D" command) 2001 | (mingus-del-marked)) 2002 | ((string-match "m\\|M" command) 2003 | (mingus-move-all)) 2004 | (t nil)))) 2005 | (message "No marked songs"))) 2006 | 2007 | ;;;; {{mouse functions}} 2008 | 2009 | (defun mingus-insert-at-mouse (ev) 2010 | "Insert song or dir at mouse." 2011 | (interactive "e") 2012 | (when mingus-use-mouse-p 2013 | (mouse-set-point ev) 2014 | (mingus-insert))) 2015 | 2016 | (defun mingus-down-at-mouse (ev) 2017 | "Insert song or dir at mouse." 2018 | (interactive "e") 2019 | (when mingus-use-mouse-p 2020 | (mouse-set-point ev) 2021 | (if (cddr ev) 2022 | (mingus-insert) 2023 | (mingus-down-dir-or-play-song)))) 2024 | 2025 | (defun mingus-show-version () 2026 | (interactive) 2027 | (message "Version of mingus: %s" mingus-version)) 2028 | 2029 | ;; {{dispatchers}} 2030 | 2031 | ;;;###autoload 2032 | (defun mingus-help () 2033 | "Help screen for `mingus'." 2034 | (interactive) 2035 | (cond 2036 | ((get-buffer-window "*Mingus Help*") 2037 | (select-window (get-buffer-window "*Mingus Help*"))) 2038 | (t (switch-to-buffer "*Mingus Help*"))) 2039 | (when (string= (buffer-string) "") 2040 | (insert mingus-help-text)) 2041 | (goto-char (point-min)) 2042 | (mingus-help-mode)) 2043 | 2044 | (define-derived-mode mingus-help-mode special-mode "Mingus-help" 2045 | "Help screen for `mingus'. 2046 | 2047 | \\{mingus-help-mode-map}" 2048 | (set (make-local-variable 'font-lock-defaults) 2049 | '(mingus-help-font-lock-keywords)) 2050 | (setq buffer-undo-list t) 2051 | (font-lock-mode t) 2052 | (setq buffer-read-only t)) 2053 | 2054 | (defun mingus-switch-to-playlist () 2055 | (cond 2056 | ((get-buffer-window "*Mingus*") 2057 | (select-window (get-buffer-window "*Mingus*"))) 2058 | (t 2059 | (switch-to-buffer "*Mingus*"))) 2060 | (mingus-playlist-mode)) 2061 | 2062 | (defun mingus-switch-to-browser () 2063 | (switch-to-buffer "*Mingus Browser*") 2064 | (mingus-browse-mode)) 2065 | 2066 | (defun mingus-buffer-p (&optional buffer) 2067 | (member (or buffer (buffer-name)) 2068 | '("*Mingus Browser*" "*Mingus Help*" 2069 | "*Mingus*" "*Mingus Burns*"))) 2070 | 2071 | (defun mingus-git-out (&optional x) 2072 | "Bury all Mingus buffers." 2073 | (interactive) 2074 | (while (mingus-buffer-p) 2075 | (bury-buffer))) 2076 | 2077 | (define-derived-mode mingus-playlist-mode special-mode "Mingus-playlist" 2078 | "Mingus playlist mode. 2079 | 2080 | See function `mingus-help' for instructions. 2081 | \\{mingus-playlist-mode-map}" 2082 | (setq buffer-undo-list t) 2083 | (delete-all-overlays) 2084 | (font-lock-mode -1) 2085 | (setq buffer-read-only t) 2086 | (setq left-fringe-width 16)) 2087 | 2088 | (define-derived-mode mingus-browse-mode special-mode "Mingus-browse" 2089 | "Mingus browse mode. 2090 | 2091 | \\{mingus-browse-mode-map}" 2092 | (let ((res mingus-last-query-results)) 2093 | (setq buffer-undo-list t) 2094 | (delete-all-overlays) 2095 | (run-hooks 'mingus-browse-hook) 2096 | (set (make-local-variable '*mingus-positions*) nil) 2097 | (setq buffer-read-only t) 2098 | (setq mingus-last-query-results res))) 2099 | 2100 | (defun mingus-mode-line-kill () 2101 | (interactive) 2102 | (cancel-timer mingus-timer)) 2103 | 2104 | (defvar mingus-mode-line-object 2105 | '(:eval 2106 | (or 2107 | (and mingus-status 2108 | (or mingus-mode-always-modeline 2109 | (member (buffer-name) 2110 | '("*Mingus Browser*" 2111 | "*Mingus Help*" 2112 | "*Mingus*" 2113 | "*Mingus Burns*"))) 2114 | (propertize 2115 | (mingus-make-mode-line-string) 2116 | 'help-echo (concat 2117 | (mingus-make-mode-line-help-echo) 2118 | (if *mingus-point-of-insertion* 2119 | (concat "\nPOI: " (cadar 2120 | *mingus-point-of-insertion*))) 2121 | "\nmouse-1: menu or switch to mingus; 2122 | mouse-3: toggle playing; 2123 | mouse-4: vol-up; 2124 | mouse-5: vol-down") 2125 | 'mouse-face 'mode-line-highlight 2126 | 'local-map '(keymap 2127 | (mode-line keymap 2128 | (mouse-4 . mingus-vol-up) ; 2129 | (mouse-5 . mingus-vol-down) ; 2130 | (down-mouse-3 . mingus-toggle) 2131 | (down-mouse-1 . (lambda () 2132 | (interactive) 2133 | (if (mingus-buffer-p) 2134 | (mouse-major-mode-menu t) 2135 | (mingus)))))))) 2136 | ""))) 2137 | 2138 | (defun mingus-make-status-string () 2139 | "Make status string of elapsed time, volume, repeat and random status etc." 2140 | (let* ((status (mpd-get-status mpd-inter-conn)) 2141 | (time-elapsed (cl-getf status 'time-elapsed)) 2142 | (time-total (cl-getf status 'time-total)) 2143 | (volume (cl-getf status 'volume)) 2144 | (repeat (cl-getf status 'repeat)) 2145 | (random (cl-getf status 'random)) 2146 | (single (cl-getf status 'single)) 2147 | (consume (cl-getf status 'consume)) 2148 | (xfade (cl-getf status 'xfade)) 2149 | (percentage (and mingus-mode-line-show-elapsed-percentage 2150 | (eq (cl-getf status 'state) 'play) 2151 | time-elapsed 2152 | time-total 2153 | (format " (%d%%)" (round (/ (float time-elapsed) 2154 | (/ (float time-total) 2155 | 100))))))) 2156 | (concat (and mingus-mode-line-show-elapsed-time 2157 | time-elapsed 2158 | (mingus-sec->min:sec time-elapsed)) 2159 | percentage 2160 | (and volume 2161 | (format 2162 | "<%d%%%s%s>" 2163 | volume 2164 | (if mingus-mode-line-show-random-and-repeat-status 2165 | (format "%s%s%s" 2166 | (if (eq repeat 1) "r" "") 2167 | (if (eq random 1) "z" "") 2168 | (if (and xfade (< 0 xfade)) 2169 | (format "#%d" xfade) 2170 | "")) 2171 | "") 2172 | (if mingus-mode-line-show-consume-and-single-status 2173 | (concat (if (and single (string= single "1")) "s" "") 2174 | (if (and consume (string= consume "1")) "c" "")) 2175 | "")))))) 2176 | 2177 | (defun mingus-make-mode-line-string () 2178 | "Make a string to use in the mode-line for Mingus." 2179 | (concat (if (member (cl-getf (mpd-get-status mpd-inter-conn) 'state) 2180 | '(play pause)) 2181 | (concat 2182 | (let* ((data (car (mingus-get-songs "currentsong"))) 2183 | (str 2184 | (mingus-format-song-compact 2185 | data 2186 | mingus-mode-line-separator))) 2187 | (truncate-string-to-width str mingus-mode-line-string-max nil nil "…")) 2188 | (if mingus-mode-line-show-status 2189 | (mingus-make-status-string) 2190 | ""))))) 2191 | 2192 | (defun mingus-set-NP-mark (override &optional pos) 2193 | "Mark song \='now playing\='. 2194 | 2195 | Optional argument POS gives possibility of supplying the currentsong without 2196 | making a connection. 2197 | 2198 | Argument OVERRIDE defines whether to treat the situation as new." 2199 | (when (null *mingus-NP-mark*) 2200 | (mingus-create-NP-mark)) 2201 | (condition-case nil 2202 | (let ((pos (or pos (cl-getf (mpd-get-status mpd-inter-conn) 'song)))) 2203 | (and pos 2204 | (save-excursion 2205 | (save-window-excursion 2206 | (mingus-switch-to-playlist) 2207 | (let (buffer-read-only) 2208 | (mingus-goto-line (1+ pos)) 2209 | (mingus-move-NP-mark 2210 | (point) 2211 | (mingus-get-song-pos))))) 2212 | (mingus-set-song-pos pos))))) 2213 | 2214 | (when (fboundp 'define-fringe-bitmap) 2215 | (define-fringe-bitmap 'mingus-NP-fringe 2216 | [128 192 224 240 248 252 248 240 224 192 128])) 2217 | 2218 | (defvar 2219 | *mingus-playing-string* 2220 | (if window-system 2221 | (propertize 2222 | ">> " 2223 | 'display 2224 | '(left-fringe mingus-NP-fringe)) 2225 | (propertize ">> " 'face 'mingus-playing-face))) 2226 | 2227 | ;; 1 0 0 0 0 0 0 0 2228 | ;; 1 1 0 0 0 0 0 0 2229 | ;; 1 1 1 0 0 0 0 0 2230 | ;; 1 1 1 1 0 0 0 0 2231 | ;; 1 1 1 1 1 0 0 0 2232 | ;; 1 1 1 1 1 1 0 0 2233 | ;; 1 1 1 1 1 1 1 0 2234 | ;; 1 1 1 1 1 1 0 0 2235 | ;; 1 1 1 1 1 0 0 0 2236 | ;; 1 1 1 1 0 0 0 0 2237 | ;; 1 1 1 0 0 0 0 0 2238 | ;; 1 1 0 0 0 0 0 0 2239 | ;; 1 0 0 0 0 0 0 0 2240 | 2241 | (when (fboundp 'define-fringe-bitmap) 2242 | (define-fringe-bitmap 'mingus-pausing-fringe 2243 | [102 102 102 102 102 102 102 102 102 102])) 2244 | 2245 | (defvar 2246 | *mingus-pausing-string* 2247 | (if window-system 2248 | (propertize 2249 | "|| " 2250 | 'display 2251 | '(left-fringe mingus-pausing-fringe)) 2252 | "|| ")) 2253 | 2254 | ;; (+ 0 64 32 0 0 4 2 0) 2255 | 2256 | ;; 0 1 1 0 0 1 1 0 2257 | ;; 0 1 1 0 0 1 1 0 2258 | ;; 0 1 1 0 0 1 1 0 2259 | ;; 0 1 1 0 0 1 1 0 2260 | ;; 0 1 1 0 0 1 1 0 2261 | ;; 0 1 1 0 0 1 1 0 2262 | ;; 0 1 1 0 0 1 1 0 2263 | ;; 0 1 1 0 0 1 1 0 2264 | ;; 0 1 1 0 0 1 1 0 2265 | ;; 0 1 1 0 0 1 1 0 2266 | ;; 0 1 1 0 0 1 1 0 2267 | ;; 0 1 1 0 0 1 1 0 2268 | ;; 0 1 1 0 0 1 1 0 2269 | 2270 | (when (fboundp 'define-fringe-bitmap) 2271 | (define-fringe-bitmap 'mingus-stopped-fringe 2272 | [-1 -1 -1 -1 -1 -1 -1 -1])) 2273 | 2274 | (defvar 2275 | *mingus-stopped-string* 2276 | (if window-system 2277 | (propertize 2278 | "[] " 2279 | 'display 2280 | '(left-fringe mingus-stopped-fringe)) 2281 | (propertize "[] " 'face 'mingus-stopped-face))) 2282 | 2283 | (when (fboundp 'set-fringe-bitmap-face) 2284 | (set-fringe-bitmap-face 'mingus-NP-fringe 'mingus-playing-face) 2285 | (set-fringe-bitmap-face 'mingus-pausing-fringe 'mingus-pausing-face) 2286 | (set-fringe-bitmap-face 'mingus-stopped-fringe 'mingus-stopped-face)) 2287 | 2288 | (defun mingus-create-NP-mark () 2289 | (let ((string *mingus-playing-string*)) 2290 | 2291 | (save-window-excursion 2292 | (setq *mingus-NP-mark* 2293 | (make-overlay (point-min) 2294 | (point-min))) 2295 | (delete-overlay *mingus-NP-mark*) 2296 | (overlay-put *mingus-NP-mark* 2297 | 'before-string string) 2298 | (overlay-put *mingus-NP-mark* 2299 | 'face 'mingus-playing-face) 2300 | (overlay-put *mingus-NP-mark* 2301 | 'name "mingus-NP-mark")))) 2302 | 2303 | (defun mingus-remove-face-text-property (beg end prop) 2304 | (let (buffer-read-only) 2305 | (save-excursion 2306 | (goto-char beg) 2307 | (while (not (= (point) end)) 2308 | (let* ((current (get-text-property (point) 'face)) 2309 | (new (and (listp current) (remove prop current)))) 2310 | (cond ((equal prop current) 2311 | (remove-text-properties (point) (1+ (point)) '(face))) 2312 | (new (put-text-property (point) (1+ (point)) 'face new)))) 2313 | (goto-char (1+ (point))))))) 2314 | 2315 | (defun mingus-embolden-line-at (pos) 2316 | (when mingus-current-song-props 2317 | (let (buffer-read-only) 2318 | (save-excursion 2319 | (goto-char pos) 2320 | (add-face-text-property 2321 | (line-beginning-position) 2322 | (line-end-position) 2323 | mingus-current-song-props))))) 2324 | 2325 | (defun mingus-debolden-buffer () 2326 | (when mingus-current-song-props 2327 | (mingus-remove-face-text-property 2328 | (point-min) 2329 | (point-max) 2330 | mingus-current-song-props))) 2331 | 2332 | (defun mingus-debolden-line (line) 2333 | (when mingus-current-song-props 2334 | (save-excursion 2335 | (mingus-goto-line line) 2336 | (mingus-remove-face-text-property 2337 | (line-beginning-position) 2338 | (line-end-position) 2339 | mingus-current-song-props)))) 2340 | 2341 | (defun mingus-move-NP-mark (pos prev) 2342 | (move-overlay *mingus-NP-mark* pos pos (get-buffer "*Mingus*")) 2343 | (and prev (mingus-debolden-line prev)) 2344 | (mingus-debolden-buffer) 2345 | (mingus-embolden-line-at (1+ pos)) 2346 | (cl-case 2347 | (cl-getf (mpd-get-status mpd-inter-conn) 'state) 2348 | ((pause) (overlay-put *mingus-NP-mark* 2349 | 'before-string 2350 | *mingus-pausing-string*)) 2351 | ((play) (overlay-put *mingus-NP-mark* 2352 | 'before-string 2353 | *mingus-playing-string*)) 2354 | ((stop) (overlay-put *mingus-NP-mark* 2355 | 'before-string 2356 | *mingus-stopped-string*)))) 2357 | 2358 | 2359 | 2360 | (defun mingus-make-mode-line-help-echo () 2361 | "Make a string to use in the mode-line-help-echo for Mingus." 2362 | (condition-case nil 2363 | (concat (if (member (cl-getf (mpd-get-status mpd-inter-conn) 'state) 2364 | '(play pause)) 2365 | (concat 2366 | (let* ((data (car (mingus-get-songs "currentsong"))) 2367 | (str 2368 | (mingus-format-song-compact data " - "))) 2369 | str) 2370 | (mingus-make-status-string)))))) 2371 | 2372 | ;; filling the buffer: 2373 | (defun mingus-playlist (&optional refresh) 2374 | "Fill the playlist buffer so as to reflect current status in most proper way. 2375 | Optional argument REFRESH means not matter what is the status, do a refresh" 2376 | (condition-case err 2377 | (with-current-buffer 2378 | (get-buffer-create "*Mingus*") 2379 | (when (or 2380 | refresh 2381 | (/= (mingus-get-old-playlist-version) 2382 | (mingus-set-playlist-version)) 2383 | (= (point-min) 2384 | ;; apparently buffer was deleted before 2385 | (point-max)) 2386 | (get 'mingus-marked-list :changed)) 2387 | (let ((songs (mingus-get-songs "playlistinfo")) 2388 | (buffer-read-only nil) 2389 | (pos (mingus-line-number-at-pos))) 2390 | (put 'mingus-marked-list :changed nil) 2391 | (mingus-set-playlist-version) 2392 | (erase-buffer) 2393 | (if songs 2394 | (progn 2395 | (insert 2396 | (replace-regexp-in-string 2397 | "\n\n" "\n" ;<<< circumvent a bug in libmpdee concerning 2398 | ;non-unique vorbiscomment tags 2399 | (mapconcat 2400 | (lambda (list) 2401 | (let ((id (plist-get list 'Id))) 2402 | (or (and 2403 | mingus-use-caching 2404 | (gethash id mingus-propertized-song-strings)) 2405 | (let ((val 2406 | (propertize 2407 | (mingus-format-song list) 2408 | 'mouse-face (when mingus-use-mouse-p 'highlight) 2409 | 'details list))) 2410 | (when mingus-use-caching 2411 | (puthash id val mingus-propertized-song-strings)) 2412 | val)))) 2413 | songs "\n"))) 2414 | (mingus-set-marks) 2415 | (mingus-set-NP-mark t)) 2416 | (insert *mingus-header-when-empty*)) 2417 | (mingus-goto-line pos)) 2418 | (run-hooks 'mingus-make-playlist-hook))) 2419 | (error err))) 2420 | 2421 | (defun mingus-playlist-set-detail-properties (songs) 2422 | (mapc 2423 | (lambda (sublist) 2424 | (mingus-goto-line (1+ (plist-get sublist 'Pos))) 2425 | (put-text-property (line-beginning-position) (line-end-position) 'details sublist)) 2426 | songs)) 2427 | 2428 | (defcustom mingus-format-song-function 'mingus-format-song-in-columns 2429 | "Function for formatting songs in the playlist. 2430 | 2431 | Argument SONG-DETAILS is a plist, see `mingus-get-details'. 2432 | 2433 | For a new format to take effect (when using caching) run M-x 2434 | mingus-clear-cache." 2435 | :type '(function) 2436 | :group 'mingus) 2437 | 2438 | (defun mingus-truncate-string (string length) 2439 | (truncate-string-to-width string (max 1 length) nil 32 "…")) 2440 | 2441 | (defun mingus-format-song (details) 2442 | (propertize (funcall mingus-format-song-function details) 2443 | 'details details 2444 | 'mingus-type 'file)) 2445 | 2446 | (defun mingus-format-song-in-columns (item) 2447 | (let* ((available-width (- (window-text-width) 9 2448 | ;; 9 is time width plus column gaps plus 2449 | ;; leeway 2450 | )) 2451 | (song-width (/ available-width 2)) 2452 | (artist-width (/ available-width 4)) 2453 | (album-width (/ available-width 4)) 2454 | (string 2455 | (concat 2456 | (format "%02d.%.2d " 2457 | (/ (or (plist-get item 'Time) 0) 60) 2458 | (mod (or (plist-get item 'Time) 0) 60)) 2459 | (propertize 2460 | (mingus-truncate-string 2461 | (or (plist-get item 'Title) 2462 | (plist-get item 'Name) 2463 | (plist-get item 'file)) 2464 | song-width) 2465 | 'face 'mingus-song-file-face) 2466 | (propertize 2467 | (concat " " 2468 | (mingus-truncate-string 2469 | (or (plist-get item 'Artist) 2470 | (plist-get item 'AlbumArtist) 2471 | "") 2472 | artist-width)) 2473 | 'face 'mingus-artist-face) 2474 | (propertize 2475 | (concat " " 2476 | (mingus-truncate-string 2477 | (or (plist-get item 'Album) "") 2478 | album-width)) 2479 | 'face 'mingus-album-stale-face)))) 2480 | string)) 2481 | 2482 | (defun mingus-format-song-compact (plist &optional separator) 2483 | "Make a string from PLIST. 2484 | 2485 | Concatenate the results for the values with SEPARATOR, where SEPARATOR 2486 | defaults to the string \" - \"." 2487 | (let ((artist (cl-getf plist 'Artist)) 2488 | (album (cl-getf plist 'Album)) 2489 | (title (cl-getf plist 'Title)) 2490 | (albumartist (cl-getf plist 'Albumartist)) 2491 | (track (cl-getf plist 'Track)) 2492 | (name (cl-getf plist 'Name)) 2493 | (genre (cl-getf plist 'Genre)) 2494 | (date (cl-getf plist 'Date)) 2495 | (composer (cl-getf plist 'Composer)) 2496 | (performer (cl-getf plist 'Performer)) 2497 | (comment (cl-getf plist 'Comment)) 2498 | (disc (cl-getf plist 'Disc)) 2499 | (time (cl-getf plist 'Time)) 2500 | (pos (cl-getf plist 'Pos)) 2501 | (id (cl-getf plist 'Id)) 2502 | (file (cl-getf plist 'file)) 2503 | (separator (or separator " - "))) 2504 | (or (and mingus-use-caching 2505 | (gethash id mingus-song-strings)) 2506 | (let ((val 2507 | (let* ((timestring 2508 | (and time 2509 | (concat "(" (mingus-sec->min:sec time) ")"))) 2510 | (filestring 2511 | (and file 2512 | (file-name-nondirectory file))) 2513 | (short (remove nil (list (or artist albumartist) 2514 | album 2515 | (or title filestring) 2516 | timestring)))) 2517 | (mapconcat 'identity short separator)))) 2518 | (and mingus-use-caching 2519 | (puthash id val mingus-song-strings)) 2520 | val)))) 2521 | 2522 | ;;;###autoload 2523 | (defun mingus (&optional set-variables) 2524 | "MPD Interface by Niels Giesen, Useful and Simple. 2525 | 2526 | Actually it is just named after that great bass player." 2527 | (interactive "P") 2528 | (when set-variables 2529 | (call-interactively 'mingus-set-variables-interactively)) 2530 | (mingus-switch-to-playlist) 2531 | (add-to-list 'global-mode-string mingus-mode-line-object) 2532 | (unless (timerp mingus-timer) 2533 | (setq mingus-timer (run-with-idle-timer mingus-timer-interval 2534 | mingus-timer-interval 2535 | 'mingus-timer-handler))) 2536 | (mingus-playlist)) 2537 | 2538 | (defun mingus-cancel-timer () 2539 | (interactive) 2540 | (when (timerp mingus-timer) 2541 | (cancel-timer mingus-timer))) 2542 | 2543 | (defun mingus-buffer-visible-p (buffer) 2544 | (and (member (get-buffer buffer) 2545 | (mingus-all-visible-buffers)) 2546 | t)) 2547 | 2548 | (defun mingus-all-visible-buffers () 2549 | (let (l) 2550 | (mapc 2551 | (lambda (f) 2552 | (when (frame-visible-p f) 2553 | (setq l (append (mingus-frame-buffer-list f) l)))) 2554 | (frame-list)) 2555 | l)) 2556 | 2557 | (defun mingus-frame-buffer-list (frame) 2558 | (mapcar #'window-buffer 2559 | (window-list frame))) 2560 | 2561 | (defun mingus-timer-handler () 2562 | (condition-case outer 2563 | (let ((changes 2564 | (condition-case inner 2565 | (mingus-exec "idle\nnoidle") 2566 | (error 2567 | (when (eq 'file-error (car inner)) 2568 | ;; (file-error "make client process failed" "Connection refused" 2569 | ;; :name "mpd" :buffer nil :host "localhost" :service 6603 :nowait nil) 2570 | (signal (car inner) (cdr inner))))))) 2571 | (setq mingus-status t) 2572 | (when changes 2573 | (if (buffer-live-p (get-buffer "*Mingus*")) 2574 | (if (member '("changed" . "playlist") changes) 2575 | (mingus-playlist) 2576 | (when (and (not (and (fboundp 'frame-parent) (frame-parent))) 2577 | (mingus-buffer-visible-p (get-buffer "*Mingus*"))) 2578 | (mingus-set-NP-mark t)))) 2579 | (force-mode-line-update))) 2580 | (error 2581 | ;; Delay before first using the timer again: 2582 | (mingus-cancel-timer) 2583 | ;; If this bad, leave timer cancelled. 2584 | (if (eq 'file-error (car outer)) 2585 | (setq mingus-status nil) 2586 | (setq mingus-timer (run-with-timer 5 mingus-timer-interval 2587 | 'mingus-timer-handler)))))) 2588 | 2589 | (defun mingus-start-daemon () 2590 | "Start mpd daemon for `mingus'." 2591 | (interactive) 2592 | (start-process "mpddaemon" nil "mpd")) 2593 | 2594 | (defun mingus-minibuffer-feedback (key) 2595 | "Get a status from mpd, where status is the value for KEY;" 2596 | (let ((val (cl-getf (mpd-get-status mpd-inter-conn) key))) 2597 | (message "Mingus: %S set to %S" key val))) 2598 | 2599 | (defun mingus-shuffle () 2600 | (interactive) 2601 | (mpd-shuffle-playlist mpd-inter-conn)) 2602 | 2603 | (defmacro mingus-define-mpd->mingus (name &rest body) 2604 | (funcall 2605 | (lambda () 2606 | `(defun ,name (&rest args) 2607 | (interactive) 2608 | (apply #',(intern-soft 2609 | (replace-regexp-in-string "mingus-" "mpd-" (symbol-name name))) 2610 | mpd-inter-conn 2611 | args) 2612 | ,@body)))) 2613 | 2614 | (mingus-define-mpd->mingus 2615 | mingus-update 2616 | (clrhash mingus-song-strings) 2617 | (clrhash mingus-propertized-song-strings) 2618 | (and (member 'updating_db (mpd-get-status mpd-inter-conn)) 2619 | (message "Updating DB"))) 2620 | 2621 | (mingus-define-mpd->mingus mingus-pause 2622 | (mingus-minibuffer-feedback 'state) 2623 | (mingus-set-NP-mark t)) 2624 | 2625 | (defalias 'mingus-toggle 'mingus-pause) 2626 | 2627 | (mingus-define-mpd->mingus 2628 | mingus-prev 2629 | (mingus-set-NP-mark t)) 2630 | 2631 | (mingus-define-mpd->mingus 2632 | mingus-next 2633 | (mingus-set-NP-mark t)) 2634 | 2635 | (mingus-define-mpd->mingus 2636 | mingus-stop 2637 | (mingus-set-NP-mark t)) 2638 | 2639 | (defun mingus-boolean->string (bool) 2640 | (cl-case bool 2641 | ((1 t) 'on) 2642 | ((0 nil) 'off))) 2643 | 2644 | (defun mingus-repeat () 2645 | "Toggle mpd repeat mode." 2646 | (interactive) 2647 | (let ((newval (abs (1- (cl-getf (mpd-get-status mpd-inter-conn) 'repeat))))) 2648 | (mpd-execute-command mpd-inter-conn (format "repeat %d" newval)) 2649 | (message "Mingus: repeat set to %S" (mingus-boolean->string newval)))) 2650 | 2651 | (defun mingus-random () 2652 | "Toggle mpd repeat mode." 2653 | (interactive) 2654 | (let ((newval (abs (1- (cl-getf (mpd-get-status mpd-inter-conn) 'random))))) 2655 | (mpd-execute-command mpd-inter-conn (format "random %d" newval)) 2656 | (message "Mingus: Random mode %S" (mingus-boolean->string newval)))) 2657 | 2658 | 2659 | (defun mingus-setvol (arg) 2660 | (mpd-execute-command mpd-inter-conn 2661 | (format "setvol %d" 2662 | (if (numberp arg) arg 2663 | (funcall 2664 | (cl-case arg 2665 | (+ '1+) 2666 | (- '1-)) 2667 | (cl-getf (mpd-get-status mpd-inter-conn) 2668 | 'volume))))) 2669 | (mingus-minibuffer-feedback 'volume)) 2670 | 2671 | (defun mingus-vol-up () 2672 | (interactive) 2673 | (mingus-setvol '+)) 2674 | 2675 | (defun mingus-vol-down () 2676 | (interactive) 2677 | (mingus-setvol '-)) 2678 | 2679 | (defmacro mingus-advice (func-name buffer-name &optional docstring) 2680 | ;fixme: should make this dependent on a 2681 | ;keyword 2682 | (funcall 2683 | (lambda () 2684 | `(defadvice ,func-name (around mingus-around-advice activate) 2685 | ,docstring 2686 | (if (string= ,buffer-name (buffer-name)) 2687 | ad-do-it 2688 | (message ,(format "Not in %s buffer" buffer-name))))))) 2689 | 2690 | (defun mingus-get-insertion-number (&optional or-playlist-length) 2691 | "When insertion point is set and valid, return it as a number. 2692 | When it is not set, return nil. 2693 | When it is set but invalid, unset it, and return nil. 2694 | 2695 | When OR-PLAYLIST-LENGTH is non-`nil', return the playlist length 2696 | when there is no (valid) insertion point." 2697 | (let ((point (caar *mingus-point-of-insertion*))) 2698 | (if point 2699 | (let ((playlistlength (mingus-playlist-length))) 2700 | (if (<= point playlistlength) 2701 | point 2702 | (mingus-unset-insertion-point) 2703 | (when or-playlist-length 2704 | playlistlength))) 2705 | (and or-playlist-length (mingus-playlist-length))))) 2706 | 2707 | (defun mingus-goto-point-of-insertion () 2708 | "Move point to *mingus-point-of-insertion*. 2709 | Switch to *Mingus* buffer if necessary." 2710 | (interactive) 2711 | (mingus-switch-to-playlist) 2712 | (mingus-goto-line (mingus-get-insertion-number t))) 2713 | 2714 | (mingus-advice mingus-toggle-marked "*Mingus*") 2715 | (mingus-advice mingus-goto-current-song "*Mingus*") 2716 | (mingus-advice mingus-del-region "*Mingus*") 2717 | (mingus-advice mingus-mark-region "*Mingus*") 2718 | (mingus-advice mingus-unmark-region "*Mingus*") 2719 | (mingus-advice mingus-move-down "*Mingus*") 2720 | (mingus-advice mingus-set-insertion-point "*Mingus*") 2721 | (mingus-advice mingus-move-up "*Mingus*") 2722 | (mingus-advice mingus-mark "*Mingus*") 2723 | (mingus-advice mingus-down-dir-or-play-song "*Mingus Browser*") 2724 | 2725 | (mapc 'ad-activate '(mingus-goto-current-song 2726 | mingus-del-region 2727 | mingus-down-dir-or-play-song 2728 | mingus-move-down 2729 | mingus-move-up 2730 | mingus-set-insertion-point)) 2731 | 2732 | (defmacro mingus-insertion-advice (func-name) 2733 | "Move inserted songs to *mingus-point-of-insertion* after insertion. 2734 | Argument FUNC-NAME is the name of the function to advice." 2735 | `(defadvice ,func-name (around mingus-insertion-advice activate) 2736 | (let ((old-version (mingus-get-new-playlist-version)) 2737 | (end-of-playlist (1+ (mingus-playlist-length))) 2738 | (insertion-point (mingus-get-insertion-number))) 2739 | (when ad-do-it 2740 | (save-window-excursion 2741 | (let* ((new-version (mingus-get-new-playlist-version)) 2742 | (changes (mingus-exec 2743 | (format "plchangesposid %d" old-version))) 2744 | (howmanysongs (if (car changes) (- new-version old-version))) 2745 | (song (if (< 1 howmanysongs) "songs" "song"))) 2746 | ;;back out when nothing is inserted: 2747 | (when howmanysongs 2748 | ;; Insertion is now done at the right point, no need to 2749 | ;; move it afterwards -- EXCEPT for playlist. 2750 | 2751 | ;; (if insertion-point 2752 | ;; (progn 2753 | ;; (message "Processing request...") 2754 | ;; ;;move all just inserted songs to their destination: 2755 | ;; (mingus-move 2756 | ;; (cl-loop for i in (cdr changes) by #'cddr collect 2757 | ;; (string-to-number (cdr i))) 2758 | ;; (make-list howmanysongs insertion-point) nil) 2759 | ;; ;; some informative message: 2760 | ;; (message "%d %s added at %s" 2761 | ;; howmanysongs song 2762 | ;; (cadar *mingus-point-of-insertion*))) 2763 | ;; (message "%d %s added at end of playlist." 2764 | ;; howmanysongs song)) 2765 | (mingus)))))))) 2766 | 2767 | (mingus-insertion-advice mingus-add-stream) 2768 | (mingus-insertion-advice mingus-add-podcast) 2769 | 2770 | (defmacro mingus-and-play (func-name new-func-name) 2771 | "Transform `insert functions' to \"(insert)-and-play\" functions." 2772 | `(defun ,new-func-name () 2773 | (interactive) 2774 | (let ((mingus-playing-point (mingus-get-insertion-number t))) 2775 | (,func-name) 2776 | (mingus-play mingus-playing-point)))) 2777 | 2778 | (mingus-and-play mingus-add-stream mingus-add-stream-and-play) 2779 | (mingus-and-play mingus-add-podcast mingus-add-podcast-and-play) 2780 | (mingus-and-play mingus-insert mingus-insert-and-play) 2781 | (mingus-and-play mingus-load-playlist mingus-load-playlist-and-play) 2782 | (mingus-and-play mingus-load-all mingus-load-all-and-play) 2783 | 2784 | (cl-defun mingus-seek (amount &optional percentage from-start) 2785 | "Seek song played by mpd in seconds or percentage. 2786 | 2787 | (Prefix) argument AMOUNT specifies movement forward or backward. 2788 | Defaults to variable `mingus-seek-amount'. 2789 | When PERCENTAGE is specified, seek to PERCENTAGE of song. 2790 | If PERCENTAGE is specified and AMOUNT is negative, seek PERCENTAGE backwards." 2791 | (interactive "p") 2792 | (let* ((data (mpd-get-status mpd-inter-conn)) 2793 | (time-total (plist-get data 'time-total)) 2794 | (time-elapsed (plist-get data 'time-elapsed)) 2795 | (amount (if (and (null from-start) (= 1 amount)) 2796 | mingus-seek-amount 2797 | amount)) 2798 | (amount-final 2799 | (max 0 2800 | (cond (percentage (round (* (/ time-total 100.0) amount))) 2801 | ((not from-start) (+ time-elapsed amount)) 2802 | (t amount))))) 2803 | (mpd-seek mpd-inter-conn (mingus-cur-song-id) amount-final t))) 2804 | 2805 | (defun mingus-seek-percents (amount) 2806 | "Seek song played by mpd in percentage." 2807 | (interactive "p") 2808 | (cond ((= 1 amount) 2809 | (message "Usage: give prefix argument to specify absolute percentage of song.\n(eg: C-u 40 %% seeks to the point at 40%% of current song)\nNegative argument seeks backward.\n(eg: C-u -10 %% to seek backward 10 percent)")) 2810 | (t 2811 | (mingus-seek amount t)))) 2812 | 2813 | (defun mingus-seek-from-start (amount) 2814 | "Seek to PREFIX seconds from start of current song played by mpd." 2815 | (interactive "p") 2816 | (if (= 1 amount) 2817 | (message "Usage: seek to PREFIX seconds from start of current song. 2818 | (eg: C-U 30 seeks to thirtieth second of song)") 2819 | (mingus-seek amount nil t))) 2820 | 2821 | (defun mingus-seek-min-sec () 2822 | "Seek to minute:second point in song." 2823 | (interactive) 2824 | (mingus-seek-from-start 2825 | (mingus-min:sec->secs (read-from-minibuffer 2826 | "Minutes and seconds (eg 2:30): ")))) 2827 | 2828 | (defun mingus-seek-backward (amount) 2829 | "Seek song played by mpd in seconds or percentage backwards." 2830 | (interactive "p") 2831 | (mingus-seek (- 0 (if (= 1 amount) mingus-seek-amount amount)))) 2832 | 2833 | (defun mingus-crossfade (p) 2834 | "Set crossfade time for mpd; 2835 | prefix argument of 0 sets crossfade off." 2836 | (interactive "P") 2837 | (let ((p (or (and p (if (listp p) (car p) p)) 0))) 2838 | (if (car 2839 | (mpd-execute-command 2840 | mpd-inter-conn 2841 | (format "crossfade %S" p))) 2842 | (message "Mingus: crossfade set to %d" p) 2843 | (message "Mingus: setting crossfade did not work")))) 2844 | 2845 | (defun mingus-cur-line (&optional stringify) 2846 | "In Mingus, return number of song under point" 2847 | (if stringify 2848 | (number-to-string (mingus-line-number-at-pos)) 2849 | (mingus-line-number-at-pos))) 2850 | 2851 | (defun mingus-unmark-all () 2852 | "In Mingus, unset `mingus-marked-list'." 2853 | (interactive) 2854 | (setq mingus-marked-list nil) 2855 | (mingus-playlist t) ;@todo: just remove marks... 2856 | (message "No songs marked anymore")) 2857 | 2858 | (defun mingus-cur-song-number () 2859 | "Return number of song currently played by mpd. 2860 | Return nil if no song playing." 2861 | (cl-getf (mpd-get-status mpd-inter-conn) 'song)) 2862 | 2863 | (defun mingus-cur-song-id () 2864 | "Return id of song currently played by mpd. 2865 | Return nil if no song playing." 2866 | (cl-getf (mpd-get-status mpd-inter-conn) 'songid)) 2867 | 2868 | (defun mingus-goto-current-song () 2869 | "In Mingus, move point to currently playing song." 2870 | (interactive) 2871 | (mingus-goto-line (1+ (or (mingus-cur-song-number) 0)))) 2872 | 2873 | (defun mingus-playlist-length () 2874 | "Return length of current mpd playlist." 2875 | (cl-getf (mpd-get-status mpd-inter-conn) 'playlistlength)) 2876 | 2877 | (defun mingus-volume () 2878 | "Return mpd volume as string." 2879 | (number-to-string (cl-getf (mpd-get-status mpd-inter-conn) 'volume))) 2880 | 2881 | (defun mingus-move (from to &optional use-id) 2882 | "Move mpd playlist id FROM to mpd playlist position TO." 2883 | (mpd-move mpd-inter-conn from to use-id)) 2884 | 2885 | ;; now for my little pearls: 2886 | (defvar mingus-uplist `(1 . ,(current-time)) 2887 | "Cons of the form (COUNT . TIME) for checking repeating commands; 2888 | COUNT is the number of repeated commands; 2889 | TIME is the last time the command has been invoked") 2890 | 2891 | (defun mingus-update-command-list (&optional inc) 2892 | (setcdr mingus-uplist (float-time (current-time))) 2893 | (if inc (cl-incf (car mingus-uplist)) 2894 | (setcar mingus-uplist 1))) 2895 | 2896 | (defun mingus-move-up () 2897 | "In Mingus, move song at point up one position, visually." 2898 | (interactive) 2899 | (if (= (mingus-line-number-at-pos) 1) 2900 | (progn 2901 | (and (> (car mingus-uplist) 1) ;there were previous calls so do 2902 | ;something 2903 | (mingus-move (1- (car mingus-uplist)) 0)) 2904 | (mingus-update-command-list)) ;set the count of calls to 1 2905 | (let ((buffer-read-only nil)) 2906 | (if (and (eq last-command this-command) 2907 | ;quick repetition of keypresses, 2908 | ;or holding down a key 2909 | (< (- (float-time (current-time))(cdr mingus-uplist)) 0.04)) 2910 | (progn (mingus-update-command-list t) ;increase the count of calls 2911 | ;with one 2912 | (transpose-lines 1) ;change positions in buffer 2913 | (forward-line -2) 2914 | (run-with-timer 2915 | 0.05 nil 2916 | (lambda (count) 2917 | ;check if this was the last call 2918 | (if (= count (car mingus-uplist)) 2919 | (progn 2920 | ;move the song to its new position 2921 | (mingus-move 2922 | (- (+ (car mingus-uplist) 2923 | (mingus-line-number-at-pos)) 2) 2924 | (max 0 (- (mingus-line-number-at-pos) 1))) 2925 | (message 2926 | "Pos %d moved to pos %d" 2927 | (max 0 (- (+ (car mingus-uplist) 2928 | (mingus-line-number-at-pos)) 2)) 2929 | (- (mingus-line-number-at-pos) 1)) 2930 | ;reset the count 2931 | (mingus-update-command-list)))) 2932 | (car mingus-uplist))) 2933 | ;single keypress handled individually 2934 | (cond ((= (mingus-line-number-at-pos) 1) (mingus-update-command-list)) 2935 | (t 2936 | (and 2937 | (mingus-move 2938 | (1- (mingus-line-number-at-pos)) 2939 | (max (- (mingus-line-number-at-pos) 1 (car mingus-uplist)) 0)) 2940 | (transpose-lines 1) 2941 | (mingus-update-command-list) 2942 | (mingus-set-song-pos) 2943 | (forward-line -2) 2944 | (message "Moved 1 song up.")))))))) 2945 | 2946 | 2947 | (defun mingus-move-down () 2948 | "In Mingus, move song at point down one position, visually." 2949 | (interactive) 2950 | (if (= (mingus-line-number-at-pos) (count-lines (point-min) (point-max))) 2951 | (progn 2952 | (and (> (car mingus-uplist) 1) ;there were previous calls so do 2953 | ;something 2954 | (mingus-move 2955 | (- (mingus-line-number-at-pos) (car mingus-uplist)) 2956 | (1- (mingus-line-number-at-pos)))) 2957 | (mingus-update-command-list)) ;set the count of calls to 1 2958 | (let ((buffer-read-only nil)) 2959 | (if (and (eq last-command this-command) 2960 | (< (- (float-time (current-time))(cdr mingus-uplist)) 0.04)) 2961 | ;quick repetition of keypresses, or 2962 | ;holding down a key 2963 | (progn (mingus-update-command-list t) ;increase the count of calls 2964 | ;with one 2965 | (forward-line 1) ;change positions in buffer 2966 | (transpose-lines 1) 2967 | (forward-line -1) 2968 | (run-with-timer 2969 | 0.05 nil 2970 | (lambda (count) 2971 | (if (= count (car mingus-uplist)) 2972 | ;check if this was the last call 2973 | (progn 2974 | (mingus-move 2975 | (max (- (mingus-line-number-at-pos)(car mingus-uplist)) 0) 2976 | (- (mingus-line-number-at-pos) 1)) ;move the song 2977 | ;to its new 2978 | ;position 2979 | (message "Pos %d moved to pos %d" 2980 | (max (- (mingus-line-number-at-pos) 2981 | (car mingus-uplist)) 0) 2982 | (- (mingus-line-number-at-pos) 1)) 2983 | (mingus-update-command-list) ;reset the count 2984 | (mingus-set-NP-mark t) 2985 | ;; (mingus-set-song-pos) 2986 | ))) 2987 | (car mingus-uplist))) 2988 | (cond ((= (mingus-line-number-at-pos) 2989 | (count-lines (point-min) (point-max))) 2990 | (mingus-update-command-list)) 2991 | ;just a single keypress, handled 2992 | ;individually 2993 | (t 2994 | (and 2995 | (mingus-move (- (mingus-line-number-at-pos) 1) 2996 | (mingus-line-number-at-pos)) 2997 | (mingus-update-command-list) 2998 | (mingus-set-song-pos) 2999 | (forward-line 1) 3000 | (transpose-lines 1) 3001 | (forward-line -1) 3002 | (message "Moved 1 song down.") 3003 | (mingus-set-NP-mark t)))))))) 3004 | 3005 | (defun mingus-move-all () 3006 | "In Mingus, move all marked songs to current position in buffer." 3007 | (interactive) 3008 | (if (null mingus-marked-list) 3009 | (message "No marked songs") 3010 | (mingus-move mingus-marked-list 3011 | (make-list (length mingus-marked-list) 3012 | (1- (mingus-line-number-at-pos))) 3013 | t))) 3014 | 3015 | (defmacro mingus-define-region-mark-operation 3016 | (name function &optional docstring) 3017 | (funcall 3018 | (lambda () 3019 | `(defun ,name (beg end) 3020 | ,docstring 3021 | (interactive "r") 3022 | (let* ((buffer-read-only nil) 3023 | (beg (1- (mingus-line-number-at-pos beg))) 3024 | (end (1- (if (bolp) 3025 | (mingus-line-number-at-pos end) 3026 | (1+ (mingus-line-number-at-pos end))))) 3027 | newsongs 3028 | (mlist-as-pos 3029 | (remove nil 3030 | (if mingus-marked-list 3031 | (mapcar 'mingus-id->pos mingus-marked-list)))) 3032 | (howmanysongs (- end beg))) 3033 | (dotimes (count howmanysongs) 3034 | (setq newsongs (cons (+ beg count) newsongs))) 3035 | (setq mingus-marked-list 3036 | (,function mingus-marked-list 3037 | (mapcar 'mingus-pos->id newsongs))) 3038 | (mingus-playlist t)))))) 3039 | 3040 | (mingus-define-region-mark-operation 3041 | mingus-mark-region cl-union 3042 | "In Mingus, mark region between BEG and END for subsequent operations.") 3043 | (mingus-define-region-mark-operation 3044 | mingus-unmark-region cl-set-difference 3045 | "In Mingus, unmark region between BEG and END.") 3046 | 3047 | (defun mingus-toggle-marked () 3048 | "In Mingus, toggle wich songs are marked." 3049 | (interactive) 3050 | (setq mingus-marked-list 3051 | (cl-nset-difference 3052 | (mapcar 3053 | (lambda (song-item) 3054 | (cl-getf song-item 'Id)) 3055 | (mingus-get-songs "playlistinfo")) 3056 | mingus-marked-list)) 3057 | (mingus-playlist t)) 3058 | 3059 | (defun mingus-del () 3060 | (interactive) 3061 | (let ((pos (1- (mingus-line-number-at-pos))) 3062 | (buffer-read-only)) 3063 | (mingus-pos-mlist-> (1- (mingus-line-number-at-pos))) 3064 | (mpd-delete mpd-inter-conn pos) 3065 | (delete-region (line-beginning-position) (line-beginning-position 2)) 3066 | (mingus-set-playlist-version))) 3067 | 3068 | (defun mingus-reset-point-of-insertion () 3069 | "Reset the variable `*mingus-point-of-insertion*'. 3070 | 3071 | This is according to the situation where the song at point will have been 3072 | deleted." 3073 | (let ((number (mingus-get-insertion-number))) 3074 | (cond ((and number 3075 | (= number (mingus-line-number-at-pos))) 3076 | (mingus-unset-insertion-point)) 3077 | ((and number 3078 | (> number (mingus-line-number-at-pos))) 3079 | (cl-decf (caar *mingus-point-of-insertion*)))))) 3080 | 3081 | (defun mingus-del-region (beg end) 3082 | "In Mingus, delete region. 3083 | Leave `mingus-marked-list' intact." 3084 | (interactive "r") 3085 | ;;no need for consuming computation and bindings when whole buffer is selected 3086 | (if (and (= beg (point-min)) (= end (point-max))) 3087 | (mingus-clear t) 3088 | (let* ((ole-beg beg) 3089 | (ole-end end) 3090 | (buffer-read-only nil) 3091 | (beg (1- (mingus-line-number-at-pos beg))) 3092 | (end (1- (if (bolp) 3093 | (mingus-line-number-at-pos end) 3094 | (1+ (mingus-line-number-at-pos end))))) 3095 | (howmanysongs (- end beg)) 3096 | deletablelist 3097 | (mlist-as-pos 3098 | (remove nil 3099 | (if mingus-marked-list 3100 | (mapcar 'mingus-id->pos mingus-marked-list))))) 3101 | (mingus-exec (format "delete %d:%d" beg end)) 3102 | ;; make a list of deletable positions 3103 | (dotimes (count howmanysongs) 3104 | (setq deletablelist (cons (+ beg count) deletablelist))) 3105 | ;; delete the files 3106 | (let ((newmlist (mapcar 'mingus-pos->id 3107 | (cl-set-difference 3108 | mlist-as-pos 3109 | (cl-intersection mlist-as-pos deletablelist))))) 3110 | (setq mingus-marked-list newmlist)) 3111 | ;; remove all songs that are deleted from the mingus-marked-list (mapcar 3112 | ;; 'mingus-pos->id (cl-set-difference '(3 111 4 5) (cl-intersection '(3 111) '(2 3113 | ;; 3 111)))) 3114 | (delete-region ole-beg ole-end) 3115 | ;; (mingus) 3116 | ))) 3117 | 3118 | (defun mingus-delete-lines (lines) 3119 | "Delete every line in LINES, where 0 is the first line in the buffer. 3120 | LINES can also be a single line." 3121 | (let ((lines (cl-etypecase lines 3122 | (list (sort lines '<)) 3123 | (integer (list lines))))) 3124 | (save-excursion 3125 | (mapc (lambda (lines) 3126 | (mingus-goto-line (1+ lines)) 3127 | (delete-region (line-beginning-position) (line-end-position))) lines) 3128 | (goto-char (point-min)) 3129 | (delete-matching-lines "^$")))) 3130 | 3131 | (defun mingus-del-marked () 3132 | "Delete songs marked in *Mingus* buffer." 3133 | (interactive) 3134 | (let ((buffer-read-only nil) 3135 | (cur-line (mingus-line-number-at-pos))) 3136 | (if mingus-marked-list 3137 | (when (y-or-n-p (format "Remove %d marked songs? " 3138 | (length mingus-marked-list))) 3139 | (progn 3140 | (let ((mlist-as-pos (mingus-idlist->poslist mingus-marked-list))) 3141 | (mpd-delete mpd-inter-conn mingus-marked-list t) 3142 | (mingus-delete-lines mlist-as-pos)) 3143 | (mingus-goto-line (- cur-line (cl-count-if (lambda (item) (> cur-line item)) 3144 | mingus-marked-list))) 3145 | (setq mingus-marked-list nil))) 3146 | (mingus-del))) 3147 | (when (eobp) 3148 | (delete-region (line-beginning-position) (line-beginning-position 2)) 3149 | (beginning-of-line))) 3150 | 3151 | (defun mingus-del-other-songs () 3152 | "In the *Mingus* buffer, delete all but the songs in `mingus-marked-list'." 3153 | (interactive) 3154 | (when mingus-marked-list 3155 | (mpd-delete mpd-inter-conn (cl-set-difference 3156 | (cl-loop for i in 3157 | (mingus-get-songs "playlistinfo") 3158 | collect (cl-getf i 'Id)) 3159 | mingus-marked-list) 3160 | t) 3161 | (message "Other songs deleted"))) 3162 | 3163 | (defun mingus-play (&optional position) 3164 | "Start playing the mpd playlist, only if not yet playing. 3165 | When called with argument POSITION, play playlist id POSITION." 3166 | (interactive) 3167 | (mpd-play mpd-inter-conn (or position (1- (mingus-line-number-at-pos)))) 3168 | (mingus-set-NP-mark t)) 3169 | 3170 | (defun mingus-play-pos (position) 3171 | "Play song in mpd playlist at position specified by prefix argument." 3172 | (interactive "p") 3173 | (mingus-play (number-to-string position))) 3174 | 3175 | (defun mingus-clear (&optional dontask) 3176 | "Clear mpd playlist; 3177 | Does prompting. 3178 | Optional argument DONTASK means no prompting." 3179 | (interactive "P") 3180 | (if (or dontask (yes-or-no-p "Clear the playlist? ")) 3181 | (mpd-clear-playlist mpd-inter-conn) 3182 | (message "Playlist not cleared"))) 3183 | 3184 | (defun mingus-load-all (&optional and-play) 3185 | "Load all songs in mpd database into mpd playlist. 3186 | Optional argument AND-PLAY means start playing after loading." 3187 | (interactive "P") 3188 | (if and-play (mingus-load-all-and-play) 3189 | (when (yes-or-no-p "Load the WHOLE mpd database? " ) 3190 | (mpd-clear-playlist mpd-inter-conn) 3191 | (mpd-execute-command mpd-inter-conn "add /")))) 3192 | 3193 | (defun mingus-crop () 3194 | "Crop mpd playlist." 3195 | (interactive) 3196 | (condition-case err 3197 | (let* 3198 | ((status (mpd-get-status mpd-inter-conn)) 3199 | (playlistlength (plist-get status 'playlistlength)) 3200 | (song (plist-get status 'song)) 3201 | list) 3202 | (and (> playlistlength 1) 3203 | (mpd-delete mpd-inter-conn 3204 | (remove song 3205 | (dotimes (count playlistlength list) 3206 | (push count list)))) 3207 | (save-selected-window 3208 | (mingus)))) 3209 | (error "Mingus error: %s" err))) 3210 | 3211 | (defun mingus-add (string &optional mingus-url) 3212 | "In Mingus, add a song." 3213 | (mingus-exec 3214 | (format "add %s" (if mingus-url 3215 | string 3216 | (mpd-safe-string string)))) 3217 | ;;hmm, where IS this mingus-url for? 3218 | (save-window-excursion (mingus))) 3219 | 3220 | (defun mingus-add-album () 3221 | "In Mingus, add all songs in the same album as the song under point." 3222 | (interactive) 3223 | (let ((album (cl-getf (mingus-get-details) 'X-AlbumUri))) 3224 | (if album 3225 | (mingus-add album) 3226 | (message "No album found for this song")))) 3227 | 3228 | (defcustom mingus-stream-alist 3229 | '(("CRo 1 - Radiozurnal (czech)" . "http://amp1.cesnet.cz:8000/cro1-256.ogg") 3230 | ("CRo 2 - Praha (czech)" . "http://amp1.cesnet.cz:8000/cro2-256.ogg") 3231 | ("CRo 3 - Vltava czech)" . "http://amp1.cesnet.cz:8000/cro3-256.ogg") 3232 | ("open radio" . "http://open-radio.nl:8000/org.ogg") 3233 | ("Radio Rota" . "http://streamer.radiorota.cz:8000/rota64.ogg")) 3234 | "Alist of radio stations to be used by the function `mingus-add-stream'." 3235 | :group 'mingus 3236 | :type '(alist)) 3237 | 3238 | (defcustom mingus-podcast-alist () 3239 | "Alist of podcasts to be used by the function `mingus-add-podcast'." 3240 | :group 'mingus 3241 | :type '(alist)) 3242 | 3243 | (defcustom mingus-wait-for-update-interval 1 3244 | "Seconds to wait after sending and update command to MPD, if 3245 | subsequent commands depend upon that update being finalized." 3246 | :group 'mingus 3247 | :type '(number)) 3248 | 3249 | (defun mingus-add-stream (&optional and-play) 3250 | "Add a url-stream to the mpd playlist. 3251 | When point is at the beginning of a url, add that url; 3252 | In w3m, add the link under point; 3253 | Completion is provided by the entries in `mingus-stream-alist' to choose from. 3254 | With prefix argument, instantly play the insertion. 3255 | Optional prefix argument AND-PLAY says: and play it now!" 3256 | (interactive "P") 3257 | (if and-play (mingus-add-stream-and-play) 3258 | (let ((url (mingus-completing-read-allow-spaces "Url: " 3259 | mingus-stream-alist nil nil 3260 | (mingus-extract-url)))) 3261 | (cl-case (mingus-playlist-type 3262 | (setq url (or 3263 | (cdr (assoc url mingus-stream-alist)) 3264 | (assoc url mingus-stream-alist) 3265 | url))) 3266 | (m3u (mingus-add (mingus-site-to-string))) 3267 | (pls (mingus-add-podcast)) 3268 | (t (mingus-add url t)))))) 3269 | 3270 | (defun mingus-extract-url () 3271 | "Return url at point; 3272 | If no url at point, return nil." 3273 | (let ((url (and (not (member major-mode 3274 | '(mingus-playlist-mode mingus-browse-mode))) 3275 | (or (plist-get (text-properties-at (point)) 'w3m-href-anchor) 3276 | (and 3277 | (thing-at-point-bounds-of-url-at-point) 3278 | (thing-at-point-url-at-point)))))) 3279 | (when (not (null url)) 3280 | (if (string-match "\?" url) 3281 | (replace-match "\\?" nil t url) 3282 | url)))) 3283 | 3284 | (defun mingus-playlist-type (url) 3285 | "Return type of playlist for URL." 3286 | (cond ((string-match ".*\.[mM]3[Uu]" (or url "something else")) 'm3u) 3287 | ((string-match ".*\.\\([pP][lL][sS]\\|[aA][sS][xX]\\)" 3288 | (or url "something else")) 'pls) 3289 | (t nil))) 3290 | 3291 | (defun mingus-site-to-string (&optional url) 3292 | "Return contents of URL as string." 3293 | (let ((url (or url (mingus-extract-url)))) 3294 | (when url 3295 | (with-current-buffer 3296 | (url-retrieve-synchronously url) 3297 | (buffer-string))))) 3298 | 3299 | (defun mingus-add-podcast (&optional and-play) 3300 | "Add all streams in podcast at point. 3301 | Actually it tries to retrieve any stream from a given url. 3302 | The variable `mingus-podcast-alist' can be used for input selection. 3303 | With prefix argument, play directly." 3304 | (interactive "P") 3305 | (if and-play (mingus-add-podcast-and-play) 3306 | (let* ((xml (or (mingus-site-to-string) 3307 | (mingus-site-to-string 3308 | (let ((url (completing-read "Add a podcast: " 3309 | mingus-podcast-alist))) 3310 | (or (cdr (assoc url mingus-podcast-alist)) 3311 | (assoc url mingus-podcast-alist) 3312 | url))))) 3313 | (streams (mingus-remove-dupes (mingus-streams-from-podcast-with-regexp xml)))) 3314 | (mapcar 'mingus-add streams)))) 3315 | 3316 | ;; (defun mingus-streams-from-podcast (xmlstring) 3317 | ;; (let ((xml 3318 | ;; (with-temp-buffer 3319 | ;; (insert xmlstring) 3320 | ;; (xml-parse-region (point-min) 3321 | ;; (point-max))))) 3322 | ;; (mapcar 'cdr (s-query xml '(rss channel item enclosure :url))))) 3323 | 3324 | (defun mingus-streams-from-podcast-with-regexp (xmlstring) 3325 | (let (streams) 3326 | (with-temp-buffer 3327 | (insert xmlstring) 3328 | (goto-char (point-min)) 3329 | (while (re-search-forward "url=\"\\([^\"]+\\)\"" nil t) 3330 | (push (match-string 1) streams)) 3331 | streams))) 3332 | 3333 | ;;;###autoload 3334 | (defun mingus-browse () 3335 | "Switch to buffer *Mingus Browser* and start the Mingus browsing experience." 3336 | (interactive) 3337 | (cond 3338 | ((get-buffer-window "*Mingus Browser*") 3339 | (select-window (get-buffer-window "*Mingus Browser*"))) 3340 | ((bufferp (get-buffer "*Mingus Browser*")) 3341 | (mingus-switch-to-browser)) 3342 | (t 3343 | (mingus-switch-to-browser) 3344 | (let ((buffer-read-only nil)) 3345 | (erase-buffer) 3346 | ;; only if not yet in browsing mode 3347 | (mingus-browse-top-level))))) 3348 | 3349 | (defun mingus-get-items () 3350 | (let ((items (unless mark-active 3351 | (list (mingus-get-details)))) 3352 | (beg (if mark-active (min (mark) (point)))) 3353 | (end (if mark-active (max (mark) (point))))) 3354 | (when mark-active 3355 | (save-excursion 3356 | (goto-char end) 3357 | (while 3358 | (> (point) beg) 3359 | (forward-line -1) 3360 | (push (mingus-get-details) items)))) 3361 | (remove nil items))) 3362 | 3363 | (defun mingus-add-things-at-p () 3364 | (interactive) 3365 | (let* ((old-length (mingus-playlist-length)) 3366 | (items (mingus-get-items)) 3367 | (commands (mapconcat #'mingus-command-for-item items "\n")) 3368 | (playlists (cl-count 'playlist items :key #'mingus-get-type)) 3369 | (directories (cl-count 'directory items :key #'mingus-get-type)) 3370 | (songs (cl-count 'file items :key #'mingus-get-type)) 3371 | (albums (cl-count 'album items :key #'mingus-get-type)) 3372 | (at (mingus-get-insertion-number)) 3373 | (tries 0) 3374 | (new-length)) 3375 | (mingus-exec commands) 3376 | (while 3377 | (and 3378 | (null (setq new-length (mingus-playlist-length))) 3379 | (< tries 100)) ; Wait for max 1 sec 3380 | (cl-incf tries) 3381 | (sleep-for 0.01)) 3382 | (when new-length 3383 | (when at 3384 | (mingus-exec 3385 | (format "move %d:%d %d" old-length new-length at))) 3386 | (message "Added total of %d songs (%d playlists, %d albums, %d songs, %d directories)" 3387 | (- new-length old-length) 3388 | playlists albums songs directories)))) 3389 | 3390 | (defun mingus-command-for-item (item) 3391 | (when item 3392 | (cl-case (mingus-get-type item) 3393 | ((playlist) (format "load %s" (mpd-safe-string (plist-get item 'Title)))) 3394 | ((file directory album) 3395 | (format "add %s" (mpd-safe-string 3396 | (or (plist-get item 'file) 3397 | (plist-get item 'Title)))))))) 3398 | 3399 | (defun mingus-down-dir-or-play-song (&optional and-play) 3400 | "In *Mingus Browser* buffer, go to dir at point, or play song at point." 3401 | (interactive "P") 3402 | (when (mingus-get-details) 3403 | (save-excursion 3404 | (beginning-of-line) 3405 | (cond 3406 | ((or 3407 | (mingus-songp) 3408 | (mingus-albump)) 3409 | ;; Does anybody know how to list album tracks? 3410 | (mingus-insert and-play)) 3411 | ((mingus-playlistp) 3412 | (mingus-list-playlist 3413 | (mingus-get-filename-at-p))) 3414 | ((mingus-directoryp) 3415 | (push (mingus-line-number-at-pos) *mingus-positions*) 3416 | (mingus-ls 3417 | (mingus-get-filename-at-p))) 3418 | (t (message "Mingus knows nothing of this type %S" 3419 | (mingus-item-type))))))) 3420 | 3421 | (defun mingus-get-details () 3422 | "Get details for song from text-property `details'" 3423 | (get-text-property (line-beginning-position) 'details)) 3424 | 3425 | (defun mingus-get-filename-at-p () 3426 | "Retrieve filename of song at point." 3427 | (let ((details (mingus-get-details))) 3428 | (or 3429 | (plist-get details 'file) 3430 | (plist-get details 'Title)))) 3431 | 3432 | (defun mingus-item-type () 3433 | (get-text-property (line-beginning-position) 'mingus-type)) 3434 | 3435 | (defun mingus-playlistp () 3436 | "In *Mingus Browser* buffer, is thing-at-p a playlist?" 3437 | (eq 'playlist (mingus-item-type))) 3438 | 3439 | (defun mingus-directoryp () 3440 | "In *Mingus Browser* buffer, is thing-at-p a directory?" 3441 | (eq 'directory (mingus-item-type))) 3442 | 3443 | (defun mingus-songp () 3444 | "In *Mingus Browser* buffer, is thing-at-p a song?" 3445 | (eq 'file (mingus-item-type))) 3446 | 3447 | (defun mingus-albump () 3448 | "In *Mingus Browser* buffer, is thing-at-p an album?" 3449 | (eq 'album (mingus-item-type))) 3450 | 3451 | (defun _mingus-string->parent-dir (child) 3452 | (if (string-match "^https?://" child) ;URLS are illegal here 3453 | (error "Not a local file!") 3454 | (string-match "\\(.*\\)/" child) 3455 | (match-string 1 child))) 3456 | 3457 | (defun mingus-get-directory-info (dir) 3458 | (mpd-get-directory-info mpd-inter-conn dir)) 3459 | 3460 | (defun mingus-browse-top-level () 3461 | "Goto top level of *Mingus Browser*." 3462 | (interactive) 3463 | (mingus-switch-to-browser) 3464 | (mingus-ls)) 3465 | 3466 | (defun mingus-ls (&optional string) 3467 | "List songs/dirs in directory STRING in dedicated *Mingus Browser* buffer." 3468 | (if (null string) 3469 | (setq string "")) 3470 | (with-current-buffer (get-buffer-create "*Mingus Browser*") 3471 | (push `(mingus-ls ,string) mingus-browse-command-history) 3472 | (mingus-browse-fill string (mingus-get-directory-info string)))) 3473 | 3474 | (defun mingus-list-playlist (playlist) 3475 | "List songs in PLAYLIST." 3476 | (mingus-switch-to-browser) 3477 | (push `(mingus-list-playlist ,playlist) mingus-browse-command-history) 3478 | (let* 3479 | ((results (make-vector 3 nil))) 3480 | (aset results 0 3481 | (mingus-get-songs 3482 | (format "listplaylistinfo %s" 3483 | (mpd-safe-string playlist)))) 3484 | (mingus-browse-fill playlist results))) 3485 | 3486 | (defun mingus-browse-fill (string results) 3487 | "Fill the Browser buffer with RESULTS for STRING. 3488 | 3489 | RESULTS is a vector of [songs playlists directories]. 3490 | \"songs\" is a list as returned by `mpd-get-songs'. 3491 | \"playlists\" and \"directories\" are a list of strings." 3492 | (save-excursion 3493 | (let* 3494 | ((buffer-read-only nil) 3495 | (songs 3496 | (mapcar 'mingus-format-song 3497 | (if (assoc 'Last-Modified (aref results 0)) 3498 | (cdr (aref results 0)) 3499 | (aref results 0)))) 3500 | (playlists (mapcar 3501 | (lambda (s) 3502 | (mingus-itemize-and-format s 'playlist)) 3503 | (aref results 1))) 3504 | (dirs (mapcar 3505 | (lambda (s) 3506 | (mingus-itemize-and-format s 'directory)) 3507 | (aref results 2))) 3508 | (newcontents 3509 | (mapconcat 3510 | (lambda (list) 3511 | (mapconcat #'identity list "\n")) 3512 | (remove nil (list songs dirs playlists)) 3513 | "\n"))) 3514 | (erase-buffer) 3515 | (if (string= "" newcontents) 3516 | (message "No songs found; check your mpd settings") 3517 | (insert newcontents)) 3518 | (setq header-line-format string)))) 3519 | 3520 | (defun mingus-browse-to-song-at-p () 3521 | (interactive) 3522 | (let ((file (mingus-get-filename-at-p))) 3523 | (mingus-browse-to-file file))) 3524 | 3525 | (defun mingus-browse-to-file (file) 3526 | (mingus-ls (_mingus-string->parent-dir file)) 3527 | (goto-char (point-min)) 3528 | (search-forward (file-name-nondirectory file) nil t) 3529 | (beginning-of-line)) 3530 | 3531 | (defun mingus-browse-to-dir (dir) 3532 | (mingus-ls dir) 3533 | (goto-char (point-min))) 3534 | 3535 | (defun mingus-open-parent () 3536 | "In Mingus-Browse, go up one level." 3537 | (interactive) 3538 | (cl-flet ((bound-regex (s) (concat "^" (regexp-quote s) "$"))) 3539 | (let* ((details (mingus-get-details)) 3540 | (dir (ignore-errors 3541 | (file-name-directory 3542 | (mingus-normalize 3543 | (or 3544 | (plist-get details 'file) 3545 | (plist-get details 'Title)))))) 3546 | (header (and 3547 | (stringp header-line-format) 3548 | (bound-regex header-line-format))) 3549 | (goal 3550 | (and dir 3551 | (bound-regex 3552 | (file-name-nondirectory 3553 | (directory-file-name dir)))))) 3554 | ;; Ditch current command 3555 | (pop mingus-browse-command-history) 3556 | ;; Get last command 3557 | (eval (pop mingus-browse-command-history)) 3558 | ;; @todo: Normal MPD (query results may list songs inside a 3559 | ;; directory - then you would want the parent 3560 | 3561 | ;; (if (re-search-backward "/" (line-beginning-position) t 2) 3562 | ;; (progn 3563 | ;; (mingus-ls 3564 | ;; (buffer-substring-no-properties (line-beginning-position) (point)))) 3565 | ;; (if (stringp header-line-format) 3566 | ;; (mingus-ls (file-name-directory header-line-format)) 3567 | ;; (mingus-ls ""))) 3568 | (goto-char (point-max)) 3569 | (or (and goal 3570 | (re-search-backward goal nil t)) 3571 | (and header 3572 | (re-search-backward header nil t)) 3573 | (goto-char (point-min)))))) 3574 | 3575 | (defun mingus-refresh () 3576 | "Refresh view." 3577 | (interactive) 3578 | (end-of-line) 3579 | (when (mingus-buffer-p) 3580 | (delete-all-overlays)) 3581 | (cl-case major-mode 3582 | (mingus-browse-mode 3583 | (mingus-save-excursion 3584 | (eval (pop mingus-browse-command-history))) 3585 | (goto-char (line-beginning-position))) 3586 | (mingus-playlist-mode 3587 | (mingus-playlist t)) 3588 | (t 3589 | (message "No refreshing action for mode: %S" major-mode)))) 3590 | 3591 | (defun mingus-insert (&optional and-play) 3592 | "In *Mingus Browser* buffer, insert stuff under point or region into playlist. 3593 | 3594 | Anywhere else, call `mingus-add-read-input'. 3595 | With prefix argument, instantly play the insertion." 3596 | (interactive "P") 3597 | (if and-play (mingus-insert-and-play) 3598 | (if (not (eq major-mode 'mingus-browse-mode)) 3599 | (mingus-add-read-input) 3600 | (mingus-add-things-at-p)) 3601 | (unless (mingus-mark-active) (forward-line 1)))) 3602 | 3603 | (cl-defun mingus-set-insertion-point (&optional p) 3604 | "In Mingus, set *mingus-point-of-insertion* for new songs. 3605 | They will be added after this point. 3606 | Prefix argument shows value of *mingus-point-of-insertion*, and moves there." 3607 | (interactive "P") 3608 | (cond ((string= "*Mingus*" (buffer-name)) 3609 | (cond ((null p) 3610 | (set '*mingus-point-of-insertion* 3611 | (list (list (mingus-line-number-at-pos) 3612 | (buffer-substring-no-properties 3613 | (line-beginning-position) (line-end-position)))))) 3614 | (*mingus-point-of-insertion* 3615 | (mingus-goto-line (caar *mingus-point-of-insertion*)))) 3616 | (message "*mingus-point-of-insertion* set AFTER %s" 3617 | (or (cadar *mingus-point-of-insertion*) 3618 | "end of playlist (unset)"))) 3619 | (t (message "Not in \"*Mingus*\" buffer")))) 3620 | 3621 | (defun mingus-set-insertion-point-at-currently-playing-song () 3622 | (interactive) 3623 | (save-window-excursion 3624 | (mingus-switch-to-playlist) 3625 | (mingus-goto-current-song) 3626 | (mingus-set-insertion-point))) 3627 | 3628 | (defun mingus-unset-insertion-point () 3629 | "Unset Mingus' *mingus-point-of-insertion*." 3630 | (interactive) 3631 | (save-window-excursion 3632 | (mingus-switch-to-playlist) 3633 | (set '*mingus-point-of-insertion* nil) 3634 | (message "*mingus-point-of-insertion* unset"))) 3635 | 3636 | ;; (@> "playlists") 3637 | 3638 | (defun mingus-list-playlists () 3639 | (remove nil (mapcar (lambda (item) 3640 | (if (string= (car item) "playlist") (cdr item))) 3641 | (cdr (mingus-exec "listplaylists"))))) 3642 | 3643 | (defun mingus-load-playlist (&optional and-play) 3644 | "Load an mpd playlist. 3645 | Append playlist to current playlist. 3646 | With prefix argument, instantly play the insertion. 3647 | Optional argument AND-PLAY means start playing thereafter." 3648 | (interactive "P") 3649 | (if and-play (mingus-load-playlist-and-play) 3650 | (let ((lst (mingus-list-playlists))) 3651 | (if (null lst) 3652 | (message "No playlist present") 3653 | (let* ((playlist (mingus-completing-read-allow-spaces "Load playlist: " 3654 | lst nil t)) 3655 | (quoted-playlist (mpd-safe-string playlist))) 3656 | (if (string= "" playlist) 3657 | (message "No playlist selected") 3658 | (let ((len (mingus-load-playlist-internal playlist))) 3659 | (message (format "Playlist %s loaded, songs: %d" 3660 | playlist len)) 3661 | (mingus)))))))) 3662 | 3663 | (defun mingus-load-playlist-internal (playlist) 3664 | "Load an mpd playlist. 3665 | 3666 | Append playlist to current playlist, then optionally move all its 3667 | songs to the insertion point." 3668 | (let ((old-length (mingus-playlist-length))) 3669 | (mpd-load-playlist mpd-inter-conn playlist) 3670 | (if (mingus-get-insertion-number) 3671 | (mingus-exec 3672 | (format "move %d:%d %d" 3673 | old-length 3674 | (mingus-playlist-length) 3675 | (mingus-get-insertion-number)))) 3676 | (- (mingus-playlist-length) old-length))) 3677 | 3678 | (defun mingus-save-playlist () 3679 | "Save an mpd playlist." 3680 | (interactive) 3681 | (let* ((lst (mingus-list-playlists)) 3682 | (playlist (mingus-completing-read-allow-spaces 3683 | "Save playlist as: " 3684 | lst nil nil)) 3685 | (quoted-playlist (mpd-safe-string playlist))) 3686 | (if (null playlist) 3687 | (message "No name for playlist provided, won't save...") 3688 | (mpd-remove-playlist mpd-inter-conn quoted-playlist) 3689 | (if (mpd-save-playlist mpd-inter-conn quoted-playlist) 3690 | (message "Playlist saved as %s" playlist) 3691 | (if (and 3692 | mingus-playlist-directory 3693 | (yes-or-no-p 3694 | (format "MPD implementation does *not* save playlists. 3695 | Shall I save it to %s?" 3696 | ;; NOTE: we could get this from a variable. 3697 | (concat mingus-playlist-directory playlist ".m3u8")))) 3698 | (let* ((songs (cdr (mingus-get-songs "playlistinfo"))) 3699 | (body (mapconcat #'mingus-format-for-m3u songs "\n"))) 3700 | (with-temp-buffer 3701 | (insert "#EXTM3U\n" body) 3702 | (write-file (concat mingus-playlist-directory playlist ".m3u") 3703 | t))) 3704 | (message "MPD implementation does save playlists *and* you do not have\ 3705 | `mingus-playlist-directory' set.")))))) 3706 | 3707 | (defun mingus-format-for-m3u (item &optional f s) 3708 | (format "#EXTINF:%d,%s - %s\n%s" 3709 | (or (plist-get item 'Time) 0) 3710 | (or 3711 | (plist-get item 'Artist) 3712 | (plist-get item 'AlbumArtist) 3713 | "") 3714 | (or 3715 | (plist-get item 'Title) 3716 | (plist-get item 'file) 3717 | (plist-get item 'Album) 3718 | "") 3719 | (or 3720 | (plist-get item 'file) 3721 | (plist-get item 'Title) 3722 | (plist-get item 'Album) 3723 | "" ))) 3724 | 3725 | (defun mingus-remove-playlist () 3726 | "Remove an mpd playlist" 3727 | (interactive) 3728 | (let ((list (mingus-list-playlists))) 3729 | (cond ((null list) 3730 | (message "No playlist to remove")) 3731 | (t 3732 | (let* ((playlist (mingus-completing-read-allow-spaces 3733 | "Remove playlist: " 3734 | list nil nil)) 3735 | (quoted-playlist (mpd-safe-string playlist))) 3736 | (if (null list) 3737 | (message "No name for playlist provided, won't remove") 3738 | (progn 3739 | (mpd-remove-playlist mpd-inter-conn quoted-playlist)) 3740 | (message "Playlist %s removed" playlist))))))) 3741 | 3742 | 3743 | ;; {{minibuffer addition of tracks/dirs}} 3744 | (defun mingus-complete-path (input) 3745 | "Complete mpd path based on INPUT. 3746 | INPUT is supposed to be supplied by current minibuffer contents." 3747 | (let ((res (mingus-exec (concat "lsinfo " (mpd-safe-string input))))) 3748 | (append 3749 | (if (and (car res) 3750 | ;;let the dir itself be sufficient too 3751 | (not (string= "" input))) 3752 | ;; do not show empty string or single "/" 3753 | (list 3754 | input 3755 | (replace-regexp-in-string "/*$" "/" input)) 3756 | ;mingus-switch-car-and-cdr 3757 | (mapcar 'cdr 3758 | (cdr (mingus-exec 3759 | (concat "lsinfo " (mpd-safe-string 3760 | (if (car res) 3761 | input 3762 | ;search on dir if no match found here: 3763 | (if (file-name-directory input) 3764 | (substring (file-name-directory input) 0 -1) 3765 | ;special case mpd root 3766 | ""))))))))))) 3767 | 3768 | (defun mingus-complete-from-minibuffer (prompt &optional predicate require-match 3769 | initial-input hist def 3770 | inherit-input-method) 3771 | (completing-read 3772 | prompt 3773 | (if (fboundp 'completion-table-dynamic) 3774 | (completion-table-dynamic (function mingus-complete-path)) 3775 | (with-no-warnings 3776 | (dynamic-completion-table 'mingus-complete-path))) 3777 | predicate 3778 | require-match 3779 | initial-input hist def 3780 | inherit-input-method)) 3781 | 3782 | (defun mingus-add-read-input () 3783 | "Add song or dir to mpd playlist using minibuffer input. 3784 | 3785 | Complete in the style of the function `find-file'." 3786 | (interactive) 3787 | (mingus-add 3788 | (mingus-complete-from-minibuffer "Add to playlist: " nil t))) 3789 | 3790 | (defun mingus-update-partially () 3791 | "Update the database partially." 3792 | (interactive) 3793 | (let ((updatable 3794 | (mingus-complete-from-minibuffer 3795 | "Update database for: " nil nil))) 3796 | (mingus-update updatable))) 3797 | 3798 | (defun mingus-update-thing-at-p () 3799 | "Update the database partially for song or directory at point." 3800 | (interactive) 3801 | (let ((updatable 3802 | (cdar 3803 | (mingus-get-details)))) 3804 | (if (listp updatable) 3805 | ;;have to fix weird differences in details tss.. 3806 | (setq updatable (car updatable))) 3807 | (mingus-update updatable) 3808 | (cl-case major-mode 3809 | ((mingus-playlist-mode mingus-browse-mode) 3810 | (message "Press [%c] to update buffer" ?g))))) 3811 | 3812 | ' (defun mingus-switch-car-and-cdr (cons) 3813 | (cons (cdr cons) (car cons))) 3814 | 3815 | ;;; Searching section 3816 | (defun mingus-completing-search-type (type query) 3817 | "Both TYPE and QUERY must be supplied as string." 3818 | (cond 3819 | ((string= type "regexp on filename") nil) 3820 | ((string= type "any") nil) 3821 | ((string-empty-p (string-trim query)) nil) 3822 | (t 3823 | (cl-remove-duplicates 3824 | (mapcar (lambda (item) 3825 | (downcase (plist-get item (if (string= "filename" type) 'file 3826 | ;special case... 3827 | (intern-soft 3828 | (concat (capitalize type))))))) 3829 | (cl-loop for i in 3830 | (mingus-get-songs 3831 | (format "search %s %s" type (mpd-safe-string (string-trim query)))) 3832 | if (eq 'file (car i)) collect i)) 3833 | :test 'string=)))) 3834 | 3835 | (defvar mingus-album-query-hist nil) 3836 | (defvar mingus-artist-query-hist nil) 3837 | (defvar mingus-genre-query-hist nil) 3838 | (defvar mingus-composer-query-hist nil) 3839 | (defvar mingus-filename-query-hist nil) 3840 | (defvar mingus-title-query-hist nil) 3841 | (defvar mingus-regexp\ on\ filename-query-hist nil) 3842 | 3843 | (defun mingus-query (&optional as-dir type) 3844 | "Query the mpd database. 3845 | 3846 | Show results in dedicated *Mingus Browser* buffer for further selection. Use 3847 | apropos matching, even with function `icicle-mode' turned on (no switching 3848 | possible). Optional argument TYPE predefines the type of query." 3849 | ;; Author does not know how to handle this stuff well. 3850 | 3851 | ;; Too bad that completing-read does not simply allow one to specify a 3852 | ;; function to return a list, but that once one specifies a function, it has 3853 | ;; got to handle all possible cases. Handling it with dynamic-completion-table 3854 | ;; strips the list of apropos matches. 3855 | (interactive "P") 3856 | (let* ((type (or type (mingus-completing-read-allow-spaces 3857 | "Search type: " 3858 | '("any" "album" "artist" "genre" 3859 | "composer" "filename" "title" 3860 | "regexp on filename") 3861 | nil t))) 3862 | (buffer (buffer-name)) 3863 | (pos (point)) 3864 | (query (mingus-completing-read-allow-spaces 3865 | (format "%s query: " (capitalize type)) 3866 | (if (and mingus-use-ido-mode-p 3867 | (fboundp 'ido-completing-read)) 3868 | (mingus-remove-dupes 3869 | (delq nil 3870 | (mapcar 3871 | (lambda (metadata) 3872 | (plist-get metadata (intern (capitalize type)))) 3873 | (mingus-get-songs-with-smart-cache "listallinfo")))) 3874 | (lambda (string predicate mode) 3875 | (with-current-buffer 3876 | (let ((window (minibuffer-selected-window))) 3877 | (if (window-live-p window) 3878 | (window-buffer window) 3879 | (current-buffer))) 3880 | (cond ((eq mode t) 3881 | (mingus-completing-search-type type string)) 3882 | ((not mode) 3883 | (let ((hits 3884 | (mingus-completing-search-type type 3885 | string))) 3886 | (if hits 3887 | (if (= 1 (length hits)) 3888 | (car hits) 3889 | (if (fboundp 'icicle-expanded-common-match) 3890 | (icicle-expanded-common-match 3891 | string hits) 3892 | (try-completion string hits)))))) 3893 | (t (test-completion 3894 | string 3895 | (mingus-completing-search-type type string) 3896 | predicate)))))) 3897 | nil 3898 | nil 3899 | nil 3900 | (intern-soft 3901 | (format "mingus-%s-query-hist" type))))) 3902 | (if (not (string-empty-p (string-trim query))) 3903 | (mingus-query-do-it type query pos buffer as-dir) 3904 | (message "Empty query")))) 3905 | 3906 | (defun mingus-query-dir (&optional type) 3907 | (interactive) 3908 | (mingus-query t type)) 3909 | 3910 | (defun mingus-query-regexp (&optional as-dir) 3911 | "Query the filenames in the mpd database with a regular expression; 3912 | Show results in dedicated *Mingus Browser* buffer for further selection." 3913 | (interactive "p") 3914 | (mingus-query as-dir "regexp on filename")) 3915 | 3916 | (defun mingus-get-type (item) 3917 | (let (file) 3918 | (or (plist-get item 'Type) 3919 | (progn 3920 | (setq file (plist-get item 'file)) 3921 | (cond 3922 | ((string-match "spotify:" file 0) 3923 | (cond 3924 | ((string-match "spotify:album" file 0) 'album) 3925 | ((string-match "spotify:artist" file 0) 'artist) 3926 | ((string-match "spotify:track" file 0) 'file) 3927 | (t (prog1 3928 | 'file 3929 | (message "Of unknown spotify type: %S" item))))) 3930 | (t 'file)))))) 3931 | 3932 | (defun mingus-format-item (item) 3933 | (let ((type (mingus-get-type item))) 3934 | (propertize 3935 | (if 3936 | (eq type 'directory) 3937 | (file-name-nondirectory 3938 | (plist-get item 'Title)) 3939 | (or 3940 | (plist-get item 'Title) 3941 | (file-name-nondirectory 3942 | (plist-get item 'file)))) 3943 | 'face 3944 | (cadr 3945 | (member type 3946 | '(file mingus-song-file-face 3947 | directory mingus-directory-face 3948 | playlist mingus-playlist-face 3949 | artist mingus-artist-face 3950 | album mingus-album-face)))))) 3951 | 3952 | (defun mingus-group-by-artist (songs) 3953 | (let ((artists)) 3954 | (mapc 3955 | (lambda (details) 3956 | (let* ((albumartist 3957 | (or 3958 | (cl-getf details 'AlbumArtist) 3959 | (cl-getf details 'Artist)))) 3960 | (when albumartist 3961 | (when (not (assoc albumartist artists)) 3962 | (push (list albumartist) artists)) 3963 | (push details (cdr (assoc albumartist artists)))))) 3964 | songs) 3965 | artists)) 3966 | 3967 | (defun mingus-group-by-album (songs) 3968 | (let ((albums)) 3969 | (mapc 3970 | (lambda (details) 3971 | (let* ((album 3972 | (or 3973 | ;; NOTE: X-AlbumUri is a better identifier, but not 3974 | ;; always present! 3975 | (cl-getf details 'Album)))) 3976 | (when album 3977 | (when (not (assoc album albums)) 3978 | (push (list album) albums)) 3979 | (push details (cdr (assoc album albums)))))) 3980 | songs) 3981 | albums)) 3982 | 3983 | (defun mingus-itemize (string type) 3984 | (list 'Title string 'Type type)) 3985 | 3986 | (defun mingus-itemize-and-format (string type) 3987 | (let ((item (mingus-itemize string type))) 3988 | (propertize 3989 | (mingus-format-item item) 3990 | 'mingus-type type 3991 | 'details item))) 3992 | 3993 | (defun mingus-query-do-it (type query pos buffer &optional as-dir) 3994 | "Perform the query provided by either `mingus-query' or `mingus-query-regexp'. 3995 | Argument TYPE specifies the kind of query. 3996 | Argument QUERY is a query string. 3997 | Argument POS is the current position in the buffer to revert to (?)." 3998 | (mingus-switch-to-browser) 3999 | (push `(mingus-query-do-it ,type ,query ,pos ,buffer ,as-dir) mingus-browse-command-history) 4000 | (setq mingus-last-query (list type query pos buffer as-dir)) 4001 | (let ((buffer-read-only nil) 4002 | (prev (buffer-string))) 4003 | (erase-buffer) 4004 | (let ((results 4005 | (cond ((string-match "regexp on filename" type) 4006 | ;; @todo (non-mopidy) 4007 | (cl-loop for i in 4008 | (cdr (mingus-exec "listall")) 4009 | if (and (string= (car i) "file") 4010 | (string-match query (cdr i))) 4011 | if (or (null as-dir) (null (file-name-directory (cdr i)))) 4012 | collect i into list 4013 | else do (add-to-list 'list 4014 | (cons "directory" 4015 | (substring (file-name-directory (cdr i)) 0 -1))) 4016 | finally return list)) 4017 | (t 4018 | (if (null as-dir) 4019 | (cdr (mingus-get-songs 4020 | (format "search %s %S" type query))) 4021 | ;; @todo what does as-dir mean? 4022 | (cl-loop for i in (cdr (mingus-get-songs 4023 | (format "search %s %S" type query))) 4024 | when 4025 | (and (string= (car i) "file")) 4026 | if (file-name-directory (cdr i)) 4027 | do (add-to-list 'list 4028 | (cons "directory" (substring (file-name-directory (cdr i)) 0 -1))) 4029 | else 4030 | collect i into list 4031 | finally return list)))))) 4032 | ;; (insert 4033 | ;; (mapconcat 4034 | ;; #'identity 4035 | ;; (mapcar #'mingus-format-item results) 4036 | ;; "\n")) 4037 | 4038 | ;; NOTE: we should probably sort on relevance ourselves -- mpd 4039 | ;; (mopidy in particular) returns pretty fuzzily... 4040 | (cl-flet ((favour-exact-match (a b) 4041 | (if (string= (downcase (car a)) (downcase query)) 4042 | (not (string= (downcase (car b)) (downcase query)))))) 4043 | (mapc 4044 | (lambda (artist) 4045 | (insert 4046 | (propertize 4047 | (car artist) 4048 | 'face 'mingus-artist-face)) 4049 | (newline) 4050 | (mapc 4051 | (lambda (album) 4052 | (insert 4053 | (propertize 4054 | (car album) 4055 | 'face 'mingus-album-stale-face)) 4056 | ;; NOTE: in mopidy, dupes are created 4057 | (newline) 4058 | (mapc 4059 | (lambda (song) 4060 | (insert (mingus-format-song song)) 4061 | (newline)) 4062 | (cl-sort (cdr album) 4063 | (lambda (a b) 4064 | (mingus-logically-less-p 4065 | (or (cl-getf a 'Track) "") 4066 | (or (cl-getf b 'Track) "")))))) 4067 | (sort 4068 | (mingus-group-by-album (cdr artist)) 4069 | #'favour-exact-match))) 4070 | (sort 4071 | (mingus-group-by-artist results) 4072 | #'favour-exact-match))) 4073 | (setq header-line-format (list type ": " query))) 4074 | (goto-char (point-min)) 4075 | (mingus-revert-from-query pos prev buffer))) 4076 | 4077 | (defun mingus-revert-from-query (pos prev buffer) 4078 | "Restore previous situation when `mingus-query-do-it' returned nothing." 4079 | (cond ((eobp) 4080 | (insert prev) 4081 | (switch-to-buffer buffer) 4082 | (goto-char pos) 4083 | (message "No hits!")) 4084 | (t 4085 | (setq mode-name "Query results") 4086 | (set (make-local-variable 'mingus-last-query-results) 4087 | (buffer-string))))) 4088 | 4089 | (defun mingus-last-query-results () 4090 | "Show last query results again in dedicated *Mingus Browser* buffer" 4091 | (interactive) 4092 | (cond ((save-window-excursion 4093 | (mingus-switch-to-browser) 4094 | (null mingus-last-query-results)) 4095 | (message "No succesful search yet")) 4096 | (t (switch-to-buffer "*Mingus Browser*") 4097 | (setq mode-name "Query results") 4098 | (let ((buffer-read-only nil)) 4099 | (erase-buffer) 4100 | (insert mingus-last-query-results) 4101 | (setq header-line-format 4102 | (list (car mingus-last-query) 4103 | ": " 4104 | (cadr mingus-last-query))))))) 4105 | 4106 | (defalias 'mingus-search 'mingus-query) 4107 | 4108 | (defun mingus-browse-sort () 4109 | "In *Mingus Browser*, sort hits." 4110 | (interactive) 4111 | (if (eq major-mode 'mingus-browse-mode) 4112 | (let ((re "\\(^\\|/\\)[^\/]+$") 4113 | list 4114 | buffer-read-only 4115 | (line (mingus-line-number-at-pos))) 4116 | (goto-char (point-max)) 4117 | (while (re-search-backward re nil t) 4118 | (push (cons 4119 | (match-string-no-properties 0) 4120 | (buffer-substring (line-beginning-position) (line-end-position))) 4121 | list)) 4122 | (erase-buffer) 4123 | (mapc (lambda (item) 4124 | (insert (concat (cdr item) "\n"))) 4125 | (cl-sort list (lambda (str1 str2) 4126 | (if (get this-command 'reverse) 4127 | (null (mingus-logically-less-p (car str1) (car str2))) 4128 | (mingus-logically-less-p (car str1) (car str2)))))) 4129 | (put this-command 'reverse (null (get this-command 'reverse))) 4130 | (mingus-goto-line line)) 4131 | (message "Buffer not in mingus-browse-mode"))) 4132 | 4133 | ;;;; {{Wake up call}} 4134 | (defun mingus-date-to-sec-from-epoch (datestring) 4135 | (apply #'encode-time 4136 | (mapcar #'string-to-number 4137 | (list 4138 | (substring datestring 12 14) ;seconds 4139 | (substring datestring 10 12) ;minute 4140 | (substring datestring 8 10) ;day 4141 | (substring datestring 6 8) ;month 4142 | (substring datestring 4 6) 4143 | (substring datestring 0 4))))) 4144 | 4145 | (defun mingus-wake-up-call (&optional p) 4146 | "Set a time for mingus to start playing. 4147 | TIME will be interpreted to always lie in the future. 4148 | With prefix argument, cancel the wake-up call. 4149 | 4150 | The timer-object is referenced to by the variable `mingus-wake-up-call'" 4151 | (interactive "P") 4152 | (cond ((and p (timerp mingus-wake-up-call)) 4153 | (cancel-timer mingus-wake-up-call) 4154 | (message "Wake-up call cancelled")) 4155 | (t 4156 | (setq 4157 | mingus-wake-up-call 4158 | (run-at-time 4159 | (let ((time (mingus-date-to-sec-from-epoch 4160 | (concat 4161 | (format-time-string "%Y%m%d") 4162 | (format "%02d" (read-number "Hour: ")) 4163 | (format "%02d" (read-number "Minute: ")) "00")))) 4164 | (if (time-less-p time (current-time)) 4165 | (time-add (days-to-time 1) time) 4166 | time)) 4167 | nil 'mingus-play)) 4168 | (message (format 4169 | "%sake sure you have a playlist set before dozing off!" 4170 | (if (= 0 (mingus-playlist-length)) "Playlist is empty, m" 4171 | "M")))))) 4172 | 4173 | ;;;; {{Shell/Dired}} 4174 | ;;; Functions for retrieving the true filenames for interaction with a shell and 4175 | ;;; `dired'; this needs reviewing for consistency and use 4176 | (defun _mingus-get-parent-dir () 4177 | "Get parent dir of song at point." 4178 | (_mingus-string->parent-dir 4179 | (mingus-get-absolute-filename))) 4180 | 4181 | (defun mingus-normalize (filename) 4182 | "Normalize FILENAME into an understandable one. 4183 | It may also mean handling file:/// links." 4184 | (cond 4185 | ((string-match "^file:///" filename) 4186 | (decode-coding-string 4187 | (url-unhex-string 4188 | (url-filename 4189 | (url-generic-parse-url filename))) 4190 | 'utf-8)) 4191 | ((string-match "^local:track:" filename) 4192 | (decode-coding-string 4193 | (url-unhex-string (substring filename 12)) 4194 | 'utf-8)) 4195 | (t filename))) 4196 | 4197 | (defun _mingus-make-absolute-filename (file) 4198 | "Turn any FILE into an understandable one. 4199 | This may mean making a file relative to `mingus-mpd-root' into an absolute one. 4200 | It may also mean handling file:/// links." 4201 | (let ((filename (mingus-normalize file))) 4202 | (cond 4203 | ((file-name-absolute-p filename) 4204 | filename) 4205 | ((string-match "^[a-z]+://" filename) 4206 | filename) ;URLS are legal here (!) 4207 | (t 4208 | (expand-file-name (concat mingus-mpd-root filename)))))) 4209 | 4210 | (defun mingus-get-absolute-filename () 4211 | "Get absolute filename for song-at-p." 4212 | (_mingus-make-absolute-filename (mingus-get-filename-at-p))) 4213 | 4214 | (defun mingus-get-filename-for-shell () 4215 | "Retrieve filename of song at point, and shell-quote it." 4216 | (shell-quote-argument (mingus-get-absolute-filename))) 4217 | 4218 | ;; Unused, but probably useful someday: 4219 | (defun mingus-get-filenames-for-shell (beg end) 4220 | "Get everything under the region, sloppily. 4221 | Region is between (beginning of line of) BEG and (beginning of line of) END." 4222 | (interactive "r") 4223 | (let ((beg (if mark-active (_mingus-bol-at beg) (line-beginning-position))) 4224 | (end (if mark-active (_mingus-bol-at end) (line-end-position))) 4225 | results) 4226 | (save-excursion 4227 | (goto-char beg) 4228 | (while (< (point) end) 4229 | (push (mingus-get-filename-for-shell) results) 4230 | (forward-line))) 4231 | results)) 4232 | 4233 | ;;;; {{Dired}} 4234 | (defun mingus-test-if-external-file-is-symlinked-in-list (sym l) 4235 | (if (file-directory-p sym) 4236 | (cl-loop for file in l 4237 | when 4238 | (string= 4239 | (file-truename (file-name-directory (concat mingus-mpd-root file))) 4240 | (file-truename (file-name-as-directory sym))) 4241 | return (substring (file-name-directory file) 0 -1)) 4242 | (cl-loop for file in l 4243 | when 4244 | (string= 4245 | (file-truename (concat mingus-mpd-root file)) 4246 | (file-truename sym)) 4247 | return file))) 4248 | 4249 | (defun mingus-resolve-files (files) 4250 | "Resolve files in the filesystem to they can be found in the MPD database" 4251 | (let* ((root (expand-file-name mingus-mpd-root)) 4252 | (rootlen (length root)) 4253 | not-under-root 4254 | unfindables) 4255 | 4256 | ;; first, add all 'normal files' 4257 | (mapc (lambda (file) 4258 | (if (not (string-prefix-p root file)) 4259 | (push file not-under-root))) files) 4260 | 4261 | (setq files (cl-set-difference files not-under-root)) 4262 | 4263 | (when files 4264 | ;; make relative to root 4265 | (setq files (mapcar (lambda (file) 4266 | (file-relative-name file root)) 4267 | files))) 4268 | ;; then, let's see what to do with the rest, if any 4269 | (when not-under-root 4270 | (let* ((files-sans-directory (mapcar #'file-name-nondirectory not-under-root)) 4271 | (putative-files-1 (mapcar (lambda (file) 4272 | (cdr (mingus-exec (format "search %s %S" 4273 | (if (file-directory-p file) "filename" "file") 4274 | file)))) 4275 | files-sans-directory)) 4276 | putative-files-2) 4277 | ;; did we find anything at all? 4278 | (when (car putative-files-1) 4279 | ;; remove all superfluous data 4280 | (mapc (lambda (file) 4281 | (mapc 4282 | (lambda (data) (when (string= (car data) "file") (push (cdr data) putative-files-2))) 4283 | file)) 4284 | putative-files-1)) 4285 | 4286 | (cl-destructuring-bind (found notfound) 4287 | (cl-loop for maybe-symlinked in not-under-root 4288 | when (mingus-test-if-external-file-is-symlinked-in-list 4289 | maybe-symlinked 4290 | putative-files-2) 4291 | collect (mingus-test-if-external-file-is-symlinked-in-list 4292 | maybe-symlinked 4293 | putative-files-2) 4294 | into found 4295 | else collect maybe-symlinked into notfound 4296 | finally return (list found notfound)) 4297 | 4298 | (setq files (nconc files found)) 4299 | (setq unfindables notfound)))) 4300 | 4301 | (cl-values files unfindables))) 4302 | 4303 | (defun mingus-abs->rel (string) 4304 | "Resolve a single file as relative to `mingus-mpd-root'." 4305 | (cl-destructuring-bind (found notfound) 4306 | (mingus-resolve-files (list string)) 4307 | (car found))) 4308 | 4309 | (defun mingus-dired-add () 4310 | "In `dired', add marked files or file at point to the mpd playlist; 4311 | 4312 | If these files do not exist in the mpd database, ask whether to 4313 | make a symlink. Create a symlink, and update the database for its 4314 | path." 4315 | (interactive) 4316 | (mingus-add-files (dired-get-marked-files))) 4317 | 4318 | (defun mingus-add-files (files) 4319 | "Add files to the mpd playlist. 4320 | 4321 | If MPD is unwary of these files, ask whether to make a symlink. 4322 | Create a symlink, update database and try to resolve those files again." 4323 | (let ((rootlen (length (expand-file-name mingus-mpd-root)))) 4324 | (cl-destructuring-bind (files unfindables) 4325 | (mingus-resolve-files files) 4326 | 4327 | (when unfindables 4328 | (let (linked) 4329 | (mapc (lambda (file) 4330 | ;; ToDo: currently links files to root. Which is not good. 4331 | (let ((src (expand-file-name 4332 | (if (file-directory-p file) 4333 | file 4334 | (substring (file-name-directory file) 0 -1)))) 4335 | (symlink (expand-file-name 4336 | (concat 4337 | (file-name-as-directory 4338 | mingus-mpd-root) 4339 | (if (file-directory-p file) 4340 | (file-name-nondirectory file) 4341 | (file-name-nondirectory 4342 | (substring (file-name-directory file) 0 -1))))))) 4343 | (when 4344 | (and (not (member (substring symlink rootlen) linked)) 4345 | (or (y-or-n-p (format "Not in database. Link %S to %S? " symlink src)) 4346 | (error "Cannot add while some songs are not in the database"))) 4347 | (make-symbolic-link src symlink) 4348 | (push (substring symlink rootlen) linked) 4349 | ;; do only partial update 4350 | (mingus-update (substring symlink rootlen))))) 4351 | unfindables)) 4352 | 4353 | ;; Wait a moment for the forced update to complete 4354 | (sit-for mingus-wait-for-update-interval) 4355 | 4356 | ;; Try to resolve again: 4357 | (cl-destructuring-bind (found notfound) (mingus-resolve-files unfindables) 4358 | ;; If update has not completed, error out, so found files will be added just once 4359 | (if notfound 4360 | (error "Please run this command again now some files have been symlinked. Updating may take some time") (setq files (append found files))))) 4361 | 4362 | ;; Bake a command for mingus-add 4363 | (if files 4364 | (let ((fmt (concat "%S" (mapconcat 'identity (make-list (length files) "") "\nadd %S")))) 4365 | ;; And do the final call 4366 | (mingus-add (apply #'format fmt files) t)) 4367 | ;; Return a non-`nil' value to indicate success 4368 | t)))) 4369 | 4370 | ;; create function mingus-dired-add-and-play 4371 | (mingus-and-play mingus-dired-add mingus-dired-add-and-play) 4372 | 4373 | ;; make sure mingus-dired-add handles point-of-insertion and mingus-marked-list 4374 | (mingus-insertion-advice mingus-dired-add) 4375 | 4376 | ;; alright, a customization is in place for interfering with dired's defaults: 4377 | (defvar mingus-dired-space-function nil) 4378 | 4379 | (defun mingus-dired-remove-keys () 4380 | (when (symbol-value 'mingus-dired-space-function) 4381 | (define-key dired-mode-map " " mingus-dired-space-function)) 4382 | (define-key dired-mode-map [menu-bar operate mingus] nil)) 4383 | 4384 | (defun mingus-dired-add-keys () 4385 | 4386 | (when 4387 | (or (not (boundp 'mingus-dired-add-keys)) 4388 | (null (symbol-value 'mingus-dired-add-keys))) 4389 | (setq mingus-dired-space-function (lookup-key dired-mode-map " "))) 4390 | 4391 | (define-key dired-mode-map " " 'mingus-dired-add) 4392 | 4393 | (define-key-after dired-mode-map [menu-bar operate mingus] 4394 | '("Add to Mingus" . mingus-dired-add) 'query-replace)) 4395 | 4396 | (defcustom mingus-dired-add-keys nil 4397 | "Add keys for interaction to dired-mode-map; 4398 | 4399 | The file \"mingus-stays-home.elc\" needs to be reloaded for a 4400 | change here to have effect. If `mingus-dired-add-keys' has a 4401 | non-`nil' value, \"SPC\" will add a song, play it immediately 4402 | when invoked with a prefix. Plus an item under Operate to add 4403 | songs to Mingus." 4404 | :group 'mingus 4405 | :type '(boolean) 4406 | :set (lambda (sym val) 4407 | (if val 4408 | (mingus-dired-add-keys) 4409 | (mingus-dired-remove-keys)) 4410 | (set-default sym val))) 4411 | 4412 | (defun mingus-dired-file () 4413 | "Open dired with parent dir of song at point." 4414 | (interactive) 4415 | (dired 4416 | (cond 4417 | ((mingus-directoryp) 4418 | (mingus-get-absolute-filename)) 4419 | ((mingus-playlistp) mingus-mpd-playlist-dir) 4420 | (t (_mingus-get-parent-dir))) "-al")) 4421 | 4422 | (defun mingus-dwim-add () 4423 | "Add files to the MPD database. 4424 | 4425 | In Dired, use `mingus-dired-add', elsewhere read a filename from 4426 | the minibuffer." 4427 | (interactive) 4428 | (cl-case major-mode 4429 | (dired-mode 4430 | (mingus-dired-add)) 4431 | (t 4432 | (mingus-add-files (list (read-file-name "Add: ")))))) 4433 | 4434 | (mingus-and-play mingus-dwim-add mingus-dwim-add-and-play) 4435 | 4436 | ;; (@> "development stuff") 4437 | ' (mapconcat (lambda (list) 4438 | (mingus-format-song-compact list)) 4439 | (mingus-get-songs "playlistinfo") "\n") 4440 | 4441 | (defun mingus-activate-timers () 4442 | (interactive) 4443 | (timer-activate mingus-timer)) 4444 | 4445 | ' (message "Average time: %f" 4446 | (let ((total (seconds-to-time 0))) 4447 | (dotimes (var 4 (/ (float-time total) var)) 4448 | (setq total (time-add total (time (mingus-playlist t))))))) 4449 | 4450 | ' (defmacro time (&rest body) 4451 | `(let ((time (current-time))) 4452 | ,@body 4453 | (time-since time))) 4454 | 4455 | (defun mingus-outputs () 4456 | (let ((output (mingus-exec "outputs"))) 4457 | (when (car output) 4458 | (cl-loop for i on (cdr output) 4459 | by 'cdddr 4460 | collect 4461 | (list 4462 | :id (string-to-number (cdr (nth 0 i))) 4463 | :name (cdr (nth 1 i)) 4464 | :enabled (string= (cdr (nth 2 i)) "1")))))) 4465 | 4466 | (defun mingus-disable-output () 4467 | (interactive) 4468 | (let* ((outputs (mingus-outputs)) 4469 | (enabled 4470 | (cl-loop for i in outputs 4471 | when (plist-get i :enabled) 4472 | collect i))) 4473 | (if (null enabled) 4474 | (message "No outputs to disable") 4475 | (let ((id 4476 | (string-to-number 4477 | (completing-read 4478 | "Disable output: " 4479 | (mapcar (lambda (output) 4480 | (format "%d: %s" 4481 | (plist-get output :id) 4482 | (plist-get output :name))) enabled) 4483 | nil t)))) 4484 | (mingus-exec (format "disableoutput %d" id)))))) 4485 | 4486 | (defun mingus-enable-output () 4487 | (interactive) 4488 | (let* ((outputs (mingus-outputs)) 4489 | (disabled 4490 | (cl-loop for i in outputs 4491 | when (not (plist-get i :enabled)) 4492 | collect i))) 4493 | (if (null disabled) 4494 | (message "No outputs to enable") 4495 | (let ((id 4496 | (string-to-number 4497 | (completing-read 4498 | "Enable output: " 4499 | (mapcar (lambda (output) 4500 | (format "%d: %s" 4501 | (plist-get output :id) 4502 | (plist-get output :name))) disabled) 4503 | nil t)))) 4504 | (mingus-exec (format "enableoutput %d" id)))))) 4505 | 4506 | ;; (@> "bookmarks") 4507 | (defun mingus-play-or-add-and-play (filestring) 4508 | (let ((song (mingus-find-in-playlist filestring))) 4509 | (if (null song) 4510 | (and (mingus-add filestring) 4511 | (mingus-play-or-add-and-play filestring)) 4512 | (mingus-play (cl-getf song 'Pos))))) 4513 | 4514 | (defun mingus-find-in-playlist (file) 4515 | (cl-find 4516 | file 4517 | (mingus-get-songs "playlistinfo") 4518 | :test 4519 | (lambda (f d) 4520 | (string= file (cl-getf d 'file))))) 4521 | 4522 | (defcustom mingus-bookmarks nil 4523 | "Alist of mingus bookmarks. 4524 | 4525 | A bookmark is a plist in the form of (file FILENAME position 4526 | POSITION-IN-SECONDS)." 4527 | :group 'mingus 4528 | :type '(alist)) 4529 | 4530 | (defun mingus-bookmark-jump (bkmk-name) 4531 | "Jump to bookmark in `mingus-bookmarks' list" 4532 | (interactive 4533 | (or 4534 | (and (null mingus-bookmarks) 4535 | (error "No bookmarks have been set yet")) 4536 | (list 4537 | (completing-read 4538 | "Bookmark: " 4539 | mingus-bookmarks 4540 | nil t)))) 4541 | (let ((bkmk (cadr (assoc bkmk-name mingus-bookmarks)))) 4542 | (mingus-play-or-add-and-play 4543 | (cl-getf bkmk 'file)) 4544 | (mingus-seek 4545 | (cl-getf bkmk 'position) 4546 | nil t))) 4547 | 4548 | (defun mingus-bookmark-create () 4549 | "Create a Mingus bookmark." 4550 | (let* ((file (cl-getf 4551 | (car (mingus-get-songs "currentsong")) 4552 | 'file)) 4553 | (status (mpd-get-status mpd-inter-conn)) 4554 | (position (cl-getf status 'time-elapsed))) 4555 | (list 'file file 'position position))) 4556 | 4557 | (defun mingus-bookmark-set (bkmk name) 4558 | "Add bookmark BKMK to `mingus-bookmarks' list identified by NAME. 4559 | 4560 | This function adds a bookmark for current song AND position in 4561 | playlist. Useful e.g. in audiobooks or language courses." 4562 | (interactive 4563 | (list 4564 | (mingus-bookmark-create) 4565 | (let* ((songdata (car (mingus-get-songs "currentsong"))) 4566 | (name (or (cl-getf 4567 | songdata 4568 | 'Title) 4569 | (file-name-sans-extension 4570 | (file-name-nondirectory 4571 | (cl-getf 4572 | songdata 4573 | 'file)))))) 4574 | (completing-read 4575 | (format "Name for bookmark (default: %s) : " name) 4576 | mingus-bookmarks 4577 | nil 4578 | nil 4579 | nil 4580 | nil 4581 | name)))) 4582 | (let ((match (assoc name mingus-bookmarks))) 4583 | (if match 4584 | (setf (cadr match) bkmk) 4585 | (push (list name bkmk) 4586 | mingus-bookmarks)) 4587 | (customize-save-variable 'mingus-bookmarks mingus-bookmarks))) 4588 | 4589 | (defun mingus-bookmark-delete (name) 4590 | "Delete bookmark from `mingus-bookmarks' list" 4591 | (interactive 4592 | (list (completing-read 4593 | "Delete bookmark: " 4594 | mingus-bookmarks))) 4595 | (let ((match (assoc name mingus-bookmarks))) 4596 | (customize-save-variable 'mingus-bookmarks 4597 | (delete match mingus-bookmarks)))) 4598 | 4599 | 4600 | (defun mingus-get-a-state (state) 4601 | "Get a certain status." 4602 | (let ((status (mpd-get-status mpd-inter-conn))) 4603 | (plist-get status state))) 4604 | 4605 | (defun mingus-single () 4606 | (interactive) 4607 | (let ((state (mingus-get-a-state 'single))) 4608 | (if (not state) 4609 | (message "Single mode seems to be unsupported") 4610 | (mingus-exec 4611 | (format "single %d" 4612 | (abs (- (string-to-number state) 1)))) 4613 | (message "Single mode is %s" 4614 | (if (string= "1" state) 4615 | "off" 4616 | "on"))))) 4617 | 4618 | (defun mingus-consume () 4619 | (interactive) 4620 | (let ((state (mingus-get-a-state 'consume))) 4621 | (if (not state) 4622 | (message "Consume mode seems to be unsupported") 4623 | (mingus-exec 4624 | (format "consume %d" 4625 | (abs (- (string-to-number state) 1)))) 4626 | (message "Consume mode is %s" 4627 | (if (string= "1" state) 4628 | "off" 4629 | "on"))))) 4630 | 4631 | (defun mingus-redraw-line () 4632 | (when (eq 'file (mingus-item-type)) 4633 | (save-excursion 4634 | (let (buffer-read-only) 4635 | (insert 4636 | (mingus-format-song (mingus-get-details))) 4637 | (delete-region (point) (line-end-position)))))) 4638 | 4639 | (defun mingus-redraw-buffer () 4640 | (interactive) 4641 | (save-excursion 4642 | (goto-char (point-min)) 4643 | (while (< (point) (point-max)) 4644 | (mingus-redraw-line) 4645 | (forward-line 1)))) 4646 | 4647 | (defun mingus-redraw-all (&optional frame) 4648 | (let ((windows (remove nil 4649 | (list 4650 | (get-buffer-window 4651 | (get-buffer "*Mingus Browser*")) 4652 | (get-buffer-window 4653 | (get-buffer "*Mingus*")))))) 4654 | (mapc (lambda (w) 4655 | (with-selected-window 4656 | w 4657 | (mingus-redraw-buffer))) 4658 | windows))) 4659 | 4660 | (provide 'mingus) 4661 | ;;; mingus.el ends here 4662 | --------------------------------------------------------------------------------