1 ;;; ampc.el --- Asynchronous Music Player Controller -*- lexical-binding: t -*-
3 ;; Copyright (C) 2011-2012, 2016 Free Software Foundation, Inc.
5 ;; Author: Christopher Schmidt <christopher@ch.ristopher.com>
6 ;; Comment: On Jan 2016, I couldn't get hold of Christopher Schmidt
7 ;; nor could I find ampc anywhere, so I re-instated GNU ELPA's old version
8 ;; and marked it as "maintainerless".
9 ;; Maintainer: emacs-devel@gnu.org
11 ;; Created: 2011-12-06
12 ;; Keywords: ampc, mpc, mpd
13 ;; Compatibility: GNU Emacs: 24.x
15 ;; This file is part of ampc.
17 ;; This program is free software; you can redistribute it and/or modify
18 ;; it under the terms of the GNU General Public License as published by
19 ;; the Free Software Foundation, either version 3 of the License, or
20 ;; (at your option) any later version.
22 ;; This program is distributed in the hope that it will be useful,
23 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
24 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
25 ;; GNU General Public License for more details.
27 ;; You should have received a copy of the GNU General Public License
28 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
32 ;; ampc is a controller for the Music Player Daemon (http://mpd.wikia.com/).
35 ;; If you use GNU ELPA, install ampc via M-x package-list-packages RET or
36 ;; (package-install 'ampc). Otherwise, grab the files in this repository and
37 ;; put the Emacs Lisp ones somewhere in your load-path or add the directory the
38 ;; files are in to it, e.g.:
40 ;; (add-to-list 'load-path "~/.emacs.d/ampc")
41 ;; (autoload 'ampc "ampc" nil t)
43 ;; Byte-compile ampc (M-x byte-compile-file RET /path/to/ampc.el RET) to improve
47 ;; ampc is not only a frontend to MPD but also a full-blown audio file tagger.
48 ;; To use this feature you have to build the backend application, `ampc_tagger',
49 ;; which in turn uses TagLib (http://taglib.github.com/), a dual-licended
50 ;; (LGPL/MPL) audio meta-data library written in C++. TagLib has no
51 ;; dependencies on its own.
53 ;; To build `ampc_tagger', locate ampc_tagger.cpp. The file can be found in the
54 ;; directory in which this file, ampc.el, is located. Compile the file and
55 ;; either customize `ampc-tagger-executable' to point to the binary file or move
56 ;; the executable in a suitable directory so Emacs finds it via consulting
59 ;; g++ -O2 ampc_tagger.cpp -oampc_tagger -ltag && sudo cp ampc_tagger /usr/local/bin && rm ampc_tagger
61 ;; You have to customize `ampc-tagger-music-directories' in order to use the
62 ;; tagger. This variable should be a list of directories in which your music
63 ;; files are located. Usually this list should have only one entry, the value
64 ;; of your mpd.conf's `music_directory'.
66 ;; If `ampc-tagger-backup-directory' is non-nil, the tagger saved copies of all
67 ;; files that are about to be modified to this directory. Emacs's regular
68 ;; numeric backup filename syntax is used for the backup file names. By default
69 ;; `ampc-tagger-backup-directory' is set to "~/.emacs.d/ampc-backups/".
72 ;; To invoke ampc call the command `ampc', e.g. via M-x ampc RET. The first
73 ;; argument to `ampc' is the host, the second is the port. Both values default
74 ;; to nil. If nil, ampc will use the value specified in `ampc-default-server',
75 ;; by default localhost:6600. To make ampc use the full frame rather than the
76 ;; selected window for its window setup, customise `ampc-use-full-frame' to a
79 ;; ampc offers three independent views which expose different parts of the user
80 ;; interface. The current playlist view, the default view at startup, may be
81 ;; accessed using the `J' key (that is `S-j'). The playlist view may be
82 ;; accessed using the `K' key. The outputs view may be accessed by pressing
85 ;;; *** current playlist view
86 ;; The playlist view looks like this:
88 ;; .........................
97 ;; .........................
99 ;; Window one exposes basic information about the daemon, such as the current
100 ;; state (stop/play/pause), the song currently playing or the volume.
102 ;; All windows, except the status window, contain a tabular list of items. Each
103 ;; item may be selected/marked. There may be multiple selections.
105 ;; To mark an entry, move the point to the entry and press `m' (ampc-mark). To
106 ;; unmark an entry, press `u' (ampc-unmark). To unmark all entries, press `U'
107 ;; (ampc-unmark-all). To toggle marks, press `t' (ampc-toggle-marks). Pressing
108 ;; `<down-mouse-1>' with the mouse mouse cursor on a list entry will move point
109 ;; to the entry and toggle the mark. To navigate to the next entry, press `n'
110 ;; (ampc-next-line). Analogous, pressing `p' (ampc-previous-line) moves the
111 ;; point to the previous entry.
113 ;; Window two shows the current playlist. The song that is currently played by
114 ;; the daemon, if any, is highlighted. To delete the selected songs from the
115 ;; playlist, press `d' (ampc-delete). Pressing `<down-mouse-3>' will move the
116 ;; point to the entry under cursor and delete it from the playlist. To move the
117 ;; selected songs up, press `<up>' (ampc-up). Analogous, press `<down>'
118 ;; (ampc-down) to move the selected songs down. Pressing `RET'
119 ;; (ampc-play-this) or `<down-mouse-2>' will play the song at point/cursor.
121 ;; Windows three to five are tag browsers. You use them to narrow the song
122 ;; database to certain songs. Think of tag browsers as filters, analogous to
123 ;; piping `grep' outputs through additional `grep' filters. The property of the
124 ;; songs that is filtered is displayed in the header line of the window.
126 ;; Window six shows the songs that match the filters defined by windows three to
127 ;; five. To add the selected song to the playlist, press `a' (ampc-add).
128 ;; Pressing `<down-mouse-3>' will move the point to the entry under the cursor
129 ;; and execute `ampc-add'. These key bindings works in tag browsers as well.
130 ;; Calling `ampc-add' in a tag browser adds all songs filtered up to the
131 ;; selected browser to the playlist.
133 ;; The tag browsers of the current playlist view (accessed via `J') are `Genre'
134 ;; (window 3), `Artist' (window 4) and `Album' (window 5). The key `M' may be
135 ;; used to fire up a slightly modified current playlist view. There is no
136 ;; difference to the default current playlist view other than that the tag
137 ;; browsers filter to `Genre' (window 3), `Album' (window 4) and `Artist'
138 ;; (window 5). Metaphorically speaking, the order of the `grep' filters defined
139 ;; by the tag browsers is different.
141 ;;; *** playlist view
142 ;; The playlist view resembles the current playlist view. The window, which
143 ;; exposes the playlist content, is replaced by three windows, vertically
144 ;; arragned, though. The top one still shows the current playlist. The bottom
145 ;; one shows a list of stored playlists. The middle window exposes the content
146 ;; of the selected (stored) playlist. All commands that used to work in the
147 ;; current playlist view and modify the current playlist now modify the selected
148 ;; (stored) playlist unless the point is within the current playlist buffer.
149 ;; The list of stored playlists is the only view in ampc that may have only one
152 ;; To queue a playlist, press `l' (ampc-load) or `<down-mouse-2>'. To delete a
153 ;; playlist, press `d' (ampc-delete-playlist) or `<down-mouse-3>'. The command
154 ;; `ampc-rename-playlist', bound to `r', can be used to rename a playlist.
156 ;; Again, the key `<' may be used to setup a playlist view with a different
157 ;; order of tag browsers.
160 ;; The outputs view contains a single list which shows the configured outputs of
161 ;; MPD. To toggle the enabled property of the selected outputs, press `a'
162 ;; (ampc-toggle-output-enabled) or `<mouse-3>'.
165 ;; To start the tagging subsystem, press `I' (ampc-tagger). This key binding
166 ;; works in every buffer associated with ampc. First, the command tries to
167 ;; determine which files you want to tag. The files are collected using either
168 ;; the selected entries within the current buffer, the file associated with the
169 ;; entry at point, or, if both sources did not provide any files, the audio file
170 ;; that is currently played by MPD. Next, the tagger view is created. On the
171 ;; right there is the buffer that contain the tag data. Each line in this
172 ;; buffer represents a tag with a value. Tag and value are separated by a
173 ;; colon. Valid tags are "Title", "Artist", "Album", "Comment", "Genre", "Year"
174 ;; and "Track". The value can be an arbitrary string. Whitespaces in front and
175 ;; at the end of the value are ignored. If the value is "<keep>", the tag line
178 ;; To save the specified tag values back to the files, press `C-c C-c'
179 ;; (ampc-tagger-save). To exit the tagger and restore the previous window
180 ;; configuration, press `C-c C-q'. `C-u C-c C-c' saved the tags and exits the
181 ;; tagger. Only tags that are actually specified within the tagger buffer
182 ;; written back to the file. Other tags will not be touched by ampc. For
183 ;; example, to clear the "Commentary" tag, you need to specify the line
187 ;; In the tagger buffer. Omitting this line will make the tagger not touch the
188 ;; "Commentary" tag at all.
190 ;; On the right there is the files list buffer. The selection of this buffer
191 ;; specifies which files the command `ampc-tag-save' will write to. If no file
192 ;; is selected, the file at point in the file list buffer is used.
194 ;; To reset the values of the tags specified in the tagger buffer to the common
195 ;; values of all selected files specified by the selection of the files list
196 ;; buffer, press `C-c C-r' (ampc-tagger-reset). With a prefix argument,
197 ;; `ampc-tagger-reset' restores missing tags as well.
199 ;; You can use tab-completion within the tagger buffer for both tags and tag
202 ;; You can also use the tagging subsystem on its own without a running ampc
203 ;; instance. To start the tagger, call `ampc-tag-files'. This function accepts
204 ;; one argument, a list of absolute file names which are the files to tag. ampc
205 ;; provides a minor mode for dired, `ampc-tagger-dired-mode'. If this mode is
206 ;; enabled within a dired buffer, pressing `C-c C-t' (ampc-tagger-dired) will
207 ;; start the tagger on the current selection.
209 ;; The following ampc-specific hooks are run during tagger usage:
211 ;; `ampc-tagger-grab-hook': Run by the tagger before grabbing tags of a file.
212 ;; Each function is called with one argument, the file name.
214 ;; `ampc-tagger-grabbed-hook': Run by the tagger after grabbing tags of a file.
215 ;; Each function is called with one argument, the file name.
217 ;; `ampc-tagger-store-hook': Run by the tagger before writing tags back to a
218 ;; file. Each function is called with two arguments, FOUND-CHANGED and DATA.
219 ;; FOUND-CHANGED is non-nil if the tags that are about to be written differ from
220 ;; the ones in the file. DATA is a cons. The car specifies the full file name
221 ;; of the file that is about to be written to, the cdr is an alist that
222 ;; specifies the tags that are about to be (over-)written. The car of each
223 ;; entry in this list is a symbol specifying the tag (one of the ones in
224 ;; `ampc-tagger-tags'), the cdr a string specifying the value. The cdr of DATA
225 ;; may be modified. If FOUND-CHANGED is nil and the cdr of DATA is not modified
226 ;; throughout the hook is run, the file is not touched.
227 ;; `ampc-tagger-stored-hook' is still run, though.
229 ;; `ampc-tagger-stored-hook': Run by the tagger after writing tags back to a
230 ;; file. Each function is called with two arguments, FOUND-CHANGED and DATA.
231 ;; These are the same arguments that were already passed to
232 ;; `ampc-tagger-store-hook'. The car of DATA, the file name, may be modified.
234 ;; These hooks can be used to handle vc locking and unlocking of files. For
235 ;; renaming files according to their (new) tag values, ampc provides the
236 ;; function `ampc-tagger-rename-artist-title' which may be added to
237 ;; `ampc-tagger-stored-hook'. The new file name generated by this function is
238 ;; "Artist"_-_"Title"."extension". Characters within "Artist" and "Title" that
239 ;; are not alphanumeric are substituted with underscores.
242 ;; Aside from `J', `M', `K', `<' and `L', which may be used to select different
243 ;; views, and `I' which starts the tagger, ampc defines the following global
244 ;; keys. These binding are available in every buffer associated with ampc:
246 ;; `k' (ampc-toggle-play): Toggle play state. If MPD does not play a song,
247 ;; start playing the song at point if the current buffer is the playlist buffer,
248 ;; otherwise start at the beginning of the playlist. With numeric prefix
249 ;; argument 4, stop player rather than pause if applicable.
251 ;; `l' (ampc-next): Play next song.
252 ;; `j' (ampc-previous): Play previous song
254 ;; `c' (ampc-clear): Clear playlist.
255 ;; `s' (ampc-shuffle): Shuffle playlist.
257 ;; `S' (ampc-store): Store playlist.
258 ;; `O' (ampc-load): Load selected playlist into the current playlist.
259 ;; `R' (ampc-rename-playlist): Rename selected playlist.
260 ;; `D' (ampc-delete-playlist): Delete selected playlist.
262 ;; `y' (ampc-increase-volume): Increase volume.
263 ;; `M-y' (ampc-decrease-volume): Decrease volume.
264 ;; `C-M-y' (ampc-set-volume): Set volume.
265 ;; `h' (ampc-increase-crossfade): Increase crossfade.
266 ;; `M-h' (ampc-decrease-crossfade): Decrease crossfade.
267 ;; `C-M-h' (ampc-set-crossfade): Set crossfade.
269 ;; `e' (ampc-toggle-repeat): Toggle repeat state.
270 ;; `r' (ampc-toggle-random): Toggle random state.
271 ;; `f' (ampc-toggle-consume): Toggle consume state.
273 ;; `P' (ampc-goto-current-song): Select the current playlist window and move
274 ;; point to the current song.
275 ;; `G' (ampc-mini): Select song to play via `completing-read'.
277 ;; `T' (ampc-trigger-update): Trigger a database update.
278 ;; `Z' (ampc-suspend): Suspend ampc.
279 ;; `q' (ampc-quit): Quit ampc.
281 ;; The keymap of ampc is designed to fit the QWERTY United States keyboard
282 ;; layout. If you use another keyboard layout, feel free to modify
283 ;; `ampc-mode-map'. For example, I use a regular QWERTZ German keyboard
284 ;; (layout), so I modify `ampc-mode-map' in my init.el like this:
286 ;; (eval-after-load 'ampc
287 ;; '(flet ((substitute-ampc-key
289 ;; (define-key ampc-mode-map to (lookup-key ampc-mode-map from))
290 ;; (define-key ampc-mode-map from nil)))
291 ;; (substitute-ampc-key (kbd "z") (kbd "Z"))
292 ;; (substitute-ampc-key (kbd "y") (kbd "z"))
293 ;; (substitute-ampc-key (kbd "M-y") (kbd "M-z"))
294 ;; (substitute-ampc-key (kbd "C-M-y") (kbd "C-M-z"))
295 ;; (substitute-ampc-key (kbd "<") (kbd ";"))))
297 ;; If ampc is suspended, you can still use every interactive command that does
298 ;; not directly operate on or with the user interace of ampc. For example it is
299 ;; perfectly fine to call `ampc-increase-volume' or `ampc-toggle-play' via M-x
300 ;; RET. Especially the commands `ampc-status' and `ampc-mini' are predesignated
301 ;; to be bound in the global keymap and called when ampc is suspended.
302 ;; `ampc-status' messages the information that is displayed by the status window
303 ;; of ampc. `ampc-mini' lets you select a song to play via `completing-read'.
304 ;; To start ampc suspended, call `ampc' with the third argument being non-nil.
305 ;; To check whether ampc is connected to the daemon and/or suspended, call
306 ;; `ampc-is-on-p' or `ampc-suspended-p'.
308 ;; (global-set-key (kbd "<f7>")
311 ;; (unless (ampc-on-p)
314 ;; (global-set-key (kbd "<f8>")
317 ;; (unless (ampc-on-p)
323 (eval-when-compile (require 'cl-lib))
324 (require 'network-stream)
329 "Asynchronous client for the Music Player Daemon."
332 :group 'applications)
335 (defcustom ampc-debug nil
336 "Non-nil means log outgoing communication between ampc and MPD.
337 If the value is neither t nor nil, also log incoming data."
338 :type '(choice (const :tag "Disable" nil)
339 (const :tag "Outgoing" t)
340 (const :tag "Incoming and outgoing" full)))
342 (defcustom ampc-use-full-frame nil
343 "If non-nil, ampc will use the entire Emacs screen."
346 (defcustom ampc-truncate-lines t
347 "If non-nil, truncate lines in ampc buffers."
350 (defcustom ampc-default-server '("localhost" . 6600)
351 "The MPD server to connect to if the arguments to `ampc' are nil.
352 This variable is a cons cell, with the car specifying the
353 hostname and the cdr specifying the port. Both values can be
354 nil, which will make ampc query the user for values on each
356 :type '(cons (choice :tag "Hostname"
358 (const :tag "Ask" nil))
362 (const :tag "Ask" nil))))
364 (defcustom ampc-synchronous-commands '(t status currentsong play)
365 "List of MPD commands that should be executed synchronously.
366 Executing commands that print lots of output synchronously will
367 result in massive performance improvements of ampc. If the car
368 of this list is t, execute all commands synchronously other
369 than the ones specified by the rest of the list."
370 :type '(repeat symbol))
372 (defcustom ampc-status-tags nil
373 "List of additional tags of the current song that are added to
374 the internal status of ampc and thus are passed to the functions
375 in `ampc-status-changed-hook'. Each element may be a string that
376 specifies a tag that is returned by MPD's `currentsong'
378 :type '(list symbol))
380 (defcustom ampc-volume-step 5
381 "Default step of `ampc-increase-volume' and
382 `ampc-decrease-volume' for changing the volume."
385 (defcustom ampc-crossfade-step 5
386 "Default step of `ampc-increase-crossfade' and
387 `ampc-decrease-crossfade' for changing the crossfade."
390 (defcustom ampc-tag-transform-funcs '(("Time" . ampc-transform-time)
391 ("Track" . ampc-transform-track))
392 "Alist of tag treatment functions.
393 The car, a string, of each entry specifies the MPD tag, the cdr a
394 function which transforms the tag to the value that should be
395 used by ampc. The function is called with one string argument,
396 the tag value, and should return the treated value."
397 :type '(alist :key-type string :value-type function))
399 (defcustom ampc-tagger-music-directories nil
400 "List of base directories in which your music files are located.
401 Usually this list should have only one entry, the value of your
402 mpd.conf's `music_directory'"
403 :type '(list directory))
405 (defcustom ampc-tagger-executable "ampc_tagger"
406 "The name or full path to ampc's tagger executable."
409 (defcustom ampc-tagger-backup-directory
410 (file-name-directory (locate-user-emacs-file "ampc-backups/"))
411 "The directory in which the tagger copies files before modifying.
412 If nil, disable backups."
413 :type '(choice (const :tag "Disable backups" nil)
414 (directory :tag "Directory")))
417 (defcustom ampc-before-startup-hook nil
418 "A hook run before startup.
419 This hook is called as the first thing when ampc is started."
422 (defcustom ampc-connected-hook nil
423 "A hook run after ampc connected to MPD."
426 (defcustom ampc-suspend-hook nil
427 "A hook run when suspending ampc."
430 (defcustom ampc-quit-hook nil
431 "A hook run when exiting ampc."
434 (defcustom ampc-status-changed-hook nil
435 "A hook run whenever the status of the daemon (that is volatile
436 properties such as volume or current song) changes. The hook is
437 run with one arg, an alist that contains the new status. The car
438 of each entry is a symbol, the cdr is a string. Valid keys are:
450 and the keys in `ampc-status-tags'. Not all keys may be present
454 (defcustom ampc-tagger-grab-hook nil
455 "Hook run by the tagger before grabbing tags of a file.
456 Each function is called with one argument, the file name."
458 (defcustom ampc-tagger-grabbed-hook nil
459 "Hook run by the tagger after grabbing tags of a file.
460 Each function is called with one argument, the file name."
463 (defcustom ampc-tagger-store-hook nil
464 "Hook run by the tagger before writing tags back to a file.
465 Each function is called with two arguments, FOUND-CHANGED and
466 DATA. FOUND-CHANGED is non-nil if the tags that are about to be
467 written differ from the ones in the file. DATA is a cons. The
468 car specifies the full file name of the file that is about to be
469 written to, the cdr is an alist that specifies the tags that are
470 about to be (over-)written. The car of each entry in this list
471 is a symbol specifying the tag (one of the ones in
472 `ampc-tagger-tags'), the cdr a string specifying the value. The
473 cdr of DATA may be modified. If FOUND-CHANGED is nil and the cdr
474 of DATA is not modified throughout the hook is run, the file is
475 not touched. `ampc-tagger-stored-hook' is still run, though."
477 (defcustom ampc-tagger-stored-hook nil
478 "Hook run by the tagger after writing tags back to a file.
479 Each function is called with two arguments, FOUND-CHANGED and
480 DATA. These are the same arguments that were already passed to
481 `ampc-tagger-store-hook'. The car of DATA, the file name, may be
486 (defface ampc-mark-face '((t (:inherit font-lock-constant-face)))
488 (defface ampc-marked-face '((t (:inherit warning)))
489 "Face of marked entries.")
490 (defface ampc-unmarked-face '((t (:inerhit default)))
491 "Face of unmarked entries.")
492 (defface ampc-current-song-mark-face '((t (:inherit region)))
493 "Face of mark of the current song.")
494 (defface ampc-current-song-marked-face '((t (:inherit region)))
495 "Face of the current song if marked.")
497 (defface ampc-tagger-tag-face '((t (:inherit font-lock-constant-face)))
498 "Face of tags within the tagger.")
499 (defface ampc-tagger-keyword-face '((t (:inherit font-lock-keyword-face)))
500 "Face of tags within the tagger.")
502 ;;; *** internal variables
504 (let* ((songs '(1.0 song :properties (("Track" :title "#" :width 4)
505 ("Title" :min 15 :max 40)
507 ("Artist" :min 15 :max 40)
508 ("Album" :min 15 :max 40))))
511 (0.33 tag :tag "Genre" :id 1 :select t)
512 (0.33 tag :tag "Artist" :id 2)
513 (1.0 tag :tag "Album" :id 3))
517 (0.33 tag :tag "Genre" :id 1 :select t)
518 (0.33 tag :tag "Album" :id 2)
519 (1.0 tag :tag "Artist" :id 3))
521 (pl-prop '(:properties (("Title" :min 15 :max 40)
522 ("Artist" :min 15 :max 40)
523 ("Album" :min 15 :max 40)
524 ("Time" :width 6)))))
528 :properties ((filename :shrink t :title "File" :min 20 :max 40)
529 ("Title" :min 15 :max 40)
530 ("Artist" :min 15 :max 40)
531 ("Album" :min 15 :max 40)
532 ("Genre" :min 15 :max 40)
534 ("Track" :title "#" :width 4)
535 ("Comment" :min 15 :max 40))
538 ("Current playlist view (Genre|Artist|Album)"
543 (1.0 current-playlist ,@pl-prop))
545 ("Current playlist view (Genre|Album|Artist)"
550 (1.0 current-playlist ,@pl-prop))
552 ("Playlist view (Genre|Artist|Album)"
558 (0.4 current-playlist ,@pl-prop)
559 (0.4 playlist ,@pl-prop)
562 ("Playlist view (Genre|Album|Artist)"
568 (0.4 current-playlist ,@pl-prop)
569 (0.4 playlist ,@pl-prop)
574 outputs :properties (("outputname" :title "Name" :min 10 :max 30)
575 ("outputenabled" :title "Enabled" :width 9))))))
577 (defvar ampc-connection nil)
578 (defvar ampc-host nil)
579 (defvar ampc-port nil)
580 (defvar ampc-outstanding-commands nil)
582 (defvar ampc-no-implicit-next-dispatch nil)
583 (defvar ampc-working-timer nil)
584 (defvar ampc-yield nil)
585 (defvar ampc-yield-redisplay nil)
587 (defvar ampc-windows nil)
588 (defvar ampc-all-buffers nil)
590 (defvar ampc-type nil)
591 (make-variable-buffer-local 'ampc-type)
592 (defvar ampc-dirty nil)
593 (make-variable-buffer-local 'ampc-dirty)
595 (defvar ampc-internal-db nil)
596 (defvar ampc-status nil)
598 (defvar ampc-tagger-previous-configuration nil)
599 (defvar ampc-tagger-version-verified nil)
600 (defvar ampc-tagger-completion-all-files nil)
601 (defvar ampc-tagger-genres nil)
603 (defconst ampc-tagger-version "0.1")
604 (defconst ampc-tagger-tags '(Title Artist Album Comment Genre Year Track))
607 (defvar ampc-mode-map
608 (let ((map (make-sparse-keymap)))
609 (suppress-keymap map)
610 (define-key map (kbd "k") 'ampc-toggle-play)
611 (define-key map (kbd "l") 'ampc-next)
612 (define-key map (kbd "j") 'ampc-previous)
613 (define-key map (kbd "c") 'ampc-clear)
614 (define-key map (kbd "s") 'ampc-shuffle)
615 (define-key map (kbd "S") 'ampc-store)
616 (define-key map (kbd "O") 'ampc-load)
617 (define-key map (kbd "R") 'ampc-rename-playlist)
618 (define-key map (kbd "D") 'ampc-delete-playlist)
619 (define-key map (kbd "y") 'ampc-increase-volume)
620 (define-key map (kbd "M-y") 'ampc-decrease-volume)
621 (define-key map (kbd "C-M-y") 'ampc-set-volume)
622 (define-key map (kbd "h") 'ampc-increase-crossfade)
623 (define-key map (kbd "M-h") 'ampc-decrease-crossfade)
624 (define-key map (kbd "C-M-h") 'ampc-set-crossfade)
625 (define-key map (kbd "e") 'ampc-toggle-repeat)
626 (define-key map (kbd "r") 'ampc-toggle-random)
627 (define-key map (kbd "f") 'ampc-toggle-consume)
628 (define-key map (kbd "P") 'ampc-goto-current-song)
629 (define-key map (kbd "G") 'ampc-mini)
630 (define-key map (kbd "q") 'ampc-quit)
631 (define-key map (kbd "z") 'ampc-suspend)
632 (define-key map (kbd "T") 'ampc-trigger-update)
633 (define-key map (kbd "I") 'ampc-tagger)
634 (cl-loop for view in ampc-views
635 do (when (stringp (car view))
636 (define-key map (cadr view)
639 (ampc-change-view ',view)))))
642 (defvar ampc-item-mode-map
643 (let ((map (make-sparse-keymap)))
644 (suppress-keymap map)
645 (define-key map (kbd "m") 'ampc-mark)
646 (define-key map (kbd "u") 'ampc-unmark)
647 (define-key map (kbd "U") 'ampc-unmark-all)
648 (define-key map (kbd "n") 'ampc-next-line)
649 (define-key map (kbd "p") 'ampc-previous-line)
650 (define-key map (kbd "<down-mouse-1>") 'ampc-mouse-toggle-mark)
651 (define-key map (kbd "<mouse-1>") 'ampc-mouse-align-point)
652 (define-key map [remap next-line] 'ampc-next-line)
653 (define-key map [remap previous-line] 'ampc-previous-line)
654 (define-key map [remap tab-to-tab-stop] 'ampc-move-to-tab)
657 (defvar ampc-current-playlist-mode-map
658 (let ((map (make-sparse-keymap)))
659 (suppress-keymap map)
660 (define-key map (kbd "RET") 'ampc-play-this)
661 (define-key map (kbd "<down-mouse-2>") 'ampc-mouse-play-this)
662 (define-key map (kbd "<mouse-2>") 'ampc-mouse-align-point)
663 (define-key map (kbd "<down-mouse-3>") 'ampc-mouse-delete)
664 (define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
667 (defvar ampc-playlist-mode-map
668 (let ((map (make-sparse-keymap)))
669 (suppress-keymap map)
670 (define-key map (kbd "t") 'ampc-toggle-marks)
671 (define-key map (kbd "d") 'ampc-delete)
672 (define-key map (kbd "<up>") 'ampc-up)
673 (define-key map (kbd "<down>") 'ampc-down)
674 (define-key map (kbd "<down-mouse-3>") 'ampc-mouse-delete)
675 (define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
678 (defvar ampc-playlists-mode-map
679 (let ((map (make-sparse-keymap)))
680 (suppress-keymap map)
681 (define-key map (kbd "l") 'ampc-load)
682 (define-key map (kbd "r") 'ampc-rename-playlist)
683 (define-key map (kbd "d") 'ampc-delete-playlist)
684 (define-key map (kbd "<down-mouse-2>") 'ampc-mouse-load)
685 (define-key map (kbd "<mouse-2>") 'ampc-mouse-align-point)
686 (define-key map (kbd "<down-mouse-3>") 'ampc-mouse-delete-playlist)
687 (define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
690 (defvar ampc-tag-song-mode-map
691 (let ((map (make-sparse-keymap)))
692 (suppress-keymap map)
693 (define-key map (kbd "t") 'ampc-toggle-marks)
694 (define-key map (kbd "a") 'ampc-add)
695 (define-key map (kbd "<down-mouse-3>") 'ampc-mouse-add)
696 (define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
699 (defvar ampc-outputs-mode-map
700 (let ((map (make-sparse-keymap)))
701 (suppress-keymap map)
702 (define-key map (kbd "t") 'ampc-toggle-marks)
703 (define-key map (kbd "a") 'ampc-toggle-output-enabled)
704 (define-key map (kbd "<down-mouse-3>") 'ampc-mouse-toggle-output-enabled)
705 (define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
708 (defvar ampc-files-list-mode-map
709 (let ((map (make-sparse-keymap)))
710 (suppress-keymap map)
711 (define-key map (kbd "t") 'ampc-toggle-marks)
712 (define-key map (kbd "C-c C-q") 'ampc-tagger-quit)
713 (define-key map (kbd "C-c C-c") 'ampc-tagger-save)
714 (define-key map (kbd "C-c C-r") 'ampc-tagger-reset)
715 (define-key map [remap ampc-tagger] nil)
716 (define-key map [remap ampc-quit] 'ampc-tagger-quit)
717 (cl-loop for view in ampc-views
718 do (when (stringp (car view))
719 (define-key map (cadr view) nil)))
722 (defvar ampc-tagger-mode-map
723 (let ((map (make-sparse-keymap)))
724 (define-key map (kbd "C-c C-q") 'ampc-tagger-quit)
725 (define-key map (kbd "C-c C-c") 'ampc-tagger-save)
726 (define-key map (kbd "C-c C-r") 'ampc-tagger-reset)
727 (define-key map (kbd "TAB") 'ampc-tagger-completion-at-point)
730 (defvar ampc-tagger-dired-mode-map
731 (let ((map (make-sparse-keymap)))
732 (define-key map (kbd "C-c C-t") 'ampc-tagger-dired)
736 (easy-menu-define nil ampc-mode-map nil
738 ("Change view" ,@(cl-loop for view in ampc-views
739 when (stringp (car view))
740 collect (vector (car view)
743 (ampc-change-view ',view)))
745 ["Run tagger" ampc-tagger]
747 ["Play" ampc-toggle-play
748 :visible (and ampc-status
749 (not (equal (cdr (assq 'state ampc-status)) "play")))]
750 ["Pause" ampc-toggle-play
751 :visible (and ampc-status
752 (equal (cdr (assq 'state ampc-status)) "play"))]
753 ["Stop" (lambda () (interactive) (ampc-toggle-play 4))
754 :visible (and ampc-status
755 (equal (cdr (assq 'state ampc-status)) "play"))]
757 ["Previous" ampc-previous]
759 ["Clear playlist" ampc-clear]
760 ["Shuffle playlist" ampc-shuffle]
761 ["Store playlist" ampc-store]
762 ["Queue Playlist" ampc-load :visible (ampc-playlist)]
763 ["Rename Playlist" ampc-rename-playlist :visible (ampc-playlist)]
764 ["Delete Playlist" ampc-delete-playlist :visible (ampc-playlist)]
766 ["Increase volume" ampc-increase-volume]
767 ["Decrease volume" ampc-decrease-volume]
768 ["Set volume" ampc-set-volume]
769 ["Increase crossfade" ampc-increase-crossfade]
770 ["Decrease crossfade" ampc-decrease-crossfade]
771 ["Set crossfade" ampc-set-crossfade]
772 ["Toggle repeat" ampc-toggle-repeat
774 :selected (equal (cdr (assq 'repeat ampc-status)) "1")]
775 ["Toggle random" ampc-toggle-random
777 :selected (equal (cdr (assq 'random ampc-status)) "1")]
778 ["Toggle consume" ampc-toggle-consume
780 :selected (equal (cdr (assq 'consume ampc-status)) "1")]
782 ["Trigger update" ampc-trigger-update]
783 ["Suspend" ampc-suspend]
786 (easy-menu-define ampc-selection-menu ampc-item-mode-map
787 "Selection menu for ampc"
789 ["Add to playlist" ampc-add
790 :visible (not (eq (car ampc-type) 'outputs))]
791 ["Toggle enabled" ampc-toggle-output-enabled
792 :visible (eq (car ampc-type) 'outputs)]
794 ["Next line" ampc-next-line]
795 ["Previous line" ampc-previous-line]
797 ["Unmark" ampc-unmark]
798 ["Unmark all" ampc-unmark-all]
799 ["Toggle marks" ampc-toggle-marks
800 :visible (not (eq (car ampc-type) 'playlists))]))
802 (defvar ampc-tool-bar-map
803 (let ((map (make-sparse-keymap)))
805 "mpc/prev" 'ampc-previous 'previous map
808 "mpc/play" 'ampc-toggle-play 'play map
810 :visible '(and ampc-status
811 (not (equal (cdr (assq 'state ampc-status)) "play"))))
813 "mpc/pause" 'ampc-toggle-play 'pause map
815 :visible '(and ampc-status
816 (equal (cdr (assq 'state ampc-status)) "play")))
818 "mpc/stop" (lambda () (interactive) (ampc-toggle-play 4)) 'stop map
820 :visible '(and ampc-status
821 (equal (cdr (assq 'state ampc-status)) "play")))
823 "mpc/next" 'ampc-next 'next map
829 (defmacro ampc-with-buffer (type &rest body)
830 (declare (indent 1) (debug t))
831 `(let* ((type- ,type)
832 (w (if (windowp type-)
834 (cl-loop for w in (ampc-normalize-windows)
835 thereis (when (with-current-buffer
838 (symbol (eq (car ampc-type) type-))
839 (cons (equal ampc-type type-))))
842 (with-selected-window w
843 (with-current-buffer (window-buffer w)
844 (let ((inhibit-read-only t))
845 ,@(if (eq (car body) 'no-se)
848 (goto-char (point-min))
851 (defmacro ampc-fill-skeleton (tag &rest body)
852 (declare (indent 1) (debug t))
854 (data-buffer (current-buffer)))
855 (ignore data-buffer) ;Don't warn if `body' doesn't use it.
856 (ampc-with-buffer tag-
858 (unless (eq ampc-dirty 'keep-dirty)
859 (let ((old-point-data (get-text-property (point) 'cmp-data))
860 (old-window-start-offset
861 (1- (count-lines (window-start) (point)))))
862 (put-text-property (point-min) (point-max) 'not-updated t)
863 (when (eq ampc-dirty 'erase)
864 (put-text-property (point-min) (point-max) 'data nil))
865 (goto-char (point-min))
867 (goto-char (point-min))
868 (cl-loop until (eobp)
869 do (if (get-text-property (point) 'not-updated)
871 (add-text-properties (+ (point) 2)
872 (progn (forward-line nil)
874 '(mouse-face highlight))))
875 (remove-text-properties (point-min) (point-max) '(not-updated))
876 (goto-char (point-min))
878 (cl-loop until (eobp)
879 do (when (equal (get-text-property (point) 'cmp-data)
884 (forward-line (- old-window-start-offset))
889 finally do (goto-char (point-min)))))
890 (let ((effective-height (- (window-height)
891 (if mode-line-format 1 0)
892 (if header-line-format 1 0))))
893 (when (< (- (1- (line-number-at-pos (point-max)))
894 (line-number-at-pos (window-start)))
896 (set-window-start nil
898 (goto-char (point-max))
899 (forward-line (- (1+ effective-height)))
903 (ampc-set-dirty nil)))))
905 (defmacro ampc-with-selection (arg &rest body)
906 (declare (indent 1) (debug t))
908 (if (or (and (not arg-)
910 (goto-char (point-min))
911 (search-forward-regexp "^* " nil t)))
912 (and arg- (symbolp arg-)))
913 (cl-loop initially do (goto-char (point-min))
914 finally do (ampc-align-point)
915 while (search-forward-regexp "^* " nil t)
919 (setf arg- (prefix-numeric-value arg-))
921 (cl-loop until (eobp)
922 for index from 0 to (1- (abs arg-))
925 until (if (< arg- 0) (ampc-previous-line) (ampc-next-line))))))
927 (defmacro ampc-iterate-source (data-buffer delimiter bindings &rest body)
928 (declare (indent 3) (debug t))
929 (when (memq (intern delimiter) bindings)
930 (cl-callf2 delq (intern delimiter) bindings)
931 (push (list (intern delimiter)
932 '(buffer-substring (point) (line-end-position)))
934 `(,@(if data-buffer `(with-current-buffer ,data-buffer) '(progn))
935 (when (search-forward-regexp
936 ,(concat "^" (regexp-quote delimiter) ": ")
940 (setf next (ampc-narrow-entry
941 ,(concat "^" (regexp-quote delimiter) ": ")))
942 (let ,(cl-loop for binding in bindings
946 collect `(,binding (ampc-extract
948 ,(symbol-name binding))))
952 do (goto-char next)))))
954 (defmacro ampc-iterate-source-output (delimiter bindings pad-data &rest body)
955 (declare (indent 2) (debug t))
956 `(let ((output-buffer (current-buffer))
957 (tags (cl-loop for (tag . props) in
958 (plist-get (cdr ampc-type) :properties)
959 collect (cons tag (ampc-extract-regexp tag)))))
961 data-buffer ,delimiter ,bindings
962 (let ((pad-data ,pad-data))
963 (with-current-buffer output-buffer
964 (ampc-insert (ampc-pad pad-data) ,@body))))))
966 (defmacro ampc-extract-regexp (tag)
968 (concat "^" (regexp-quote tag) ": \\(.*\\)$")
969 `(concat "^" (regexp-quote ,tag) ": \\(.*\\)$")))
971 (defmacro ampc-tagger-log (&rest what)
972 (declare (indent 0) (debug t))
973 `(with-current-buffer (get-buffer-create "*Tagger Log*")
974 (ampc-tagger-log-mode)
976 (goto-char (point-max))
977 (let ((inhibit-read-only t)
978 (what (concat ,@what)))
980 (message "ampc: %s" what))
984 (define-derived-mode ampc-outputs-mode ampc-item-mode "ampc-o")
986 (define-derived-mode ampc-tag-song-mode ampc-item-mode "ampc-ts")
988 (define-derived-mode ampc-current-playlist-mode ampc-playlist-mode "ampc-cpl"
989 (ampc-highlight-current-song-mode))
991 (define-derived-mode ampc-playlist-mode ampc-item-mode "ampc-pl")
993 (define-derived-mode ampc-playlists-mode ampc-item-mode "ampc-pls")
995 (define-derived-mode ampc-files-list-mode ampc-item-mode "ampc-files-list")
997 (define-derived-mode ampc-tagger-mode nil "ampc-tagger"
998 (set (make-local-variable 'tool-bar-map) ampc-tool-bar-map)
999 (set (make-local-variable 'tab-stop-list)
1000 (list (+ (cl-loop for tag in ampc-tagger-tags
1001 maximize (length (symbol-name tag)))
1003 (set (make-local-variable 'completion-at-point-functions)
1004 '(ampc-tagger-complete-tag ampc-tagger-complete-value))
1005 (setf truncate-lines ampc-truncate-lines
1007 `(((,(concat "^\\([ \t]*\\(?:"
1008 (mapconcat #'symbol-name ampc-tagger-tags "\\|")
1012 (mapconcat #'identity ampc-tagger-genres "\\|") "\\|<keep>"
1015 (1 'ampc-tagger-tag-face)
1016 (2 'ampc-tagger-keyword-face)))
1019 (define-derived-mode ampc-tagger-log-mode nil "ampc-tagger-log")
1021 (define-derived-mode ampc-item-mode ampc-mode "ampc-item"
1022 (setf font-lock-defaults '((("^\\(\\*\\)\\(.*\\)$"
1024 (2 'ampc-marked-face))
1025 ("" 0 'ampc-unmarked-face))
1028 (define-derived-mode ampc-mode special-mode "ampc"
1029 (buffer-disable-undo)
1030 (set (make-local-variable 'tool-bar-map) ampc-tool-bar-map)
1031 (setf truncate-lines ampc-truncate-lines
1032 mode-line-modified "--"))
1034 (define-minor-mode ampc-highlight-current-song-mode ""
1035 ;; FIXME: The "" above looks bogus!
1039 (funcall (if ampc-highlight-current-song-mode
1040 #'font-lock-add-keywords
1041 #'font-lock-remove-keywords)
1043 '((ampc-find-current-song
1044 (1 'ampc-current-song-mark-face)
1045 (2 'ampc-current-song-marked-face)))))
1048 (define-minor-mode ampc-tagger-dired-mode
1049 "Minor mode that adds a audio file meta data tagging key binding to dired."
1050 :lighter " ampc-tagger"
1051 (cl-assert (derived-mode-p 'dired-mode)))
1053 ;;; *** internal functions
1054 (defun ampc-tagger-report (args status)
1055 (unless (zerop status)
1056 (let ((message (format (concat "ampc_tagger (%s %s) returned with a "
1057 "non-zero exit status (%s)")
1058 ampc-tagger-executable
1059 (mapconcat #'identity args " ")
1061 (ampc-tagger-log message "\n")
1064 (defun ampc-tagger-call (&rest args)
1067 (apply #'call-process ampc-tagger-executable nil t nil args)))
1069 (defun ampc-int-insert-cmp (p1 p2)
1070 (cond ((< p1 p2) 'insert)
1071 ((eq p1 p2) 'overwrite)
1074 (defun ampc-normalize-windows ()
1076 (cl-loop for (window . buffer) in ampc-windows
1077 collect (cons (if (and (window-live-p window)
1078 (eq (window-buffer window) buffer))
1080 (get-buffer-window buffer))
1082 (delq nil (mapcar #'car ampc-windows)))
1084 (defun ampc-restore-window-configuration ()
1088 (when (eq (window-frame w)
1091 (ampc-normalize-windows)))
1093 (cl-loop for w in (window-list nil nil (frame-first-window))
1097 (cl-return nil)))))))
1099 (setf (window-dedicated-p (car windows)) nil)
1100 (cl-loop for w in (cdr windows)
1101 do (delete-window w)))))
1103 (defun ampc-tagger-tags-modified (tags new-tags)
1104 (cl-loop with found-changed
1105 for (tag . value) in new-tags
1106 for prop = (assq tag tags)
1107 do (unless (equal (cdr prop) value)
1108 (setf (cdr prop) value
1110 finally return found-changed))
1112 (defun ampc-change-view (view)
1113 (if (equal ampc-outstanding-commands '((idle nil)))
1114 (ampc-configure-frame (cddr view))
1115 (message "ampc is busy, cannot change window layout")))
1117 (defun ampc-quote (string)
1118 (concat "\"" (replace-regexp-in-string "\"" "\\\"" string) "\""))
1120 (defun ampc-in-ampc-p (&optional or-in-tagger)
1121 (or (when (ampc-on-p)
1124 (memq (car ampc-type) '(files-list tagger)))))
1126 (defun ampc-add-impl (&optional data)
1127 (ampc-on-files (lambda (file)
1129 (ampc-send-command 'playlistadd
1131 (ampc-quote (ampc-playlist))
1133 (ampc-send-command 'add '(:keep-prev t) (ampc-quote file)))
1136 (defun ampc-on-files (func &optional data)
1138 (cl-loop for d in (get-text-property (line-end-position) 'data)
1139 do (ampc-on-files func d)))
1141 (avl-tree-mapc (lambda (e) (ampc-on-files func (cdr e))) data))
1143 (funcall func data))
1145 (cl-loop for d in (reverse data)
1146 do (ampc-on-files func (cdr (assoc "file" d)))))))
1148 (defun ampc-skip (N)
1151 `(:callback ,(lambda ()
1152 (ampc-send-command 'status '(:front t))))
1154 (let ((song (cdr (assq 'song ampc-status)))
1155 (playlist-length (cdr (assq 'playlistlength ampc-status))))
1156 (unless (and song playlist-length)
1158 (max 0 (min (+ (string-to-number song) N)
1159 (1- (string-to-number playlist-length))))))))
1161 (cl-defun ampc-find-current-song
1162 (limit &aux (point (point)) (song (cdr (assq 'song ampc-status))))
1164 (<= (1- (line-number-at-pos (point)))
1165 (setf song (string-to-number song)))
1166 (>= (1- (line-number-at-pos limit)) song))
1167 (goto-char (point-min))
1170 (narrow-to-region (max point (point)) (min limit (line-end-position)))
1171 (search-forward-regexp "\\(?1:\\(\\`\\*\\)?\\)\\(?2:.*\\)$"))))
1173 (defun ampc-set-volume-impl (arg &optional func)
1175 (setf arg (prefix-numeric-value arg)))
1178 `(:callback ,(lambda ()
1179 (ampc-send-command 'status '(:front t))))
1186 (cdr (assq 'volume ampc-status)))
1187 (or arg ampc-volume-step))
1192 (defun ampc-set-crossfade-impl (arg &optional func)
1194 (setf arg (prefix-numeric-value arg)))
1197 `(:callback ,(lambda ()
1198 (ampc-send-command 'status '(:front t))))
1205 (cdr (assq 'xfade ampc-status)))
1206 (or arg ampc-crossfade-step))
1210 (cl-defun ampc-tagger-make-backup (file)
1211 (unless ampc-tagger-backup-directory
1212 (cl-return-from ampc-tagger-make-backup))
1213 (when (functionp ampc-tagger-backup-directory)
1214 (funcall ampc-tagger-backup-directory file)
1215 (cl-return-from ampc-tagger-make-backup))
1216 (unless (file-directory-p ampc-tagger-backup-directory)
1217 (make-directory ampc-tagger-backup-directory t))
1219 (cl-loop with real-file = file
1220 for target = (file-symlink-p real-file)
1222 do (setf real-file (expand-file-name
1223 target (file-name-directory real-file)))
1224 finally return real-file))
1226 (cl-loop with base = (file-name-nondirectory real-file)
1228 for file = (expand-file-name
1232 ampc-tagger-backup-directory)
1233 while (file-exists-p file)
1234 finally return file)))
1235 (ampc-tagger-log "\tBackup file: " (abbreviate-file-name target) "\n")
1236 (copy-file real-file target nil t)))
1238 (cl-defun ampc-move (N &aux with-marks entries-to-move (up (< N 0)))
1240 (goto-char (point-min))
1241 (cl-loop while (search-forward-regexp "^* " nil t)
1242 do (push (point) entries-to-move)))
1245 (push (point) entries-to-move))
1246 (when (save-excursion
1247 (cl-loop with max = (1- (count-lines (point-min) (point-max)))
1248 for p in entries-to-move
1250 for line = (+ (1- (line-number-at-pos)) N)
1251 always (and (>= line 0) (<= line max))))
1253 (setf entries-to-move (nreverse entries-to-move)))
1256 (cl-loop for p in entries-to-move
1258 for line = (1- (line-number-at-pos))
1259 do (if (and (not (eq (car ampc-type) 'current-playlist))
1261 (ampc-send-command 'playlistmove
1263 (ampc-quote (ampc-playlist))
1266 (ampc-send-command 'move '(:keep-prev t) line (+ line N))))
1268 (cl-loop for p in (nreverse entries-to-move)
1272 (ampc-mark-impl t 1))
1275 (ampc-align-point))))
1277 (defun ampc-toggle-state (state arg)
1278 (when (or arg ampc-status)
1283 (if (equal (cdr (assq state ampc-status)) "1")
1286 ((> (prefix-numeric-value arg) 0) 1)
1289 (defun ampc-playlist (&optional at-point)
1290 (ampc-with-buffer 'playlists
1291 (if (and (not at-point)
1292 (search-forward-regexp "^* \\(.*\\)$" nil t))
1293 (let ((result (match-string 1)))
1294 (set-text-properties 0 (length result) nil result)
1297 (buffer-substring-no-properties
1298 (+ (line-beginning-position) 2)
1299 (line-end-position))))))
1301 (cl-defun ampc-mark-impl (select N &aux result (inhibit-read-only t))
1302 (when (eq (car ampc-type) 'playlists)
1303 (cl-assert (or (not select) (null N) (eq N 1)))
1304 (ampc-with-buffer 'playlists
1305 (cl-loop while (search-forward-regexp "^\\* " nil t)
1306 do (replace-match " " nil nil))))
1307 (cl-loop repeat (or N 1)
1309 do (move-beginning-of-line nil)
1311 (insert (if select "*" " "))
1312 (setf result (ampc-next-line nil)))
1313 (ampc-post-mark-change-update)
1316 (defun ampc-post-mark-change-update ()
1317 (cl-ecase (car ampc-type)
1318 ((current-playlist playlist outputs))
1320 (ampc-update-playlist))
1324 (cl-loop for w on (ampc-normalize-windows)
1325 thereis (when (or (eq (car w) (selected-window))
1326 (and (eq (car ampc-type) 'tag)
1327 (eq (with-current-buffer
1328 (window-buffer (car w))
1332 do (with-current-buffer (window-buffer w)
1333 (when (memq (car ampc-type) '(song tag))
1334 (ampc-set-dirty t))))
1335 (ampc-fill-tag-song))
1337 (ampc-tagger-update))))
1339 (cl-defun ampc-tagger-get-values (tag all-files &aux result)
1340 (ampc-with-buffer 'files-list
1346 `(let ((value (cdr (assq tag (get-text-property (point) 'data)))))
1347 (unless (member value result)
1348 (push value result)))))
1350 (cl-loop until (eobp)
1351 initially do (goto-char (point-min))
1354 until (ampc-next-line))
1355 (ampc-with-selection nil
1359 (defun ampc-tagger-update ()
1360 (ampc-with-buffer 'tagger
1362 while (search-forward-regexp (concat "^[ \t]*\\("
1363 (mapconcat #'symbol-name
1367 "[ \t]*\\(<keep>[ \t]*?\\)"
1371 for tag = (intern (match-string 1))
1372 do (when (memq tag ampc-tagger-tags)
1373 (let ((values (save-match-data (ampc-tagger-get-values tag nil))))
1374 (when (eq (length values) 1)
1375 (replace-match (car values) nil t nil 2)))))))
1377 (defun ampc-tagger-complete-tag ()
1380 (narrow-to-region (line-beginning-position) (line-end-position))
1381 (unless (search-backward-regexp "^.*:" nil t)
1382 (when (search-backward-regexp "\\(^\\|[ \t]\\).*" nil t)
1383 (when (looking-at "[ \t]")
1386 (search-forward-regexp ":\\|$")
1387 (mapcar (lambda (tag) (concat (symbol-name tag) ":"))
1388 ampc-tagger-tags)))))))
1390 (cl-defun ampc-tagger-complete-value (&aux tag)
1393 (narrow-to-region (line-beginning-position) (line-end-position))
1395 (unless (search-backward-regexp (concat "^[ \t]*\\("
1396 (mapconcat #'symbol-name
1401 (cl-return-from ampc-tagger-complete-tag))
1402 (setf tag (intern (match-string 1))))
1404 (search-backward-regexp "[: \t]")
1407 (search-forward-regexp "[ \t]\\|$")
1408 (let ((values (cons "<keep>" (ampc-tagger-get-values
1410 ampc-tagger-completion-all-files))))
1411 (when (eq tag 'Genre)
1412 (cl-loop for g in ampc-tagger-genres
1413 do (unless (member g values)
1417 (defun ampc-align-point ()
1419 (move-beginning-of-line nil)
1421 (re-search-forward " *" nil t)))
1423 (cl-defun ampc-pad (tabs &optional dont-honour-item-mode)
1424 (cl-loop with new-tab-stop-list
1425 with offset-dec = (if (and (not dont-honour-item-mode)
1426 (derived-mode-p 'ampc-item-mode))
1430 for offset-cell on (if (derived-mode-p 'ampc-item-mode)
1432 (cons 0 tab-stop-list))
1433 for offset = (car offset-cell)
1434 for props in (or (plist-get (cdr ampc-type) :properties)
1436 by (lambda (cell) (or (cdr cell) '(nil . nil)))
1437 do (cl-decf offset offset-dec)
1439 with current-offset = 0
1440 when (<= current-offset offset)
1441 do (when (and (not first) (eq (- offset current-offset) 0))
1443 and concat (make-string (- offset current-offset) ? ) into result
1444 and do (setf current-offset offset)
1446 concat " " into result
1447 and do (cl-incf current-offset)
1451 (when (and (plist-get (cdr props) :shrink)
1453 (>= (+ current-offset (length tab) 1) (- (cadr offset-cell)
1455 (setf tab (concat (substring tab 0 (max (- (cadr offset-cell)
1461 concat tab into result
1462 do (push (+ current-offset offset-dec) new-tab-stop-list)
1463 (cl-incf current-offset (length tab))
1466 (if (equal (cl-callf nreverse new-tab-stop-list) tab-stop-list)
1468 (propertize result 'tab-stop-list new-tab-stop-list))))
1470 (defun ampc-update-header ()
1471 (when (or (memq (car ampc-type) '(tag playlists))
1472 (plist-get (cdr ampc-type) :properties))
1473 (setf header-line-format
1475 (make-string (floor (fringe-columns 'left t)) ? )
1476 (cl-ecase (car ampc-type)
1478 (concat " " (plist-get (cdr ampc-type) :tag)))
1482 (ampc-pad (cl-loop for (name . props) in
1483 (plist-get (cdr ampc-type) :properties)
1484 collect (or (plist-get props :title) name))
1487 (defun ampc-set-dirty (tag-or-dirty &optional dirty)
1488 (if (or (null tag-or-dirty) (memq tag-or-dirty '(t erase keep-dirty)))
1489 (setf ampc-dirty tag-or-dirty)
1490 (cl-loop for w in (ampc-normalize-windows)
1491 do (with-current-buffer (window-buffer w)
1492 (when (eq (car ampc-type) tag-or-dirty)
1493 (ampc-set-dirty dirty))))))
1495 (defun ampc-update ()
1497 (cl-loop for w in (ampc-normalize-windows)
1498 do (with-current-buffer (window-buffer w)
1499 (when (and ampc-dirty (not (eq ampc-dirty 'keep-dirty)))
1500 (cl-ecase (car ampc-type)
1502 (ampc-send-command 'outputs))
1504 (ampc-update-playlist))
1506 (if (assoc (ampc-tags) ampc-internal-db)
1507 (ampc-fill-tag-song)
1508 (push (cons (ampc-tags) nil) ampc-internal-db)
1509 (ampc-set-dirty 'tag 'keep-dirty)
1510 (ampc-set-dirty 'song 'keep-dirty)
1511 (ampc-send-command 'listallinfo)))
1513 (ampc-send-command 'status)
1514 (ampc-send-command 'currentsong))
1516 (ampc-send-command 'listplaylists))
1518 (ampc-send-command 'playlistinfo))))))
1519 (ampc-send-command 'status)
1520 (ampc-send-command 'currentsong)))
1522 (defun ampc-update-playlist ()
1523 (ampc-with-buffer 'playlists
1524 (if (search-forward-regexp "^\\* " nil t)
1525 (ampc-send-command 'listplaylistinfo
1527 (get-text-property (point) 'data))
1528 (ampc-with-buffer 'playlist
1530 (ampc-set-dirty nil)))))
1532 (defun ampc-send-command-impl (command)
1534 (message "ampc: -> %s" command))
1536 (process-send-string ampc-connection (concat command "\n"))))
1538 (cl-defun ampc-send-command (command &optional props &rest args)
1539 (cl-destructuring-bind (&key (front nil) (keep-prev nil) (full-remove nil)
1540 (remove-other nil) &allow-other-keys
1543 (when (and (not keep-prev)
1544 (eq (caar ampc-outstanding-commands) command)
1545 (equal (cl-cddar ampc-outstanding-commands) args))
1546 (cl-return-from ampc-send-command))
1547 (unless ampc-working-timer
1549 ampc-working-timer (run-at-time nil 0.1 'ampc-yield)))
1550 (when (equal (caar ampc-outstanding-commands) 'idle)
1551 (pop ampc-outstanding-commands)
1553 (when (and (not keep-prev) (cdr ampc-outstanding-commands))
1554 (setf (cdr ampc-outstanding-commands)
1555 (cl-loop for other-cmd in (cdr ampc-outstanding-commands)
1556 unless (and (memq (car other-cmd) (list command remove-other))
1557 (or (not full-remove)
1559 (cl-assert (null remove-other))
1560 (equal (cddr other-cmd) args))))
1563 (setf command (apply #'list command props args))
1565 (push command ampc-outstanding-commands)
1566 (setf ampc-outstanding-commands
1567 (nconc ampc-outstanding-commands
1570 (push '(noidle nil) ampc-outstanding-commands)
1571 (ampc-send-command-impl "noidle"))))
1573 (defun ampc-send-next-command ()
1574 (cl-loop while ampc-outstanding-commands
1576 (cl-loop for command = (car ampc-outstanding-commands)
1577 for command-id = (replace-regexp-in-string
1579 (symbol-name (car command)))
1582 (ampc-send-command-impl
1584 (cl-loop for a in (cddr command)
1586 do (when (functionp a)
1587 (cl-callf funcall a))
1588 concat (cl-etypecase a
1589 (integer (number-to-string a))
1591 (let ((callback (plist-get (cl-cadar ampc-outstanding-commands)
1593 (old-head (pop ampc-outstanding-commands)))
1594 (when callback (funcall callback))
1595 (push old-head ampc-outstanding-commands))
1597 do (pop ampc-outstanding-commands)
1598 while ampc-outstanding-commands)
1600 while (let ((member (memq (intern command) ampc-synchronous-commands)))
1602 (not (eq (car ampc-synchronous-commands) t))
1603 (eq (car ampc-synchronous-commands) t)))
1604 do (cl-loop with head = ampc-outstanding-commands
1605 with ampc-no-implicit-next-dispatch = t
1606 with ampc-yield-redisplay = t
1608 while (eq head ampc-outstanding-commands)
1609 do (accept-process-output ampc-connection 0 100)))
1610 (unless ampc-outstanding-commands
1611 (when ampc-working-timer
1612 (cancel-timer ampc-working-timer)
1613 (setf ampc-yield nil
1614 ampc-working-timer nil)
1616 (setf ampc-outstanding-commands '((idle nil)))
1617 (ampc-send-command-impl "idle")))
1619 (defun ampc-tree< (a b)
1620 (string< (car a) (car b)))
1622 (defun ampc-create-tree ()
1623 (avl-tree-create 'ampc-tree<))
1625 (defsubst ampc-extract (regexp)
1626 (goto-char (point-min))
1627 (when (search-forward-regexp regexp nil t)
1630 (defsubst ampc-clean-tag (tag value)
1632 (let ((func (cdr (assoc tag ampc-tag-transform-funcs))))
1634 (funcall func value)
1636 (unless (equal tag "Track")
1637 "[Not Specified]")))
1639 (defun ampc-insert (element data &optional cmp cmp-data)
1640 (goto-char (point-min))
1642 (setf cmp-data data))
1645 (cl-loop until (eobp)
1646 for tp = (get-text-property (+ (point) 2) 'cmp-data)
1647 thereis (let ((r (funcall cmp cmp-data tp)))
1652 finally return 'insert)
1653 (cl-loop with stringp-cmp-data = (stringp cmp-data)
1655 with max = (1+ (count-lines (point-min) (point-max)))
1657 do (when (< (- max min) 20)
1659 (forward-line (- min max)))
1660 (cl-return (cl-loop repeat (- max min)
1661 for tp = (get-text-property (+ (point) 2)
1664 (if (equal tp cmp-data)
1666 (unless (if stringp-cmp-data
1667 (string< tp cmp-data)
1669 (buffer-substring-no-properties
1671 (line-end-position))
1675 finally return 'insert)))
1676 do (forward-line (funcall (if at-min #'+ #'-)
1678 for tp = (get-text-property (+ (point) 2) 'cmp-data)
1679 thereis (when (equal tp cmp-data) 'update)
1680 do (if (setf at-min (if stringp-cmp-data
1681 (string< tp cmp-data)
1682 (string< (buffer-substring-no-properties
1684 (line-end-position))
1686 (cl-incf min (floor (/ (- max min) 2.0)))
1687 (cl-decf max (floor (/ (- max min) 2.0))))
1688 finally return 'insert))))
1691 (insert (propertize (concat " " element "\n")
1692 'data (if (eq cmp t) (list data) data)
1693 'cmp-data cmp-data)))
1695 (remove-text-properties (point) (1+ (point)) '(not-updated))
1696 (when (or (eq ampc-dirty 'erase) (eq action 'overwrite))
1697 (let ((origin (point)))
1700 (insert element "\n")
1701 (goto-char origin)))
1702 (let ((next (1+ (line-end-position))))
1703 (put-text-property (point) next 'cmp-data cmp-data)
1706 'data (cond ((eq cmp t)
1707 (let ((rest (get-text-property (point) 'data)))
1708 (if (memq data rest)
1712 (eq (char-after) ?*)))))
1714 (defun ampc-fill-tag (trees)
1715 (put-text-property (point-min) (point-max) 'data nil)
1716 (cl-loop with new-trees
1721 (when (ampc-insert (car e) (cdr e) t (car e))
1722 (push (cdr e) new-trees)))
1724 finally return new-trees))
1726 (defun ampc-fill-song (trees)
1729 do (cl-loop for song in songs
1732 (cl-loop for (p . v) in (plist-get (cdr ampc-type) :properties)
1733 collect (cdr (assoc p song))))
1736 (defsubst ampc-narrow-entry (delimiter-regexp)
1739 (line-beginning-position)
1741 (goto-char (line-end-position))
1742 (when (search-forward-regexp delimiter-regexp nil t)
1743 (setf result (point))
1744 (1- (line-beginning-position))))
1748 (defun ampc-fill-playlist ()
1749 (ampc-fill-skeleton 'playlist
1751 (ampc-iterate-source-output "file" (file)
1752 (cl-loop for (tag . tag-regexp) in tags
1753 collect (ampc-clean-tag tag (ampc-extract tag-regexp)))
1755 (index . ,(1- (cl-incf index))))
1756 'ampc-int-insert-cmp
1759 (defun ampc-fill-outputs ()
1760 (ampc-fill-skeleton 'outputs
1761 (ampc-iterate-source-output "outputid" (outputid outputenabled)
1762 (cl-loop for (tag . tag-regexp) in tags
1763 collect (ampc-clean-tag tag (ampc-extract tag-regexp)))
1764 `(("outputid" . ,outputid)
1765 ("outputenabled" . ,outputenabled)))))
1767 (cl-defun ampc-mini-impl (&aux songs)
1768 (ampc-iterate-source
1773 (Pos (string-to-number (ampc-extract (ampc-extract-regexp "Pos")))))
1774 (let ((entry (cons (concat Title
1776 (concat " - " Artist)))
1778 (cl-loop with mentry = (cons (car entry) (cdr entry))
1780 while (assoc (car mentry) songs)
1781 do (setf (car mentry) (concat (car entry)
1782 " (" (int-to-string index) ")"))
1783 finally do (push mentry songs))))
1785 (message "No song in the playlist")
1786 (cl-return-from ampc-mini-impl))
1787 (let ((song (assoc (let ((inhibit-quit t))
1790 (completing-read "Song to play: " songs nil t))
1791 (setf quit-flag nil)))
1794 (ampc-play-this (cdr song)))))
1796 (defun ampc-fill-current-playlist ()
1797 (ampc-fill-skeleton 'current-playlist
1798 (ampc-iterate-source-output
1800 (file (pos (string-to-number (ampc-extract
1801 (ampc-extract-regexp "Pos")))))
1802 (cl-loop for (tag . tag-regexp) in tags
1803 collect (ampc-clean-tag tag (ampc-extract tag-regexp)))
1806 'ampc-int-insert-cmp
1809 (defun ampc-fill-playlists ()
1810 (ampc-fill-skeleton 'playlists
1811 (with-current-buffer data-buffer
1812 (cl-loop while (search-forward-regexp "^playlist: \\(.*\\)$" nil t)
1813 for playlist = (match-string 1)
1814 do (ampc-with-buffer 'playlists
1815 (ampc-insert playlist playlist)))))
1816 (ampc-set-dirty 'playlist t)
1819 (defun ampc-yield ()
1820 (cl-incf ampc-yield)
1822 (when ampc-yield-redisplay
1825 (defun ampc-fill-status ()
1826 (ampc-with-buffer 'status
1828 (funcall (or (plist-get (cadr ampc-type) :filler)
1830 (insert (ampc-status t) "\n")))
1832 (ampc-set-dirty nil)))
1834 (defun ampc-fill-tag-song ()
1836 with trees = (list (cdr (assoc (ampc-tags) ampc-internal-db)))
1837 for type in '(tag song)
1840 for w in (ampc-normalize-windows)
1842 (with-current-buffer (window-buffer w)
1843 (when (eq (car ampc-type) type)
1845 (if (and (not trees) (not (eq ampc-dirty 'keep-dirty)))
1847 (let ((inhibit-read-only t))
1849 (ampc-set-dirty nil))
1850 (ampc-fill-skeleton w
1852 (setf trees (ampc-fill-tag trees))
1853 (ampc-fill-song trees))))
1856 (goto-char (point-min))
1857 (cl-loop while (search-forward-regexp "^* " nil t)
1858 do (cl-callf append trees
1859 (get-text-property (point) 'data))))))))))
1861 (defun ampc-transform-track (track)
1862 (when (eq (length track) 1)
1863 (setf track (concat "0" track)))
1866 (cl-defun ampc-transform-time (data &aux (time (string-to-number data)))
1867 (concat (number-to-string (/ time 60))
1869 (when (< (% time 60) 10)
1871 (number-to-string (% time 60))))
1873 (defun ampc-handle-idle ()
1874 (cl-loop until (eobp)
1875 for subsystem = (buffer-substring (point) (line-end-position))
1876 do (when (string-match "^changed: \\(.*\\)$" subsystem)
1877 (cl-case (intern (match-string 1 subsystem))
1879 (setf ampc-internal-db (list (cons (ampc-tags) nil)))
1880 (ampc-set-dirty 'tag 'keep-dirty)
1881 (ampc-set-dirty 'song 'keep-dirty)
1882 (ampc-send-command 'listallinfo))
1884 (ampc-set-dirty 'outputs t))
1885 ((player options mixer)
1886 (setf ampc-status nil)
1887 (ampc-set-dirty 'status t))
1889 (ampc-set-dirty 'playlists t))
1891 (ampc-set-dirty 'current-playlist t)
1892 (ampc-set-dirty 'status t))))
1896 (defun ampc-handle-setup (status)
1897 (unless (and (string-match "^ MPD \\(.+\\)\\.\\(.+\\)\\.\\(.+\\)$"
1899 (let ((version-a (string-to-number (match-string 1 status)))
1900 (version-b (string-to-number (match-string 2 status)))
1901 ;; (version-c (string-to-number (match-string 2 status)))
1904 (>= version-b 15))))
1905 (error (concat "Your version of MPD is not supported. "
1906 "ampc supports MPD protocol version 0.15.0 "
1909 (defun ampc-fill-internal-db (running)
1910 (cl-loop with tree = (assoc (ampc-tags) ampc-internal-db)
1912 (cl-loop for w in (ampc-normalize-windows)
1913 for props = (with-current-buffer (window-buffer w)
1914 (when (eq (car ampc-type) 'tag)
1916 (plist-get (cdr ampc-type) :tag)))
1920 with song-props = (ampc-with-buffer 'song
1922 (plist-get (cdr ampc-type) :properties))
1923 for origin = (and (search-forward-regexp "^file: " nil t)
1924 (line-beginning-position))
1927 do (goto-char (1+ origin))
1928 for next = (and (search-forward-regexp "^file: " nil t)
1929 (line-beginning-position))
1930 while (or (not running) next)
1931 do (save-restriction
1932 (narrow-to-region origin (or next (point-max)))
1933 (ampc-fill-internal-db-entry tree tags song-props))
1935 (delete-region origin next)
1936 (setf next origin))))
1939 (cl-loop for w in (ampc-normalize-windows)
1940 for tag = (with-current-buffer (window-buffer w)
1941 (when (eq (car ampc-type) 'tag)
1942 (plist-get (cdr ampc-type) :tag)))
1947 (defun ampc-fill-internal-db-entry (tree tags song-props)
1948 (cl-loop for tag in tags
1949 for data = (ampc-clean-tag tag (ampc-extract (ampc-extract-regexp tag)))
1950 do (unless (cdr tree)
1951 (setf (cdr tree) (ampc-create-tree)))
1952 (setf tree (avl-tree-enter (cdr tree)
1956 (push (cons (cons "file" (ampc-extract (ampc-extract-regexp "file")))
1957 (cl-loop for p in song-props
1958 for data = (ampc-clean-tag (car p)
1960 (ampc-extract-regexp (car p))))
1962 collect (cons (car p) data)
1966 (defun ampc-fill-status-var (tags)
1967 (cl-loop for k in tags
1968 for v = (ampc-extract (ampc-extract-regexp k))
1971 (setf (cdr (or (assq s ampc-status)
1972 (car (push (cons s nil) ampc-status))))
1974 (cl-callf2 assq-delete-all s ampc-status))))
1976 (defun ampc-handle-current-song ()
1977 (ampc-fill-status-var (append ampc-status-tags '("Artist" "Title" "file")))
1979 (run-hook-with-args ampc-status-changed-hook ampc-status))
1981 (defun ampc-handle-status ()
1982 (ampc-fill-status-var '("volume" "repeat" "random" "consume" "xfade" "state"
1983 "song" "playlistlength"))
1984 (ampc-with-buffer 'current-playlist
1985 (when ampc-highlight-current-song-mode
1986 (font-lock-fontify-buffer)))
1987 (run-hook-with-args ampc-status-changed-hook ampc-status))
1989 (defun ampc-handle-update ()
1990 (message "Database update started"))
1992 (defun ampc-handle-command (status)
1995 (pop ampc-outstanding-commands))
1996 ((eq status 'running)
1997 (cl-case (caar ampc-outstanding-commands)
1998 (listallinfo (ampc-fill-internal-db t))))
2000 (let ((command (pop ampc-outstanding-commands)))
2001 (cl-case (car command)
2005 (ampc-handle-setup status))
2007 (ampc-handle-current-song))
2009 (ampc-handle-status))
2011 (ampc-handle-update))
2013 (ampc-fill-playlist))
2015 (ampc-fill-playlists))
2017 (ampc-fill-current-playlist))
2022 (shuffle-listplaylistinfo
2023 (ampc-shuffle-playlist (plist-get (cadr command) :playlist)))
2025 (ampc-handle-listallinfo))
2027 (ampc-fill-outputs))))
2028 (unless ampc-outstanding-commands
2031 (cl-defun ampc-shuffle-playlist (playlist &aux songs)
2032 (ampc-iterate-source nil "file" (file)
2033 (push (cons file (random)) songs))
2034 (ampc-send-command 'playlistclear '(:full-remove t) (ampc-quote playlist))
2035 (cl-loop for file in (mapcar #'car (sort songs
2036 (lambda (a b) (< (cdr a) (cdr b)))))
2037 do (ampc-send-command 'playlistadd
2039 (ampc-quote playlist)
2043 (defun ampc-handle-listallinfo ()
2044 (ampc-fill-internal-db nil)
2045 (ampc-set-dirty 'tag t)
2046 (ampc-set-dirty 'song t))
2048 (defun ampc-filter (_process string)
2049 (cl-assert (buffer-live-p (process-buffer ampc-connection)))
2050 (with-current-buffer (process-buffer ampc-connection)
2052 (when (and ampc-debug (not (eq ampc-debug t)))
2053 (message "ampc: <- %s" string))
2054 (goto-char (process-mark ampc-connection))
2056 (set-marker (process-mark ampc-connection) (point)))
2058 (goto-char (point-min))
2061 (when (search-forward-regexp
2062 "^ACK \\[\\(.*\\)\\] {.*} \\(.*\\)\n\\'"
2065 (message "ampc command error: %s (%s; %s)"
2068 (funcall (if ampc-debug #'identity #'car)
2069 (car ampc-outstanding-commands)))
2071 (when (search-forward-regexp "^OK\\(.*\\)\n\\'" nil t)
2074 (let ((match-end (match-end 0)))
2076 (narrow-to-region (point-min) match-end)
2077 (goto-char (point-min))
2078 (ampc-handle-command (if success (match-string 1) 'error)))
2079 (delete-region (point-min) match-end))
2080 (unless ampc-no-implicit-next-dispatch
2081 (ampc-send-next-command))))
2082 (ampc-handle-command 'running)))))
2084 (cl-defun ampc-set-tab-offsets
2085 (&rest properties &aux (min 2) (optional-padding 0))
2087 (cl-return-from ampc-set-tab-offsets))
2088 (set (make-local-variable 'tab-stop-list) nil)
2089 (cl-loop for (_title . props) in properties
2090 for min- = (plist-get props :min)
2091 do (cl-incf min (or (plist-get props :width) min-))
2093 (cl-incf optional-padding (- (plist-get props :max) min-))))
2094 (cl-loop for (_title . props) in properties
2096 do (push offset tab-stop-list)
2097 (cl-incf offset (or (plist-get props :width)
2098 (let ((min- (plist-get props :min))
2099 (max (plist-get props :max)))
2100 (if (>= min (window-width))
2104 (floor (* (/ (float (- max min-))
2108 (cl-callf nreverse tab-stop-list))
2110 (cl-defun ampc-configure-frame-1 (split &aux (split-type (car split)))
2111 (if (memq split-type '(vertical horizontal))
2113 (cl-loop with length = (if (eq split-type 'horizontal)
2114 (window-total-width)
2115 (window-total-height))
2118 for (size . subsplit) in (cdr split)
2119 do (if (equal size 1.0)
2120 (progn (push t sizes)
2121 (setf rest-car sizes))
2122 (let ((l (if (integerp size) size (round (* size length)))))
2125 finally do (setf (car rest-car) rest))
2126 (let ((first-window (selected-window)))
2127 (cl-callf nreverse sizes)
2128 (cl-loop for size in (copy-sequence sizes)
2129 for window on (cdr sizes)
2132 (split-window nil size (eq split-type 'horizontal)))))
2133 (setf (car sizes) first-window))
2134 (cl-loop for subsplit in (cdr split)
2137 do (with-selected-window window
2139 (or (ampc-configure-frame-1 (cdr subsplit)) result)))
2140 finally return result))
2141 (setf (window-dedicated-p (selected-window)) nil)
2142 (pop-to-buffer-same-window
2145 (mapconcat (lambda (s) (concat (upcase (substring s 0 1))
2147 (if (memq split-type '(tag song))
2148 (list (or (plist-get (cdr split) :tag) "song"))
2149 (split-string (symbol-name split-type) "-"))
2152 (if (memq split-type '(tag song))
2153 (ampc-tag-song-mode)
2154 (let ((mode (intern (concat "ampc-" (symbol-name split-type) "-mode"))))
2155 (unless (fboundp mode)
2156 (setf mode 'ampc-mode))
2157 (unless (eq major-mode 'mode) ;FIXME: This quote looks spurious!
2159 (cl-destructuring-bind
2160 (&key (properties nil) (dedicated t) (mode-line t) &allow-other-keys)
2162 (apply #'ampc-set-tab-offsets properties)
2163 (setf ampc-type split
2164 (window-dedicated-p (selected-window)) dedicated
2165 mode-line-format (when mode-line
2166 (default-value 'mode-line-format))))
2167 (set (make-local-variable 'mode-line-buffer-identification)
2168 '(:eval (let ((result
2169 (concat (car-safe (propertized-buffer-identification
2172 " [Updating...]"))))
2173 (if (< (length result) 12)
2174 (concat result (make-string (- 12 (length result)) ? ))
2176 (ampc-update-header)
2177 (add-to-list 'ampc-all-buffers (current-buffer))
2178 (push (cons (or (plist-get (cdr split) :id) 9999) (selected-window))
2181 (when (plist-get (cdr split) :select)
2182 (selected-window))))
2184 (cl-defun ampc-configure-frame
2185 (split &optional no-update &aux (old-selection ampc-type) old-window-starts)
2186 (cl-loop for w in (ampc-normalize-windows)
2187 do (with-selected-window w
2188 (with-current-buffer (window-buffer w)
2189 (push (cons (current-buffer) (window-start))
2190 old-window-starts))))
2191 (if (not ampc-use-full-frame)
2192 (ampc-restore-window-configuration)
2193 (setf (window-dedicated-p (selected-window)) nil)
2194 (delete-other-windows))
2195 (setf ampc-windows nil)
2196 (let ((select-window (ampc-configure-frame-1 split)))
2198 (mapcar (lambda (window)
2199 (cons window (window-buffer window)))
2200 (mapcar #'cdr (sort ampc-windows
2201 (lambda (a b) (< (car a) (car b)))))))
2202 (cl-loop for w in (ampc-normalize-windows)
2203 do (with-selected-window w
2204 (let ((old-window-start (cdr (assq (current-buffer)
2205 old-window-starts))))
2206 (when old-window-start
2207 (set-window-start nil old-window-start)))
2208 (when (and (derived-mode-p 'ampc-item-mode)
2209 (> (length tab-stop-list) 1))
2210 (ampc-set-dirty 'erase))))
2211 (select-window (or (cl-loop for w in (ampc-normalize-windows)
2213 (when (equal (with-current-buffer (window-buffer w)
2218 (selected-window))))
2222 (defun ampc-tagger-rename-artist-title (_changed-tags data)
2223 "Rename music file according to its tags.
2224 This function is meant to be inserted into
2225 `ampc-tagger-stored-hook'. The new file name is
2226 `Artist'_-_`Title'.`extension'. Characters within `Artist' and
2227 `Title' that are not alphanumeric are substituted with underscore."
2228 (let* ((artist (replace-regexp-in-string
2230 (or (cdr (assq 'Artist (cdr data))) "")))
2231 (title (replace-regexp-in-string
2233 (or (cdr (assq 'Title (cdr data))) "")))
2235 (expand-file-name (replace-regexp-in-string
2239 (when (and (> (length artist) 0)
2240 (> (length title) 0))
2243 (file-name-extension (car data) t)))
2244 (file-name-directory (car data)))))
2245 (unless (equal (car data) new-file)
2246 (ampc-tagger-log "Renaming file " (abbreviate-file-name (car data))
2247 " to " (abbreviate-file-name new-file) "\n")
2248 (rename-file (car data) new-file)
2249 (setf (car data) new-file))))
2251 ;;; *** interactives
2252 (defun ampc-tagger-completion-at-point (&optional all-files)
2253 "Perform completion at point via `completion-at-point'.
2254 If optional prefix argument ALL-FILES is non-nil, use all files
2255 within the files list buffer as source for completion. The
2256 default behaviour is to use only the selected ones."
2258 (let ((ampc-tagger-completion-all-files all-files))
2259 (completion-at-point)))
2261 (defun ampc-tagger-reset (&optional reset-all-tags)
2262 "Reset all tag values within the tagger, based on the selection of files.
2263 If optional prefix argument RESET-ALL-TAGS is non-nil, restore
2266 (when reset-all-tags
2267 (ampc-with-buffer 'tagger
2270 (cl-loop for tag in ampc-tagger-tags
2271 do (insert (ampc-pad (list (concat (symbol-name tag) ":") "dummy"))
2273 (goto-char (point-min))
2274 (re-search-forward ":\\( \\)+")))
2275 (ampc-with-buffer 'tagger
2276 (cl-loop while (search-forward-regexp
2277 (concat "^\\([ \t]*\\)\\("
2278 (mapconcat #'symbol-name ampc-tagger-tags "\\|")
2279 "\\)\\([ \t]*\\):\\([ \t]*.*\\)$")
2282 do (replace-match "" nil nil nil 1)
2283 (replace-match "" nil nil nil 3)
2284 (replace-match (concat (make-string (- (car tab-stop-list)
2285 (1+ (length (match-string 2))))
2289 (ampc-tagger-update)
2290 (ampc-with-buffer 'tagger
2292 (when (looking-at "[ \t]+")
2293 (goto-char (match-end 0)))))
2295 (cl-defun ampc-tagger-save (&optional quit &aux tags)
2297 If optional prefix argument QUIT is non-nil, quit tagger
2298 afterwards. If the numeric value of QUIT is 16, quit tagger and
2299 do not trigger a database update"
2301 (ampc-with-buffer 'tagger
2302 (cl-loop do (cl-loop until (eobp)
2303 while (looking-at "^[ \t]*$")
2306 do (unless (and (looking-at
2307 (concat "^[ \t]*\\("
2308 (mapconcat #'symbol-name
2312 "[ \t]*\\(.*\\)[ \t]*$"))
2313 (not (assq (intern (match-string 1)) tags)))
2314 (error "Malformed line \"%s\""
2315 (buffer-substring (line-beginning-position)
2316 (line-end-position))))
2317 (push (cons (intern (match-string 1))
2318 (let ((val (match-string 2)))
2319 (if (string= "<keep>" val)
2321 (set-text-properties 0 (length val) nil val)
2325 (cl-callf2 rassq-delete-all t tags)
2327 (cl-loop for (tag . value) in tags
2328 do (insert (symbol-name tag) "\n"
2330 (let ((input-buffer (current-buffer)))
2331 (ampc-with-buffer 'files-list
2334 (make-progress-reporter "Storing tags"
2336 (let ((count (count-matches "^\\* ")))
2341 (ampc-with-selection nil
2342 (let* ((data (get-text-property (point) 'data))
2343 (old-tags (cl-loop for (tag . data) in (cdr data)
2344 collect (cons tag data)))
2345 (found-changed (ampc-tagger-tags-modified (cdr data) tags)))
2346 (let ((pre-hook-tags (cdr data)))
2347 (run-hook-with-args 'ampc-tagger-store-hook found-changed data)
2350 (ampc-tagger-tags-modified pre-hook-tags
2354 "Storing tags for file "
2355 (abbreviate-file-name (car data)) "\n"
2357 (cl-loop for (tag . value) in old-tags
2358 concat (concat "\t\t"
2359 (symbol-name tag) ": "
2362 (cl-loop for (tag . value) in (cdr data)
2363 concat (concat "\t\t"
2364 (symbol-name tag) ": "
2366 (ampc-tagger-make-backup (car data))
2368 (list "--set" (car data))
2370 (insert-buffer-substring input-buffer)
2372 (call-process-region (point-min) (point-max)
2373 ampc-tagger-executable
2377 (message "ampc-tagger: %s"
2379 (point-min) (point))))))))
2380 (run-hook-with-args 'ampc-tagger-stored-hook found-changed data)
2381 (let ((inhibit-read-only t))
2382 (move-beginning-of-line nil)
2386 (ampc-pad (cl-loop for p in (plist-get (cdr ampc-type)
2388 when (eq (car p) 'filename)
2389 collect (file-name-nondirectory (car data))
2391 collect (cdr (assq (intern (car p))
2396 (put-text-property (line-beginning-position)
2397 (1+ (line-end-position))
2399 (progress-reporter-update reporter (cl-incf step))))
2400 (progress-reporter-done reporter)))))
2402 (ampc-tagger-quit (eq (prefix-numeric-value quit) 16))))
2404 (defun ampc-tagger-quit (&optional no-update)
2405 "Quit tagger and restore previous window configuration.
2406 With optional prefix NO-UPDATE, do not trigger a database update."
2408 (set-window-configuration (or (car-safe ampc-tagger-previous-configuration)
2409 ampc-tagger-previous-configuration))
2410 (when (car-safe ampc-tagger-previous-configuration)
2412 (ampc-trigger-update))
2413 (setf ampc-windows (cadr ampc-tagger-previous-configuration)))
2414 (setf ampc-tagger-previous-configuration nil))
2416 (defun ampc-move-to-tab ()
2417 "Move point to next logical tab stop."
2419 (let ((tab (cl-loop for tab in
2420 (or (get-text-property (point) 'tab-stop-list)
2422 while (>= (current-column) tab)
2423 finally return tab)))
2425 (goto-char (min (+ (line-beginning-position) tab) (line-end-position))))))
2427 (defun ampc-mouse-play-this (event)
2429 (select-window (posn-window (event-end event)))
2430 (goto-char (posn-point (event-end event)))
2433 (defun ampc-mouse-delete (event)
2435 (select-window (posn-window (event-end event)))
2436 (goto-char (posn-point (event-end event)))
2439 (defun ampc-mouse-add (event)
2441 (select-window (posn-window (event-end event)))
2442 (goto-char (posn-point (event-end event)))
2445 (defun ampc-mouse-delete-playlist (event)
2447 (select-window (posn-window (event-end event)))
2448 (goto-char (posn-point (event-end event)))
2449 (ampc-delete-playlist t))
2451 (defun ampc-mouse-load (event)
2453 (select-window (posn-window (event-end event)))
2454 (goto-char (posn-point (event-end event)))
2457 (defun ampc-mouse-toggle-output-enabled (event)
2459 (select-window (posn-window (event-end event)))
2460 (goto-char (posn-point (event-end event)))
2461 (ampc-toggle-output-enabled 1))
2463 (cl-defun ampc-mouse-toggle-mark (event &aux (inhibit-read-only t))
2465 (let ((window (posn-window (event-end event))))
2466 (when (with-selected-window window
2467 (goto-char (posn-point (event-end event)))
2469 (move-beginning-of-line nil)
2470 (ampc-mark-impl (not (eq (char-after) ?*)) 1)
2472 (select-window window))))
2474 (defun ampc-mouse-align-point (event)
2476 (select-window (posn-window (event-end event)))
2477 (goto-char (posn-point (event-end event)))
2480 (cl-defun ampc-unmark-all (&aux (inhibit-read-only t))
2483 (cl-assert (ampc-in-ampc-p t))
2485 (goto-char (point-min))
2486 (cl-loop while (search-forward-regexp "^\\* " nil t)
2487 do (replace-match " " nil nil)))
2488 (ampc-post-mark-change-update))
2490 (defun ampc-trigger-update ()
2491 "Trigger a database update."
2493 (cl-assert (ampc-on-p))
2494 (ampc-send-command 'update))
2496 (cl-defun ampc-toggle-marks (&aux (inhibit-read-only t))
2498 Marked entries become unmarked, and vice versa."
2500 (cl-assert (ampc-in-ampc-p t))
2502 (cl-loop for (a . b) in '(("* " . "T ")
2505 do (goto-char (point-min))
2506 (cl-loop while (search-forward-regexp (concat "^" (regexp-quote a))
2509 do (replace-match b nil nil))))
2510 (ampc-post-mark-change-update))
2512 (defun ampc-up (&optional arg)
2513 "Move selected entries ARG positions upwards.
2514 ARG defaults to one."
2516 (cl-assert (ampc-in-ampc-p))
2517 (ampc-move (- (or arg 1))))
2519 (defun ampc-down (&optional arg)
2520 "Move selected entries ARG positions downwards.
2521 ARG defaults to one."
2523 (cl-assert (ampc-in-ampc-p))
2524 (ampc-move (or arg 1)))
2526 (defun ampc-mark (&optional arg)
2527 "Mark the next ARG'th entries.
2530 (cl-assert (ampc-in-ampc-p t))
2531 (ampc-mark-impl t arg))
2533 (defun ampc-unmark (&optional arg)
2534 "Unmark the next ARG'th entries.
2537 (cl-assert (ampc-in-ampc-p t))
2538 (ampc-mark-impl nil arg))
2540 (defun ampc-set-volume (&optional arg)
2541 "Set volume to ARG percent.
2542 If ARG is nil, read ARG from minibuffer."
2544 (cl-assert (ampc-on-p))
2545 (ampc-set-volume-impl (or arg (read-number "Volume: "))))
2547 (defun ampc-increase-volume (&optional arg)
2548 "Increase volume by prefix argument ARG or, if ARG is nil,
2549 `ampc-volume-step'."
2551 (cl-assert (ampc-on-p))
2552 (ampc-set-volume-impl arg '+))
2554 (defun ampc-decrease-volume (&optional arg)
2555 "Decrease volume by prefix argument ARG or, if ARG is nil,
2556 `ampc-volume-step'."
2558 (cl-assert (ampc-on-p))
2559 (ampc-set-volume-impl arg '-))
2561 (defun ampc-set-crossfade (&optional arg)
2562 "Set crossfade to ARG seconds.
2563 If ARG is nil, read ARG from minibuffer."
2565 (cl-assert (ampc-on-p))
2566 (ampc-set-crossfade-impl (or arg (read-number "Crossfade: "))))
2568 (defun ampc-increase-crossfade (&optional arg)
2569 "Increase crossfade by prefix argument ARG or, if ARG is nil,
2570 `ampc-crossfade-step'."
2572 (cl-assert (ampc-on-p))
2573 (ampc-set-crossfade-impl arg '+))
2575 (defun ampc-decrease-crossfade (&optional arg)
2576 "Decrease crossfade by prefix argument ARG or, if ARG is nil,
2577 `ampc-crossfade-step'."
2579 (cl-assert (ampc-on-p))
2580 (ampc-set-crossfade-impl arg '-))
2582 (defun ampc-toggle-repeat (&optional arg)
2583 "Toggle MPD's repeat state.
2584 With prefix argument ARG, enable repeating if ARG is positive,
2585 otherwise disable it."
2587 (cl-assert (ampc-on-p))
2588 (ampc-toggle-state 'repeat arg))
2590 (defun ampc-toggle-consume (&optional arg)
2591 "Toggle MPD's consume state.
2592 With prefix argument ARG, enable consuming if ARG is positive,
2593 otherwise disable it.
2595 When consume is activated, each song played is removed from the playlist."
2597 (cl-assert (ampc-on-p))
2598 (ampc-toggle-state 'consume arg))
2600 (defun ampc-toggle-random (&optional arg)
2601 "Toggle MPD's random state.
2602 With prefix argument ARG, enable random playing if ARG is positive,
2603 otherwise disable it."
2605 (ampc-toggle-state 'random arg))
2607 (defun ampc-play-this (&optional arg)
2608 "Play selected song.
2609 With prefix argument ARG, play the ARG'th song located at the
2610 zero-indexed position of the current playlist."
2612 (cl-assert (and (ampc-on-p) (or arg (ampc-in-ampc-p))))
2615 (ampc-send-command 'play nil (1- (line-number-at-pos)))
2616 (ampc-send-command 'pause nil 0))
2617 (ampc-send-command 'play nil arg)
2618 (ampc-send-command 'pause nil 0)))
2620 (cl-defun ampc-toggle-play
2621 (&optional arg &aux (state (cdr (assq 'state ampc-status))))
2623 If MPD does not play a song already, start playing the song at
2624 point if the current buffer is the playlist buffer, otherwise
2625 start at the beginning of the playlist.
2627 If ARG is 4, stop player rather than pause if applicable."
2629 (cl-assert (ampc-on-p))
2631 (cl-return-from ampc-toggle-play))
2633 (setf arg (prefix-numeric-value arg)))
2634 (cl-ecase (intern state)
2636 (when (or (null arg) (> arg 0))
2639 '(:remove-other (pause))
2640 (if (and (eq (car ampc-type) 'current-playlist) (not (eobp)))
2641 (1- (line-number-at-pos))
2644 (when (or (null arg) (> arg 0))
2645 (ampc-send-command 'pause '(:remove-other (play)) 0)))
2647 (cond ((or (null arg) (< arg 0))
2648 (ampc-send-command 'pause '(:remove-other (play)) 1))
2650 (ampc-send-command 'stop))))))
2652 (defun ampc-next (&optional arg)
2654 With prefix argument ARG, skip ARG songs."
2656 (cl-assert (ampc-on-p))
2657 (ampc-skip (or arg 1)))
2659 (defun ampc-previous (&optional arg)
2660 "Play previous song.
2661 With prefix argument ARG, skip ARG songs."
2663 (cl-assert (ampc-on-p))
2664 (ampc-skip (- (or arg 1))))
2666 (defun ampc-rename-playlist (new-name)
2667 "Rename selected playlist to NEW-NAME.
2668 If NEW-NAME is nil, read NEW-NAME from the minibuffer."
2671 (setf new-name (read-from-minibuffer (concat "New name for playlist "
2674 (cl-assert (ampc-in-ampc-p))
2676 (ampc-send-command 'rename '(:full-remove t) (ampc-quote new-name))
2677 (message "No playlist selected")))
2679 (defun ampc-load (&optional at-point)
2680 "Load selected playlist in the current playlist.
2681 If optional argument AT-POINT is non-nil (or if no playlist is
2682 selected), use playlist at point rather than the selected one."
2684 (cl-assert (ampc-in-ampc-p))
2685 (if (ampc-playlist at-point)
2687 'load '(:keep-prev t)
2688 (ampc-quote (ampc-playlist at-point)))
2690 (message "No playlist at point")
2691 (message "No playlist selected"))))
2693 (defun ampc-toggle-output-enabled (&optional arg)
2694 "Toggle the next ARG outputs.
2695 If ARG is omitted, use the selected entries."
2697 (cl-assert (ampc-in-ampc-p))
2698 (ampc-with-selection arg
2699 (let ((data (get-text-property (point) 'data)))
2700 (ampc-send-command (if (equal (cdr (assoc "outputenabled" data)) "1")
2704 (cdr (assoc "outputid" data))))))
2706 (defun ampc-delete (&optional arg)
2707 "Delete the next ARG songs from the playlist.
2708 If ARG is omitted, use the selected entries. If ARG is non-nil,
2709 all marks after point are removed nontheless."
2711 (cl-assert (ampc-in-ampc-p))
2712 (let ((first-del nil))
2713 (ampc-with-selection arg
2714 (unless (or first-del (when arg (< arg 0)))
2715 (setf first-del (point)))
2716 (let ((val (1- (- (line-number-at-pos) (if (or (not arg) (> arg 0))
2719 (if (and (not (eq (car ampc-type) 'current-playlist)) (ampc-playlist))
2720 (ampc-send-command 'playlistdelete
2722 (ampc-quote (ampc-playlist))
2724 (ampc-send-command 'delete '(:keep-prev t) val))
2725 (ampc-mark-impl nil nil)))
2727 (goto-char first-del))))
2729 (defun ampc-shuffle ()
2732 (cl-assert (ampc-on-p))
2733 (if (and (not (eq (car ampc-type) 'current-playlist)) (ampc-playlist))
2734 (ampc-send-command 'shuffle-listplaylistinfo
2735 `(:playlist ,(ampc-playlist))
2736 (ampc-quote (ampc-playlist)))
2737 (ampc-send-command 'shuffle)))
2739 (defun ampc-clear ()
2742 (cl-assert (ampc-on-p))
2743 (if (and (not (eq (car ampc-type) 'current-playlist)) (ampc-playlist))
2744 (ampc-send-command 'playlistclear '(:full-remove t)
2745 (ampc-quote (ampc-playlist)))
2746 (ampc-send-command 'clear)))
2748 (defun ampc-add (&optional arg)
2749 "Add the songs associated with the next ARG entries after point
2751 If ARG is omitted, use the selected entries in the current buffer."
2753 (cl-assert (ampc-in-ampc-p))
2754 (ampc-with-selection arg
2757 (defun ampc-status (&optional no-print)
2758 "Display and return the information that is displayed in the status window.
2759 If optional argument NO-PRINT is non-nil, just return the text.
2760 If NO-PRINT is nil, the display may be delayed if ampc does not
2761 have enough information yet."
2763 (cl-assert (ampc-on-p))
2764 (unless (or ampc-status no-print)
2765 (ampc-send-command 'status)
2766 (ampc-send-command 'mini-currentsong)
2767 (cl-return-from ampc-status))
2768 (let* ((flags (mapconcat
2770 (cl-loop for (f . n) in '((repeat . "Repeat")
2772 (consume . "Consume"))
2773 when (equal (cdr (assq f ampc-status)) "1")
2777 (state (cdr (assq 'state ampc-status)))
2778 (status (concat "State: " state
2779 (when (and ampc-yield no-print)
2780 (concat (make-string (- 10 (length state)) ? )
2781 (nth (% ampc-yield 4) '("|" "/" "-" "\\"))))
2783 (when (equal state "play")
2787 (cdr (assq 'Artist ampc-status)))
2791 (cdr (assq 'Title ampc-status)))
2793 "Volume: " (cdr (assq 'volume ampc-status)) "\n"
2794 "Crossfade: " (cdr (assq 'xfade ampc-status))
2795 (unless (equal flags "")
2796 (concat "\n" flags)))))
2798 (message "%s" status))
2801 (defun ampc-delete-playlist (&optional at-point)
2802 "Delete selected playlist.
2803 If optional argument AT-POINT is non-nil (or if no playlist is
2804 selected), use playlist at point rather than the selected one."
2806 (cl-assert (ampc-in-ampc-p))
2807 (if (ampc-playlist at-point)
2808 (when (y-or-n-p (concat "Delete playlist " (ampc-playlist at-point) "?"))
2809 (ampc-send-command 'rm '(:full-remove t)
2810 (ampc-quote (ampc-playlist at-point))))
2812 (message "No playlist at point")
2813 (message "No playlist selected"))))
2815 (require 'dired) ;Needed to properly compile dired-map-over-marks.
2817 (defun ampc-tagger-dired (&optional arg)
2818 "Start the tagging subsystem on dired's marked files.
2819 With optional prefix argument ARG, use the next ARG files."
2821 (cl-assert (derived-mode-p 'dired-mode))
2823 (cl-loop for file in (dired-map-over-marks (dired-get-filename) arg)
2824 unless (file-directory-p file)
2829 (defun ampc-tag-files (files)
2830 "Start the tagging subsystem.
2831 FILES should be a list of absolute file names, the files to tag."
2833 (message "No files specified")
2834 (cl-return-from ampc-tagger-files t))
2835 (when (memq (car ampc-type) '(files-list tagger))
2836 (message "You are already within the tagger")
2837 (cl-return-from ampc-tagger-files t))
2838 (let ((reporter (make-progress-reporter "Grabbing tags" 0 (length files))))
2839 (cl-loop for file in-ref files
2841 do (run-hook-with-args 'ampc-tagger-grab-hook file)
2843 (ampc-tagger-call "--get" file)
2847 (cl-loop for tag in ampc-tagger-tags
2849 (cons tag (or (ampc-extract (ampc-extract-regexp
2852 (run-hook-with-args 'ampc-tagger-grabbed-hook file)
2853 (progress-reporter-update reporter i))
2854 (progress-reporter-done reporter))
2855 (unless ampc-tagger-previous-configuration
2856 (setf ampc-tagger-previous-configuration (current-window-configuration)))
2857 (ampc-configure-frame (cdr (assq 'tagger ampc-views)) t)
2858 (ampc-with-buffer 'files-list
2860 (cl-loop for (file . props) in files
2861 do (insert (propertize
2865 (cl-loop for p in (plist-get (cdr ampc-type) :properties)
2866 when (eq (car p) 'filename)
2867 collect (file-name-nondirectory file)
2869 collect (cdr (assq (intern (car p)) props))
2872 'data (cons file props))))
2873 (ampc-set-dirty nil)
2874 (ampc-toggle-marks))
2875 (ampc-with-buffer 'tagger
2877 (ampc-tagger-reset t)
2878 (goto-char (point-min))
2879 (search-forward-regexp ": *")
2880 (ampc-set-dirty nil))
2883 (cl-defun ampc-tagger (&optional arg &aux files)
2884 "Start the tagging subsystem.
2885 The files to tag are collected by using either the selected
2886 entries within the current buffer or the next ARG entries at
2887 point if numeric perfix argument ARG is non-nil, the file
2888 associated with the entry at point, or, if both sources did not
2889 provide any files, the audio file that is currently played by
2892 (cl-assert (ampc-in-ampc-p))
2893 (unless ampc-tagger-version-verified
2895 (ampc-tagger-call "--version")
2896 (goto-char (point-min))
2897 (let ((version (buffer-substring (line-beginning-position)
2898 (line-end-position))))
2899 (unless (equal version ampc-tagger-version)
2900 (message (concat "The reported version of %s is not supported - "
2901 "got \"%s\", want \"%s\"")
2902 ampc-tagger-executable
2904 ampc-tagger-version)
2905 (cl-return-from ampc-tagger))))
2906 (setf ampc-tagger-version-verified t))
2907 (unless ampc-tagger-genres
2909 (ampc-tagger-call "--genres")
2910 (cl-loop while (search-backward-regexp "^\\(.+\\)$" nil t)
2911 do (push (match-string 1) ampc-tagger-genres))))
2912 (unless ampc-tagger-music-directories
2913 (message (concat "ampc-tagger-music-directories is nil. Fill it via "
2914 "M-x customize-variable RET ampc-tagger-music-directories "
2916 (cl-return-from ampc-tagger))
2917 (cl-case (car ampc-type)
2920 (ampc-with-selection arg
2921 (cl-callf nconc files (list (cdr (assoc "file" (get-text-property
2924 ((playlist tag song)
2926 (ampc-with-selection arg
2927 (ampc-on-files (lambda (file) (push file files)))))
2928 (cl-callf nreverse files))
2930 (let ((file (cdr (assoc 'file ampc-status))))
2932 (setf files (list file))))))
2933 (cl-loop for file in-ref files
2934 for read-file = (locate-file file ampc-tagger-music-directories)
2935 do (unless read-file
2936 (error "Cannot locate file %s in ampc-tagger-music-directories"
2938 (cl-return-from ampc-tagger))
2939 (setf file (expand-file-name read-file)))
2940 (setf ampc-tagger-previous-configuration
2941 (list (current-window-configuration) ampc-windows))
2942 (when (ampc-tag-files files)
2943 (setf ampc-tagger-previous-configuration nil)))
2945 (defun ampc-store (&optional name-or-append)
2946 "Store current playlist as NAME-OR-APPEND.
2947 If NAME is non-nil and not a string, append selected entries
2948 within the current playlist buffer to the selected playlist. If
2949 NAME-OR-APPEND is a negative integer, append the next (-
2950 NAME-OR-APPEND) entries after point within the current playlist
2951 buffer to the selected playlist. If NAME-OR-APPEND is nil, read
2952 playlist name from the minibuffer."
2954 (cl-assert (ampc-in-ampc-p))
2955 (unless name-or-append
2956 (setf name-or-append (read-from-minibuffer "Save playlist as: ")))
2957 (if (stringp name-or-append)
2958 (ampc-send-command 'save '(:full-remove t) (ampc-quote name-or-append))
2959 (if (not (ampc-playlist))
2960 (message "No playlist selected")
2961 (ampc-with-buffer 'current-playlist
2962 (when name-or-append
2963 (cl-callf prefix-numeric-value name-or-append))
2964 (ampc-with-selection (if (and name-or-append (< name-or-append 0))
2970 (ampc-quote (ampc-playlist))
2971 (ampc-quote (cdr (assoc "file"
2972 (get-text-property (point) 'data))))))))))
2974 (cl-defun ampc-goto-current-song (&aux (song (cdr (assq 'song ampc-status))))
2975 "Select the current playlist window and move point to the current song."
2977 (cl-assert (ampc-in-ampc-p))
2978 (let ((window (ampc-with-buffer 'current-playlist
2979 (selected-window))))
2981 (select-window window)
2983 (goto-char (point-min))
2984 (forward-line (string-to-number song)))
2985 (ampc-align-point))))
2987 (defun ampc-previous-line (&optional arg)
2988 "Go to previous ARG'th entry in the current buffer.
2991 (cl-assert (ampc-in-ampc-p t))
2992 (ampc-next-line (* (or arg 1) -1)))
2994 (defun ampc-next-line (&optional arg)
2995 "Go to next ARG'th entry in the current buffer.
2998 (cl-assert (ampc-in-ampc-p t))
3001 (progn (forward-line -1)
3007 (cl-defun ampc-suspend (&optional (run-hook t))
3009 This function resets the window configuration, but does not close
3010 the connection to MPD or destroy the internal cache of ampc.
3011 This means subsequent startups of ampc will be faster."
3013 (when ampc-working-timer
3014 (cancel-timer ampc-working-timer))
3015 (ampc-restore-window-configuration)
3016 (cl-loop for b in ampc-all-buffers
3017 do (when (buffer-live-p b)
3019 (setf ampc-windows nil
3020 ampc-all-buffers nil
3021 ampc-working-timer nil)
3023 (run-hooks 'ampc-suspend-hook)))
3026 "Select song to play via `completing-read'."
3028 (cl-assert (ampc-on-p))
3029 (ampc-send-command 'mini-playlistinfo))
3031 (defun ampc-quit (&optional arg)
3033 If prefix argument ARG is non-nil, kill the MPD instance that
3034 ampc is connected to."
3037 (set-process-filter ampc-connection nil)
3038 (when (equal (car-safe ampc-outstanding-commands) '(idle nil))
3039 (ampc-send-command-impl "noidle")
3040 (with-current-buffer (process-buffer ampc-connection)
3041 (cl-loop do (goto-char (point-min))
3042 until (search-forward-regexp "^\\(ACK\\)\\|\\(OK\\).*\n\\'" nil t)
3044 do (accept-process-output ampc-connection nil 50))))
3045 (ampc-send-command-impl (if arg "kill" "close"))
3046 (delete-process ampc-connection))
3047 (when ampc-working-timer
3048 (cancel-timer ampc-working-timer))
3050 (setf ampc-connection nil
3051 ampc-internal-db nil
3052 ampc-outstanding-commands nil
3054 (run-hooks 'ampc-quit-hook))
3057 (defun ampc-suspended-p ()
3058 "Return non-nil if ampc is suspended."
3060 (and (ampc-on-p) (not ampc-windows)))
3064 "Return non-nil if ampc is connected to the daemon."
3066 (and ampc-connection (memq (process-status ampc-connection) '(open run))))
3069 (defun ampc (&optional host port suspend)
3070 "Ampc is an asynchronous client for the MPD media player.
3071 This function is the main entry point for ampc.
3073 HOST and PORT specify the MPD instance to connect to. The values
3074 default to the ones specified in `ampc-default-server'."
3076 (unless (byte-code-function-p (symbol-function 'ampc))
3077 (message "You should byte-compile ampc"))
3078 (run-hooks 'ampc-before-startup-hook)
3080 (setf host (or (car ampc-default-server) (read-string "Host: "))))
3082 (setf port (or (cdr ampc-default-server) (read-string "Port: "))))
3083 (when (and ampc-connection
3084 (not (and (equal host ampc-host)
3085 (equal port ampc-port)
3088 (unless ampc-connection
3089 (let ((connection (open-network-stream "ampc"
3090 (with-current-buffer
3091 (get-buffer-create " *ampc*")
3096 :type 'plain :return-list t)))
3097 (unless (car connection)
3098 (error "Failed connecting to server: %s"
3099 (plist-get ampc-connection :error)))
3100 (setf ampc-connection (car connection)
3103 (set-process-coding-system ampc-connection 'utf-8-unix 'utf-8-unix)
3104 (set-process-filter ampc-connection 'ampc-filter)
3105 (set-process-query-on-exit-flag ampc-connection nil)
3106 (setf ampc-outstanding-commands '((setup))))
3109 (ampc-configure-frame (cl-cddadr ampc-views)))
3110 (run-hooks 'ampc-connected-hook)
3113 (ampc-filter (process-buffer ampc-connection) nil))
3118 ;; eval: (outline-minor-mode 1)
3119 ;; outline-regexp: ";;; \\*+"
3121 ;; indent-tabs-mode: nil
3123 ;;; ampc.el ends here