1 ;;; ampc.el --- Asynchronous Music Player Controller -*- lexical-binding: t -*-
3 ;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
5 ;; Author: Christopher Schmidt <christopher@ch.ristopher.com>
6 ;; Maintainer: Christopher Schmidt <christopher@ch.ristopher.com>
9 ;; Keywords: ampc, mpc, mpd
10 ;; Compatibility: GNU Emacs: 24.x
12 ;; This file is part of ampc.
14 ;; This program is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
19 ;; This program is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
29 ;; ampc is a controller for the Music Player Daemon (http://mpd.wikia.com/).
32 ;; If you use GNU ELPA, install ampc via M-x package-list-packages RET or
33 ;; (package-install 'ampc). Otherwise, grab the files in this repository and
34 ;; put the Emacs Lisp ones somewhere in your load-path or add the directory the
35 ;; files are in to it, e.g.:
37 ;; (add-to-list 'load-path "~/.emacs.d/ampc")
38 ;; (autoload 'ampc "ampc" nil t)
40 ;; Byte-compile ampc (M-x byte-compile-file RET /path/to/ampc.el RET) to improve
44 ;; ampc is not only a frontend to MPD but also a full-blown audio file tagger.
45 ;; To use this feature you have to build the backend application, `ampc_tagger',
46 ;; which in turn uses TagLib (http://taglib.github.com/), a dual-licended
47 ;; (LGPL/MPL) audio meta-data library written in C++. TagLib has no
48 ;; dependencies on its own.
50 ;; To build `ampc_tagger', locate ampc_tagger.cpp. The file can be found in the
51 ;; directory in which this file, ampc.el, is located. Compile the file and
52 ;; either customize `ampc-tagger-executable' to point to the binary file or move
53 ;; the executable in a suitable directory so Emacs finds it via consulting
56 ;; g++ -O2 ampc_tagger.cpp -oampc_tagger -ltag && sudo cp ampc_tagger /usr/local/bin && rm ampc_tagger
58 ;; You have to customize `ampc-tagger-music-directories' in order to use the
59 ;; tagger. This variable should be a list of directories in which your music
60 ;; files are located. Usually this list should have only one entry, the value
61 ;; of your mpd.conf's `music_directory'.
63 ;; If `ampc-tagger-backup-directory' is non-nil, the tagger saved copies of all
64 ;; files that are about to be modified to this directory. Emacs's regular
65 ;; numeric backup filename syntax is used for the backup file names. By default
66 ;; `ampc-tagger-backup-directory' is set to "~/.emacs.d/ampc-backups/".
69 ;; To invoke ampc call the command `ampc', e.g. via M-x ampc RET. The first
70 ;; argument to `ampc' is the host, the second is the port. Both values default
71 ;; to nil. If nil, ampc will use the value specified in `ampc-default-server',
72 ;; by default localhost:6600. To make ampc use the full frame rather than the
73 ;; selected window for its window setup, customise `ampc-use-full-frame' to a
76 ;; ampc offers three independent views which expose different parts of the user
77 ;; interface. The current playlist view, the default view at startup, may be
78 ;; accessed using the `J' key (that is `S-j'). The playlist view may be
79 ;; accessed using the `K' key. The outputs view may be accessed by pressing
82 ;;; *** current playlist view
83 ;; The playlist view looks like this:
85 ;; .........................
94 ;; .........................
96 ;; Window one exposes basic information about the daemon, such as the current
97 ;; state (stop/play/pause), the song currently playing or the volume.
99 ;; All windows, except the status window, contain a tabular list of items. Each
100 ;; item may be selected/marked. There may be multiple selections.
102 ;; To mark an entry, move the point to the entry and press `m' (ampc-mark). To
103 ;; unmark an entry, press `u' (ampc-unmark). To unmark all entries, press `U'
104 ;; (ampc-unmark-all). To toggle marks, press `t' (ampc-toggle-marks). Pressing
105 ;; `<down-mouse-1>' with the mouse mouse cursor on a list entry will move point
106 ;; to the entry and toggle the mark. To navigate to the next entry, press `n'
107 ;; (ampc-next-line). Analogous, pressing `p' (ampc-previous-line) moves the
108 ;; point to the previous entry.
110 ;; Window two shows the current playlist. The song that is currently played by
111 ;; the daemon, if any, is highlighted. To delete the selected songs from the
112 ;; playlist, press `d' (ampc-delete). Pressing `<down-mouse-3>' will move the
113 ;; point to the entry under cursor and delete it from the playlist. To move the
114 ;; selected songs up, press `<up>' (ampc-up). Analogous, press `<down>'
115 ;; (ampc-down) to move the selected songs down. Pressing `<return>'
116 ;; (ampc-play-this) or `<down-mouse-2>' will play the song at point/cursor.
118 ;; Windows three to five are tag browsers. You use them to narrow the song
119 ;; database to certain songs. Think of tag browsers as filters, analogous to
120 ;; piping `grep' outputs through additional `grep' filters. The property of the
121 ;; songs that is filtered is displayed in the header line of the window.
123 ;; Window six shows the songs that match the filters defined by windows three to
124 ;; five. To add the selected song to the playlist, press `a' (ampc-add).
125 ;; Pressing `<down-mouse-3>' will move the point to the entry under the cursor
126 ;; and execute `ampc-add'. These key bindings works in tag browsers as well.
127 ;; Calling `ampc-add' in a tag browser adds all songs filtered up to the
128 ;; selected browser to the playlist.
130 ;; The tag browsers of the current playlist view (accessed via `J') are `Genre'
131 ;; (window 3), `Artist' (window 4) and `Album' (window 5). The key `M' may be
132 ;; used to fire up a slightly modified current playlist view. There is no
133 ;; difference to the default current playlist view other than that the tag
134 ;; browsers filter to `Genre' (window 3), `Album' (window 4) and `Artist'
135 ;; (window 5). Metaphorically speaking, the order of the `grep' filters defined
136 ;; by the tag browsers is different.
138 ;;; *** playlist view
139 ;; The playlist view resembles the current playlist view. The window, which
140 ;; exposes the playlist content, is replaced by three windows, vertically
141 ;; arragned, though. The top one still shows the current playlist. The bottom
142 ;; one shows a list of stored playlists. The middle window exposes the content
143 ;; of the selected (stored) playlist. All commands that used to work in the
144 ;; current playlist view and modify the current playlist now modify the selected
145 ;; (stored) playlist unless the point is within the current playlist buffer.
146 ;; The list of stored playlists is the only view in ampc that may have only one
149 ;; To queue a playlist, press `l' (ampc-load) or `<down-mouse-2>'. To delete a
150 ;; playlist, press `d' (ampc-delete-playlist) or `<down-mouse-3>'. The command
151 ;; `ampc-rename-playlist', bound to `r', can be used to rename a playlist.
153 ;; Again, the key `<' may be used to setup a playlist view with a different
154 ;; order of tag browsers.
157 ;; The outputs view contains a single list which shows the configured outputs of
158 ;; MPD. To toggle the enabled property of the selected outputs, press `a'
159 ;; (ampc-toggle-output-enabled) or `<mouse-3>'.
162 ;; To start the tagging subsystem, press `I' (ampc-tagger). This key binding
163 ;; works in every buffer associated with ampc. First, the command tries to
164 ;; determine which files you want to tag. The files are collected using either
165 ;; the selected entries within the current buffer, the file associated with the
166 ;; entry at point, or, if both sources did not provide any files, the audio file
167 ;; that is currently played by MPD. Next, the tagger view is created. On the
168 ;; right there is the buffer that contain the tag data. Each line in this
169 ;; buffer represents a tag with a value. Tag and value are separated by a
170 ;; colon. Valid tags are "Title", "Artist", "Album", "Comment", "Genre", "Year"
171 ;; and "Track". The value can be an arbitrary string. Whitespaces in front and
172 ;; at the end of the value are ignored. If the value is "<keep>", the tag line
175 ;; To save the specified tag values back to the files, press `C-c C-c'
176 ;; (ampc-tagger-save). To exit the tagger and restore the previous window
177 ;; configuration, press `C-c C-q'. `C-u C-c C-c' saved the tags and exits the
178 ;; tagger. Only tags that are actually specified within the tagger buffer
179 ;; written back to the file. Other tags will not be touched by ampc. For
180 ;; example, to clear the "Commentary" tag, you need to specify the line
184 ;; In the tagger buffer. Omitting this line will make the tagger not touch the
185 ;; "Commentary" tag at all.
187 ;; On the right there is the files list buffer. The selection of this buffer
188 ;; specifies which files the command `ampc-tag-save' will write to. If no file
189 ;; is selected, the file at point in the file list buffer is used.
191 ;; To reset the values of the tags specified in the tagger buffer to the common
192 ;; values of all selected files specified by the selection of the files list
193 ;; buffer, press `C-c C-r' (ampc-tagger-reset). With a prefix argument,
194 ;; `ampc-tagger-reset' restores missing tags as well.
196 ;; You can use tab-completion within the tagger buffer for both tags and tag
199 ;; You can also use the tagging subsystem on its own without a running ampc
200 ;; instance. To start the tagger, call `ampc-tag-files'. This function accepts
201 ;; one argument, a list of absolute file names which are the files to tag. ampc
202 ;; provides a minor mode for dired, `ampc-tagger-dired-mode'. If this mode is
203 ;; enabled within a dired buffer, pressing `C-c C-t' (ampc-tagger-dired) will
204 ;; start the tagger on the current selection.
206 ;; The following ampc-specific hooks are run during tagger usage:
208 ;; `ampc-tagger-grab-hook': Run by the tagger before grabbing tags of a file.
209 ;; Each function is called with one argument, the file name.
211 ;; `ampc-tagger-grabbed-hook': Run by the tagger after grabbing tags of a file.
212 ;; Each function is called with one argument, the file name.
214 ;; `ampc-tagger-store-hook': Run by the tagger before writing tags back to a
215 ;; file. Each function is called with two arguments, FOUND-CHANGED and DATA.
216 ;; FOUND-CHANGED is non-nil if the tags that are about to be written differ from
217 ;; the ones in the file. DATA is a cons. The car specifies the full file name
218 ;; of the file that is about to be written to, the cdr is an alist that
219 ;; specifies the tags that are about to be (over-)written. The car of each
220 ;; entry in this list is a symbol specifying the tag (one of the ones in
221 ;; `ampc-tagger-tags'), the cdr a string specifying the value. The cdr of DATA
222 ;; may be modified. If FOUND-CHANGED is nil and the cdr of DATA is not modified
223 ;; throughout the hook is run, the file is not touched.
224 ;; `ampc-tagger-stored-hook' is still run, though.
226 ;; `ampc-tagger-stored-hook': Run by the tagger after writing tags back to a
227 ;; file. Each function is called with two arguments, FOUND-CHANGED and DATA.
228 ;; These are the same arguments that were already passed to
229 ;; `ampc-tagger-store-hook'. The car of DATA, the file name, may be modified.
231 ;; These hooks can be used to handle vc locking and unlocking of files. For
232 ;; renaming files according to their (new) tag values, ampc provides the
233 ;; function `ampc-tagger-rename-artist-title' which may be added to
234 ;; `ampc-tagger-stored-hook'. The new file name generated by this function is
235 ;; "Artist"_-_"Title"."extension". Characters within "Artist" and "Title" that
236 ;; are not alphanumeric are substituted with underscores.
239 ;; Aside from `J', `M', `K', `<' and `L', which may be used to select different
240 ;; views, and `I' which starts the tagger, ampc defines the following global
241 ;; keys. These binding are available in every buffer associated with ampc:
243 ;; `k' (ampc-toggle-play): Toggle play state. If MPD does not play a song,
244 ;; start playing the song at point if the current buffer is the playlist buffer,
245 ;; otherwise start at the beginning of the playlist. With numeric prefix
246 ;; argument 4, stop player rather than pause if applicable.
248 ;; `l' (ampc-next): Play next song.
249 ;; `j' (ampc-previous): Play previous song
251 ;; `c' (ampc-clear): Clear playlist.
252 ;; `s' (ampc-shuffle): Shuffle playlist.
254 ;; `S' (ampc-store): Store playlist.
255 ;; `O' (ampc-load): Load selected playlist into the current playlist.
256 ;; `R' (ampc-rename-playlist): Rename selected playlist.
257 ;; `D' (ampc-delete-playlist): Delete selected playlist.
259 ;; `y' (ampc-increase-volume): Increase volume.
260 ;; `M-y' (ampc-decrease-volume): Decrease volume.
261 ;; `C-M-y' (ampc-set-volume): Set volume.
262 ;; `h' (ampc-increase-crossfade): Increase crossfade.
263 ;; `M-h' (ampc-decrease-crossfade): Decrease crossfade.
264 ;; `C-M-h' (ampc-set-crossfade): Set crossfade.
266 ;; `e' (ampc-toggle-repeat): Toggle repeat state.
267 ;; `r' (ampc-toggle-random): Toggle random state.
268 ;; `f' (ampc-toggle-consume): Toggle consume state.
270 ;; `P' (ampc-goto-current-song): Select the current playlist window and move
271 ;; point to the current song.
272 ;; `G' (ampc-mini): Select song to play via `completing-read'.
274 ;; `T' (ampc-trigger-update): Trigger a database update.
275 ;; `Z' (ampc-suspend): Suspend ampc.
276 ;; `q' (ampc-quit): Quit ampc.
278 ;; The keymap of ampc is designed to fit the QWERTY United States keyboard
279 ;; layout. If you use another keyboard layout, feel free to modify
280 ;; `ampc-mode-map'. For example, I use a regular QWERTZ German keyboard
281 ;; (layout), so I modify `ampc-mode-map' in my init.el like this:
283 ;; (eval-after-load 'ampc
284 ;; '(flet ((substitute-ampc-key
286 ;; (define-key ampc-mode-map to (lookup-key ampc-mode-map from))
287 ;; (define-key ampc-mode-map from nil)))
288 ;; (substitute-ampc-key (kbd "z") (kbd "Z"))
289 ;; (substitute-ampc-key (kbd "y") (kbd "z"))
290 ;; (substitute-ampc-key (kbd "M-y") (kbd "M-z"))
291 ;; (substitute-ampc-key (kbd "C-M-y") (kbd "C-M-z"))
292 ;; (substitute-ampc-key (kbd "<") (kbd ";"))))
294 ;; If ampc is suspended, you can still use every interactive command that does
295 ;; not directly operate on or with the user interace of ampc. For example it is
296 ;; perfectly fine to call `ampc-increase-volume' or `ampc-toggle-play' via M-x
297 ;; RET. Especially the commands `ampc-status' and `ampc-mini' are predesignated
298 ;; to be bound in the global keymap and called when ampc is suspended.
299 ;; `ampc-status' messages the information that is displayed by the status window
300 ;; of ampc. `ampc-mini' lets you select a song to play via `completing-read'.
301 ;; To start ampc suspended, call `ampc' with the third argument being non-nil.
302 ;; To check whether ampc is connected to the daemon and/or suspended, call
303 ;; `ampc-is-on-p' or `ampc-suspended-p'.
305 ;; (global-set-key (kbd "<f7>")
308 ;; (unless (ampc-on-p)
311 ;; (global-set-key (kbd "<f8>")
314 ;; (unless (ampc-on-p)
322 (require 'network-stream
)
327 "Asynchronous client for the Music Player Daemon."
330 :group
'applications
)
333 (defcustom ampc-debug nil
334 "Non-nil means log outgoing communication between ampc and MPD.
335 If the value is neither t nor nil, also log incoming data."
336 :type
'(choice (const :tag
"Disable" nil
)
337 (const :tag
"Outgoing" t
)
338 (const :tag
"Incoming and outgoing" full
)))
340 (defcustom ampc-use-full-frame nil
341 "If non-nil, ampc will use the entire Emacs screen."
344 (defcustom ampc-truncate-lines t
345 "If non-nil, truncate lines in ampc buffers."
348 (defcustom ampc-default-server
'("localhost" .
6600)
349 "The MPD server to connect to if the arguments to `ampc' are nil.
350 This variable is a cons cell, with the car specifying the
351 hostname and the cdr specifying the port. Both values can be
352 nil, which will make ampc query the user for values on each
354 :type
'(cons (choice :tag
"Hostname"
356 (const :tag
"Ask" nil
))
360 (const :tag
"Ask" nil
))))
362 (defcustom ampc-synchronous-commands
'(t status currentsong play
)
363 "List of MPD commands that should be executed synchronously.
364 Executing commands that print lots of output synchronously will
365 result in massive performance improvements of ampc. If the car
366 of this list is t, execute all commands synchronously other
367 than the ones specified by the rest of the list."
368 :type
'(repeat symbol
))
370 (defcustom ampc-status-tags nil
371 "List of additional tags of the current song that are added to
372 the internal status of ampc and thus are passed to the functions
373 in `ampc-status-changed-hook'. Each element may be a string that
374 specifies a tag that is returned by MPD's `currentsong'
376 :type
'(list symbol
))
378 (defcustom ampc-volume-step
5
379 "Default step of `ampc-increase-volume' and
380 `ampc-decrease-volume' for changing the volume."
383 (defcustom ampc-crossfade-step
5
384 "Default step of `ampc-increase-crossfade' and
385 `ampc-decrease-crossfade' for changing the crossfade."
388 (defcustom ampc-tag-transform-funcs
'(("Time" . ampc-transform-time
)
389 ("Track" . ampc-transform-track
))
390 "Alist of tag treatment functions.
391 The car, a string, of each entry specifies the MPD tag, the cdr a
392 function which transforms the tag to the value that should be
393 used by ampc. The function is called with one string argument,
394 the tag value, and should return the treated value."
395 :type
'(alist :key-type string
:value-type function
))
397 (defcustom ampc-tagger-music-directories nil
398 "List of base directories in which your music files are located.
399 Usually this list should have only one entry, the value of your
400 mpd.conf's `music_directory'"
401 :type
'(list directory
))
403 (defcustom ampc-tagger-executable
"ampc_tagger"
404 "The name or full path to ampc's tagger executable."
407 (defcustom ampc-tagger-backup-directory
408 (file-name-directory (locate-user-emacs-file "ampc-backups/"))
409 "The directory in which the tagger copies files before modifying.
410 If nil, disable backups."
411 :type
'(choice (const :tag
"Disable backups" nil
)
412 (directory :tag
"Directory")))
415 (defcustom ampc-before-startup-hook nil
416 "A hook run before startup.
417 This hook is called as the first thing when ampc is started."
420 (defcustom ampc-connected-hook nil
421 "A hook run after ampc connected to MPD."
424 (defcustom ampc-suspend-hook nil
425 "A hook run when suspending ampc."
428 (defcustom ampc-quit-hook nil
429 "A hook run when exiting ampc."
432 (defcustom ampc-status-changed-hook nil
433 "A hook run whenever the status of the daemon (that is volatile
434 properties such as volume or current song) changes. The hook is
435 run with one arg, an alist that contains the new status. The car
436 of each entry is a symbol, the cdr is a string. Valid keys are:
448 and the keys in `ampc-status-tags'. Not all keys may be present
452 (defcustom ampc-tagger-grab-hook nil
453 "Hook run by the tagger before grabbing tags of a file.
454 Each function is called with one argument, the file name."
456 (defcustom ampc-tagger-grabbed-hook nil
457 "Hook run by the tagger after grabbing tags of a file.
458 Each function is called with one argument, the file name."
461 (defcustom ampc-tagger-store-hook nil
462 "Hook run by the tagger before writing tags back to a file.
463 Each function is called with two arguments, FOUND-CHANGED and
464 DATA. FOUND-CHANGED is non-nil if the tags that are about to be
465 written differ from the ones in the file. DATA is a cons. The
466 car specifies the full file name of the file that is about to be
467 written to, the cdr is an alist that specifies the tags that are
468 about to be (over-)written. The car of each entry in this list
469 is a symbol specifying the tag (one of the ones in
470 `ampc-tagger-tags'), the cdr a string specifying the value. The
471 cdr of DATA may be modified. If FOUND-CHANGED is nil and the cdr
472 of DATA is not modified throughout the hook is run, the file is
473 not touched. `ampc-tagger-stored-hook' is still run, though."
475 (defcustom ampc-tagger-stored-hook nil
476 "Hook run by the tagger after writing tags back to a file.
477 Each function is called with two arguments, FOUND-CHANGED and
478 DATA. These are the same arguments that were already passed to
479 `ampc-tagger-store-hook'. The car of DATA, the file name, may be
484 (defface ampc-mark-face
'((t (:inherit font-lock-constant-face
)))
486 (defface ampc-marked-face
'((t (:inherit warning
)))
487 "Face of marked entries.")
488 (defface ampc-unmarked-face
'((t (:inerhit default
)))
489 "Face of unmarked entries.")
490 (defface ampc-current-song-mark-face
'((t (:inherit region
)))
491 "Face of mark of the current song.")
492 (defface ampc-current-song-marked-face
'((t (:inherit region
)))
493 "Face of the current song if marked.")
495 (defface ampc-tagger-tag-face
'((t (:inherit font-lock-constant-face
)))
496 "Face of tags within the tagger.")
497 (defface ampc-tagger-keyword-face
'((t (:inherit font-lock-keyword-face
)))
498 "Face of tags within the tagger.")
500 ;;; *** internal variables
502 (let* ((songs '(1.0 song
:properties
(("Track" :title
"#" :width
4)
503 ("Title" :min
15 :max
40)
505 ("Artist" :min
15 :max
40)
506 ("Album" :min
15 :max
40))))
509 (0.33 tag
:tag
"Genre" :id
1 :select t
)
510 (0.33 tag
:tag
"Artist" :id
2)
511 (1.0 tag
:tag
"Album" :id
3))
515 (0.33 tag
:tag
"Genre" :id
1 :select t
)
516 (0.33 tag
:tag
"Album" :id
2)
517 (1.0 tag
:tag
"Artist" :id
3))
519 (pl-prop '(:properties
(("Title" :min
15 :max
40)
520 ("Artist" :min
15 :max
40)
521 ("Album" :min
15 :max
40)
522 ("Time" :width
6)))))
526 :properties
((filename :shrink t
:title
"File" :min
20 :max
40)
527 ("Title" :min
15 :max
40)
528 ("Artist" :min
15 :max
40)
529 ("Album" :min
15 :max
40)
530 ("Genre" :min
15 :max
40)
532 ("Track" :title
"#" :width
4)
533 ("Comment" :min
15 :max
40))
536 ("Current playlist view (Genre|Artist|Album)"
541 (1.0 current-playlist
,@pl-prop
))
543 ("Current playlist view (Genre|Album|Artist)"
548 (1.0 current-playlist
,@pl-prop
))
550 ("Playlist view (Genre|Artist|Album)"
556 (0.4 current-playlist
,@pl-prop
)
557 (0.4 playlist
,@pl-prop
)
560 ("Playlist view (Genre|Album|Artist)"
566 (0.4 current-playlist
,@pl-prop
)
567 (0.4 playlist
,@pl-prop
)
572 outputs
:properties
(("outputname" :title
"Name" :min
10 :max
30)
573 ("outputenabled" :title
"Enabled" :width
9))))))
575 (defvar ampc-connection nil
)
576 (defvar ampc-host nil
)
577 (defvar ampc-port nil
)
578 (defvar ampc-outstanding-commands nil
)
580 (defvar ampc-no-implicit-next-dispatch nil
)
581 (defvar ampc-working-timer nil
)
582 (defvar ampc-yield nil
)
583 (defvar ampc-yield-redisplay nil
)
585 (defvar ampc-windows nil
)
586 (defvar ampc-all-buffers nil
)
588 (defvar ampc-type nil
)
589 (make-variable-buffer-local 'ampc-type
)
590 (defvar ampc-dirty nil
)
591 (make-variable-buffer-local 'ampc-dirty
)
593 (defvar ampc-internal-db nil
)
594 (defvar ampc-status nil
)
596 (defvar ampc-tagger-previous-configuration nil
)
597 (defvar ampc-tagger-version-verified nil
)
598 (defvar ampc-tagger-completion-all-files nil
)
599 (defvar ampc-tagger-genres nil
)
601 (defconst ampc-tagger-version
"0.1")
602 (defconst ampc-tagger-tags
'(Title Artist Album Comment Genre Year Track
))
605 (defvar ampc-mode-map
606 (let ((map (make-sparse-keymap)))
607 (suppress-keymap map
)
608 (define-key map
(kbd "k") 'ampc-toggle-play
)
609 (define-key map
(kbd "l") 'ampc-next
)
610 (define-key map
(kbd "j") 'ampc-previous
)
611 (define-key map
(kbd "c") 'ampc-clear
)
612 (define-key map
(kbd "s") 'ampc-shuffle
)
613 (define-key map
(kbd "S") 'ampc-store
)
614 (define-key map
(kbd "O") 'ampc-load
)
615 (define-key map
(kbd "R") 'ampc-rename-playlist
)
616 (define-key map
(kbd "D") 'ampc-delete-playlist
)
617 (define-key map
(kbd "y") 'ampc-increase-volume
)
618 (define-key map
(kbd "M-y") 'ampc-decrease-volume
)
619 (define-key map
(kbd "C-M-y") 'ampc-set-volume
)
620 (define-key map
(kbd "h") 'ampc-increase-crossfade
)
621 (define-key map
(kbd "M-h") 'ampc-decrease-crossfade
)
622 (define-key map
(kbd "C-M-h") 'ampc-set-crossfade
)
623 (define-key map
(kbd "e") 'ampc-toggle-repeat
)
624 (define-key map
(kbd "r") 'ampc-toggle-random
)
625 (define-key map
(kbd "f") 'ampc-toggle-consume
)
626 (define-key map
(kbd "P") 'ampc-goto-current-song
)
627 (define-key map
(kbd "G") 'ampc-mini
)
628 (define-key map
(kbd "q") 'ampc-quit
)
629 (define-key map
(kbd "z") 'ampc-suspend
)
630 (define-key map
(kbd "T") 'ampc-trigger-update
)
631 (define-key map
(kbd "I") 'ampc-tagger
)
632 (loop for view in ampc-views
633 do
(when (stringp (car view
))
634 (define-key map
(cadr view
)
637 (ampc-change-view ',view
)))))
640 (defvar ampc-item-mode-map
641 (let ((map (make-sparse-keymap)))
642 (suppress-keymap map
)
643 (define-key map
(kbd "m") 'ampc-mark
)
644 (define-key map
(kbd "u") 'ampc-unmark
)
645 (define-key map
(kbd "U") 'ampc-unmark-all
)
646 (define-key map
(kbd "n") 'ampc-next-line
)
647 (define-key map
(kbd "p") 'ampc-previous-line
)
648 (define-key map
(kbd "<down-mouse-1>") 'ampc-mouse-toggle-mark
)
649 (define-key map
(kbd "<mouse-1>") 'ampc-mouse-align-point
)
650 (define-key map
[remap next-line
] 'ampc-next-line
)
651 (define-key map
[remap previous-line
] 'ampc-previous-line
)
652 (define-key map
[remap tab-to-tab-stop
] 'ampc-move-to-tab
)
655 (defvar ampc-current-playlist-mode-map
656 (let ((map (make-sparse-keymap)))
657 (suppress-keymap map
)
658 (define-key map
(kbd "<return>") 'ampc-play-this
)
659 (define-key map
(kbd "<down-mouse-2>") 'ampc-mouse-play-this
)
660 (define-key map
(kbd "<mouse-2>") 'ampc-mouse-align-point
)
661 (define-key map
(kbd "<down-mouse-3>") 'ampc-mouse-delete
)
662 (define-key map
(kbd "<mouse-3>") 'ampc-mouse-align-point
)
665 (defvar ampc-playlist-mode-map
666 (let ((map (make-sparse-keymap)))
667 (suppress-keymap map
)
668 (define-key map
(kbd "t") 'ampc-toggle-marks
)
669 (define-key map
(kbd "d") 'ampc-delete
)
670 (define-key map
(kbd "<up>") 'ampc-up
)
671 (define-key map
(kbd "<down>") 'ampc-down
)
672 (define-key map
(kbd "<down-mouse-3>") 'ampc-mouse-delete
)
673 (define-key map
(kbd "<mouse-3>") 'ampc-mouse-align-point
)
676 (defvar ampc-playlists-mode-map
677 (let ((map (make-sparse-keymap)))
678 (suppress-keymap map
)
679 (define-key map
(kbd "l") 'ampc-load
)
680 (define-key map
(kbd "r") 'ampc-rename-playlist
)
681 (define-key map
(kbd "d") 'ampc-delete-playlist
)
682 (define-key map
(kbd "<down-mouse-2>") 'ampc-mouse-load
)
683 (define-key map
(kbd "<mouse-2>") 'ampc-mouse-align-point
)
684 (define-key map
(kbd "<down-mouse-3>") 'ampc-mouse-delete-playlist
)
685 (define-key map
(kbd "<mouse-3>") 'ampc-mouse-align-point
)
688 (defvar ampc-tag-song-mode-map
689 (let ((map (make-sparse-keymap)))
690 (suppress-keymap map
)
691 (define-key map
(kbd "t") 'ampc-toggle-marks
)
692 (define-key map
(kbd "a") 'ampc-add
)
693 (define-key map
(kbd "<down-mouse-3>") 'ampc-mouse-add
)
694 (define-key map
(kbd "<mouse-3>") 'ampc-mouse-align-point
)
697 (defvar ampc-outputs-mode-map
698 (let ((map (make-sparse-keymap)))
699 (suppress-keymap map
)
700 (define-key map
(kbd "t") 'ampc-toggle-marks
)
701 (define-key map
(kbd "a") 'ampc-toggle-output-enabled
)
702 (define-key map
(kbd "<down-mouse-3>") 'ampc-mouse-toggle-output-enabled
)
703 (define-key map
(kbd "<mouse-3>") 'ampc-mouse-align-point
)
706 (defvar ampc-files-list-mode-map
707 (let ((map (make-sparse-keymap)))
708 (suppress-keymap map
)
709 (define-key map
(kbd "t") 'ampc-toggle-marks
)
710 (define-key map
(kbd "C-c C-q") 'ampc-tagger-quit
)
711 (define-key map
(kbd "C-c C-c") 'ampc-tagger-save
)
712 (define-key map
(kbd "C-c C-r") 'ampc-tagger-reset
)
713 (define-key map
[remap ampc-tagger
] nil
)
714 (define-key map
[remap ampc-quit
] 'ampc-tagger-quit
)
715 (loop for view in ampc-views
716 do
(when (stringp (car view
))
717 (define-key map
(cadr view
) nil
)))
720 (defvar ampc-tagger-mode-map
721 (let ((map (make-sparse-keymap)))
722 (define-key map
(kbd "C-c C-q") 'ampc-tagger-quit
)
723 (define-key map
(kbd "C-c C-c") 'ampc-tagger-save
)
724 (define-key map
(kbd "C-c C-r") 'ampc-tagger-reset
)
725 (define-key map
(kbd "<tab>") 'ampc-tagger-completion-at-point
)
728 (defvar ampc-tagger-dired-mode-map
729 (let ((map (make-sparse-keymap)))
730 (define-key map
(kbd "C-c C-t") 'ampc-tagger-dired
)
734 (easy-menu-define nil ampc-mode-map nil
736 ("Change view" ,@(loop for view in ampc-views
737 when
(stringp (car view
))
738 collect
(vector (car view
)
741 (ampc-change-view ',view
)))
743 ["Run tagger" ampc-tagger
]
745 ["Play" ampc-toggle-play
746 :visible
(and ampc-status
747 (not (equal (cdr (assq 'state ampc-status
)) "play")))]
748 ["Pause" ampc-toggle-play
749 :visible
(and ampc-status
750 (equal (cdr (assq 'state ampc-status
)) "play"))]
751 ["Stop" (lambda () (interactive) (ampc-toggle-play 4))
752 :visible
(and ampc-status
753 (equal (cdr (assq 'state ampc-status
)) "play"))]
755 ["Previous" ampc-previous
]
757 ["Clear playlist" ampc-clear
]
758 ["Shuffle playlist" ampc-shuffle
]
759 ["Store playlist" ampc-store
]
760 ["Queue Playlist" ampc-load
:visible
(ampc-playlist)]
761 ["Rename Playlist" ampc-rename-playlist
:visible
(ampc-playlist)]
762 ["Delete Playlist" ampc-delete-playlist
:visible
(ampc-playlist)]
764 ["Increase volume" ampc-increase-volume
]
765 ["Decrease volume" ampc-decrease-volume
]
766 ["Set volume" ampc-set-volume
]
767 ["Increase crossfade" ampc-increase-crossfade
]
768 ["Decrease crossfade" ampc-decrease-crossfade
]
769 ["Set crossfade" ampc-set-crossfade
]
770 ["Toggle repeat" ampc-toggle-repeat
772 :selected
(equal (cdr (assq 'repeat ampc-status
)) "1")]
773 ["Toggle random" ampc-toggle-random
775 :selected
(equal (cdr (assq 'random ampc-status
)) "1")]
776 ["Toggle consume" ampc-toggle-consume
778 :selected
(equal (cdr (assq 'consume ampc-status
)) "1")]
780 ["Trigger update" ampc-trigger-update
]
781 ["Suspend" ampc-suspend
]
784 (easy-menu-define ampc-selection-menu ampc-item-mode-map
785 "Selection menu for ampc"
787 ["Add to playlist" ampc-add
788 :visible
(not (eq (car ampc-type
) 'outputs
))]
789 ["Toggle enabled" ampc-toggle-output-enabled
790 :visible
(eq (car ampc-type
) 'outputs
)]
792 ["Next line" ampc-next-line
]
793 ["Previous line" ampc-previous-line
]
795 ["Unmark" ampc-unmark
]
796 ["Unmark all" ampc-unmark-all
]
797 ["Toggle marks" ampc-toggle-marks
798 :visible
(not (eq (car ampc-type
) 'playlists
))]))
800 (defvar ampc-tool-bar-map
801 (let ((map (make-sparse-keymap)))
803 "mpc/prev" 'ampc-previous
'previous map
806 "mpc/play" 'ampc-toggle-play
'play map
808 :visible
'(and ampc-status
809 (not (equal (cdr (assq 'state ampc-status
)) "play"))))
811 "mpc/pause" 'ampc-toggle-play
'pause map
813 :visible
'(and ampc-status
814 (equal (cdr (assq 'state ampc-status
)) "play")))
816 "mpc/stop" (lambda () (interactive) (ampc-toggle-play 4)) 'stop map
818 :visible
'(and ampc-status
819 (equal (cdr (assq 'state ampc-status
)) "play")))
821 "mpc/next" 'ampc-next
'next map
827 (defmacro ampc-with-buffer
(type &rest body
)
828 (declare (indent 1) (debug t
))
829 `(let* ((type- ,type
)
830 (w (if (windowp type-
)
832 (loop for w in
(ampc-normalize-windows)
833 thereis
(when (with-current-buffer
836 (symbol (eq (car ampc-type
) type-
))
837 (cons (equal ampc-type type-
))))
840 (with-selected-window w
841 (with-current-buffer (window-buffer w
)
842 (let ((inhibit-read-only t
))
843 ,@(if (eq (car body
) 'no-se
)
846 (goto-char (point-min))
849 (defmacro ampc-fill-skeleton
(tag &rest body
)
850 (declare (indent 1) (debug t
))
852 (data-buffer (current-buffer)))
853 (ampc-with-buffer tag-
855 (unless (eq ampc-dirty
'keep-dirty
)
856 (let ((old-point-data (get-text-property (point) 'cmp-data
))
857 (old-window-start-offset
858 (1- (count-lines (window-start) (point)))))
859 (put-text-property (point-min) (point-max) 'not-updated t
)
860 (when (eq ampc-dirty
'erase
)
861 (put-text-property (point-min) (point-max) 'data nil
))
862 (goto-char (point-min))
864 (goto-char (point-min))
866 do
(if (get-text-property (point) 'not-updated
)
868 (add-text-properties (+ (point) 2)
869 (progn (forward-line nil
)
871 '(mouse-face highlight
))))
872 (remove-text-properties (point-min) (point-max) '(not-updated))
873 (goto-char (point-min))
876 do
(when (equal (get-text-property (point) 'cmp-data
)
881 (forward-line (- old-window-start-offset
))
886 finally do
(goto-char (point-min)))))
887 (let ((effective-height (- (window-height)
888 (if mode-line-format
1 0)
889 (if header-line-format
1 0))))
890 (when (< (- (1- (line-number-at-pos (point-max)))
891 (line-number-at-pos (window-start)))
893 (set-window-start nil
895 (goto-char (point-max))
896 (forward-line (- (1+ effective-height
)))
900 (ampc-set-dirty nil
)))))
902 (defmacro ampc-with-selection
(arg &rest body
)
903 (declare (indent 1) (debug t
))
905 (if (or (and (not arg-
)
907 (goto-char (point-min))
908 (search-forward-regexp "^* " nil t
)))
909 (and arg-
(symbolp arg-
)))
910 (loop initially do
(goto-char (point-min))
911 finally do
(ampc-align-point)
912 while
(search-forward-regexp "^* " nil t
)
916 (setf arg-
(prefix-numeric-value arg-
))
919 for index from
0 to
(1- (abs arg-
))
922 until
(if (< arg-
0) (ampc-previous-line) (ampc-next-line))))))
924 (defmacro ampc-iterate-source
(data-buffer delimiter bindings
&rest body
)
925 (declare (indent 3) (debug t
))
926 (when (memq (intern delimiter
) bindings
)
927 (callf2 delq
(intern delimiter
) bindings
)
928 (push (list (intern delimiter
)
929 '(buffer-substring (point) (line-end-position)))
931 `(,@(if data-buffer
`(with-current-buffer ,data-buffer
) '(progn))
932 (when (search-forward-regexp
933 ,(concat "^" (regexp-quote delimiter
) ": ")
937 (setf next
(ampc-narrow-entry
938 ,(concat "^" (regexp-quote delimiter
) ": ")))
939 (let ,(loop for binding in bindings
943 collect
`(,binding
(ampc-extract
945 ,(symbol-name binding
))))
949 do
(goto-char next
)))))
951 (defmacro ampc-iterate-source-output
(delimiter bindings pad-data
&rest body
)
952 (declare (indent 2) (debug t
))
953 `(let ((output-buffer (current-buffer))
954 (tags (loop for
(tag . props
) in
955 (plist-get (cdr ampc-type
) :properties
)
956 collect
(cons tag
(ampc-extract-regexp tag
)))))
958 data-buffer
,delimiter
,bindings
959 (let ((pad-data ,pad-data
))
960 (with-current-buffer output-buffer
961 (ampc-insert (ampc-pad pad-data
) ,@body
))))))
963 (defmacro ampc-extract-regexp
(tag)
965 (concat "^" (regexp-quote tag
) ": \\(.*\\)$")
966 `(concat "^" (regexp-quote ,tag
) ": \\(.*\\)$")))
968 (defmacro ampc-tagger-log
(&rest what
)
969 (declare (indent 0) (debug t
))
970 `(with-current-buffer (get-buffer-create "*Tagger Log*")
971 (ampc-tagger-log-mode)
973 (goto-char (point-max))
974 (let ((inhibit-read-only t
)
975 (what (concat ,@what
)))
977 (message "ampc: %s" what
))
981 (define-derived-mode ampc-outputs-mode ampc-item-mode
"ampc-o")
983 (define-derived-mode ampc-tag-song-mode ampc-item-mode
"ampc-ts")
985 (define-derived-mode ampc-current-playlist-mode ampc-playlist-mode
"ampc-cpl"
986 (ampc-highlight-current-song-mode))
988 (define-derived-mode ampc-playlist-mode ampc-item-mode
"ampc-pl")
990 (define-derived-mode ampc-playlists-mode ampc-item-mode
"ampc-pls")
992 (define-derived-mode ampc-files-list-mode ampc-item-mode
"ampc-files-list")
994 (define-derived-mode ampc-tagger-mode nil
"ampc-tagger"
995 (set (make-local-variable 'tool-bar-map
) ampc-tool-bar-map
)
996 (set (make-local-variable 'tab-stop-list
)
997 (list (+ (loop for tag in ampc-tagger-tags
998 maximize
(length (symbol-name tag
)))
1000 (set (make-local-variable 'completion-at-point-functions
)
1001 '(ampc-tagger-complete-tag ampc-tagger-complete-value
))
1002 (setf truncate-lines ampc-truncate-lines
1004 `(((,(concat "^\\([ \t]*\\(?:"
1005 (mapconcat 'symbol-name ampc-tagger-tags
"\\|")
1009 (mapconcat 'identity ampc-tagger-genres
"\\|") "\\|<keep>"
1012 (1 'ampc-tagger-tag-face
)
1013 (2 'ampc-tagger-keyword-face
)))
1016 (define-derived-mode ampc-tagger-log-mode nil
"ampc-tagger-log")
1018 (define-derived-mode ampc-item-mode ampc-mode
"ampc-item"
1019 (setf font-lock-defaults
'((("^\\(\\*\\)\\(.*\\)$"
1021 (2 'ampc-marked-face
))
1022 ("" 0 'ampc-unmarked-face
))
1025 (define-derived-mode ampc-mode special-mode
"ampc"
1026 (buffer-disable-undo)
1027 (set (make-local-variable 'tool-bar-map
) ampc-tool-bar-map
)
1028 (setf truncate-lines ampc-truncate-lines
1029 mode-line-modified
"--"))
1031 (define-minor-mode ampc-highlight-current-song-mode
""
1035 (funcall (if ampc-highlight-current-song-mode
1036 'font-lock-add-keywords
1037 'font-lock-remove-keywords
)
1039 '((ampc-find-current-song
1040 (1 'ampc-current-song-mark-face
)
1041 (2 'ampc-current-song-marked-face
)))))
1044 (define-minor-mode ampc-tagger-dired-mode
1045 "Minor mode that adds a audio file meta data tagging key binding to dired."
1049 (assert (derived-mode-p 'dired-mode
)))
1051 ;;; *** internal functions
1052 (defun ampc-tagger-report (args status
)
1053 (unless (zerop status
)
1054 (let ((message (format (concat "ampc_tagger (%s %s) returned with a "
1055 "non-zero exit status (%s)")
1056 ampc-tagger-executable
1057 (mapconcat 'identity args
" ")
1059 (ampc-tagger-log message
"\n")
1062 (defun ampc-tagger-call (&rest args
)
1065 (apply 'call-process ampc-tagger-executable nil t nil args
)))
1067 (defun ampc-int-insert-cmp (p1 p2
)
1068 (cond ((< p1 p2
) 'insert
)
1069 ((eq p1 p2
) 'overwrite
)
1072 (defun ampc-normalize-windows ()
1074 (loop for
(window . buffer
) in ampc-windows
1075 collect
(cons (if (and (window-live-p window
)
1076 (eq (window-buffer window
) buffer
))
1078 (get-buffer-window buffer
))
1080 (delq nil
(mapcar 'car ampc-windows
)))
1082 (defun ampc-restore-window-configuration ()
1086 (when (eq (window-frame w
)
1089 (ampc-normalize-windows)))
1091 (loop for w in
(window-list nil nil
(frame-first-window))
1097 (setf (window-dedicated-p (car windows
)) nil
)
1098 (loop for w in
(cdr windows
)
1099 do
(delete-window w
)))))
1101 (defun ampc-tagger-tags-modified (tags new-tags
)
1102 (loop with found-changed
1103 for
(tag . value
) in new-tags
1104 for prop
= (assq tag tags
)
1105 do
(unless (equal (cdr prop
) value
)
1106 (setf (cdr prop
) value
1108 finally return found-changed
))
1110 (defun ampc-change-view (view)
1111 (if (equal ampc-outstanding-commands
'((idle nil
)))
1112 (ampc-configure-frame (cddr view
))
1113 (message "ampc is busy, cannot change window layout")))
1115 (defun ampc-quote (string)
1116 (concat "\"" (replace-regexp-in-string "\"" "\\\"" string
) "\""))
1118 (defun ampc-in-ampc-p (&optional or-in-tagger
)
1119 (or (when (ampc-on-p)
1122 (memq (car ampc-type
) '(files-list tagger
)))))
1124 (defun ampc-add-impl (&optional data
)
1125 (ampc-on-files (lambda (file)
1127 (ampc-send-command 'playlistadd
1129 (ampc-quote (ampc-playlist))
1131 (ampc-send-command 'add
'(:keep-prev t
) (ampc-quote file
)))
1134 (defun ampc-on-files (func &optional data
)
1136 (loop for d in
(get-text-property (line-end-position) 'data
)
1137 do
(ampc-on-files func d
)))
1139 (avl-tree-mapc (lambda (e) (ampc-on-files func
(cdr e
))) data
))
1141 (funcall func data
))
1143 (loop for d in
(reverse data
)
1144 do
(ampc-on-files func
(cdr (assoc "file" d
)))))))
1146 (defun ampc-skip (N)
1149 `(:callback
,(lambda ()
1150 (ampc-send-command 'status
'(:front t
))))
1152 (let ((song (cdr (assq 'song ampc-status
)))
1153 (playlist-length (cdr (assq 'playlistlength ampc-status
))))
1154 (unless (and song playlist-length
)
1156 (max 0 (min (+ (string-to-number song
) N
)
1157 (1- (string-to-number playlist-length
))))))))
1159 (defun* ampc-find-current-song
1160 (limit &aux
(point (point)) (song (cdr (assq 'song ampc-status
))))
1162 (<= (1- (line-number-at-pos (point)))
1163 (setf song
(string-to-number song
)))
1164 (>= (1- (line-number-at-pos limit
)) song
))
1165 (goto-char (point-min))
1168 (narrow-to-region (max point
(point)) (min limit
(line-end-position)))
1169 (search-forward-regexp "\\(?1:\\(\\`\\*\\)?\\)\\(?2:.*\\)$"))))
1171 (defun ampc-set-volume-impl (arg &optional func
)
1173 (setf arg
(prefix-numeric-value arg
)))
1176 `(:callback
,(lambda ()
1177 (ampc-send-command 'status
'(:front t
))))
1184 (cdr (assq 'volume ampc-status
)))
1185 (or arg ampc-volume-step
))
1190 (defun ampc-set-crossfade-impl (arg &optional func
)
1192 (setf arg
(prefix-numeric-value arg
)))
1195 `(:callback
,(lambda ()
1196 (ampc-send-command 'status
'(:front t
))))
1203 (cdr (assq 'xfade ampc-status
)))
1204 (or arg ampc-crossfade-step
))
1208 (defun* ampc-tagger-make-backup
(file)
1209 (unless ampc-tagger-backup-directory
1210 (return-from ampc-tagger-make-backup
))
1211 (when (functionp ampc-tagger-backup-directory
)
1212 (funcall ampc-tagger-backup-directory file
)
1213 (return-from ampc-tagger-make-backup
))
1214 (unless (file-directory-p ampc-tagger-backup-directory
)
1215 (make-directory ampc-tagger-backup-directory t
))
1217 (loop with real-file
= file
1218 for target
= (file-symlink-p real-file
)
1220 do
(setf real-file
(expand-file-name
1221 target
(file-name-directory real-file
)))
1222 finally return real-file
))
1224 (loop with base
= (file-name-nondirectory real-file
)
1226 for file
= (expand-file-name
1230 ampc-tagger-backup-directory
)
1231 while
(file-exists-p file
)
1232 finally return file
)))
1233 (ampc-tagger-log "\tBackup file: " (abbreviate-file-name target
) "\n")
1234 (copy-file real-file target nil t
)))
1236 (defun* ampc-move
(N &aux with-marks entries-to-move
(up (< N
0)))
1238 (goto-char (point-min))
1239 (loop while
(search-forward-regexp "^* " nil t
)
1240 do
(push (point) entries-to-move
)))
1243 (push (point) entries-to-move
))
1244 (when (save-excursion
1245 (loop with max
= (1- (count-lines (point-min) (point-max)))
1246 for p in entries-to-move
1248 for line
= (+ (1- (line-number-at-pos)) N
)
1249 always
(and (>= line
0) (<= line max
))))
1251 (setf entries-to-move
(nreverse entries-to-move
)))
1254 (loop for p in entries-to-move
1256 for line
= (1- (line-number-at-pos))
1257 do
(if (and (not (eq (car ampc-type
) 'current-playlist
))
1259 (ampc-send-command 'playlistmove
1261 (ampc-quote (ampc-playlist))
1264 (ampc-send-command 'move
'(:keep-prev t
) line
(+ line N
))))
1266 (loop for p in
(nreverse entries-to-move
)
1270 (ampc-mark-impl t
1))
1273 (ampc-align-point))))
1275 (defun ampc-toggle-state (state arg
)
1276 (when (or arg ampc-status
)
1281 (if (equal (cdr (assq state ampc-status
)) "1")
1284 ((> (prefix-numeric-value arg
) 0) 1)
1287 (defun ampc-playlist (&optional at-point
)
1288 (ampc-with-buffer 'playlists
1289 (if (and (not at-point
)
1290 (search-forward-regexp "^* \\(.*\\)$" nil t
))
1291 (let ((result (match-string 1)))
1292 (set-text-properties 0 (length result
) nil result
)
1295 (buffer-substring-no-properties
1296 (+ (line-beginning-position) 2)
1297 (line-end-position))))))
1299 (defun* ampc-mark-impl
(select N
&aux result
(inhibit-read-only t
))
1300 (when (eq (car ampc-type
) 'playlists
)
1301 (assert (or (not select
) (null N
) (eq N
1)))
1302 (ampc-with-buffer 'playlists
1303 (loop while
(search-forward-regexp "^\\* " nil t
)
1304 do
(replace-match " " nil nil
))))
1305 (loop repeat
(or N
1)
1307 do
(move-beginning-of-line nil
)
1309 (insert (if select
"*" " "))
1310 (setf result
(ampc-next-line nil
)))
1311 (ampc-post-mark-change-update)
1314 (defun ampc-post-mark-change-update ()
1315 (ecase (car ampc-type
)
1316 ((current-playlist playlist outputs
))
1318 (ampc-update-playlist))
1322 (loop for w on
(ampc-normalize-windows)
1323 thereis
(when (or (eq (car w
) (selected-window))
1324 (and (eq (car ampc-type
) 'tag
)
1325 (eq (with-current-buffer
1326 (window-buffer (car w
))
1330 do
(with-current-buffer (window-buffer w
)
1331 (when (memq (car ampc-type
) '(song tag
))
1332 (ampc-set-dirty t
))))
1333 (ampc-fill-tag-song))
1335 (ampc-tagger-update))))
1337 (defun* ampc-tagger-get-values
(tag all-files
&aux result
)
1338 (ampc-with-buffer 'files-list
1344 `(let ((value (cdr (assq tag
(get-text-property (point) 'data
)))))
1345 (unless (member value result
)
1346 (push value result
)))))
1349 initially do
(goto-char (point-min))
1352 until
(ampc-next-line))
1353 (ampc-with-selection nil
1357 (defun ampc-tagger-update ()
1358 (ampc-with-buffer 'tagger
1360 while
(search-forward-regexp (concat "^[ \t]*\\("
1361 (mapconcat 'symbol-name
1365 "[ \t]*\\(<keep>[ \t]*?\\)"
1369 for tag
= (intern (match-string 1))
1370 do
(when (memq tag ampc-tagger-tags
)
1371 (let ((values (save-match-data (ampc-tagger-get-values tag nil
))))
1372 (when (eq (length values
) 1)
1373 (replace-match (car values
) nil t nil
2)))))))
1375 (defun ampc-tagger-complete-tag ()
1378 (narrow-to-region (line-beginning-position) (line-end-position))
1379 (unless (search-backward-regexp "^.*:" nil t
)
1380 (when (search-backward-regexp "\\(^\\|[ \t]\\).*" nil t
)
1381 (when (looking-at "[ \t]")
1384 (search-forward-regexp ":\\|$")
1385 (mapcar (lambda (tag) (concat (symbol-name tag
) ":"))
1386 ampc-tagger-tags
)))))))
1388 (defun* ampc-tagger-complete-value
(&aux tag
)
1391 (narrow-to-region (line-beginning-position) (line-end-position))
1393 (unless (search-backward-regexp (concat "^[ \t]*\\("
1394 (mapconcat 'symbol-name
1399 (return-from ampc-tagger-complete-tag
))
1400 (setf tag
(intern (match-string 1))))
1402 (search-backward-regexp "[: \t]")
1405 (search-forward-regexp "[ \t]\\|$")
1406 (let ((values (cons "<keep>" (ampc-tagger-get-values
1408 ampc-tagger-completion-all-files
))))
1409 (when (eq tag
'Genre
)
1410 (loop for g in ampc-tagger-genres
1411 do
(unless (member g values
)
1415 (defun ampc-align-point ()
1417 (move-beginning-of-line nil
)
1419 (re-search-forward " *" nil t
)))
1421 (defun* ampc-pad
(tabs &optional dont-honour-item-mode
)
1422 (loop with new-tab-stop-list
1423 with offset-dec
= (if (and (not dont-honour-item-mode
)
1424 (derived-mode-p 'ampc-item-mode
))
1428 for offset-cell on
(if (derived-mode-p 'ampc-item-mode
)
1430 (cons 0 tab-stop-list
))
1431 for offset
= (car offset-cell
)
1432 for props in
(or (plist-get (cdr ampc-type
) :properties
)
1434 by
(lambda (cell) (or (cdr cell
) '(nil . nil
)))
1435 do
(decf offset offset-dec
)
1437 with current-offset
= 0
1438 when
(<= current-offset offset
)
1439 do
(when (and (not first
) (eq (- offset current-offset
) 0))
1441 and concat
(make-string (- offset current-offset
) ?
) into result
1442 and do
(setf current-offset offset
)
1444 concat
" " into result
1445 and do
(incf current-offset
)
1449 (when (and (plist-get (cdr props
) :shrink
)
1451 (>= (+ current-offset
(length tab
) 1) (- (cadr offset-cell
)
1453 (setf tab
(concat (substring tab
0 (max (- (cadr offset-cell
)
1459 concat tab into result
1460 do
(push (+ current-offset offset-dec
) new-tab-stop-list
)
1461 (incf current-offset
(length tab
))
1464 (if (equal (callf nreverse new-tab-stop-list
) tab-stop-list
)
1466 (propertize result
'tab-stop-list new-tab-stop-list
))))
1468 (defun ampc-update-header ()
1469 (when (or (memq (car ampc-type
) '(tag playlists
))
1470 (plist-get (cdr ampc-type
) :properties
))
1471 (setf header-line-format
1473 (make-string (floor (fringe-columns 'left t
)) ?
)
1474 (ecase (car ampc-type
)
1476 (concat " " (plist-get (cdr ampc-type
) :tag
)))
1480 (ampc-pad (loop for
(name . props
) in
1481 (plist-get (cdr ampc-type
) :properties
)
1482 collect
(or (plist-get props
:title
) name
))
1485 (defun ampc-set-dirty (tag-or-dirty &optional dirty
)
1486 (if (or (null tag-or-dirty
) (memq tag-or-dirty
'(t erase keep-dirty
)))
1487 (setf ampc-dirty tag-or-dirty
)
1488 (loop for w in
(ampc-normalize-windows)
1489 do
(with-current-buffer (window-buffer w
)
1490 (when (eq (car ampc-type
) tag-or-dirty
)
1491 (ampc-set-dirty dirty
))))))
1493 (defun ampc-update ()
1495 (loop for w in
(ampc-normalize-windows)
1496 do
(with-current-buffer (window-buffer w
)
1497 (when (and ampc-dirty
(not (eq ampc-dirty
'keep-dirty
)))
1498 (ecase (car ampc-type
)
1500 (ampc-send-command 'outputs
))
1502 (ampc-update-playlist))
1504 (if (assoc (ampc-tags) ampc-internal-db
)
1505 (ampc-fill-tag-song)
1506 (push (cons (ampc-tags) nil
) ampc-internal-db
)
1507 (ampc-set-dirty 'tag
'keep-dirty
)
1508 (ampc-set-dirty 'song
'keep-dirty
)
1509 (ampc-send-command 'listallinfo
)))
1511 (ampc-send-command 'status
)
1512 (ampc-send-command 'currentsong
))
1514 (ampc-send-command 'listplaylists
))
1516 (ampc-send-command 'playlistinfo
))))))
1517 (ampc-send-command 'status
)
1518 (ampc-send-command 'currentsong
)))
1520 (defun ampc-update-playlist ()
1521 (ampc-with-buffer 'playlists
1522 (if (search-forward-regexp "^\\* " nil t
)
1523 (ampc-send-command 'listplaylistinfo
1525 (get-text-property (point) 'data
))
1526 (ampc-with-buffer 'playlist
1528 (ampc-set-dirty nil
)))))
1530 (defun ampc-send-command-impl (command)
1532 (message "ampc: -> %s" command
))
1534 (process-send-string ampc-connection
(concat command
"\n"))))
1536 (defun* ampc-send-command
(command &optional props
&rest args
)
1537 (destructuring-bind (&key
(front nil
) (keep-prev nil
) (full-remove nil
)
1538 (remove-other nil
) &allow-other-keys
1541 (when (and (not keep-prev
)
1542 (eq (caar ampc-outstanding-commands
) command
)
1543 (equal (cddar ampc-outstanding-commands
) args
))
1544 (return-from ampc-send-command
))
1545 (unless ampc-working-timer
1547 ampc-working-timer
(run-at-time nil
0.1 'ampc-yield
)))
1548 (when (equal (caar ampc-outstanding-commands
) 'idle
)
1549 (pop ampc-outstanding-commands
)
1551 (when (and (not keep-prev
) (cdr ampc-outstanding-commands
))
1552 (setf (cdr ampc-outstanding-commands
)
1553 (loop for other-cmd in
(cdr ampc-outstanding-commands
)
1554 unless
(and (memq (car other-cmd
) (list command remove-other
))
1555 (or (not full-remove
)
1557 (assert (null remove-other
))
1558 (equal (cddr other-cmd
) args
))))
1561 (setf command
(apply 'list command props args
))
1563 (push command ampc-outstanding-commands
)
1564 (setf ampc-outstanding-commands
1565 (nconc ampc-outstanding-commands
1568 (push '(noidle nil
) ampc-outstanding-commands
)
1569 (ampc-send-command-impl "noidle"))))
1571 (defun ampc-send-next-command ()
1572 (loop while ampc-outstanding-commands
1574 (loop for command
= (car ampc-outstanding-commands
)
1575 for command-id
= (replace-regexp-in-string
1577 (symbol-name (car command
)))
1580 (ampc-send-command-impl
1582 (loop for a in
(cddr command
)
1584 do
(when (functionp a
)
1587 (integer (number-to-string a
))
1589 (let ((callback (plist-get (cadar ampc-outstanding-commands
)
1591 (old-head (pop ampc-outstanding-commands
)))
1592 (when callback
(funcall callback
))
1593 (push old-head ampc-outstanding-commands
))
1595 do
(pop ampc-outstanding-commands
)
1596 while ampc-outstanding-commands
)
1598 while
(let ((member (memq (intern command
) ampc-synchronous-commands
)))
1600 (not (eq (car ampc-synchronous-commands
) t
))
1601 (eq (car ampc-synchronous-commands
) t
)))
1602 do
(loop with head
= ampc-outstanding-commands
1603 with ampc-no-implicit-next-dispatch
= t
1604 with ampc-yield-redisplay
= t
1606 while
(eq head ampc-outstanding-commands
)
1607 do
(accept-process-output ampc-connection
0 100)))
1608 (unless ampc-outstanding-commands
1609 (when ampc-working-timer
1610 (cancel-timer ampc-working-timer
)
1611 (setf ampc-yield nil
1612 ampc-working-timer nil
)
1614 (setf ampc-outstanding-commands
'((idle nil
)))
1615 (ampc-send-command-impl "idle")))
1617 (defun ampc-tree< (a b
)
1618 (string< (car a
) (car b
)))
1620 (defun ampc-create-tree ()
1621 (avl-tree-create 'ampc-tree
<))
1623 (defsubst ampc-extract
(regexp)
1624 (goto-char (point-min))
1625 (when (search-forward-regexp regexp nil t
)
1628 (defsubst ampc-clean-tag
(tag value
)
1630 (let ((func (cdr (assoc tag ampc-tag-transform-funcs
))))
1632 (funcall func value
)
1634 (unless (equal tag
"Track")
1635 "[Not Specified]")))
1637 (defun ampc-insert (element data
&optional cmp cmp-data
)
1638 (goto-char (point-min))
1640 (setf cmp-data data
))
1644 for tp
= (get-text-property (+ (point) 2) 'cmp-data
)
1645 thereis
(let ((r (funcall cmp cmp-data tp
)))
1650 finally return
'insert
)
1651 (loop with stringp-cmp-data
= (stringp cmp-data
)
1653 with max
= (1+ (count-lines (point-min) (point-max)))
1655 do
(when (< (- max min
) 20)
1657 (forward-line (- min max
)))
1658 (return (loop repeat
(- max min
)
1659 for tp
= (get-text-property (+ (point) 2)
1662 (if (equal tp cmp-data
)
1664 (unless (if stringp-cmp-data
1665 (string< tp cmp-data
)
1667 (buffer-substring-no-properties
1669 (line-end-position))
1673 finally return
'insert
)))
1674 do
(forward-line (funcall (if at-min
'+ '-
) (/ (- max min
) 2)))
1675 for tp
= (get-text-property (+ (point) 2) 'cmp-data
)
1676 thereis
(when (equal tp cmp-data
) 'update
)
1677 do
(if (setf at-min
(if stringp-cmp-data
1678 (string< tp cmp-data
)
1679 (string< (buffer-substring-no-properties
1681 (line-end-position))
1683 (incf min
(floor (/ (- max min
) 2.0)))
1684 (decf max
(floor (/ (- max min
) 2.0))))
1685 finally return
'insert
))))
1688 (insert (propertize (concat " " element
"\n")
1689 'data
(if (eq cmp t
) (list data
) data
)
1690 'cmp-data cmp-data
)))
1692 (remove-text-properties (point) (1+ (point)) '(not-updated))
1693 (when (or (eq ampc-dirty
'erase
) (eq action
'overwrite
))
1694 (let ((origin (point)))
1697 (insert element
"\n")
1698 (goto-char origin
)))
1699 (let ((next (1+ (line-end-position))))
1700 (put-text-property (point) next
'cmp-data cmp-data
)
1703 'data
(cond ((eq cmp t
)
1704 (let ((rest (get-text-property (point) 'data
)))
1705 (if (memq data rest
)
1709 (eq (char-after) ?
*)))))
1711 (defun ampc-fill-tag (trees)
1712 (put-text-property (point-min) (point-max) 'data nil
)
1713 (loop with new-trees
1718 (when (ampc-insert (car e
) (cdr e
) t
(car e
))
1719 (push (cdr e
) new-trees
)))
1721 finally return new-trees
))
1723 (defun ampc-fill-song (trees)
1726 do
(loop for song in songs
1729 (loop for
(p . v
) in
(plist-get (cdr ampc-type
) :properties
)
1730 collect
(cdr (assoc p song
))))
1733 (defsubst ampc-narrow-entry
(delimiter-regexp)
1736 (line-beginning-position)
1738 (goto-char (line-end-position))
1739 (when (search-forward-regexp delimiter-regexp nil t
)
1740 (setf result
(point))
1741 (1- (line-beginning-position))))
1745 (defun ampc-fill-playlist ()
1746 (ampc-fill-skeleton 'playlist
1748 (ampc-iterate-source-output "file" (file)
1749 (loop for
(tag . tag-regexp
) in tags
1750 collect
(ampc-clean-tag tag
(ampc-extract tag-regexp
)))
1752 (index .
,(1- (incf index
))))
1753 'ampc-int-insert-cmp
1756 (defun ampc-fill-outputs ()
1757 (ampc-fill-skeleton 'outputs
1758 (ampc-iterate-source-output "outputid" (outputid outputenabled
)
1759 (loop for
(tag . tag-regexp
) in tags
1760 collect
(ampc-clean-tag tag
(ampc-extract tag-regexp
)))
1761 `(("outputid" .
,outputid
)
1762 ("outputenabled" .
,outputenabled
)))))
1764 (defun* ampc-mini-impl
(&aux songs
)
1765 (ampc-iterate-source
1770 (Pos (string-to-number (ampc-extract (ampc-extract-regexp "Pos")))))
1771 (let ((entry (cons (concat Title
1773 (concat " - " Artist
)))
1775 (loop with mentry
= (cons (car entry
) (cdr entry
))
1777 while
(assoc (car mentry
) songs
)
1778 do
(setf (car mentry
) (concat (car entry
)
1779 " (" (int-to-string index
) ")"))
1780 finally do
(push mentry songs
))))
1782 (message "No song in the playlist")
1783 (return-from ampc-mini-impl
))
1784 (let ((song (assoc (let ((inhibit-quit t
))
1787 (completing-read "Song to play: " songs nil t
))
1788 (setf quit-flag nil
)))
1791 (ampc-play-this (cdr song
)))))
1793 (defun ampc-fill-current-playlist ()
1794 (ampc-fill-skeleton 'current-playlist
1795 (ampc-iterate-source-output
1797 (file (pos (string-to-number (ampc-extract
1798 (ampc-extract-regexp "Pos")))))
1799 (loop for
(tag . tag-regexp
) in tags
1800 collect
(ampc-clean-tag tag
(ampc-extract tag-regexp
)))
1803 'ampc-int-insert-cmp
1806 (defun ampc-fill-playlists ()
1807 (ampc-fill-skeleton 'playlists
1808 (with-current-buffer data-buffer
1809 (loop while
(search-forward-regexp "^playlist: \\(.*\\)$" nil t
)
1810 for playlist
= (match-string 1)
1811 do
(ampc-with-buffer 'playlists
1812 (ampc-insert playlist playlist
)))))
1813 (ampc-set-dirty 'playlist t
)
1816 (defun ampc-yield ()
1819 (when ampc-yield-redisplay
1822 (defun ampc-fill-status ()
1823 (ampc-with-buffer 'status
1825 (funcall (or (plist-get (cadr ampc-type
) :filler
)
1827 (insert (ampc-status t
) "\n")))
1829 (ampc-set-dirty nil
)))
1831 (defun ampc-fill-tag-song ()
1833 with trees
= (list (cdr (assoc (ampc-tags) ampc-internal-db
)))
1834 for type in
'(tag song
)
1837 for w in
(ampc-normalize-windows)
1839 (with-current-buffer (window-buffer w
)
1840 (when (eq (car ampc-type
) type
)
1842 (if (and (not trees
) (not (eq ampc-dirty
'keep-dirty
)))
1844 (let ((inhibit-read-only t
))
1846 (ampc-set-dirty nil
))
1847 (ampc-fill-skeleton w
1849 (setf trees
(ampc-fill-tag trees
))
1850 (ampc-fill-song trees
))))
1853 (goto-char (point-min))
1854 (loop while
(search-forward-regexp "^* " nil t
)
1855 do
(callf append trees
1856 (get-text-property (point) 'data
))))))))))
1858 (defun ampc-transform-track (track)
1859 (when (eq (length track
) 1)
1860 (setf track
(concat "0" track
)))
1863 (defun* ampc-transform-time
(data &aux
(time (string-to-number data
)))
1864 (concat (number-to-string (/ time
60))
1866 (when (< (% time
60) 10)
1868 (number-to-string (% time
60))))
1870 (defun ampc-handle-idle ()
1872 for subsystem
= (buffer-substring (point) (line-end-position))
1873 do
(when (string-match "^changed: \\(.*\\)$" subsystem
)
1874 (case (intern (match-string 1 subsystem
))
1876 (setf ampc-internal-db
(list (cons (ampc-tags) nil
)))
1877 (ampc-set-dirty 'tag
'keep-dirty
)
1878 (ampc-set-dirty 'song
'keep-dirty
)
1879 (ampc-send-command 'listallinfo
))
1881 (ampc-set-dirty 'outputs t
))
1882 ((player options mixer
)
1883 (setf ampc-status nil
)
1884 (ampc-set-dirty 'status t
))
1886 (ampc-set-dirty 'playlists t
))
1888 (ampc-set-dirty 'current-playlist t
)
1889 (ampc-set-dirty 'status t
))))
1893 (defun ampc-handle-setup (status)
1894 (unless (and (string-match "^ MPD \\(.+\\)\\.\\(.+\\)\\.\\(.+\\)$"
1896 (let ((version-a (string-to-number (match-string 1 status
)))
1897 (version-b (string-to-number (match-string 2 status
)))
1898 ;; (version-c (string-to-number (match-string 2 status)))
1901 (>= version-b
15))))
1902 (error (concat "Your version of MPD is not supported. "
1903 "ampc supports MPD protocol version 0.15.0 "
1906 (defun ampc-fill-internal-db (running)
1907 (loop with tree
= (assoc (ampc-tags) ampc-internal-db
)
1909 (loop for w in
(ampc-normalize-windows)
1910 for props
= (with-current-buffer (window-buffer w
)
1911 (when (eq (car ampc-type
) 'tag
)
1913 (plist-get (cdr ampc-type
) :tag
)))
1917 with song-props
= (ampc-with-buffer 'song
1919 (plist-get (cdr ampc-type
) :properties
))
1920 for origin
= (and (search-forward-regexp "^file: " nil t
)
1921 (line-beginning-position))
1924 do
(goto-char (1+ origin
))
1925 for next
= (and (search-forward-regexp "^file: " nil t
)
1926 (line-beginning-position))
1927 while
(or (not running
) next
)
1928 do
(save-restriction
1929 (narrow-to-region origin
(or next
(point-max)))
1930 (ampc-fill-internal-db-entry tree tags song-props
))
1932 (delete-region origin next
)
1933 (setf next origin
))))
1936 (loop for w in
(ampc-normalize-windows)
1937 for tag
= (with-current-buffer (window-buffer w
)
1938 (when (eq (car ampc-type
) 'tag
)
1939 (plist-get (cdr ampc-type
) :tag
)))
1944 (defun ampc-fill-internal-db-entry (tree tags song-props
)
1945 (loop for tag in tags
1946 for data
= (ampc-clean-tag tag
(ampc-extract (ampc-extract-regexp tag
)))
1947 do
(unless (cdr tree
)
1948 (setf (cdr tree
) (ampc-create-tree)))
1949 (setf tree
(avl-tree-enter (cdr tree
)
1953 (push (cons (cons "file" (ampc-extract (ampc-extract-regexp "file")))
1954 (loop for p in song-props
1955 for data
= (ampc-clean-tag (car p
)
1957 (ampc-extract-regexp (car p
))))
1959 collect
(cons (car p
) data
)
1963 (defun ampc-fill-status-var (tags)
1965 for v
= (ampc-extract (ampc-extract-regexp k
))
1968 (setf (cdr (or (assq s ampc-status
)
1969 (car (push (cons s nil
) ampc-status
))))
1971 (callf2 assq-delete-all s ampc-status
))))
1973 (defun ampc-handle-current-song ()
1974 (ampc-fill-status-var (append ampc-status-tags
'("Artist" "Title" "file")))
1976 (run-hook-with-args ampc-status-changed-hook ampc-status
))
1978 (defun ampc-handle-status ()
1979 (ampc-fill-status-var '("volume" "repeat" "random" "consume" "xfade" "state"
1980 "song" "playlistlength"))
1981 (ampc-with-buffer 'current-playlist
1982 (when ampc-highlight-current-song-mode
1983 (font-lock-fontify-buffer)))
1984 (run-hook-with-args ampc-status-changed-hook ampc-status
))
1986 (defun ampc-handle-update ()
1987 (message "Database update started"))
1989 (defun ampc-handle-command (status)
1992 (pop ampc-outstanding-commands
))
1993 ((eq status
'running
)
1994 (case (caar ampc-outstanding-commands
)
1995 (listallinfo (ampc-fill-internal-db t
))))
1997 (let ((command (pop ampc-outstanding-commands
)))
2002 (ampc-handle-setup status
))
2004 (ampc-handle-current-song))
2006 (ampc-handle-status))
2008 (ampc-handle-update))
2010 (ampc-fill-playlist))
2012 (ampc-fill-playlists))
2014 (ampc-fill-current-playlist))
2019 (shuffle-listplaylistinfo
2020 (ampc-shuffle-playlist (plist-get (cadr command
) :playlist
)))
2022 (ampc-handle-listallinfo))
2024 (ampc-fill-outputs))))
2025 (unless ampc-outstanding-commands
2028 (defun* ampc-shuffle-playlist
(playlist &aux songs
)
2029 (ampc-iterate-source nil
"file" (file)
2030 (push (cons file
(random)) songs
))
2031 (ampc-send-command 'playlistclear
'(:full-remove t
) (ampc-quote playlist
))
2032 (loop for file in
(mapcar 'car
(sort songs
2033 (lambda (a b
) (< (cdr a
) (cdr b
)))))
2034 do
(ampc-send-command 'playlistadd
2036 (ampc-quote playlist
)
2040 (defun ampc-handle-listallinfo ()
2041 (ampc-fill-internal-db nil
)
2042 (ampc-set-dirty 'tag t
)
2043 (ampc-set-dirty 'song t
))
2045 (defun ampc-filter (_process string
)
2046 (assert (buffer-live-p (process-buffer ampc-connection
)))
2047 (with-current-buffer (process-buffer ampc-connection
)
2049 (when (and ampc-debug
(not (eq ampc-debug t
)))
2050 (message "ampc: <- %s" string
))
2051 (goto-char (process-mark ampc-connection
))
2053 (set-marker (process-mark ampc-connection
) (point)))
2055 (goto-char (point-min))
2058 (when (search-forward-regexp
2059 "^ACK \\[\\(.*\\)\\] {.*} \\(.*\\)\n\\'"
2062 (message "ampc command error: %s (%s; %s)"
2065 (funcall (if ampc-debug
'identity
'car
)
2066 (car ampc-outstanding-commands
)))
2068 (when (search-forward-regexp "^OK\\(.*\\)\n\\'" nil t
)
2071 (let ((match-end (match-end 0)))
2073 (narrow-to-region (point-min) match-end
)
2074 (goto-char (point-min))
2075 (ampc-handle-command (if success
(match-string 1) 'error
)))
2076 (delete-region (point-min) match-end
))
2077 (unless ampc-no-implicit-next-dispatch
2078 (ampc-send-next-command))))
2079 (ampc-handle-command 'running
)))))
2081 (defun* ampc-set-tab-offsets
2082 (&rest properties
&aux
(min 2) (optional-padding 0))
2084 (return-from ampc-set-tab-offsets
))
2085 (set (make-local-variable 'tab-stop-list
) nil
)
2086 (loop for
(title . props
) in properties
2087 for min-
= (plist-get props
:min
)
2088 do
(incf min
(or (plist-get props
:width
) min-
))
2090 (incf optional-padding
(- (plist-get props
:max
) min-
))))
2091 (loop for
(title . props
) in properties
2093 do
(push offset tab-stop-list
)
2094 (incf offset
(or (plist-get props
:width
)
2095 (let ((min- (plist-get props
:min
))
2096 (max (plist-get props
:max
)))
2097 (if (>= min
(window-width))
2101 (floor (* (/ (float (- max min-
))
2105 (callf nreverse tab-stop-list
))
2107 (defun* ampc-configure-frame-1
(split &aux
(split-type (car split
)))
2108 (if (memq split-type
'(vertical horizontal
))
2110 (loop with length
= (if (eq split-type
'horizontal
)
2111 (window-total-width)
2112 (window-total-height))
2115 for
(size . subsplit
) in
(cdr split
)
2116 do
(if (equal size
1.0)
2117 (progn (push t sizes
)
2118 (setf rest-car sizes
))
2119 (let ((l (if (integerp size
) size
(round (* size length
)))))
2122 finally do
(setf (car rest-car
) rest
))
2123 (let ((first-window (selected-window)))
2124 (callf nreverse sizes
)
2125 (loop for size in
(copy-sequence sizes
)
2126 for window on
(cdr sizes
)
2129 (split-window nil size
(eq split-type
'horizontal
)))))
2130 (setf (car sizes
) first-window
))
2131 (loop for subsplit in
(cdr split
)
2134 do
(with-selected-window window
2136 (or (ampc-configure-frame-1 (cdr subsplit
)) result
)))
2137 finally return result
))
2138 (setf (window-dedicated-p (selected-window)) nil
)
2139 (pop-to-buffer-same-window
2142 (mapconcat (lambda (s) (concat (upcase (substring s
0 1))
2144 (if (memq split-type
'(tag song
))
2145 (list (or (plist-get (cdr split
) :tag
) "song"))
2146 (split-string (symbol-name split-type
) "-"))
2149 (if (memq split-type
'(tag song
))
2150 (ampc-tag-song-mode)
2151 (let ((mode (intern (concat "ampc-" (symbol-name split-type
) "-mode"))))
2152 (unless (fboundp mode
)
2153 (setf mode
'ampc-mode
))
2154 (unless (eq major-mode
'mode
)
2157 (&key
(properties nil
) (dedicated t
) (mode-line t
) &allow-other-keys
)
2159 (apply 'ampc-set-tab-offsets properties
)
2160 (setf ampc-type split
2161 (window-dedicated-p (selected-window)) dedicated
2162 mode-line-format
(when mode-line
2163 (default-value 'mode-line-format
))))
2164 (set (make-local-variable 'mode-line-buffer-identification
)
2165 '(:eval
(let ((result
2166 (concat (car-safe (propertized-buffer-identification
2169 " [Updating...]"))))
2170 (if (< (length result
) 12)
2171 (concat result
(make-string (- 12 (length result
)) ?
))
2173 (ampc-update-header)
2174 (add-to-list 'ampc-all-buffers
(current-buffer))
2175 (push (cons (or (plist-get (cdr split
) :id
) 9999) (selected-window))
2178 (when (plist-get (cdr split
) :select
)
2179 (selected-window))))
2181 (defun* ampc-configure-frame
2182 (split &optional no-update
&aux
(old-selection ampc-type
) old-window-starts
)
2183 (loop for w in
(ampc-normalize-windows)
2184 do
(with-selected-window w
2185 (with-current-buffer (window-buffer w
)
2186 (push (cons (current-buffer) (window-start))
2187 old-window-starts
))))
2188 (if (not ampc-use-full-frame
)
2189 (ampc-restore-window-configuration)
2190 (setf (window-dedicated-p (selected-window)) nil
)
2191 (delete-other-windows))
2192 (setf ampc-windows nil
)
2193 (let ((select-window (ampc-configure-frame-1 split
)))
2195 (mapcar (lambda (window)
2196 (cons window
(window-buffer window
)))
2197 (mapcar 'cdr
(sort ampc-windows
2198 (lambda (a b
) (< (car a
) (car b
)))))))
2199 (loop for w in
(ampc-normalize-windows)
2200 do
(with-selected-window w
2201 (let ((old-window-start (cdr (assq (current-buffer)
2202 old-window-starts
))))
2203 (when old-window-start
2204 (set-window-start nil old-window-start
)))
2205 (when (and (derived-mode-p 'ampc-item-mode
)
2206 (> (length tab-stop-list
) 1))
2207 (ampc-set-dirty 'erase
))))
2208 (select-window (or (loop for w in
(ampc-normalize-windows)
2210 (when (equal (with-current-buffer (window-buffer w
)
2215 (selected-window))))
2219 (defun ampc-tagger-rename-artist-title (_changed-tags data
)
2220 "Rename music file according to its tags.
2221 This function is meant to be inserted into
2222 `ampc-tagger-stored-hook'. The new file name is
2223 `Artist'_-_`Title'.`extension'. Characters within `Artist' and
2224 `Title' that are not alphanumeric are substituted with underscore."
2225 (let* ((artist (replace-regexp-in-string
2227 (or (cdr (assq 'Artist
(cdr data
))) "")))
2228 (title (replace-regexp-in-string
2230 (or (cdr (assq 'Title
(cdr data
))) "")))
2232 (expand-file-name (replace-regexp-in-string
2236 (when (and (> (length artist
) 0)
2237 (> (length title
) 0))
2240 (file-name-extension (car data
) t
)))
2241 (file-name-directory (car data
)))))
2242 (unless (equal (car data
) new-file
)
2243 (ampc-tagger-log "Renaming file " (abbreviate-file-name (car data
))
2244 " to " (abbreviate-file-name new-file
) "\n")
2245 (rename-file (car data
) new-file
)
2246 (setf (car data
) new-file
))))
2248 ;;; *** interactives
2249 (defun ampc-tagger-completion-at-point (&optional all-files
)
2250 "Perform completion at point via `completion-at-point'.
2251 If optional prefix argument ALL-FILES is non-nil, use all files
2252 within the files list buffer as source for completion. The
2253 default behaviour is to use only the selected ones."
2255 (let ((ampc-tagger-completion-all-files all-files
))
2256 (completion-at-point)))
2258 (defun ampc-tagger-reset (&optional reset-all-tags
)
2259 "Reset all tag values within the tagger, based on the selection of files.
2260 If optional prefix argument RESET-ALL-TAGS is non-nil, restore
2263 (when reset-all-tags
2264 (ampc-with-buffer 'tagger
2267 (loop for tag in ampc-tagger-tags
2268 do
(insert (ampc-pad (list (concat (symbol-name tag
) ":") "dummy"))
2270 (goto-char (point-min))
2271 (re-search-forward ":\\( \\)+")))
2272 (ampc-with-buffer 'tagger
2273 (loop while
(search-forward-regexp
2274 (concat "^\\([ \t]*\\)\\("
2275 (mapconcat 'symbol-name ampc-tagger-tags
"\\|")
2276 "\\)\\([ \t]*\\):\\([ \t]*.*\\)$")
2279 do
(replace-match "" nil nil nil
1)
2280 (replace-match "" nil nil nil
3)
2281 (replace-match (concat (make-string (- (car tab-stop-list
)
2282 (1+ (length (match-string 2))))
2286 (ampc-tagger-update)
2287 (ampc-with-buffer 'tagger
2289 (when (looking-at "[ \t]+")
2290 (goto-char (match-end 0)))))
2292 (defun* ampc-tagger-save
(&optional quit
&aux tags
)
2294 If optional prefix argument QUIT is non-nil, quit tagger
2295 afterwards. If the numeric value of QUIT is 16, quit tagger and
2296 do not trigger a database update"
2298 (ampc-with-buffer 'tagger
2299 (loop do
(loop until
(eobp)
2300 while
(looking-at "^[ \t]*$")
2303 do
(unless (and (looking-at
2304 (concat "^[ \t]*\\("
2305 (mapconcat 'symbol-name
2309 "[ \t]*\\(.*\\)[ \t]*$"))
2310 (not (assq (intern (match-string 1)) tags
)))
2311 (error "Malformed line \"%s\""
2312 (buffer-substring (line-beginning-position)
2313 (line-end-position))))
2314 (push (cons (intern (match-string 1))
2315 (let ((val (match-string 2)))
2316 (if (string= "<keep>" val
)
2318 (set-text-properties 0 (length val
) nil val
)
2322 (callf2 rassq-delete-all t tags
)
2324 (loop for
(tag . value
) in tags
2325 do
(insert (symbol-name tag
) "\n"
2327 (let ((input-buffer (current-buffer)))
2328 (ampc-with-buffer 'files-list
2331 (make-progress-reporter "Storing tags"
2333 (let ((count (count-matches "^\\* ")))
2338 (ampc-with-selection nil
2339 (let* ((data (get-text-property (point) 'data
))
2340 (old-tags (loop for
(tag . data
) in
(cdr data
)
2341 collect
(cons tag data
)))
2342 (found-changed (ampc-tagger-tags-modified (cdr data
) tags
)))
2343 (let ((pre-hook-tags (cdr data
)))
2344 (run-hook-with-args 'ampc-tagger-store-hook found-changed data
)
2347 (ampc-tagger-tags-modified pre-hook-tags
2351 "Storing tags for file "
2352 (abbreviate-file-name (car data
)) "\n"
2354 (loop for
(tag . value
) in old-tags
2355 concat
(concat "\t\t"
2356 (symbol-name tag
) ": "
2359 (loop for
(tag . value
) in
(cdr data
)
2360 concat
(concat "\t\t"
2361 (symbol-name tag
) ": "
2363 (ampc-tagger-make-backup (car data
))
2365 (list "--set" (car data
))
2367 (insert-buffer-substring input-buffer
)
2369 (call-process-region (point-min) (point-max)
2370 ampc-tagger-executable
2374 (message "ampc-tagger: %s"
2376 (point-min) (point))))))))
2377 (run-hook-with-args 'ampc-tagger-stored-hook found-changed data
)
2378 (let ((inhibit-read-only t
))
2379 (move-beginning-of-line nil
)
2383 (ampc-pad (loop for p in
(plist-get (cdr ampc-type
)
2385 when
(eq (car p
) 'filename
)
2386 collect
(file-name-nondirectory (car data
))
2388 collect
(cdr (assq (intern (car p
))
2393 (put-text-property (line-beginning-position)
2394 (1+ (line-end-position))
2396 (progress-reporter-update reporter
(incf step
))))
2397 (progress-reporter-done reporter
)))))
2399 (ampc-tagger-quit (eq (prefix-numeric-value quit
) 16))))
2401 (defun ampc-tagger-quit (&optional no-update
)
2402 "Quit tagger and restore previous window configuration.
2403 With optional prefix NO-UPDATE, do not trigger a database update."
2405 (set-window-configuration (or (car-safe ampc-tagger-previous-configuration
)
2406 ampc-tagger-previous-configuration
))
2407 (when (car-safe ampc-tagger-previous-configuration
)
2409 (ampc-trigger-update))
2410 (setf ampc-windows
(cadr ampc-tagger-previous-configuration
)))
2411 (setf ampc-tagger-previous-configuration nil
))
2413 (defun ampc-move-to-tab ()
2414 "Move point to next logical tab stop."
2416 (let ((tab (loop for tab in
2417 (or (get-text-property (point) 'tab-stop-list
) tab-stop-list
)
2418 while
(>= (current-column) tab
)
2419 finally return tab
)))
2421 (goto-char (min (+ (line-beginning-position) tab
) (line-end-position))))))
2423 (defun ampc-mouse-play-this (event)
2425 (select-window (posn-window (event-end event
)))
2426 (goto-char (posn-point (event-end event
)))
2429 (defun ampc-mouse-delete (event)
2431 (select-window (posn-window (event-end event
)))
2432 (goto-char (posn-point (event-end event
)))
2435 (defun ampc-mouse-add (event)
2437 (select-window (posn-window (event-end event
)))
2438 (goto-char (posn-point (event-end event
)))
2441 (defun ampc-mouse-delete-playlist (event)
2443 (select-window (posn-window (event-end event
)))
2444 (goto-char (posn-point (event-end event
)))
2445 (ampc-delete-playlist t
))
2447 (defun ampc-mouse-load (event)
2449 (select-window (posn-window (event-end event
)))
2450 (goto-char (posn-point (event-end event
)))
2453 (defun ampc-mouse-toggle-output-enabled (event)
2455 (select-window (posn-window (event-end event
)))
2456 (goto-char (posn-point (event-end event
)))
2457 (ampc-toggle-output-enabled 1))
2459 (defun* ampc-mouse-toggle-mark
(event &aux
(inhibit-read-only t
))
2461 (let ((window (posn-window (event-end event
))))
2462 (when (with-selected-window window
2463 (goto-char (posn-point (event-end event
)))
2465 (move-beginning-of-line nil
)
2466 (ampc-mark-impl (not (eq (char-after) ?
*)) 1)
2468 (select-window window
))))
2470 (defun ampc-mouse-align-point (event)
2472 (select-window (posn-window (event-end event
)))
2473 (goto-char (posn-point (event-end event
)))
2476 (defun* ampc-unmark-all
(&aux
(inhibit-read-only t
))
2479 (assert (ampc-in-ampc-p t
))
2481 (goto-char (point-min))
2482 (loop while
(search-forward-regexp "^\\* " nil t
)
2483 do
(replace-match " " nil nil
)))
2484 (ampc-post-mark-change-update))
2486 (defun ampc-trigger-update ()
2487 "Trigger a database update."
2489 (assert (ampc-on-p))
2490 (ampc-send-command 'update
))
2492 (defun* ampc-toggle-marks
(&aux
(inhibit-read-only t
))
2494 Marked entries become unmarked, and vice versa."
2496 (assert (ampc-in-ampc-p t
))
2498 (loop for
(a . b
) in
'(("* " .
"T ")
2501 do
(goto-char (point-min))
2502 (loop while
(search-forward-regexp (concat "^" (regexp-quote a
))
2505 do
(replace-match b nil nil
))))
2506 (ampc-post-mark-change-update))
2508 (defun ampc-up (&optional arg
)
2509 "Move selected entries ARG positions upwards.
2510 ARG defaults to one."
2512 (assert (ampc-in-ampc-p))
2513 (ampc-move (- (or arg
1))))
2515 (defun ampc-down (&optional arg
)
2516 "Move selected entries ARG positions downwards.
2517 ARG defaults to one."
2519 (assert (ampc-in-ampc-p))
2520 (ampc-move (or arg
1)))
2522 (defun ampc-mark (&optional arg
)
2523 "Mark the next ARG'th entries.
2526 (assert (ampc-in-ampc-p t
))
2527 (ampc-mark-impl t arg
))
2529 (defun ampc-unmark (&optional arg
)
2530 "Unmark the next ARG'th entries.
2533 (assert (ampc-in-ampc-p t
))
2534 (ampc-mark-impl nil arg
))
2536 (defun ampc-set-volume (&optional arg
)
2537 "Set volume to ARG percent.
2538 If ARG is nil, read ARG from minibuffer."
2540 (assert (ampc-on-p))
2541 (ampc-set-volume-impl (or arg
(read-number "Volume: "))))
2543 (defun ampc-increase-volume (&optional arg
)
2544 "Increase volume by prefix argument ARG or, if ARG is nil,
2545 `ampc-volume-step'."
2547 (assert (ampc-on-p))
2548 (ampc-set-volume-impl arg
'+))
2550 (defun ampc-decrease-volume (&optional arg
)
2551 "Decrease volume by prefix argument ARG or, if ARG is nil,
2552 `ampc-volume-step'."
2554 (assert (ampc-on-p))
2555 (ampc-set-volume-impl arg
'-
))
2557 (defun ampc-set-crossfade (&optional arg
)
2558 "Set crossfade to ARG seconds.
2559 If ARG is nil, read ARG from minibuffer."
2561 (assert (ampc-on-p))
2562 (ampc-set-crossfade-impl (or arg
(read-number "Crossfade: "))))
2564 (defun ampc-increase-crossfade (&optional arg
)
2565 "Increase crossfade by prefix argument ARG or, if ARG is nil,
2566 `ampc-crossfade-step'."
2568 (assert (ampc-on-p))
2569 (ampc-set-crossfade-impl arg
'+))
2571 (defun ampc-decrease-crossfade (&optional arg
)
2572 "Decrease crossfade by prefix argument ARG or, if ARG is nil,
2573 `ampc-crossfade-step'."
2575 (assert (ampc-on-p))
2576 (ampc-set-crossfade-impl arg
'-
))
2578 (defun ampc-toggle-repeat (&optional arg
)
2579 "Toggle MPD's repeat state.
2580 With prefix argument ARG, enable repeating if ARG is positive,
2581 otherwise disable it."
2583 (assert (ampc-on-p))
2584 (ampc-toggle-state 'repeat arg
))
2586 (defun ampc-toggle-consume (&optional arg
)
2587 "Toggle MPD's consume state.
2588 With prefix argument ARG, enable consuming if ARG is positive,
2589 otherwise disable it.
2591 When consume is activated, each song played is removed from the playlist."
2593 (assert (ampc-on-p))
2594 (ampc-toggle-state 'consume arg
))
2596 (defun ampc-toggle-random (&optional arg
)
2597 "Toggle MPD's random state.
2598 With prefix argument ARG, enable random playing if ARG is positive,
2599 otherwise disable it."
2601 (ampc-toggle-state 'random arg
))
2603 (defun ampc-play-this (&optional arg
)
2604 "Play selected song.
2605 With prefix argument ARG, play the ARG'th song located at the
2606 zero-indexed position of the current playlist."
2608 (assert (and (ampc-on-p) (or arg
(ampc-in-ampc-p))))
2611 (ampc-send-command 'play nil
(1- (line-number-at-pos)))
2612 (ampc-send-command 'pause nil
0))
2613 (ampc-send-command 'play nil arg
)
2614 (ampc-send-command 'pause nil
0)))
2616 (defun* ampc-toggle-play
2617 (&optional arg
&aux
(state (cdr (assq 'state ampc-status
))))
2619 If MPD does not play a song already, start playing the song at
2620 point if the current buffer is the playlist buffer, otherwise
2621 start at the beginning of the playlist.
2623 If ARG is 4, stop player rather than pause if applicable."
2625 (assert (ampc-on-p))
2627 (return-from ampc-toggle-play
))
2629 (setf arg
(prefix-numeric-value arg
)))
2630 (ecase (intern state
)
2632 (when (or (null arg
) (> arg
0))
2635 '(:remove-other
(pause))
2636 (if (and (eq (car ampc-type
) 'current-playlist
) (not (eobp)))
2637 (1- (line-number-at-pos))
2640 (when (or (null arg
) (> arg
0))
2641 (ampc-send-command 'pause
'(:remove-other
(play)) 0)))
2643 (cond ((or (null arg
) (< arg
0))
2644 (ampc-send-command 'pause
'(:remove-other
(play)) 1))
2646 (ampc-send-command 'stop
))))))
2648 (defun ampc-next (&optional arg
)
2650 With prefix argument ARG, skip ARG songs."
2652 (assert (ampc-on-p))
2653 (ampc-skip (or arg
1)))
2655 (defun ampc-previous (&optional arg
)
2656 "Play previous song.
2657 With prefix argument ARG, skip ARG songs."
2659 (assert (ampc-on-p))
2660 (ampc-skip (- (or arg
1))))
2662 (defun ampc-rename-playlist (new-name)
2663 "Rename selected playlist to NEW-NAME.
2664 If NEW-NAME is nil, read NEW-NAME from the minibuffer."
2667 (setf new-name
(read-from-minibuffer (concat "New name for playlist "
2670 (assert (ampc-in-ampc-p))
2672 (ampc-send-command 'rename
'(:full-remove t
) (ampc-quote new-name
))
2673 (message "No playlist selected")))
2675 (defun ampc-load (&optional at-point
)
2676 "Load selected playlist in the current playlist.
2677 If optional argument AT-POINT is non-nil (or if no playlist is
2678 selected), use playlist at point rather than the selected one."
2680 (assert (ampc-in-ampc-p))
2681 (if (ampc-playlist at-point
)
2683 'load
'(:keep-prev t
)
2684 (ampc-quote (ampc-playlist at-point
)))
2686 (message "No playlist at point")
2687 (message "No playlist selected"))))
2689 (defun ampc-toggle-output-enabled (&optional arg
)
2690 "Toggle the next ARG outputs.
2691 If ARG is omitted, use the selected entries."
2693 (assert (ampc-in-ampc-p))
2694 (ampc-with-selection arg
2695 (let ((data (get-text-property (point) 'data
)))
2696 (ampc-send-command (if (equal (cdr (assoc "outputenabled" data
)) "1")
2700 (cdr (assoc "outputid" data
))))))
2702 (defun ampc-delete (&optional arg
)
2703 "Delete the next ARG songs from the playlist.
2704 If ARG is omitted, use the selected entries. If ARG is non-nil,
2705 all marks after point are removed nontheless."
2707 (assert (ampc-in-ampc-p))
2708 (let ((first-del nil
))
2709 (ampc-with-selection arg
2710 (unless (or first-del
(when arg
(< arg
0)))
2711 (setf first-del
(point)))
2712 (let ((val (1- (- (line-number-at-pos) (if (or (not arg
) (> arg
0))
2715 (if (and (not (eq (car ampc-type
) 'current-playlist
)) (ampc-playlist))
2716 (ampc-send-command 'playlistdelete
2718 (ampc-quote (ampc-playlist))
2720 (ampc-send-command 'delete
'(:keep-prev t
) val
))
2721 (ampc-mark-impl nil nil
)))
2723 (goto-char first-del
))))
2725 (defun ampc-shuffle ()
2728 (assert (ampc-on-p))
2729 (if (and (not (eq (car ampc-type
) 'current-playlist
)) (ampc-playlist))
2730 (ampc-send-command 'shuffle-listplaylistinfo
2731 `(:playlist
,(ampc-playlist))
2732 (ampc-quote (ampc-playlist)))
2733 (ampc-send-command 'shuffle
)))
2735 (defun ampc-clear ()
2738 (assert (ampc-on-p))
2739 (if (and (not (eq (car ampc-type
) 'current-playlist
)) (ampc-playlist))
2740 (ampc-send-command 'playlistclear
'(:full-remove t
)
2741 (ampc-quote (ampc-playlist)))
2742 (ampc-send-command 'clear
)))
2744 (defun ampc-add (&optional arg
)
2745 "Add the songs associated with the next ARG entries after point
2747 If ARG is omitted, use the selected entries in the current buffer."
2749 (assert (ampc-in-ampc-p))
2750 (ampc-with-selection arg
2753 (defun ampc-status (&optional no-print
)
2754 "Display and return the information that is displayed in the status window.
2755 If optional argument NO-PRINT is non-nil, just return the text.
2756 If NO-PRINT is nil, the display may be delayed if ampc does not
2757 have enough information yet."
2759 (assert (ampc-on-p))
2760 (unless (or ampc-status no-print
)
2761 (ampc-send-command 'status
)
2762 (ampc-send-command 'mini-currentsong
)
2763 (return-from ampc-status
))
2764 (let* ((flags (mapconcat
2766 (loop for
(f . n
) in
'((repeat .
"Repeat")
2768 (consume .
"Consume"))
2769 when
(equal (cdr (assq f ampc-status
)) "1")
2773 (state (cdr (assq 'state ampc-status
)))
2774 (status (concat "State: " state
2775 (when (and ampc-yield no-print
)
2776 (concat (make-string (- 10 (length state
)) ?
)
2777 (nth (% ampc-yield
4) '("|" "/" "-" "\\"))))
2779 (when (equal state
"play")
2783 (cdr (assq 'Artist ampc-status
)))
2787 (cdr (assq 'Title ampc-status
)))
2789 "Volume: " (cdr (assq 'volume ampc-status
)) "\n"
2790 "Crossfade: " (cdr (assq 'xfade ampc-status
))
2791 (unless (equal flags
"")
2792 (concat "\n" flags
)))))
2794 (message "%s" status
))
2797 (defun ampc-delete-playlist (&optional at-point
)
2798 "Delete selected playlist.
2799 If optional argument AT-POINT is non-nil (or if no playlist is
2800 selected), use playlist at point rather than the selected one."
2802 (assert (ampc-in-ampc-p))
2803 (if (ampc-playlist at-point
)
2804 (when (y-or-n-p (concat "Delete playlist " (ampc-playlist at-point
) "?"))
2805 (ampc-send-command 'rm
'(:full-remove t
)
2806 (ampc-quote (ampc-playlist at-point
))))
2808 (message "No playlist at point")
2809 (message "No playlist selected"))))
2812 (defun ampc-tagger-dired (&optional arg
)
2813 "Start the tagging subsystem on dired's marked files.
2814 With optional prefix argument ARG, use the next ARG files."
2816 (assert (derived-mode-p 'dired-mode
))
2818 (loop for file in
(dired-map-over-marks (dired-get-filename) arg
)
2819 unless
(file-directory-p file
)
2824 (defun ampc-tag-files (files)
2825 "Start the tagging subsystem.
2826 FILES should be a list of absolute file names, the files to tag."
2828 (message "No files specified")
2829 (return-from ampc-tagger-files t
))
2830 (when (memq (car ampc-type
) '(files-list tagger
))
2831 (message "You are already within the tagger")
2832 (return-from ampc-tagger-files t
))
2833 (let ((reporter (make-progress-reporter "Grabbing tags" 0 (length files
))))
2834 (loop for file in-ref files
2836 do
(run-hook-with-args 'ampc-tagger-grab-hook file
)
2838 (ampc-tagger-call "--get" file
)
2842 (loop for tag in ampc-tagger-tags
2844 (cons tag
(or (ampc-extract (ampc-extract-regexp
2847 (run-hook-with-args 'ampc-tagger-grabbed-hook file
)
2848 (progress-reporter-update reporter i
))
2849 (progress-reporter-done reporter
))
2850 (unless ampc-tagger-previous-configuration
2851 (setf ampc-tagger-previous-configuration
(current-window-configuration)))
2852 (ampc-configure-frame (cdr (assq 'tagger ampc-views
)) t
)
2853 (ampc-with-buffer 'files-list
2855 (loop for
(file . props
) in files
2856 do
(insert (propertize
2860 (loop for p in
(plist-get (cdr ampc-type
) :properties
)
2861 when
(eq (car p
) 'filename
)
2862 collect
(file-name-nondirectory file
)
2864 collect
(cdr (assq (intern (car p
)) props
))
2867 'data
(cons file props
))))
2868 (ampc-set-dirty nil
)
2869 (ampc-toggle-marks))
2870 (ampc-with-buffer 'tagger
2872 (ampc-tagger-reset t
)
2873 (goto-char (point-min))
2874 (search-forward-regexp ": *")
2875 (ampc-set-dirty nil
))
2878 (defun* ampc-tagger
(&optional arg
&aux files
)
2879 "Start the tagging subsystem.
2880 The files to tag are collected by using either the selected
2881 entries within the current buffer or the next ARG entries at
2882 point if numeric perfix argument ARG is non-nil, the file
2883 associated with the entry at point, or, if both sources did not
2884 provide any files, the audio file that is currently played by
2887 (assert (ampc-in-ampc-p))
2888 (unless ampc-tagger-version-verified
2890 (ampc-tagger-call "--version")
2891 (goto-char (point-min))
2892 (let ((version (buffer-substring (line-beginning-position)
2893 (line-end-position))))
2894 (unless (equal version ampc-tagger-version
)
2895 (message (concat "The reported version of %s is not supported - "
2896 "got \"%s\", want \"%s\"")
2897 ampc-tagger-executable
2899 ampc-tagger-version
)
2900 (return-from ampc-tagger
))))
2901 (setf ampc-tagger-version-verified t
))
2902 (unless ampc-tagger-genres
2904 (ampc-tagger-call "--genres")
2905 (loop while
(search-backward-regexp "^\\(.+\\)$" nil t
)
2906 do
(push (match-string 1) ampc-tagger-genres
))))
2907 (unless ampc-tagger-music-directories
2908 (message (concat "ampc-tagger-music-directories is nil. Fill it via "
2909 "M-x customize-variable RET ampc-tagger-music-directories "
2911 (return-from ampc-tagger
))
2912 (case (car ampc-type
)
2915 (ampc-with-selection arg
2916 (callf nconc files
(list (cdr (assoc "file" (get-text-property
2919 ((playlist tag song
)
2921 (ampc-with-selection arg
2922 (ampc-on-files (lambda (file) (push file files
)))))
2923 (callf nreverse files
))
2925 (let ((file (cdr (assoc 'file ampc-status
))))
2927 (setf files
(list file
))))))
2928 (loop for file in-ref files
2929 for read-file
= (locate-file file ampc-tagger-music-directories
)
2930 do
(unless read-file
2931 (error "Cannot locate file %s in ampc-tagger-music-directories"
2933 (return-from ampc-tagger
))
2934 (setf file
(expand-file-name read-file
)))
2935 (setf ampc-tagger-previous-configuration
2936 (list (current-window-configuration) ampc-windows
))
2937 (when (ampc-tag-files files
)
2938 (setf ampc-tagger-previous-configuration nil
)))
2940 (defun ampc-store (&optional name-or-append
)
2941 "Store current playlist as NAME-OR-APPEND.
2942 If NAME is non-nil and not a string, append selected entries
2943 within the current playlist buffer to the selected playlist. If
2944 NAME-OR-APPEND is a negative integer, append the next (-
2945 NAME-OR-APPEND) entries after point within the current playlist
2946 buffer to the selected playlist. If NAME-OR-APPEND is nil, read
2947 playlist name from the minibuffer."
2949 (assert (ampc-in-ampc-p))
2950 (unless name-or-append
2951 (setf name-or-append
(read-from-minibuffer "Save playlist as: ")))
2952 (if (stringp name-or-append
)
2953 (ampc-send-command 'save
'(:full-remove t
) (ampc-quote name-or-append
))
2954 (if (not (ampc-playlist))
2955 (message "No playlist selected")
2956 (ampc-with-buffer 'current-playlist
2957 (when name-or-append
2958 (callf prefix-numeric-value name-or-append
))
2959 (ampc-with-selection (if (and name-or-append
(< name-or-append
0))
2965 (ampc-quote (ampc-playlist))
2966 (ampc-quote (cdr (assoc "file"
2967 (get-text-property (point) 'data
))))))))))
2969 (defun* ampc-goto-current-song
(&aux
(song (cdr (assq 'song ampc-status
))))
2970 "Select the current playlist window and move point to the current song."
2972 (assert (ampc-in-ampc-p))
2973 (let ((window (ampc-with-buffer 'current-playlist
2974 (selected-window))))
2976 (select-window window
)
2978 (goto-char (point-min))
2979 (forward-line (string-to-number song
)))
2980 (ampc-align-point))))
2982 (defun ampc-previous-line (&optional arg
)
2983 "Go to previous ARG'th entry in the current buffer.
2986 (assert (ampc-in-ampc-p t
))
2987 (ampc-next-line (* (or arg
1) -
1)))
2989 (defun ampc-next-line (&optional arg
)
2990 "Go to next ARG'th entry in the current buffer.
2993 (assert (ampc-in-ampc-p t
))
2996 (progn (forward-line -
1)
3002 (defun* ampc-suspend
(&optional
(run-hook t
))
3004 This function resets the window configuration, but does not close
3005 the connection to MPD or destroy the internal cache of ampc.
3006 This means subsequent startups of ampc will be faster."
3008 (when ampc-working-timer
3009 (cancel-timer ampc-working-timer
))
3010 (ampc-restore-window-configuration)
3011 (loop for b in ampc-all-buffers
3012 do
(when (buffer-live-p b
)
3014 (setf ampc-windows nil
3015 ampc-all-buffers nil
3016 ampc-working-timer nil
)
3018 (run-hooks 'ampc-suspend-hook
)))
3021 "Select song to play via `completing-read'."
3023 (assert (ampc-on-p))
3024 (ampc-send-command 'mini-playlistinfo
))
3026 (defun ampc-quit (&optional arg
)
3028 If prefix argument ARG is non-nil, kill the MPD instance that
3029 ampc is connected to."
3032 (set-process-filter ampc-connection nil
)
3033 (when (equal (car-safe ampc-outstanding-commands
) '(idle nil
))
3034 (ampc-send-command-impl "noidle")
3035 (with-current-buffer (process-buffer ampc-connection
)
3036 (loop do
(goto-char (point-min))
3037 until
(search-forward-regexp "^\\(ACK\\)\\|\\(OK\\).*\n\\'" nil t
)
3039 do
(accept-process-output ampc-connection nil
50))))
3040 (ampc-send-command-impl (if arg
"kill" "close"))
3041 (delete-process ampc-connection
))
3042 (when ampc-working-timer
3043 (cancel-timer ampc-working-timer
))
3045 (setf ampc-connection nil
3046 ampc-internal-db nil
3047 ampc-outstanding-commands nil
3049 (run-hooks 'ampc-quit-hook
))
3052 (defun ampc-suspended-p ()
3053 "Return non-nil if ampc is suspended."
3055 (and (ampc-on-p) (not ampc-windows
)))
3059 "Return non-nil if ampc is connected to the daemon."
3061 (and ampc-connection
(memq (process-status ampc-connection
) '(open run
))))
3064 (defun ampc (&optional host port suspend
)
3065 "Ampc is an asynchronous client for the MPD media player.
3066 This function is the main entry point for ampc.
3068 HOST and PORT specify the MPD instance to connect to. The values
3069 default to the ones specified in `ampc-default-server'."
3071 (unless (byte-code-function-p (symbol-function 'ampc
))
3072 (message "You should byte-compile ampc"))
3073 (run-hooks 'ampc-before-startup-hook
)
3075 (setf host
(or (car ampc-default-server
) (read-string "Host: "))))
3077 (setf port
(or (cdr ampc-default-server
) (read-string "Port: "))))
3078 (when (and ampc-connection
3079 (not (and (equal host ampc-host
)
3080 (equal port ampc-port
)
3083 (unless ampc-connection
3084 (let ((connection (open-network-stream "ampc"
3085 (with-current-buffer
3086 (get-buffer-create " *ampc*")
3091 :type
'plain
:return-list t
)))
3092 (unless (car connection
)
3093 (error "Failed connecting to server: %s"
3094 (plist-get ampc-connection
:error
)))
3095 (setf ampc-connection
(car connection
)
3098 (set-process-coding-system ampc-connection
'utf-8-unix
'utf-8-unix
)
3099 (set-process-filter ampc-connection
'ampc-filter
)
3100 (set-process-query-on-exit-flag ampc-connection nil
)
3101 (setf ampc-outstanding-commands
'((setup))))
3104 (ampc-configure-frame (cddadr ampc-views
)))
3105 (run-hooks 'ampc-connected-hook
)
3108 (ampc-filter (process-buffer ampc-connection
) nil
))
3113 ;; eval: (outline-minor-mode 1)
3114 ;; outline-regexp: ";;; \\*+"
3116 ;; indent-tabs-mode: nil
3118 ;;; ampc.el ends here