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 (setq font-lock-defaults `(((ampc-find-current-song
990 (1 'ampc-current-song-mark-face)
991 (2 'ampc-current-song-marked-face))
992 . ,(car font-lock-defaults))
993 . (cdr font-lock-defaults))))
995 (define-derived-mode ampc-playlist-mode ampc-item-mode "ampc-pl")
997 (define-derived-mode ampc-playlists-mode ampc-item-mode "ampc-pls")
999 (define-derived-mode ampc-files-list-mode ampc-item-mode "ampc-files-list")
1001 (define-derived-mode ampc-tagger-mode nil "ampc-tagger"
1002 (set (make-local-variable 'tool-bar-map) ampc-tool-bar-map)
1003 (set (make-local-variable 'tab-stop-list)
1004 (list (+ (cl-loop for tag in ampc-tagger-tags
1005 maximize (length (symbol-name tag)))
1007 (set (make-local-variable 'completion-at-point-functions)
1008 '(ampc-tagger-complete-tag ampc-tagger-complete-value))
1009 (setf truncate-lines ampc-truncate-lines
1011 `(((,(concat "^\\([ \t]*\\(?:"
1012 (mapconcat #'symbol-name ampc-tagger-tags "\\|")
1016 (mapconcat #'identity ampc-tagger-genres "\\|") "\\|<keep>"
1019 (1 'ampc-tagger-tag-face)
1020 (2 'ampc-tagger-keyword-face)))
1023 (define-derived-mode ampc-tagger-log-mode nil "ampc-tagger-log")
1025 (define-derived-mode ampc-item-mode ampc-mode "ampc-item"
1026 (setf font-lock-defaults '((("^\\(\\*\\)\\(.*\\)$"
1028 (2 'ampc-marked-face))
1029 ;; FIXME: Why do this?
1030 ;; ("" 0 'ampc-unmarked-face)
1034 (define-derived-mode ampc-mode special-mode "ampc"
1035 (buffer-disable-undo)
1036 (set (make-local-variable 'tool-bar-map) ampc-tool-bar-map)
1037 (setf truncate-lines ampc-truncate-lines
1038 mode-line-modified "--"))
1041 (define-minor-mode ampc-tagger-dired-mode
1042 "Minor mode that adds a audio file meta data tagging key binding to dired."
1043 :lighter " ampc-tagger"
1044 (cl-assert (derived-mode-p 'dired-mode)))
1046 ;;; *** internal functions
1047 (defun ampc-tagger-report (args status)
1048 (unless (zerop status)
1049 (let ((message (format (concat "ampc_tagger (%s %s) returned with a "
1050 "non-zero exit status (%s)")
1051 ampc-tagger-executable
1052 (mapconcat #'identity args " ")
1054 (ampc-tagger-log message "\n")
1057 (defun ampc-tagger-call (&rest args)
1060 (apply #'call-process ampc-tagger-executable nil t nil args)))
1062 (defun ampc-int-insert-cmp (p1 p2)
1063 (cond ((< p1 p2) 'insert)
1064 ((eq p1 p2) 'overwrite)
1067 (defun ampc-normalize-windows ()
1069 (cl-loop for (window . buffer) in ampc-windows
1070 collect (cons (if (and (window-live-p window)
1071 (eq (window-buffer window) buffer))
1073 (get-buffer-window buffer))
1075 (delq nil (mapcar #'car ampc-windows)))
1077 (defun ampc-restore-window-configuration ()
1081 (when (eq (window-frame w)
1084 (ampc-normalize-windows)))
1086 (cl-loop for w in (window-list nil nil (frame-first-window))
1090 (cl-return nil)))))))
1092 (setf (window-dedicated-p (car windows)) nil)
1093 (cl-loop for w in (cdr windows)
1094 do (delete-window w)))))
1096 (defun ampc-tagger-tags-modified (tags new-tags)
1097 (cl-loop with found-changed
1098 for (tag . value) in new-tags
1099 for prop = (assq tag tags)
1100 do (unless (equal (cdr prop) value)
1101 (setf (cdr prop) value
1103 finally return found-changed))
1105 (defun ampc-change-view (view)
1106 (if (equal ampc-outstanding-commands '((idle nil)))
1107 (ampc-configure-frame (cddr view))
1108 (message "ampc is busy, cannot change window layout")))
1110 (defun ampc-quote (string)
1111 (concat "\"" (replace-regexp-in-string "\"" "\\\"" string) "\""))
1113 (defun ampc-in-ampc-p (&optional or-in-tagger)
1114 (or (when (ampc-on-p)
1117 (memq (car ampc-type) '(files-list tagger)))))
1119 (defun ampc-add-impl (&optional data)
1120 (ampc-on-files (lambda (file)
1122 (ampc-send-command 'playlistadd
1124 (ampc-quote (ampc-playlist))
1126 (ampc-send-command 'add '(:keep-prev t) (ampc-quote file)))
1129 (defun ampc-on-files (func &optional data)
1131 (cl-loop for d in (get-text-property (line-end-position) 'data)
1132 do (ampc-on-files func d)))
1134 (avl-tree-mapc (lambda (e) (ampc-on-files func (cdr e))) data))
1136 (funcall func data))
1138 (cl-loop for d in (reverse data)
1139 do (ampc-on-files func (cdr (assoc "file" d)))))))
1141 (defun ampc-skip (N)
1144 `(:callback ,(lambda ()
1145 (ampc-send-command 'status '(:front t))))
1147 (let ((song (cdr (assq 'song ampc-status)))
1148 (playlist-length (cdr (assq 'playlistlength ampc-status))))
1149 (unless (and song playlist-length)
1151 (max 0 (min (+ (string-to-number song) N)
1152 (1- (string-to-number playlist-length))))))))
1154 (cl-defun ampc-find-current-song
1155 (limit &aux (point (point)) (song (cdr (assq 'song ampc-status))))
1157 (<= (1- (line-number-at-pos (point)))
1158 (setf song (string-to-number song)))
1159 (>= (1- (line-number-at-pos limit)) song))
1160 (goto-char (point-min))
1163 (narrow-to-region (max point (point)) (min limit (line-end-position)))
1164 (search-forward-regexp "\\(?1:\\(\\`\\*\\)?\\)\\(?2:.*\\)$"))))
1166 (defun ampc-set-volume-impl (arg &optional func)
1168 (setf arg (prefix-numeric-value arg)))
1171 `(:callback ,(lambda ()
1172 (ampc-send-command 'status '(:front t))))
1179 (cdr (assq 'volume ampc-status)))
1180 (or arg ampc-volume-step))
1185 (defun ampc-set-crossfade-impl (arg &optional func)
1187 (setf arg (prefix-numeric-value arg)))
1190 `(:callback ,(lambda ()
1191 (ampc-send-command 'status '(:front t))))
1198 (cdr (assq 'xfade ampc-status)))
1199 (or arg ampc-crossfade-step))
1203 (cl-defun ampc-tagger-make-backup (file)
1204 (unless ampc-tagger-backup-directory
1205 (cl-return-from ampc-tagger-make-backup))
1206 (when (functionp ampc-tagger-backup-directory)
1207 (funcall ampc-tagger-backup-directory file)
1208 (cl-return-from ampc-tagger-make-backup))
1209 (unless (file-directory-p ampc-tagger-backup-directory)
1210 (make-directory ampc-tagger-backup-directory t))
1212 (cl-loop with real-file = file
1213 for target = (file-symlink-p real-file)
1215 do (setf real-file (expand-file-name
1216 target (file-name-directory real-file)))
1217 finally return real-file))
1219 (cl-loop with base = (file-name-nondirectory real-file)
1221 for file = (expand-file-name
1225 ampc-tagger-backup-directory)
1226 while (file-exists-p file)
1227 finally return file)))
1228 (ampc-tagger-log "\tBackup file: " (abbreviate-file-name target) "\n")
1229 (copy-file real-file target nil t)))
1231 (cl-defun ampc-move (N &aux with-marks entries-to-move (up (< N 0)))
1233 (goto-char (point-min))
1234 (cl-loop while (search-forward-regexp "^* " nil t)
1235 do (push (point) entries-to-move)))
1238 (push (point) entries-to-move))
1239 (when (save-excursion
1240 (cl-loop with max = (1- (count-lines (point-min) (point-max)))
1241 for p in entries-to-move
1243 for line = (+ (1- (line-number-at-pos)) N)
1244 always (and (>= line 0) (<= line max))))
1246 (setf entries-to-move (nreverse entries-to-move)))
1249 (cl-loop for p in entries-to-move
1251 for line = (1- (line-number-at-pos))
1252 do (if (and (not (eq (car ampc-type) 'current-playlist))
1254 (ampc-send-command 'playlistmove
1256 (ampc-quote (ampc-playlist))
1259 (ampc-send-command 'move '(:keep-prev t) line (+ line N))))
1261 (cl-loop for p in (nreverse entries-to-move)
1265 (ampc-mark-impl t 1))
1268 (ampc-align-point))))
1270 (defun ampc-toggle-state (state arg)
1271 (when (or arg ampc-status)
1276 (if (equal (cdr (assq state ampc-status)) "1")
1279 ((> (prefix-numeric-value arg) 0) 1)
1282 (defun ampc-playlist (&optional at-point)
1283 (ampc-with-buffer 'playlists
1284 (if (and (not at-point)
1285 (search-forward-regexp "^* \\(.*\\)$" nil t))
1286 (let ((result (match-string 1)))
1287 (set-text-properties 0 (length result) nil result)
1290 (buffer-substring-no-properties
1291 (+ (line-beginning-position) 2)
1292 (line-end-position))))))
1294 (cl-defun ampc-mark-impl (select N &aux result (inhibit-read-only t))
1295 (when (eq (car ampc-type) 'playlists)
1296 (cl-assert (or (not select) (null N) (eq N 1)))
1297 (ampc-with-buffer 'playlists
1298 (cl-loop while (search-forward-regexp "^\\* " nil t)
1299 do (replace-match " " nil nil))))
1300 (cl-loop repeat (or N 1)
1302 do (move-beginning-of-line nil)
1304 (insert (if select "*" " "))
1305 (setf result (ampc-next-line nil)))
1306 (ampc-post-mark-change-update)
1309 (defun ampc-post-mark-change-update ()
1310 (cl-ecase (car ampc-type)
1311 ((current-playlist playlist outputs))
1313 (ampc-update-playlist))
1317 (cl-loop for w on (ampc-normalize-windows)
1318 thereis (when (or (eq (car w) (selected-window))
1319 (and (eq (car ampc-type) 'tag)
1320 (eq (with-current-buffer
1321 (window-buffer (car w))
1325 do (with-current-buffer (window-buffer w)
1326 (when (memq (car ampc-type) '(song tag))
1327 (ampc-set-dirty t))))
1328 (ampc-fill-tag-song))
1330 (ampc-tagger-update))))
1332 (cl-defun ampc-tagger-get-values (tag all-files &aux result)
1333 (ampc-with-buffer 'files-list
1339 `(let ((value (cdr (assq tag (get-text-property (point) 'data)))))
1340 (unless (member value result)
1341 (push value result)))))
1343 (cl-loop until (eobp)
1344 initially do (goto-char (point-min))
1347 until (ampc-next-line))
1348 (ampc-with-selection nil
1352 (defun ampc-tagger-update ()
1353 (ampc-with-buffer 'tagger
1355 while (search-forward-regexp (concat "^[ \t]*\\("
1356 (mapconcat #'symbol-name
1360 "[ \t]*\\(<keep>[ \t]*?\\)"
1364 for tag = (intern (match-string 1))
1365 do (when (memq tag ampc-tagger-tags)
1366 (let ((values (save-match-data (ampc-tagger-get-values tag nil))))
1367 (when (eq (length values) 1)
1368 (replace-match (car values) nil t nil 2)))))))
1370 (defun ampc-tagger-complete-tag ()
1373 (narrow-to-region (line-beginning-position) (line-end-position))
1374 (unless (search-backward-regexp "^.*:" nil t)
1375 (when (search-backward-regexp "\\(^\\|[ \t]\\).*" nil t)
1376 (when (looking-at "[ \t]")
1379 (search-forward-regexp ":\\|$")
1380 (mapcar (lambda (tag) (concat (symbol-name tag) ":"))
1381 ampc-tagger-tags)))))))
1383 (cl-defun ampc-tagger-complete-value (&aux tag)
1386 (narrow-to-region (line-beginning-position) (line-end-position))
1388 (unless (search-backward-regexp (concat "^[ \t]*\\("
1389 (mapconcat #'symbol-name
1394 (cl-return-from ampc-tagger-complete-tag))
1395 (setf tag (intern (match-string 1))))
1397 (search-backward-regexp "[: \t]")
1400 (search-forward-regexp "[ \t]\\|$")
1401 (let ((values (cons "<keep>" (ampc-tagger-get-values
1403 ampc-tagger-completion-all-files))))
1404 (when (eq tag 'Genre)
1405 (cl-loop for g in ampc-tagger-genres
1406 do (unless (member g values)
1410 (defun ampc-align-point ()
1412 (move-beginning-of-line nil)
1414 (re-search-forward " *" nil t)))
1416 (cl-defun ampc-pad (tabs &optional dont-honour-item-mode)
1417 (cl-loop with new-tab-stop-list
1418 with offset-dec = (if (and (not dont-honour-item-mode)
1419 (derived-mode-p 'ampc-item-mode))
1423 for offset-cell on (if (derived-mode-p 'ampc-item-mode)
1425 (cons 0 tab-stop-list))
1426 for offset = (car offset-cell)
1427 for props in (or (plist-get (cdr ampc-type) :properties)
1429 by (lambda (cell) (or (cdr cell) '(nil . nil)))
1430 do (cl-decf offset offset-dec)
1432 with current-offset = 0
1433 when (<= current-offset offset)
1434 do (when (and (not first) (eq (- offset current-offset) 0))
1436 and concat (make-string (- offset current-offset) ? ) into result
1437 and do (setf current-offset offset)
1439 concat " " into result
1440 and do (cl-incf current-offset)
1444 (when (and (plist-get (cdr props) :shrink)
1446 (>= (+ current-offset (length tab) 1) (- (cadr offset-cell)
1448 (setf tab (concat (substring tab 0 (max (- (cadr offset-cell)
1454 concat tab into result
1455 do (push (+ current-offset offset-dec) new-tab-stop-list)
1456 (cl-incf current-offset (length tab))
1459 (if (equal (cl-callf nreverse new-tab-stop-list) tab-stop-list)
1461 (propertize result 'tab-stop-list new-tab-stop-list))))
1463 (defun ampc-update-header ()
1464 (when (or (memq (car ampc-type) '(tag playlists))
1465 (plist-get (cdr ampc-type) :properties))
1466 (setf header-line-format
1468 (make-string (floor (fringe-columns 'left t)) ? )
1469 (cl-ecase (car ampc-type)
1471 (concat " " (plist-get (cdr ampc-type) :tag)))
1475 (ampc-pad (cl-loop for (name . props) in
1476 (plist-get (cdr ampc-type) :properties)
1477 collect (or (plist-get props :title) name))
1480 (defun ampc-set-dirty (tag-or-dirty &optional dirty)
1481 (if (or (null tag-or-dirty) (memq tag-or-dirty '(t erase keep-dirty)))
1482 (setf ampc-dirty tag-or-dirty)
1483 (cl-loop for w in (ampc-normalize-windows)
1484 do (with-current-buffer (window-buffer w)
1485 (when (eq (car ampc-type) tag-or-dirty)
1486 (ampc-set-dirty dirty))))))
1488 (defun ampc-update ()
1490 (cl-loop for w in (ampc-normalize-windows)
1491 do (with-current-buffer (window-buffer w)
1492 (when (and ampc-dirty (not (eq ampc-dirty 'keep-dirty)))
1493 (cl-ecase (car ampc-type)
1495 (ampc-send-command 'outputs))
1497 (ampc-update-playlist))
1499 (if (assoc (ampc-tags) ampc-internal-db)
1500 (ampc-fill-tag-song)
1501 (push (cons (ampc-tags) nil) ampc-internal-db)
1502 (ampc-set-dirty 'tag 'keep-dirty)
1503 (ampc-set-dirty 'song 'keep-dirty)
1504 (ampc-send-command 'listallinfo)))
1506 (ampc-send-command 'status)
1507 (ampc-send-command 'currentsong))
1509 (ampc-send-command 'listplaylists))
1511 (ampc-send-command 'playlistinfo))))))
1512 (ampc-send-command 'status)
1513 (ampc-send-command 'currentsong)))
1515 (defun ampc-update-playlist ()
1516 (ampc-with-buffer 'playlists
1517 (if (search-forward-regexp "^\\* " nil t)
1518 (ampc-send-command 'listplaylistinfo
1520 (get-text-property (point) 'data))
1521 (ampc-with-buffer 'playlist
1523 (ampc-set-dirty nil)))))
1525 (defun ampc-send-command-impl (command)
1527 (message "ampc: -> %s" command))
1529 (process-send-string ampc-connection (concat command "\n"))))
1531 (cl-defun ampc-send-command (command &optional props &rest args)
1532 (cl-destructuring-bind (&key (front nil) (keep-prev nil) (full-remove nil)
1533 (remove-other nil) &allow-other-keys
1536 (when (and (not keep-prev)
1537 (eq (caar ampc-outstanding-commands) command)
1538 (equal (cl-cddar ampc-outstanding-commands) args))
1539 (cl-return-from ampc-send-command))
1540 (unless ampc-working-timer
1542 ampc-working-timer (run-at-time nil 0.1 'ampc-yield)))
1543 (when (equal (caar ampc-outstanding-commands) 'idle)
1544 (pop ampc-outstanding-commands)
1546 (when (and (not keep-prev) (cdr ampc-outstanding-commands))
1547 (setf (cdr ampc-outstanding-commands)
1548 (cl-loop for other-cmd in (cdr ampc-outstanding-commands)
1549 unless (and (memq (car other-cmd) (list command remove-other))
1550 (or (not full-remove)
1552 (cl-assert (null remove-other))
1553 (equal (cddr other-cmd) args))))
1556 (setf command (apply #'list command props args))
1558 (push command ampc-outstanding-commands)
1559 (setf ampc-outstanding-commands
1560 (nconc ampc-outstanding-commands
1563 (push '(noidle nil) ampc-outstanding-commands)
1564 (ampc-send-command-impl "noidle"))))
1566 (defun ampc-send-next-command ()
1567 (cl-loop while ampc-outstanding-commands
1569 (cl-loop for command = (car ampc-outstanding-commands)
1570 for command-id = (replace-regexp-in-string
1572 (symbol-name (car command)))
1575 (ampc-send-command-impl
1577 (cl-loop for a in (cddr command)
1579 do (when (functionp a)
1580 (cl-callf funcall a))
1581 concat (cl-etypecase a
1582 (integer (number-to-string a))
1584 (let ((callback (plist-get (cl-cadar ampc-outstanding-commands)
1586 (old-head (pop ampc-outstanding-commands)))
1587 (when callback (funcall callback))
1588 (push old-head ampc-outstanding-commands))
1590 do (pop ampc-outstanding-commands)
1591 while ampc-outstanding-commands)
1593 while (let ((member (memq (intern command) ampc-synchronous-commands)))
1595 (not (eq (car ampc-synchronous-commands) t))
1596 (eq (car ampc-synchronous-commands) t)))
1597 do (cl-loop with head = ampc-outstanding-commands
1598 with ampc-no-implicit-next-dispatch = t
1599 with ampc-yield-redisplay = t
1601 while (eq head ampc-outstanding-commands)
1602 do (accept-process-output ampc-connection 0 100)))
1603 (unless ampc-outstanding-commands
1604 (when ampc-working-timer
1605 (cancel-timer ampc-working-timer)
1606 (setf ampc-yield nil
1607 ampc-working-timer nil)
1609 (setf ampc-outstanding-commands '((idle nil)))
1610 (ampc-send-command-impl "idle")))
1612 (defun ampc-tree< (a b)
1613 (string< (car a) (car b)))
1615 (defun ampc-create-tree ()
1616 (avl-tree-create 'ampc-tree<))
1618 (defsubst ampc-extract (regexp)
1619 (goto-char (point-min))
1620 (when (search-forward-regexp regexp nil t)
1623 (defsubst ampc-clean-tag (tag value)
1625 (let ((func (cdr (assoc tag ampc-tag-transform-funcs))))
1627 (funcall func value)
1629 (unless (equal tag "Track")
1630 "[Not Specified]")))
1632 (defun ampc-insert (element data &optional cmp cmp-data)
1633 (goto-char (point-min))
1635 (setf cmp-data data))
1638 (cl-loop until (eobp)
1639 for tp = (get-text-property (+ (point) 2) 'cmp-data)
1640 thereis (let ((r (funcall cmp cmp-data tp)))
1645 finally return 'insert)
1646 (cl-loop with stringp-cmp-data = (stringp cmp-data)
1648 with max = (1+ (count-lines (point-min) (point-max)))
1650 do (when (< (- max min) 20)
1652 (forward-line (- min max)))
1653 (cl-return (cl-loop repeat (- max min)
1654 for tp = (get-text-property (+ (point) 2)
1657 (if (equal tp cmp-data)
1659 (unless (if stringp-cmp-data
1660 (string< tp cmp-data)
1662 (buffer-substring-no-properties
1664 (line-end-position))
1668 finally return 'insert)))
1669 do (forward-line (funcall (if at-min #'+ #'-)
1671 for tp = (get-text-property (+ (point) 2) 'cmp-data)
1672 thereis (when (equal tp cmp-data) 'update)
1673 do (if (setf at-min (if stringp-cmp-data
1674 (string< tp cmp-data)
1675 (string< (buffer-substring-no-properties
1677 (line-end-position))
1679 (cl-incf min (floor (/ (- max min) 2.0)))
1680 (cl-decf max (floor (/ (- max min) 2.0))))
1681 finally return 'insert))))
1684 (insert (propertize (concat " " element "\n")
1685 'data (if (eq cmp t) (list data) data)
1686 'cmp-data cmp-data)))
1688 (remove-text-properties (point) (1+ (point)) '(not-updated))
1689 (when (or (eq ampc-dirty 'erase) (eq action 'overwrite))
1690 (let ((origin (point)))
1693 (insert element "\n")
1694 (goto-char origin)))
1695 (let ((next (1+ (line-end-position))))
1696 (put-text-property (point) next 'cmp-data cmp-data)
1699 'data (cond ((eq cmp t)
1700 (let ((rest (get-text-property (point) 'data)))
1701 (if (memq data rest)
1705 (eq (char-after) ?*)))))
1707 (defun ampc-fill-tag (trees)
1708 (put-text-property (point-min) (point-max) 'data nil)
1709 (cl-loop with new-trees
1714 (when (ampc-insert (car e) (cdr e) t (car e))
1715 (push (cdr e) new-trees)))
1717 finally return new-trees))
1719 (defun ampc-fill-song (trees)
1722 do (cl-loop for song in songs
1725 (cl-loop for (p . v) in (plist-get (cdr ampc-type) :properties)
1726 collect (cdr (assoc p song))))
1729 (defsubst ampc-narrow-entry (delimiter-regexp)
1732 (line-beginning-position)
1734 (goto-char (line-end-position))
1735 (when (search-forward-regexp delimiter-regexp nil t)
1736 (setf result (point))
1737 (1- (line-beginning-position))))
1741 (defun ampc-fill-playlist ()
1742 (ampc-fill-skeleton 'playlist
1744 (ampc-iterate-source-output "file" (file)
1745 (cl-loop for (tag . tag-regexp) in tags
1746 collect (ampc-clean-tag tag (ampc-extract tag-regexp)))
1748 (index . ,(1- (cl-incf index))))
1749 'ampc-int-insert-cmp
1752 (defun ampc-fill-outputs ()
1753 (ampc-fill-skeleton 'outputs
1754 (ampc-iterate-source-output "outputid" (outputid outputenabled)
1755 (cl-loop for (tag . tag-regexp) in tags
1756 collect (ampc-clean-tag tag (ampc-extract tag-regexp)))
1757 `(("outputid" . ,outputid)
1758 ("outputenabled" . ,outputenabled)))))
1760 (cl-defun ampc-mini-impl (&aux songs)
1761 (ampc-iterate-source
1766 (Pos (string-to-number (ampc-extract (ampc-extract-regexp "Pos")))))
1767 (let ((entry (cons (concat Title
1769 (concat " - " Artist)))
1771 (cl-loop with mentry = (cons (car entry) (cdr entry))
1773 while (assoc (car mentry) songs)
1774 do (setf (car mentry) (concat (car entry)
1775 " (" (int-to-string index) ")"))
1776 finally do (push mentry songs))))
1778 (message "No song in the playlist")
1779 (cl-return-from ampc-mini-impl))
1780 (let ((song (assoc (let ((inhibit-quit t))
1783 (completing-read "Song to play: " songs nil t))
1784 (setf quit-flag nil)))
1787 (ampc-play-this (cdr song)))))
1789 (defun ampc-fill-current-playlist ()
1790 (ampc-fill-skeleton 'current-playlist
1791 (ampc-iterate-source-output
1793 (file (pos (string-to-number (ampc-extract
1794 (ampc-extract-regexp "Pos")))))
1795 (cl-loop for (tag . tag-regexp) in tags
1796 collect (ampc-clean-tag tag (ampc-extract tag-regexp)))
1799 'ampc-int-insert-cmp
1802 (defun ampc-fill-playlists ()
1803 (ampc-fill-skeleton 'playlists
1804 (with-current-buffer data-buffer
1805 (cl-loop while (search-forward-regexp "^playlist: \\(.*\\)$" nil t)
1806 for playlist = (match-string 1)
1807 do (ampc-with-buffer 'playlists
1808 (ampc-insert playlist playlist)))))
1809 (ampc-set-dirty 'playlist t)
1812 (defun ampc-yield ()
1813 (cl-incf ampc-yield)
1815 (when ampc-yield-redisplay
1818 (defun ampc-fill-status ()
1819 (ampc-with-buffer 'status
1821 (funcall (or (plist-get (cadr ampc-type) :filler)
1823 (insert (ampc-status t) "\n")))
1825 (ampc-set-dirty nil)))
1827 (defun ampc-fill-tag-song ()
1829 with trees = (list (cdr (assoc (ampc-tags) ampc-internal-db)))
1830 for type in '(tag song)
1833 for w in (ampc-normalize-windows)
1835 (with-current-buffer (window-buffer w)
1836 (when (eq (car ampc-type) type)
1838 (if (and (not trees) (not (eq ampc-dirty 'keep-dirty)))
1840 (let ((inhibit-read-only t))
1842 (ampc-set-dirty nil))
1843 (ampc-fill-skeleton w
1845 (setf trees (ampc-fill-tag trees))
1846 (ampc-fill-song trees))))
1849 (goto-char (point-min))
1850 (cl-loop while (search-forward-regexp "^* " nil t)
1851 do (cl-callf append trees
1852 (get-text-property (point) 'data))))))))))
1854 (defun ampc-transform-track (track)
1855 (when (eq (length track) 1)
1856 (setf track (concat "0" track)))
1859 (cl-defun ampc-transform-time (data &aux (time (string-to-number data)))
1860 (concat (number-to-string (/ time 60))
1862 (when (< (% time 60) 10)
1864 (number-to-string (% time 60))))
1866 (defun ampc-handle-idle ()
1867 (cl-loop until (eobp)
1868 for subsystem = (buffer-substring (point) (line-end-position))
1869 do (when (string-match "^changed: \\(.*\\)$" subsystem)
1870 (cl-case (intern (match-string 1 subsystem))
1872 (setf ampc-internal-db (list (cons (ampc-tags) nil)))
1873 (ampc-set-dirty 'tag 'keep-dirty)
1874 (ampc-set-dirty 'song 'keep-dirty)
1875 (ampc-send-command 'listallinfo))
1877 (ampc-set-dirty 'outputs t))
1878 ((player options mixer)
1879 (setf ampc-status nil)
1880 (ampc-set-dirty 'status t))
1882 (ampc-set-dirty 'playlists t))
1884 (ampc-set-dirty 'current-playlist t)
1885 (ampc-set-dirty 'status t))))
1889 (defun ampc-handle-setup (status)
1890 (unless (and (string-match "^ MPD \\(.+\\)\\.\\(.+\\)\\.\\(.+\\)$"
1892 (let ((version-a (string-to-number (match-string 1 status)))
1893 (version-b (string-to-number (match-string 2 status)))
1894 ;; (version-c (string-to-number (match-string 2 status)))
1897 (>= version-b 15))))
1898 (error (concat "Your version of MPD is not supported. "
1899 "ampc supports MPD protocol version 0.15.0 "
1902 (defun ampc-fill-internal-db (running)
1903 (cl-loop with tree = (assoc (ampc-tags) ampc-internal-db)
1905 (cl-loop for w in (ampc-normalize-windows)
1906 for props = (with-current-buffer (window-buffer w)
1907 (when (eq (car ampc-type) 'tag)
1909 (plist-get (cdr ampc-type) :tag)))
1913 with song-props = (ampc-with-buffer 'song
1915 (plist-get (cdr ampc-type) :properties))
1916 for origin = (and (search-forward-regexp "^file: " nil t)
1917 (line-beginning-position))
1920 do (goto-char (1+ origin))
1921 for next = (and (search-forward-regexp "^file: " nil t)
1922 (line-beginning-position))
1923 while (or (not running) next)
1924 do (save-restriction
1925 (narrow-to-region origin (or next (point-max)))
1926 (ampc-fill-internal-db-entry tree tags song-props))
1928 (delete-region origin next)
1929 (setf next origin))))
1932 (cl-loop for w in (ampc-normalize-windows)
1933 for tag = (with-current-buffer (window-buffer w)
1934 (when (eq (car ampc-type) 'tag)
1935 (plist-get (cdr ampc-type) :tag)))
1940 (defun ampc-fill-internal-db-entry (tree tags song-props)
1941 (cl-loop for tag in tags
1942 for data = (ampc-clean-tag tag (ampc-extract (ampc-extract-regexp tag)))
1943 do (unless (cdr tree)
1944 (setf (cdr tree) (ampc-create-tree)))
1945 (setf tree (avl-tree-enter (cdr tree)
1949 (push (cons (cons "file" (ampc-extract (ampc-extract-regexp "file")))
1950 (cl-loop for p in song-props
1951 for data = (ampc-clean-tag (car p)
1953 (ampc-extract-regexp (car p))))
1955 collect (cons (car p) data)
1959 (defun ampc-fill-status-var (tags)
1960 (cl-loop for k in tags
1961 for v = (ampc-extract (ampc-extract-regexp k))
1964 (setf (cdr (or (assq s ampc-status)
1965 (car (push (cons s nil) ampc-status))))
1967 (cl-callf2 assq-delete-all s ampc-status))))
1969 (defun ampc-handle-current-song ()
1970 (ampc-fill-status-var (append ampc-status-tags '("Artist" "Title" "file")))
1972 (run-hook-with-args ampc-status-changed-hook ampc-status))
1974 (defun ampc-handle-status ()
1975 (ampc-fill-status-var '("volume" "repeat" "random" "consume" "xfade" "state"
1976 "song" "playlistlength"))
1977 (ampc-with-buffer 'current-playlist
1978 (if (fboundp 'font-lock-flush)
1980 (with-no-warnings (font-lock-fontify-buffer))))
1981 (run-hook-with-args ampc-status-changed-hook ampc-status))
1983 (defun ampc-handle-update ()
1984 (message "Database update started"))
1986 (defun ampc-handle-command (status)
1989 (pop ampc-outstanding-commands))
1990 ((eq status 'running)
1991 (cl-case (caar ampc-outstanding-commands)
1992 (listallinfo (ampc-fill-internal-db t))))
1994 (let ((command (pop ampc-outstanding-commands)))
1995 (cl-case (car command)
1999 (ampc-handle-setup status))
2001 (ampc-handle-current-song))
2003 (ampc-handle-status))
2005 (ampc-handle-update))
2007 (ampc-fill-playlist))
2009 (ampc-fill-playlists))
2011 (ampc-fill-current-playlist))
2016 (shuffle-listplaylistinfo
2017 (ampc-shuffle-playlist (plist-get (cadr command) :playlist)))
2019 (ampc-handle-listallinfo))
2021 (ampc-fill-outputs))))
2022 (unless ampc-outstanding-commands
2025 (cl-defun ampc-shuffle-playlist (playlist &aux songs)
2026 (ampc-iterate-source nil "file" (file)
2027 (push (cons file (random)) songs))
2028 (ampc-send-command 'playlistclear '(:full-remove t) (ampc-quote playlist))
2029 (cl-loop for file in (mapcar #'car (sort songs
2030 (lambda (a b) (< (cdr a) (cdr b)))))
2031 do (ampc-send-command 'playlistadd
2033 (ampc-quote playlist)
2037 (defun ampc-handle-listallinfo ()
2038 (ampc-fill-internal-db nil)
2039 (ampc-set-dirty 'tag t)
2040 (ampc-set-dirty 'song t))
2042 (defun ampc-filter (_process string)
2043 (cl-assert (buffer-live-p (process-buffer ampc-connection)))
2044 (with-current-buffer (process-buffer ampc-connection)
2046 (when (and ampc-debug (not (eq ampc-debug t)))
2047 (message "ampc: <- %s" string))
2048 (goto-char (process-mark ampc-connection))
2050 (set-marker (process-mark ampc-connection) (point)))
2052 (goto-char (point-min))
2055 (when (search-forward-regexp
2056 "^ACK \\[\\(.*\\)\\] {.*} \\(.*\\)\n\\'"
2059 (message "ampc command error: %s (%s; %s)"
2062 (funcall (if ampc-debug #'identity #'car)
2063 (car ampc-outstanding-commands)))
2065 (when (search-forward-regexp "^OK\\(.*\\)\n\\'" nil t)
2068 (let ((match-end (match-end 0)))
2070 (narrow-to-region (point-min) match-end)
2071 (goto-char (point-min))
2072 (ampc-handle-command (if success (match-string 1) 'error)))
2073 (delete-region (point-min) match-end))
2074 (unless ampc-no-implicit-next-dispatch
2075 (ampc-send-next-command))))
2076 (ampc-handle-command 'running)))))
2078 (cl-defun ampc-set-tab-offsets
2079 (&rest properties &aux (min 2) (optional-padding 0))
2081 (cl-return-from ampc-set-tab-offsets))
2082 (set (make-local-variable 'tab-stop-list) nil)
2083 (cl-loop for (_title . props) in properties
2084 for min- = (plist-get props :min)
2085 do (cl-incf min (or (plist-get props :width) min-))
2087 (cl-incf optional-padding (- (plist-get props :max) min-))))
2088 (cl-loop for (_title . props) in properties
2090 do (push offset tab-stop-list)
2091 (cl-incf offset (or (plist-get props :width)
2092 (let ((min- (plist-get props :min))
2093 (max (plist-get props :max)))
2094 (if (>= min (window-width))
2098 (floor (* (/ (float (- max min-))
2102 (cl-callf nreverse tab-stop-list))
2104 (cl-defun ampc-configure-frame-1 (split &aux (split-type (car split)))
2105 (if (memq split-type '(vertical horizontal))
2107 (cl-loop with length = (if (eq split-type 'horizontal)
2108 (window-total-width)
2109 (window-total-height))
2112 for (size . subsplit) in (cdr split)
2113 do (if (equal size 1.0)
2114 (progn (push t sizes)
2115 (setf rest-car sizes))
2116 (let ((l (if (integerp size) size (round (* size length)))))
2119 finally do (setf (car rest-car) rest))
2120 (let ((first-window (selected-window)))
2121 (cl-callf nreverse sizes)
2122 (cl-loop for size in (copy-sequence sizes)
2123 for window on (cdr sizes)
2126 (split-window nil size (eq split-type 'horizontal)))))
2127 (setf (car sizes) first-window))
2128 (cl-loop for subsplit in (cdr split)
2131 do (with-selected-window window
2133 (or (ampc-configure-frame-1 (cdr subsplit)) result)))
2134 finally return result))
2135 (setf (window-dedicated-p (selected-window)) nil)
2136 (pop-to-buffer-same-window
2139 (mapconcat (lambda (s) (concat (upcase (substring s 0 1))
2141 (if (memq split-type '(tag song))
2142 (list (or (plist-get (cdr split) :tag) "song"))
2143 (split-string (symbol-name split-type) "-"))
2146 (if (memq split-type '(tag song))
2147 (ampc-tag-song-mode)
2148 (let ((mode (intern (concat "ampc-" (symbol-name split-type) "-mode"))))
2149 (unless (fboundp mode)
2150 (setf mode 'ampc-mode))
2151 (unless (eq major-mode 'mode) ;FIXME: This quote looks spurious!
2153 (cl-destructuring-bind
2154 (&key (properties nil) (dedicated t) (mode-line t) &allow-other-keys)
2156 (apply #'ampc-set-tab-offsets properties)
2157 (setf ampc-type split
2158 (window-dedicated-p (selected-window)) dedicated
2159 mode-line-format (when mode-line
2160 (default-value 'mode-line-format))))
2161 (set (make-local-variable 'mode-line-buffer-identification)
2162 '(:eval (let ((result
2163 (concat (car-safe (propertized-buffer-identification
2166 " [Updating...]"))))
2167 (if (< (length result) 12)
2168 (concat result (make-string (- 12 (length result)) ? ))
2170 (ampc-update-header)
2171 (add-to-list 'ampc-all-buffers (current-buffer))
2172 (push (cons (or (plist-get (cdr split) :id) 9999) (selected-window))
2175 (when (plist-get (cdr split) :select)
2176 (selected-window))))
2178 (cl-defun ampc-configure-frame
2179 (split &optional no-update &aux (old-selection ampc-type) old-window-starts)
2180 (cl-loop for w in (ampc-normalize-windows)
2181 do (with-selected-window w
2182 (with-current-buffer (window-buffer w)
2183 (push (cons (current-buffer) (window-start))
2184 old-window-starts))))
2185 (if (not ampc-use-full-frame)
2186 (ampc-restore-window-configuration)
2187 (setf (window-dedicated-p (selected-window)) nil)
2188 (delete-other-windows))
2189 (setf ampc-windows nil)
2190 (let ((select-window (ampc-configure-frame-1 split)))
2192 (mapcar (lambda (window)
2193 (cons window (window-buffer window)))
2194 (mapcar #'cdr (sort ampc-windows
2195 (lambda (a b) (< (car a) (car b)))))))
2196 (cl-loop for w in (ampc-normalize-windows)
2197 do (with-selected-window w
2198 (let ((old-window-start (cdr (assq (current-buffer)
2199 old-window-starts))))
2200 (when old-window-start
2201 (set-window-start nil old-window-start)))
2202 (when (and (derived-mode-p 'ampc-item-mode)
2203 (> (length tab-stop-list) 1))
2204 (ampc-set-dirty 'erase))))
2205 (select-window (or (cl-loop for w in (ampc-normalize-windows)
2207 (when (equal (with-current-buffer (window-buffer w)
2212 (selected-window))))
2216 (defun ampc-tagger-rename-artist-title (_changed-tags data)
2217 "Rename music file according to its tags.
2218 This function is meant to be inserted into
2219 `ampc-tagger-stored-hook'. The new file name is
2220 `Artist'_-_`Title'.`extension'. Characters within `Artist' and
2221 `Title' that are not alphanumeric are substituted with underscore."
2222 (let* ((artist (replace-regexp-in-string
2224 (or (cdr (assq 'Artist (cdr data))) "")))
2225 (title (replace-regexp-in-string
2227 (or (cdr (assq 'Title (cdr data))) "")))
2229 (expand-file-name (replace-regexp-in-string
2233 (when (and (> (length artist) 0)
2234 (> (length title) 0))
2237 (file-name-extension (car data) t)))
2238 (file-name-directory (car data)))))
2239 (unless (equal (car data) new-file)
2240 (ampc-tagger-log "Renaming file " (abbreviate-file-name (car data))
2241 " to " (abbreviate-file-name new-file) "\n")
2242 (rename-file (car data) new-file)
2243 (setf (car data) new-file))))
2245 ;;; *** interactives
2246 (defun ampc-tagger-completion-at-point (&optional all-files)
2247 "Perform completion at point via `completion-at-point'.
2248 If optional prefix argument ALL-FILES is non-nil, use all files
2249 within the files list buffer as source for completion. The
2250 default behaviour is to use only the selected ones."
2252 (let ((ampc-tagger-completion-all-files all-files))
2253 (completion-at-point)))
2255 (defun ampc-tagger-reset (&optional reset-all-tags)
2256 "Reset all tag values within the tagger, based on the selection of files.
2257 If optional prefix argument RESET-ALL-TAGS is non-nil, restore
2260 (when reset-all-tags
2261 (ampc-with-buffer 'tagger
2264 (cl-loop for tag in ampc-tagger-tags
2265 do (insert (ampc-pad (list (concat (symbol-name tag) ":") "dummy"))
2267 (goto-char (point-min))
2268 (re-search-forward ":\\( \\)+")))
2269 (ampc-with-buffer 'tagger
2270 (cl-loop while (search-forward-regexp
2271 (concat "^\\([ \t]*\\)\\("
2272 (mapconcat #'symbol-name ampc-tagger-tags "\\|")
2273 "\\)\\([ \t]*\\):\\([ \t]*.*\\)$")
2276 do (replace-match "" nil nil nil 1)
2277 (replace-match "" nil nil nil 3)
2278 (replace-match (concat (make-string (- (car tab-stop-list)
2279 (1+ (length (match-string 2))))
2283 (ampc-tagger-update)
2284 (ampc-with-buffer 'tagger
2286 (when (looking-at "[ \t]+")
2287 (goto-char (match-end 0)))))
2289 (cl-defun ampc-tagger-save (&optional quit &aux tags)
2291 If optional prefix argument QUIT is non-nil, quit tagger
2292 afterwards. If the numeric value of QUIT is 16, quit tagger and
2293 do not trigger a database update"
2295 (ampc-with-buffer 'tagger
2296 (cl-loop do (cl-loop until (eobp)
2297 while (looking-at "^[ \t]*$")
2300 do (unless (and (looking-at
2301 (concat "^[ \t]*\\("
2302 (mapconcat #'symbol-name
2306 "[ \t]*\\(.*\\)[ \t]*$"))
2307 (not (assq (intern (match-string 1)) tags)))
2308 (error "Malformed line \"%s\""
2309 (buffer-substring (line-beginning-position)
2310 (line-end-position))))
2311 (push (cons (intern (match-string 1))
2312 (let ((val (match-string 2)))
2313 (if (string= "<keep>" val)
2315 (set-text-properties 0 (length val) nil val)
2319 (cl-callf2 rassq-delete-all t tags)
2321 (cl-loop for (tag . value) in tags
2322 do (insert (symbol-name tag) "\n"
2324 (let ((input-buffer (current-buffer)))
2325 (ampc-with-buffer 'files-list
2328 (make-progress-reporter "Storing tags"
2330 (let ((count (count-matches "^\\* ")))
2335 (ampc-with-selection nil
2336 (let* ((data (get-text-property (point) 'data))
2337 (old-tags (cl-loop for (tag . data) in (cdr data)
2338 collect (cons tag data)))
2339 (found-changed (ampc-tagger-tags-modified (cdr data) tags)))
2340 (let ((pre-hook-tags (cdr data)))
2341 (run-hook-with-args 'ampc-tagger-store-hook found-changed data)
2344 (ampc-tagger-tags-modified pre-hook-tags
2348 "Storing tags for file "
2349 (abbreviate-file-name (car data)) "\n"
2351 (cl-loop for (tag . value) in old-tags
2352 concat (concat "\t\t"
2353 (symbol-name tag) ": "
2356 (cl-loop for (tag . value) in (cdr data)
2357 concat (concat "\t\t"
2358 (symbol-name tag) ": "
2360 (ampc-tagger-make-backup (car data))
2362 (list "--set" (car data))
2364 (insert-buffer-substring input-buffer)
2366 (call-process-region (point-min) (point-max)
2367 ampc-tagger-executable
2371 (message "ampc-tagger: %s"
2373 (point-min) (point))))))))
2374 (run-hook-with-args 'ampc-tagger-stored-hook found-changed data)
2375 (let ((inhibit-read-only t))
2376 (move-beginning-of-line nil)
2380 (ampc-pad (cl-loop for p in (plist-get (cdr ampc-type)
2382 when (eq (car p) 'filename)
2383 collect (file-name-nondirectory (car data))
2385 collect (cdr (assq (intern (car p))
2390 (put-text-property (line-beginning-position)
2391 (1+ (line-end-position))
2393 (progress-reporter-update reporter (cl-incf step))))
2394 (progress-reporter-done reporter)))))
2396 (ampc-tagger-quit (eq (prefix-numeric-value quit) 16))))
2398 (defun ampc-tagger-quit (&optional no-update)
2399 "Quit tagger and restore previous window configuration.
2400 With optional prefix NO-UPDATE, do not trigger a database update."
2402 (set-window-configuration (or (car-safe ampc-tagger-previous-configuration)
2403 ampc-tagger-previous-configuration))
2404 (when (car-safe ampc-tagger-previous-configuration)
2406 (ampc-trigger-update))
2407 (setf ampc-windows (cadr ampc-tagger-previous-configuration)))
2408 (setf ampc-tagger-previous-configuration nil))
2410 (defun ampc-move-to-tab ()
2411 "Move point to next logical tab stop."
2413 (let ((tab (cl-loop for tab in
2414 (or (get-text-property (point) 'tab-stop-list)
2416 while (>= (current-column) tab)
2417 finally return tab)))
2419 (goto-char (min (+ (line-beginning-position) tab) (line-end-position))))))
2421 (defun ampc-mouse-play-this (event)
2423 (select-window (posn-window (event-end event)))
2424 (goto-char (posn-point (event-end event)))
2427 (defun ampc-mouse-delete (event)
2429 (select-window (posn-window (event-end event)))
2430 (goto-char (posn-point (event-end event)))
2433 (defun ampc-mouse-add (event)
2435 (select-window (posn-window (event-end event)))
2436 (goto-char (posn-point (event-end event)))
2439 (defun ampc-mouse-delete-playlist (event)
2441 (select-window (posn-window (event-end event)))
2442 (goto-char (posn-point (event-end event)))
2443 (ampc-delete-playlist t))
2445 (defun ampc-mouse-load (event)
2447 (select-window (posn-window (event-end event)))
2448 (goto-char (posn-point (event-end event)))
2451 (defun ampc-mouse-toggle-output-enabled (event)
2453 (select-window (posn-window (event-end event)))
2454 (goto-char (posn-point (event-end event)))
2455 (ampc-toggle-output-enabled 1))
2457 (cl-defun ampc-mouse-toggle-mark (event &aux (inhibit-read-only t))
2459 (let ((window (posn-window (event-end event))))
2460 (when (with-selected-window window
2461 (goto-char (posn-point (event-end event)))
2463 (move-beginning-of-line nil)
2464 (ampc-mark-impl (not (eq (char-after) ?*)) 1)
2466 (select-window window))))
2468 (defun ampc-mouse-align-point (event)
2470 (select-window (posn-window (event-end event)))
2471 (goto-char (posn-point (event-end event)))
2474 (cl-defun ampc-unmark-all (&aux (inhibit-read-only t))
2477 (cl-assert (ampc-in-ampc-p t))
2479 (goto-char (point-min))
2480 (cl-loop while (search-forward-regexp "^\\* " nil t)
2481 do (replace-match " " nil nil)))
2482 (ampc-post-mark-change-update))
2484 (defun ampc-trigger-update ()
2485 "Trigger a database update."
2487 (cl-assert (ampc-on-p))
2488 (ampc-send-command 'update))
2490 (cl-defun ampc-toggle-marks (&aux (inhibit-read-only t))
2492 Marked entries become unmarked, and vice versa."
2494 (cl-assert (ampc-in-ampc-p t))
2496 (cl-loop for (a . b) in '(("* " . "T ")
2499 do (goto-char (point-min))
2500 (cl-loop while (search-forward-regexp (concat "^" (regexp-quote a))
2503 do (replace-match b nil nil))))
2504 (ampc-post-mark-change-update))
2506 (defun ampc-up (&optional arg)
2507 "Move selected entries ARG positions upwards.
2508 ARG defaults to one."
2510 (cl-assert (ampc-in-ampc-p))
2511 (ampc-move (- (or arg 1))))
2513 (defun ampc-down (&optional arg)
2514 "Move selected entries ARG positions downwards.
2515 ARG defaults to one."
2517 (cl-assert (ampc-in-ampc-p))
2518 (ampc-move (or arg 1)))
2520 (defun ampc-mark (&optional arg)
2521 "Mark the next ARG'th entries.
2524 (cl-assert (ampc-in-ampc-p t))
2525 (ampc-mark-impl t arg))
2527 (defun ampc-unmark (&optional arg)
2528 "Unmark the next ARG'th entries.
2531 (cl-assert (ampc-in-ampc-p t))
2532 (ampc-mark-impl nil arg))
2534 (defun ampc-set-volume (&optional arg)
2535 "Set volume to ARG percent.
2536 If ARG is nil, read ARG from minibuffer."
2538 (cl-assert (ampc-on-p))
2539 (ampc-set-volume-impl (or arg (read-number "Volume: "))))
2541 (defun ampc-increase-volume (&optional arg)
2542 "Increase volume by prefix argument ARG or, if ARG is nil,
2543 `ampc-volume-step'."
2545 (cl-assert (ampc-on-p))
2546 (ampc-set-volume-impl arg '+))
2548 (defun ampc-decrease-volume (&optional arg)
2549 "Decrease volume by prefix argument ARG or, if ARG is nil,
2550 `ampc-volume-step'."
2552 (cl-assert (ampc-on-p))
2553 (ampc-set-volume-impl arg '-))
2555 (defun ampc-set-crossfade (&optional arg)
2556 "Set crossfade to ARG seconds.
2557 If ARG is nil, read ARG from minibuffer."
2559 (cl-assert (ampc-on-p))
2560 (ampc-set-crossfade-impl (or arg (read-number "Crossfade: "))))
2562 (defun ampc-increase-crossfade (&optional arg)
2563 "Increase crossfade by prefix argument ARG or, if ARG is nil,
2564 `ampc-crossfade-step'."
2566 (cl-assert (ampc-on-p))
2567 (ampc-set-crossfade-impl arg '+))
2569 (defun ampc-decrease-crossfade (&optional arg)
2570 "Decrease crossfade by prefix argument ARG or, if ARG is nil,
2571 `ampc-crossfade-step'."
2573 (cl-assert (ampc-on-p))
2574 (ampc-set-crossfade-impl arg '-))
2576 (defun ampc-toggle-repeat (&optional arg)
2577 "Toggle MPD's repeat state.
2578 With prefix argument ARG, enable repeating if ARG is positive,
2579 otherwise disable it."
2581 (cl-assert (ampc-on-p))
2582 (ampc-toggle-state 'repeat arg))
2584 (defun ampc-toggle-consume (&optional arg)
2585 "Toggle MPD's consume state.
2586 With prefix argument ARG, enable consuming if ARG is positive,
2587 otherwise disable it.
2589 When consume is activated, each song played is removed from the playlist."
2591 (cl-assert (ampc-on-p))
2592 (ampc-toggle-state 'consume arg))
2594 (defun ampc-toggle-random (&optional arg)
2595 "Toggle MPD's random state.
2596 With prefix argument ARG, enable random playing if ARG is positive,
2597 otherwise disable it."
2599 (ampc-toggle-state 'random arg))
2601 (defun ampc-play-this (&optional arg)
2602 "Play selected song.
2603 With prefix argument ARG, play the ARG'th song located at the
2604 zero-indexed position of the current playlist."
2606 (cl-assert (and (ampc-on-p) (or arg (ampc-in-ampc-p))))
2609 (ampc-send-command 'play nil (1- (line-number-at-pos)))
2610 (ampc-send-command 'pause nil 0))
2611 (ampc-send-command 'play nil arg)
2612 (ampc-send-command 'pause nil 0)))
2614 (cl-defun ampc-toggle-play
2615 (&optional arg &aux (state (cdr (assq 'state ampc-status))))
2617 If MPD does not play a song already, start playing the song at
2618 point if the current buffer is the playlist buffer, otherwise
2619 start at the beginning of the playlist.
2621 If ARG is 4, stop player rather than pause if applicable."
2623 (cl-assert (ampc-on-p))
2625 (cl-return-from ampc-toggle-play))
2627 (setf arg (prefix-numeric-value arg)))
2628 (cl-ecase (intern state)
2630 (when (or (null arg) (> arg 0))
2633 '(:remove-other (pause))
2634 (if (and (eq (car ampc-type) 'current-playlist) (not (eobp)))
2635 (1- (line-number-at-pos))
2638 (when (or (null arg) (> arg 0))
2639 (ampc-send-command 'pause '(:remove-other (play)) 0)))
2641 (cond ((or (null arg) (< arg 0))
2642 (ampc-send-command 'pause '(:remove-other (play)) 1))
2644 (ampc-send-command 'stop))))))
2646 (defun ampc-next (&optional arg)
2648 With prefix argument ARG, skip ARG songs."
2650 (cl-assert (ampc-on-p))
2651 (ampc-skip (or arg 1)))
2653 (defun ampc-previous (&optional arg)
2654 "Play previous song.
2655 With prefix argument ARG, skip ARG songs."
2657 (cl-assert (ampc-on-p))
2658 (ampc-skip (- (or arg 1))))
2660 (defun ampc-rename-playlist (new-name)
2661 "Rename selected playlist to NEW-NAME.
2662 If NEW-NAME is nil, read NEW-NAME from the minibuffer."
2665 (setf new-name (read-from-minibuffer (concat "New name for playlist "
2668 (cl-assert (ampc-in-ampc-p))
2670 (ampc-send-command 'rename '(:full-remove t) (ampc-quote new-name))
2671 (message "No playlist selected")))
2673 (defun ampc-load (&optional at-point)
2674 "Load selected playlist in the current playlist.
2675 If optional argument AT-POINT is non-nil (or if no playlist is
2676 selected), use playlist at point rather than the selected one."
2678 (cl-assert (ampc-in-ampc-p))
2679 (if (ampc-playlist at-point)
2681 'load '(:keep-prev t)
2682 (ampc-quote (ampc-playlist at-point)))
2684 (message "No playlist at point")
2685 (message "No playlist selected"))))
2687 (defun ampc-toggle-output-enabled (&optional arg)
2688 "Toggle the next ARG outputs.
2689 If ARG is omitted, use the selected entries."
2691 (cl-assert (ampc-in-ampc-p))
2692 (ampc-with-selection arg
2693 (let ((data (get-text-property (point) 'data)))
2694 (ampc-send-command (if (equal (cdr (assoc "outputenabled" data)) "1")
2698 (cdr (assoc "outputid" data))))))
2700 (defun ampc-delete (&optional arg)
2701 "Delete the next ARG songs from the playlist.
2702 If ARG is omitted, use the selected entries. If ARG is non-nil,
2703 all marks after point are removed nontheless."
2705 (cl-assert (ampc-in-ampc-p))
2706 (let ((first-del nil))
2707 (ampc-with-selection arg
2708 (unless (or first-del (when arg (< arg 0)))
2709 (setf first-del (point)))
2710 (let ((val (1- (- (line-number-at-pos) (if (or (not arg) (> arg 0))
2713 (if (and (not (eq (car ampc-type) 'current-playlist)) (ampc-playlist))
2714 (ampc-send-command 'playlistdelete
2716 (ampc-quote (ampc-playlist))
2718 (ampc-send-command 'delete '(:keep-prev t) val))
2719 (ampc-mark-impl nil nil)))
2721 (goto-char first-del))))
2723 (defun ampc-shuffle ()
2726 (cl-assert (ampc-on-p))
2727 (if (and (not (eq (car ampc-type) 'current-playlist)) (ampc-playlist))
2728 (ampc-send-command 'shuffle-listplaylistinfo
2729 `(:playlist ,(ampc-playlist))
2730 (ampc-quote (ampc-playlist)))
2731 (ampc-send-command 'shuffle)))
2733 (defun ampc-clear ()
2736 (cl-assert (ampc-on-p))
2737 (if (and (not (eq (car ampc-type) 'current-playlist)) (ampc-playlist))
2738 (ampc-send-command 'playlistclear '(:full-remove t)
2739 (ampc-quote (ampc-playlist)))
2740 (ampc-send-command 'clear)))
2742 (defun ampc-add (&optional arg)
2743 "Add the songs associated with the next ARG entries after point
2745 If ARG is omitted, use the selected entries in the current buffer."
2747 (cl-assert (ampc-in-ampc-p))
2748 (ampc-with-selection arg
2751 (defun ampc-status (&optional no-print)
2752 "Display and return the information that is displayed in the status window.
2753 If optional argument NO-PRINT is non-nil, just return the text.
2754 If NO-PRINT is nil, the display may be delayed if ampc does not
2755 have enough information yet."
2757 (cl-assert (ampc-on-p))
2758 (unless (or ampc-status no-print)
2759 (ampc-send-command 'status)
2760 (ampc-send-command 'mini-currentsong)
2761 (cl-return-from ampc-status))
2762 (let* ((flags (mapconcat
2764 (cl-loop for (f . n) in '((repeat . "Repeat")
2766 (consume . "Consume"))
2767 when (equal (cdr (assq f ampc-status)) "1")
2771 (state (cdr (assq 'state ampc-status)))
2772 (status (concat "State: " state
2773 (when (and ampc-yield no-print)
2774 (concat (make-string (- 10 (length state)) ? )
2775 (nth (% ampc-yield 4) '("|" "/" "-" "\\"))))
2777 (when (equal state "play")
2781 (cdr (assq 'Artist ampc-status)))
2785 (cdr (assq 'Title ampc-status)))
2787 "Volume: " (cdr (assq 'volume ampc-status)) "\n"
2788 "Crossfade: " (cdr (assq 'xfade ampc-status))
2789 (unless (equal flags "")
2790 (concat "\n" flags)))))
2792 (message "%s" status))
2795 (defun ampc-delete-playlist (&optional at-point)
2796 "Delete selected playlist.
2797 If optional argument AT-POINT is non-nil (or if no playlist is
2798 selected), use playlist at point rather than the selected one."
2800 (cl-assert (ampc-in-ampc-p))
2801 (if (ampc-playlist at-point)
2802 (when (y-or-n-p (concat "Delete playlist " (ampc-playlist at-point) "?"))
2803 (ampc-send-command 'rm '(:full-remove t)
2804 (ampc-quote (ampc-playlist at-point))))
2806 (message "No playlist at point")
2807 (message "No playlist selected"))))
2809 (require 'dired) ;Needed to properly compile dired-map-over-marks.
2811 (defun ampc-tagger-dired (&optional arg)
2812 "Start the tagging subsystem on dired's marked files.
2813 With optional prefix argument ARG, use the next ARG files."
2815 (cl-assert (derived-mode-p 'dired-mode))
2817 (cl-loop for file in (dired-map-over-marks (dired-get-filename) arg)
2818 unless (file-directory-p file)
2823 (defun ampc-tag-files (files)
2824 "Start the tagging subsystem.
2825 FILES should be a list of absolute file names, the files to tag."
2827 (message "No files specified")
2828 (cl-return-from ampc-tagger-files t))
2829 (when (memq (car ampc-type) '(files-list tagger))
2830 (message "You are already within the tagger")
2831 (cl-return-from ampc-tagger-files t))
2832 (let ((reporter (make-progress-reporter "Grabbing tags" 0 (length files))))
2833 (cl-loop for file in-ref files
2835 do (run-hook-with-args 'ampc-tagger-grab-hook file)
2837 (ampc-tagger-call "--get" file)
2841 (cl-loop for tag in ampc-tagger-tags
2843 (cons tag (or (ampc-extract (ampc-extract-regexp
2846 (run-hook-with-args 'ampc-tagger-grabbed-hook file)
2847 (progress-reporter-update reporter i))
2848 (progress-reporter-done reporter))
2849 (unless ampc-tagger-previous-configuration
2850 (setf ampc-tagger-previous-configuration (current-window-configuration)))
2851 (ampc-configure-frame (cdr (assq 'tagger ampc-views)) t)
2852 (ampc-with-buffer 'files-list
2854 (cl-loop for (file . props) in files
2855 do (insert (propertize
2859 (cl-loop for p in (plist-get (cdr ampc-type) :properties)
2860 when (eq (car p) 'filename)
2861 collect (file-name-nondirectory file)
2863 collect (cdr (assq (intern (car p)) props))
2866 'data (cons file props))))
2867 (ampc-set-dirty nil)
2868 (ampc-toggle-marks))
2869 (ampc-with-buffer 'tagger
2871 (ampc-tagger-reset t)
2872 (goto-char (point-min))
2873 (search-forward-regexp ": *")
2874 (ampc-set-dirty nil))
2877 (cl-defun ampc-tagger (&optional arg &aux files)
2878 "Start the tagging subsystem.
2879 The files to tag are collected by using either the selected
2880 entries within the current buffer or the next ARG entries at
2881 point if numeric perfix argument ARG is non-nil, the file
2882 associated with the entry at point, or, if both sources did not
2883 provide any files, the audio file that is currently played by
2886 (cl-assert (ampc-in-ampc-p))
2887 (unless ampc-tagger-version-verified
2889 (ampc-tagger-call "--version")
2890 (goto-char (point-min))
2891 (let ((version (buffer-substring (line-beginning-position)
2892 (line-end-position))))
2893 (unless (equal version ampc-tagger-version)
2894 (message (concat "The reported version of %s is not supported - "
2895 "got \"%s\", want \"%s\"")
2896 ampc-tagger-executable
2898 ampc-tagger-version)
2899 (cl-return-from ampc-tagger))))
2900 (setf ampc-tagger-version-verified t))
2901 (unless ampc-tagger-genres
2903 (ampc-tagger-call "--genres")
2904 (cl-loop while (search-backward-regexp "^\\(.+\\)$" nil t)
2905 do (push (match-string 1) ampc-tagger-genres))))
2906 (unless ampc-tagger-music-directories
2907 (message (concat "ampc-tagger-music-directories is nil. Fill it via "
2908 "M-x customize-variable RET ampc-tagger-music-directories "
2910 (cl-return-from ampc-tagger))
2911 (cl-case (car ampc-type)
2914 (ampc-with-selection arg
2915 (cl-callf nconc files (list (cdr (assoc "file" (get-text-property
2918 ((playlist tag song)
2920 (ampc-with-selection arg
2921 (ampc-on-files (lambda (file) (push file files)))))
2922 (cl-callf nreverse files))
2924 (let ((file (cdr (assoc 'file ampc-status))))
2926 (setf files (list file))))))
2927 (cl-loop for file in-ref files
2928 for read-file = (locate-file file ampc-tagger-music-directories)
2929 do (unless read-file
2930 (error "Cannot locate file %s in ampc-tagger-music-directories"
2932 (cl-return-from ampc-tagger))
2933 (setf file (expand-file-name read-file)))
2934 (setf ampc-tagger-previous-configuration
2935 (list (current-window-configuration) ampc-windows))
2936 (when (ampc-tag-files files)
2937 (setf ampc-tagger-previous-configuration nil)))
2939 (defun ampc-store (&optional name-or-append)
2940 "Store current playlist as NAME-OR-APPEND.
2941 If NAME is non-nil and not a string, append selected entries
2942 within the current playlist buffer to the selected playlist. If
2943 NAME-OR-APPEND is a negative integer, append the next (-
2944 NAME-OR-APPEND) entries after point within the current playlist
2945 buffer to the selected playlist. If NAME-OR-APPEND is nil, read
2946 playlist name from the minibuffer."
2948 (cl-assert (ampc-in-ampc-p))
2949 (unless name-or-append
2950 (setf name-or-append (read-from-minibuffer "Save playlist as: ")))
2951 (if (stringp name-or-append)
2952 (ampc-send-command 'save '(:full-remove t) (ampc-quote name-or-append))
2953 (if (not (ampc-playlist))
2954 (message "No playlist selected")
2955 (ampc-with-buffer 'current-playlist
2956 (when name-or-append
2957 (cl-callf prefix-numeric-value name-or-append))
2958 (ampc-with-selection (if (and name-or-append (< name-or-append 0))
2964 (ampc-quote (ampc-playlist))
2965 (ampc-quote (cdr (assoc "file"
2966 (get-text-property (point) 'data))))))))))
2968 (cl-defun ampc-goto-current-song (&aux (song (cdr (assq 'song ampc-status))))
2969 "Select the current playlist window and move point to the current song."
2971 (cl-assert (ampc-in-ampc-p))
2972 (let ((window (ampc-with-buffer 'current-playlist
2973 (selected-window))))
2975 (select-window window)
2977 (goto-char (point-min))
2978 (forward-line (string-to-number song)))
2979 (ampc-align-point))))
2981 (defun ampc-previous-line (&optional arg)
2982 "Go to previous ARG'th entry in the current buffer.
2985 (cl-assert (ampc-in-ampc-p t))
2986 (ampc-next-line (* (or arg 1) -1)))
2988 (defun ampc-next-line (&optional arg)
2989 "Go to next ARG'th entry in the current buffer.
2992 (cl-assert (ampc-in-ampc-p t))
2995 (progn (forward-line -1)
3001 (cl-defun ampc-suspend (&optional (run-hook t))
3003 This function resets the window configuration, but does not close
3004 the connection to MPD or destroy the internal cache of ampc.
3005 This means subsequent startups of ampc will be faster."
3007 (when ampc-working-timer
3008 (cancel-timer ampc-working-timer))
3009 (ampc-restore-window-configuration)
3010 (cl-loop for b in ampc-all-buffers
3011 do (when (buffer-live-p b)
3013 (setf ampc-windows nil
3014 ampc-all-buffers nil
3015 ampc-working-timer nil)
3017 (run-hooks 'ampc-suspend-hook)))
3020 "Select song to play via `completing-read'."
3022 (cl-assert (ampc-on-p))
3023 (ampc-send-command 'mini-playlistinfo))
3025 (defun ampc-quit (&optional arg)
3027 If prefix argument ARG is non-nil, kill the MPD instance that
3028 ampc is connected to."
3031 (set-process-filter ampc-connection nil)
3032 (when (equal (car-safe ampc-outstanding-commands) '(idle nil))
3033 (ampc-send-command-impl "noidle")
3034 (with-current-buffer (process-buffer ampc-connection)
3035 (cl-loop do (goto-char (point-min))
3036 until (search-forward-regexp "^\\(ACK\\)\\|\\(OK\\).*\n\\'" nil t)
3038 do (accept-process-output ampc-connection nil 50))))
3039 (ampc-send-command-impl (if arg "kill" "close"))
3040 (delete-process ampc-connection))
3041 (when ampc-working-timer
3042 (cancel-timer ampc-working-timer))
3044 (setf ampc-connection nil
3045 ampc-internal-db nil
3046 ampc-outstanding-commands nil
3048 (run-hooks 'ampc-quit-hook))
3051 (defun ampc-suspended-p ()
3052 "Return non-nil if ampc is suspended."
3054 (and (ampc-on-p) (not ampc-windows)))
3058 "Return non-nil if ampc is connected to the daemon."
3060 (and ampc-connection (memq (process-status ampc-connection) '(open run))))
3063 (defun ampc (&optional host port suspend)
3064 "Ampc is an asynchronous client for the MPD media player.
3065 This function is the main entry point for ampc.
3067 HOST and PORT specify the MPD instance to connect to. The values
3068 default to the ones specified in `ampc-default-server'."
3070 (unless (byte-code-function-p (symbol-function 'ampc))
3071 (message "You should byte-compile ampc"))
3072 (run-hooks 'ampc-before-startup-hook)
3074 (setf host (or (car ampc-default-server) (read-string "Host: "))))
3076 (setf port (or (cdr ampc-default-server) (read-string "Port: "))))
3077 (when (and ampc-connection
3078 (not (and (equal host ampc-host)
3079 (equal port ampc-port)
3082 (unless ampc-connection
3083 (let ((connection (open-network-stream "ampc"
3084 (with-current-buffer
3085 (get-buffer-create " *ampc*")
3090 :type 'plain :return-list t)))
3091 (unless (car connection)
3092 (error "Failed connecting to server: %s"
3093 (plist-get ampc-connection :error)))
3094 (setf ampc-connection (car connection)
3097 (set-process-coding-system ampc-connection 'utf-8-unix 'utf-8-unix)
3098 (set-process-filter ampc-connection 'ampc-filter)
3099 (set-process-query-on-exit-flag ampc-connection nil)
3100 (setf ampc-outstanding-commands '((setup))))
3103 (ampc-configure-frame (cl-cddadr ampc-views)))
3104 (run-hooks 'ampc-connected-hook)
3107 (ampc-filter (process-buffer ampc-connection) nil))
3112 ;; eval: (outline-minor-mode 1)
3113 ;; outline-regexp: ";;; \\*+"
3115 ;; indent-tabs-mode: nil
3117 ;;; ampc.el ends here