[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[ELPA-diffs] /srv/bzr/emacs/elpa r246: * ampc: Sync to version 0.2.
|
From: |
Christopher Schmidt |
|
Subject: |
[ELPA-diffs] /srv/bzr/emacs/elpa r246: * ampc: Sync to version 0.2. |
|
Date: |
Mon, 06 Aug 2012 09:06:26 +0200 |
|
User-agent: |
Bazaar (2.5.0) |
------------------------------------------------------------
revno: 246 [merge]
committer: Christopher Schmidt <address@hidden>
branch nick: elpa
timestamp: Mon 2012-08-06 09:06:26 +0200
message:
* ampc: Sync to version 0.2.
added:
packages/ampc/ampc_tagger.cpp
modified:
packages/ampc/ampc.el
=== modified file 'packages/ampc/ampc.el'
--- a/packages/ampc/ampc.el 2012-06-06 00:56:29 +0000
+++ b/packages/ampc/ampc.el 2012-08-06 07:06:26 +0000
@@ -1,10 +1,10 @@
-;;; ampc.el --- Asynchronous Music Player Controller
+;;; ampc.el --- Asynchronous Music Player Controller -*- lexical-binding: t -*-
;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Christopher Schmidt <address@hidden>
;; Maintainer: Christopher Schmidt <address@hidden>
-;; Version: 0.1.3
+;; Version: 0.2
;; Created: 2011-12-06
;; Keywords: ampc, mpc, mpd
;; Compatibility: GNU Emacs: 24.x
@@ -30,43 +30,57 @@
;;; ** installation
;; If you use GNU ELPA, install ampc via M-x package-list-packages RET or
-;; (package-install 'ampc). Otherwise, grab this file and put it somewhere in
-;; your load-path or add the directory the file is in to it, e.g.:
+;; (package-install 'ampc). Otherwise, grab the files in this repository and
+;; put the emacs lisp ones somewhere in your load-path or add the directory the
+;; files are in to it, e.g.:
;;
;; (add-to-list 'load-path "~/.emacs.d/ampc")
-;;
-;; Then add one autoload definition:
-;;
;; (autoload 'ampc "ampc" nil t)
;;
-;; Optionally bind a key to this function, e.g.:
-;;
-;; (global-set-key (kbd "<f9>") 'ampc)
-;;
-;; or
-;;
-;; (global-set-key (kbd "<f9>") (lambda () (interactive) (ampc "host" "port")))
-;;
;; Byte-compile ampc (M-x byte-compile-file RET /path/to/ampc.el RET) to
improve
;; its performance!
+;;; *** tagger
+;; ampc is not only a frontend to MPD but also a full-blown audio file tagger.
+;; To use this feature you have to build the backend application,
`ampc_tagger',
+;; which in turn uses TagLib (http://taglib.github.com/), a dual-licended
+;; (LGPL/MPL) audio meta-data library written in C++. TagLib has no
+;; dependencies on its own.
+;;
+;; To build `ampc_tagger', locate ampc_tagger.cpp. The file can be found in
the
+;; directory in which this file, ampc.el, is located. Compile the file and
+;; either customize `ampc-tagger-executable' to point to the binary file or
move
+;; the executable in a suitable directory so Emacs finds it via consulting
+;; `exec-path'.
+;;
+;; g++ -O2 ampc_tagger.cpp -oampc_tagger -ltag && sudo cp ampc_tagger
/usr/local/bin && rm ampc_tagger
+;;
+;; You have to customize `ampc-tagger-music-directories' in order to use the
+;; tagger. This variable should be a list of directories in which your music
+;; files are located. Usually this list should have only one entry, the value
+;; of your mpd.conf's `music_directory'.
+;;
+;; If `ampc-tagger-backup-directory' is non-nil, the tagger saved copies of all
+;; files that are about to be modified to this directory. Emacs's regular
+;; numeric backup filename syntax is used for the backup file names. By
default
+;; `ampc-tagger-backup-directory' is set to "~/.emacs.d/ampc-backups/".
+
;;; ** usage
-;; To invoke ampc, call the command `ampc', e.g. via M-x ampc RET. When called
-;; interactively, `ampc' reads host address and port from the minibuffer. If
-;; called non-interactively, the first argument to `ampc' is the host, the
-;; second is the port. Both values default to nil, which will make ampc
connect
-;; to localhost:6600. Once ampc is connected to the daemon, it creates its
-;; window configuration in the selected window. To make ampc use the full
frame
-;; rather than the selected window, customise `ampc-use-full-frame'.
+;; To invoke ampc call the command `ampc', e.g. via M-x ampc RET. The first
+;; argument to `ampc' is the host, the second is the port. Both values default
+;; to nil. If nil, ampc will use the value specified in `ampc-default-server',
+;; by default localhost:6600. To make ampc use the full frame rather than the
+;; selected window for its window setup, customise `ampc-use-full-frame' to a
+;; non-nil value.
;;
;; ampc offers three independent views which expose different parts of the user
;; interface. The current playlist view, the default view at startup, may be
-;; accessed using the `J' (that is `S-j') key. The playlist view may be
-;; accessed using the `K' key. The outputs view may be accessed using the `L'
-;; key.
+;; accessed using the `J' key (that is `S-j'). The playlist view may be
+;; accessed using the `K' key. The outputs view may be accessed by pressing
+;; `L'.
;;; *** current playlist view
-;; The playlist view should look like this
+;; The playlist view looks like this:
;;
;; .........................
;; . 1 . 3 . 4 . 5 .
@@ -80,7 +94,7 @@
;; .........................
;;
;; Window one exposes basic information about the daemon, such as the current
-;; state (stop/play/pause), the song currently playing, or the volume.
+;; state (stop/play/pause), the song currently playing or the volume.
;;
;; All windows, except the status window, contain a tabular list of items.
Each
;; item may be selected/marked. There may be multiple selections.
@@ -113,41 +127,123 @@
;; Calling `ampc-add' in a tag browser adds all songs filtered up to the
;; selected browser to the playlist.
;;
-;; The tag browsers of the (default) current playlist view (accessed via `J')
-;; are `Genre' (window 3), `Artist' (window 4) and `Album' (window 5). The key
-;; `M' may be used to fire up a slightly modified current playlist view. There
-;; is no difference to the default current playlist view other than that the
tag
+;; The tag browsers of the current playlist view (accessed via `J') are `Genre'
+;; (window 3), `Artist' (window 4) and `Album' (window 5). The key `M' may be
+;; used to fire up a slightly modified current playlist view. There is no
+;; difference to the default current playlist view other than that the tag
;; browsers filter to `Genre' (window 3), `Album' (window 4) and `Artist'
;; (window 5). Metaphorically speaking, the order of the `grep' filters
defined
;; by the tag browsers is different.
;;; *** playlist view
;; The playlist view resembles the current playlist view. The window, which
-;; exposes the playlist content, is split, though. The bottom half shows a
list
-;; of stored playlists. The upper half does not expose the current playlist
-;; anymore. Instead, the content of the selected (stored) playlist is shown.
-;; All commands that used to work in the current playlist view and modify the
-;; current playlist now modify the selected (stored) playlist. The list of
-;; stored playlists is the only view in ampc that may have only one marked
-;; entry.
+;; exposes the playlist content, is replaced by three windows, vertically
+;; arragned, though. The top one still shows the current playlist. The bottom
+;; one shows a list of stored playlists. The middle window exposes the content
+;; of the selected (stored) playlist. All commands that used to work in the
+;; current playlist view and modify the current playlist now modify the
selected
+;; (stored) playlist unless the point is within the current playlist buffer.
+;; The list of stored playlists is the only view in ampc that may have only one
+;; marked entry.
+;;
+;; To queue a playlist, press `l' (ampc-load) or `<down-mouse-2>'. To delete a
+;; playlist, press `d' (ampc-delete-playlist) or `<down-mouse-3>'. The command
+;; `ampc-rename-playlist', bound to `r', can be used to rename a playlist.
;;
;; Again, the key `<' may be used to setup a playlist view with a different
;; order of tag browsers.
;;; *** outputs view
;; The outputs view contains a single list which shows the configured outputs
of
-;; mpd. To toggle the enabled property of the selected outputs, press `a'
+;; MPD. To toggle the enabled property of the selected outputs, press `a'
;; (ampc-toggle-output-enabled) or `<mouse-3>'.
-;;; *** global keys
+;;; ** tagger
+;; To start the tagging subsystem, press `I' (ampc-tagger). This key binding
+;; works in every buffer associated with ampc. First, the command tries to
+;; determine which files you want to tag. The files are collected using either
+;; the selected entries within the current buffer, the file associated with the
+;; entry at point, or, if both sources did not provide any files, the audio
file
+;; that is currently played by MPD. Next, the tagger view is created. On the
+;; right there is the buffer that contain the tag data. Each line in this
+;; buffer represents a tag with a value. Tag and value are separated by a
+;; colon. Valid tags are "Title", "Artist", "Album", "Comment", "Genre",
"Year"
+;; and "Track". The value can be an arbitrary string. Whitespaces in front
and
+;; at the end of the value are ignored. If the value is "<keep>", the tag line
+;; is ignored.
+;;
+;; To save the specified tag values back to the files, press `C-c C-c'
+;; (ampc-tagger-save). To exit the tagger and restore the previous window
+;; configuration, press `C-c C-q'. `C-u C-c C-c' saved the tags and exits the
+;; tagger. Only tags that are actually specified within the tagger buffer
+;; written back to the file. Other tags will not be touched by ampc. For
+;; example, to clear the "Commentary" tag, you need to specify the line
+;;
+;; Commentary:
+;;
+;; In the tagger buffer. Omitting this line will make the tagger not touch the
+;; "Commentary" tag at all.
+;;
+;; On the right there is the files list buffer. The selection of this buffer
+;; specifies which files the command `ampc-tag-save' will write to. If no file
+;; is selected, the file at point in the file list buffer is used.
+;;
+;; To reset the values of the tags specified in the tagger buffer to the common
+;; values of all selected files specified by the selection of the files list
+;; buffer, press `C-c C-r' (ampc-tagger-reset). With a prefix argument,
+;; `ampc-tagger-reset' restores missing tags as well.
+;;
+;; You can use tab-completion within the tagger buffer for both tags and tag
+;; values.
+;;
+;; You can also use the tagging subsystem on its own without a running ampc
+;; instance. To start the tagger, call `ampc-tag-files'. This function
accepts
+;; one argument, a list of absolute file names which are the files to tag.
ampc
+;; provides a minor mode for dired, `ampc-tagger-dired-mode'. If this mode is
+;; enabled within a dired buffer, pressing `C-c C-t' (ampc-tagger-dired) will
+;; start the tagger on the current selection.
+;;
+;; The following ampc-specific hooks are run during tagger usage:
+;;
+;; `ampc-tagger-grab-hook': Run by the tagger before grabbing tags of a file.
+;; Each function is called with one argument, the file name.
+;;
+;; `ampc-tagger-grabbed-hook': Run by the tagger after grabbing tags of a file.
+;; Each function is called with one argument, the file name.
+;;
+;; `ampc-tagger-store-hook': Run by the tagger before writing tags back to a
+;; file. Each function is called with two arguments, FOUND-CHANGED and DATA.
+;; FOUND-CHANGED is non-nil if the tags that are about to be written differ
from
+;; the ones in the file. DATA is a cons. The car specifies the full file name
+;; of the file that is about to be written to, the cdr is an alist that
+;; specifies the tags that are about to be (over-)written. The car of each
+;; entry in this list is a symbol specifying the tag (one of the ones in
+;; `ampc-tagger-tags'), the cdr a string specifying the value. The cdr of DATA
+;; may be modified. If FOUND-CHANGED is nil and the cdr of DATA is not
modified
+;; throughout the hook is run, the file is not touched.
+;; `ampc-tagger-stored-hook' is still run, though.
+;;
+;; `ampc-tagger-stored-hook': Run by the tagger after writing tags back to a
+;; file. Each function is called with two arguments, FOUND-CHANGED and DATA.
+;; These are the same arguments that were already passed to
+;; `ampc-tagger-store-hook'. The car of DATA, the file name, may be modified.
+;;
+;; These hooks can be used to handle vc locking and unlocking of files. For
+;; renaming files according to their (new) tag values, ampc provides the
+;; function `ampc-tagger-rename-artist-title' which may be added to
+;; `ampc-tagger-stored-hook'. The new file name generated by this function is
+;; "Artist"_-_"Title"."extension". Characters within "Artist" and "Title" that
+;; are not alphanumeric are substituted with underscores.
+
+;;; ** global keys
;; Aside from `J', `M', `K', `<' and `L', which may be used to select different
-;; views, ampc defines the following global keys, which may be used in every
-;; window associated with ampc:
+;; views, and `I' which starts the tagger, ampc defines the following global
+;; keys. These binding are available in every buffer associated with ampc:
;;
-;; `k' (ampc-toggle-play): Toggle play state. If mpd does not play a song
-;; already, start playing the song at point if the current buffer is the
-;; playlist buffer, otherwise start at the beginning of the playlist. With
-;; prefix argument 4, stop player rather than pause if applicable.
+;; `k' (ampc-toggle-play): Toggle play state. If MPD does not play a song,
+;; start playing the song at point if the current buffer is the playlist
buffer,
+;; otherwise start at the beginning of the playlist. With numeric prefix
+;; argument 4, stop player rather than pause if applicable.
;;
;; `l' (ampc-next): Play next song.
;; `j' (ampc-previous): Play previous song
@@ -156,14 +252,16 @@
;; `s' (ampc-shuffle): Shuffle playlist.
;;
;; `S' (ampc-store): Store playlist.
-;; `O' (ampc-load): Load selected playlist in the current playlist.
+;; `O' (ampc-load): Load selected playlist into the current playlist.
;; `R' (ampc-rename-playlist): Rename selected playlist.
;; `D' (ampc-delete-playlist): Delete selected playlist.
;;
;; `y' (ampc-increase-volume): Increase volume.
;; `M-y' (ampc-decrease-volume): Decrease volume.
+;; `C-M-y' (ampc-set-volume): Set volume.
;; `h' (ampc-increase-crossfade): Increase crossfade.
;; `M-h' (ampc-decrease-crossfade): Decrease crossfade.
+;; `C-M-h' (ampc-set-crossfade): Set crossfade.
;;
;; `e' (ampc-toggle-repeat): Toggle repeat state.
;; `r' (ampc-toggle-random): Toggle random state.
@@ -171,6 +269,7 @@
;;
;; `P' (ampc-goto-current-song): Select the current playlist window and move
;; point to the current song.
+;; `G' (ampc-mini): Select song to play via `completing-read'.
;;
;; `T' (ampc-trigger-update): Trigger a database update.
;; `Z' (ampc-suspend): Suspend ampc.
@@ -189,24 +288,41 @@
;; (substitute-ampc-key (kbd "z") (kbd "Z"))
;; (substitute-ampc-key (kbd "y") (kbd "z"))
;; (substitute-ampc-key (kbd "M-y") (kbd "M-z"))
+;; (substitute-ampc-key (kbd "C-M-y") (kbd "C-M-z"))
;; (substitute-ampc-key (kbd "<") (kbd ";"))))
;;
;; If ampc is suspended, you can still use every interactive command that does
;; not directly operate on or with the user interace of ampc. For example it
is
;; perfectly fine to call `ampc-increase-volume' or `ampc-toggle-play' via M-x
-;; RET. To display the information that is displayed by the status window of
-;; ampc, call `ampc-status'.
+;; RET. Especially the commands `ampc-status' and `ampc-mini' are
predesignated
+;; to be bound in the global keymap and called when ampc is suspended.
+;; `ampc-status' messages the information that is displayed by the status
window
+;; of ampc. `ampc-mini' lets you select a song to play via `completing-read'.
+;; To start ampc suspended, call `ampc' with the third argument being non-nil.
+;; To check whether ampc is connected to the daemon and/or suspended, call
+;; `ampc-is-on-p' or `ampc-suspended-p'.
+;;
+;; (global-set-key (kbd "<f7>")
+;; (lambda ()
+;; (interactive)
+;; (unless (ampc-on-p)
+;; (ampc nil nil t))
+;; (ampc-status)))
+;; (global-set-key (kbd "<f8>")
+;; (lambda ()
+;; (interactive)
+;; (unless (ampc-on-p)
+;; (ampc nil nil t))
+;; (ampc-mini)))
;;; Code:
;;; * code
(eval-when-compile
- (require 'easymenu)
(require 'cl))
(require 'network-stream)
(require 'avl-tree)
;;; ** declarations
-;;; *** variables
(defgroup ampc ()
"Asynchronous client for the Music Player Daemon."
:prefix "ampc-"
@@ -215,8 +331,11 @@
;;; *** customs
(defcustom ampc-debug nil
- "Non-nil means log communication between ampc and MPD."
- :type 'boolean)
+ "Non-nil means log outgoing communication between ampc and MPD.
+If the value is neither t nor nil, also log incoming data."
+ :type '(choice (const :tag "Disable" nil)
+ (const :tag "Outgoing" t)
+ (const :tag "Incoming and outgoing" full)))
(defcustom ampc-use-full-frame nil
"If non-nil, ampc will use the entire Emacs screen."
@@ -226,12 +345,71 @@
"If non-nil, truncate lines in ampc buffers."
:type 'boolean)
+(defcustom ampc-default-server '("localhost" . 6600)
+ "The MPD server to connect to if the arguments to `ampc' are nil.
+This variable is a cons cell, with the car specifying the
+hostname and the cdr specifying the port. Both values can be
+nil, which will make ampc query the user for values on each
+invocation."
+ :type '(cons (choice :tag "Hostname"
+ (string)
+ (const :tag "Ask" nil))
+ (choice :tag "Port"
+ (string)
+ (integer)
+ (const :tag "Ask" nil))))
+
+(defcustom ampc-synchronous-commands '(t status currentsong play)
+ "List of MPD commands that should be executed synchronously.
+Executing commands that print lots of output synchronously will
+result in massive performance improvements of ampc. If the car
+of this list is `t', execute all commands synchronously other
+than the ones specified by the rest of the list."
+ :type '(repeat symbol))
+
(defcustom ampc-status-tags nil
"List of additional tags of the current song that are added to
the internal status of ampc and thus are passed to the functions
in `ampc-status-changed-hook'. Each element may be a string that
specifies a tag that is returned by MPD's `currentsong'
-command.")
+command."
+ :type '(list symbol))
+
+(defcustom ampc-volume-step 5
+ "Default step of `ampc-increase-volume' and
+`ampc-decrease-volume' for changing the volume."
+ :type 'integer)
+
+(defcustom ampc-crossfade-step 5
+ "Default step of `ampc-increase-crossfade' and
+`ampc-decrease-crossfade' for changing the crossfade."
+ :type 'integer)
+
+(defcustom ampc-tag-transform-funcs '(("Time" . ampc-transform-time)
+ ("Track" . ampc-transform-track))
+ "Alist of tag treatment functions.
+The car, a string, of each entry specifies the MPD tag, the cdr a
+function which transforms the tag to the value that should be
+used by ampc. The function is called with one string argument,
+the tag value, and should return the treated value."
+ :type '(alist :key-type string :value-type function))
+
+(defcustom ampc-tagger-music-directories nil
+ "List of base directories in which your music files are located.
+Usually this list should have only one entry, the value of your
+mpd.conf's `music_directory'"
+ :type '(list directory))
+
+(defcustom ampc-tagger-executable "ampc_tagger"
+ "The name or full path to ampc's tagger executable."
+ :type 'string)
+
+(defcustom ampc-tagger-backup-directory
+ (file-name-directory (locate-user-emacs-file "ampc-backups/"))
+ "The directory in which the tagger copies files before modifying.
+If nil, disable backups."
+ :type '(choice (const :tag "Disable backups" nil)
+ (directory :tag "Directory")))
;;; **** hooks
(defcustom ampc-before-startup-hook nil
@@ -271,52 +449,103 @@
all the time!"
:type 'hook)
+(defcustom ampc-tagger-grab-hook nil
+ "Hook run by the tagger before grabbing tags of a file.
+Each function is called with one argument, the file name."
+ :type 'hook)
+(defcustom ampc-tagger-grabbed-hook nil
+ "Hook run by the tagger after grabbing tags of a file.
+Each function is called with one argument, the file name."
+ :type 'hook)
+
+(defcustom ampc-tagger-store-hook nil
+ "Hook run by the tagger before writing tags back to a file.
+Each function is called with two arguments, FOUND-CHANGED and
+DATA. FOUND-CHANGED is non-nil if the tags that are about to be
+written differ from the ones in the file. DATA is a cons. The
+car specifies the full file name of the file that is about to be
+written to, the cdr is an alist that specifies the tags that are
+about to be (over-)written. The car of each entry in this list
+is a symbol specifying the tag (one of the ones in
+`ampc-tagger-tags'), the cdr a string specifying the value. The
+cdr of DATA may be modified. If FOUND-CHANGED is nil and the cdr
+of DATA is not modified throughout the hook is run, the file is
+not touched. `ampc-tagger-stored-hook' is still run, though."
+ :type 'hook)
+(defcustom ampc-tagger-stored-hook nil
+ "Hook run by the tagger after writing tags back to a file.
+Each function is called with two arguments, FOUND-CHANGED and
+DATA. These are the same arguments that were already passed to
+`ampc-tagger-store-hook'. The car of DATA, the file name, may be
+modified."
+ :type 'hook)
+
;;; *** faces
(defface ampc-mark-face '((t (:inherit font-lock-constant-face)))
"Face of the mark.")
(defface ampc-marked-face '((t (:inherit warning)))
"Face of marked entries.")
-(defface ampc-face '((t (:inerhit default)))
+(defface ampc-unmarked-face '((t (:inerhit default)))
"Face of unmarked entries.")
(defface ampc-current-song-mark-face '((t (:inherit region)))
"Face of mark of the current song.")
(defface ampc-current-song-marked-face '((t (:inherit region)))
"Face of the current song if marked.")
+(defface ampc-tagger-tag-face '((t (:inherit font-lock-constant-face)))
+ "Face of tags within the tagger.")
+(defface ampc-tagger-keyword-face '((t (:inherit font-lock-keyword-face)))
+ "Face of tags within the tagger.")
+
;;; *** internal variables
(defvar ampc-views
- (let* ((songs '(1.0 song :properties (("Track" :title "#")
- ("Title" :offset 6)
- ("Time" :offset 26))))
+ (let* ((songs '(1.0 song :properties (("Track" :title "#" :width 4)
+ ("Title" :min 15 :max 40)
+ ("Time" :width 6)
+ ("Artist" :min 15 :max 40)
+ ("Album" :min 15 :max 40))))
(rs_a `(1.0 vertical
(0.7 horizontal
- (0.33 tag :tag "Genre" :id 1)
+ (0.33 tag :tag "Genre" :id 1 :select t)
(0.33 tag :tag "Artist" :id 2)
(1.0 tag :tag "Album" :id 3))
,songs))
(rs_b `(1.0 vertical
(0.7 horizontal
- (0.33 tag :tag "Genre" :id 1)
+ (0.33 tag :tag "Genre" :id 1 :select t)
(0.33 tag :tag "Album" :id 2)
(1.0 tag :tag "Artist" :id 3))
,songs))
- (pl-prop '(("Title")
- ("Artist" :offset 20)
- ("Album" :offset 40)
- ("Time" :offset 60))))
- `(("Current playlist view (Genre|Artist|Album)"
+ (pl-prop '(:properties (("Title" :min 15 :max 40)
+ ("Artist" :min 15 :max 40)
+ ("Album" :min 15 :max 40)
+ ("Time" :width 6)))))
+ `((tagger
+ horizontal
+ (0.65 files-list
+ :properties ((filename :shrink t :title "File" :min 20 :max 40)
+ ("Title" :min 15 :max 40)
+ ("Artist" :min 15 :max 40)
+ ("Album" :min 15 :max 40)
+ ("Genre" :min 15 :max 40)
+ ("Year" :width 5)
+ ("Track" :title "#" :width 4)
+ ("Comment" :min 15 :max 40))
+ :dedicated nil)
+ (1.0 tagger))
+ ("Current playlist view (Genre|Artist|Album)"
,(kbd "J")
horizontal
(0.4 vertical
(6 status)
- (1.0 current-playlist :properties ,pl-prop))
+ (1.0 current-playlist ,@pl-prop))
,rs_a)
("Current playlist view (Genre|Album|Artist)"
,(kbd "M")
horizontal
(0.4 vertical
(6 status)
- (1.0 current-playlist :properties ,pl-prop))
+ (1.0 current-playlist ,@pl-prop))
,rs_b)
("Playlist view (Genre|Artist|Album)"
,(kbd "K")
@@ -324,7 +553,8 @@
(0.4 vertical
(6 status)
(1.0 vertical
- (0.8 playlist :properties ,pl-prop)
+ (0.4 current-playlist ,@pl-prop)
+ (0.4 playlist ,@pl-prop)
(1.0 playlists)))
,rs_a)
("Playlist view (Genre|Album|Artist)"
@@ -333,24 +563,26 @@
(0.4 vertical
(6 status)
(1.0 vertical
- (0.8 playlist :properties ,pl-prop)
+ (0.4 current-playlist ,@pl-prop)
+ (0.4 playlist ,@pl-prop)
(1.0 playlists)))
,rs_b)
("Outputs view"
,(kbd "L")
- outputs :properties (("outputname" :title "Name")
- ("outputenabled" :title "Enabled" :offset 10))))))
+ outputs :properties (("outputname" :title "Name" :min 10 :max 30)
+ ("outputenabled" :title "Enabled" :width 9))))))
(defvar ampc-connection nil)
(defvar ampc-host nil)
(defvar ampc-port nil)
(defvar ampc-outstanding-commands nil)
+(defvar ampc-no-implicit-next-dispatch nil)
(defvar ampc-working-timer nil)
(defvar ampc-yield nil)
+(defvar ampc-yield-redisplay nil)
-(defvar ampc-buffers nil)
-(defvar ampc-buffers-unordered nil)
+(defvar ampc-windows nil)
(defvar ampc-all-buffers nil)
(defvar ampc-type nil)
@@ -361,6 +593,14 @@
(defvar ampc-internal-db nil)
(defvar ampc-status nil)
+(defvar ampc-tagger-previous-configuration nil)
+(defvar ampc-tagger-version-verified nil)
+(defvar ampc-tagger-completion-all-files nil)
+(defvar ampc-tagger-genres nil)
+
+(defconst ampc-tagger-version "0.1")
+(defconst ampc-tagger-tags '(Title Artist Album Comment Genre Year Track))
+
;;; *** mode maps
(defvar ampc-mode-map
(let ((map (make-sparse-keymap)))
@@ -376,20 +616,25 @@
(define-key map (kbd "D") 'ampc-delete-playlist)
(define-key map (kbd "y") 'ampc-increase-volume)
(define-key map (kbd "M-y") 'ampc-decrease-volume)
+ (define-key map (kbd "C-M-y") 'ampc-set-volume)
(define-key map (kbd "h") 'ampc-increase-crossfade)
(define-key map (kbd "M-h") 'ampc-decrease-crossfade)
+ (define-key map (kbd "C-M-h") 'ampc-set-crossfade)
(define-key map (kbd "e") 'ampc-toggle-repeat)
(define-key map (kbd "r") 'ampc-toggle-random)
(define-key map (kbd "f") 'ampc-toggle-consume)
(define-key map (kbd "P") 'ampc-goto-current-song)
+ (define-key map (kbd "G") 'ampc-mini)
(define-key map (kbd "q") 'ampc-quit)
(define-key map (kbd "z") 'ampc-suspend)
(define-key map (kbd "T") 'ampc-trigger-update)
+ (define-key map (kbd "I") 'ampc-tagger)
(loop for view in ampc-views
- do (define-key map (cadr view)
- `(lambda ()
- (interactive)
- (ampc-change-view ',view))))
+ do (when (stringp (car view))
+ (define-key map (cadr view)
+ `(lambda ()
+ (interactive)
+ (ampc-change-view ',view)))))
map))
(defvar ampc-item-mode-map
@@ -400,10 +645,11 @@
(define-key map (kbd "U") 'ampc-unmark-all)
(define-key map (kbd "n") 'ampc-next-line)
(define-key map (kbd "p") 'ampc-previous-line)
+ (define-key map (kbd "<down-mouse-1>") 'ampc-mouse-toggle-mark)
+ (define-key map (kbd "<mouse-1>") 'ampc-mouse-align-point)
(define-key map [remap next-line] 'ampc-next-line)
(define-key map [remap previous-line] 'ampc-previous-line)
- (define-key map (kbd "<down-mouse-1>") 'ampc-mouse-toggle-mark)
- (define-key map (kbd "<mouse-1>") 'ampc-mouse-align-point)
+ (define-key map [remap tab-to-tab-stop] 'ampc-move-to-tab)
map))
(defvar ampc-current-playlist-mode-map
@@ -413,6 +659,7 @@
(define-key map (kbd "<down-mouse-2>") 'ampc-mouse-play-this)
(define-key map (kbd "<mouse-2>") 'ampc-mouse-align-point)
(define-key map (kbd "<down-mouse-3>") 'ampc-mouse-delete)
+ (define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
map))
(defvar ampc-playlist-mode-map
@@ -423,6 +670,7 @@
(define-key map (kbd "<up>") 'ampc-up)
(define-key map (kbd "<down>") 'ampc-down)
(define-key map (kbd "<down-mouse-3>") 'ampc-mouse-delete)
+ (define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
map))
(defvar ampc-playlists-mode-map
@@ -431,6 +679,10 @@
(define-key map (kbd "l") 'ampc-load)
(define-key map (kbd "r") 'ampc-rename-playlist)
(define-key map (kbd "d") 'ampc-delete-playlist)
+ (define-key map (kbd "<down-mouse-2>") 'ampc-mouse-load)
+ (define-key map (kbd "<mouse-2>") 'ampc-mouse-align-point)
+ (define-key map (kbd "<down-mouse-3>") 'ampc-mouse-delete-playlist)
+ (define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
map))
(defvar ampc-tag-song-mode-map
@@ -451,14 +703,44 @@
(define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
map))
+(defvar ampc-files-list-mode-map
+ (let ((map (make-sparse-keymap)))
+ (suppress-keymap map)
+ (define-key map (kbd "t") 'ampc-toggle-marks)
+ (define-key map (kbd "C-c C-q") 'ampc-tagger-quit)
+ (define-key map (kbd "C-c C-c") 'ampc-tagger-save)
+ (define-key map (kbd "C-c C-r") 'ampc-tagger-reset)
+ (define-key map [remap ampc-tagger] nil)
+ (define-key map [remap ampc-quit] 'ampc-tagger-quit)
+ (loop for view in ampc-views
+ do (when (stringp (car view))
+ (define-key map (cadr view) nil)))
+ map))
+
+(defvar ampc-tagger-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c C-q") 'ampc-tagger-quit)
+ (define-key map (kbd "C-c C-c") 'ampc-tagger-save)
+ (define-key map (kbd "C-c C-r") 'ampc-tagger-reset)
+ (define-key map (kbd "<tab>") 'ampc-tagger-completion-at-point)
+ map))
+
+(defvar ampc-tagger-dired-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c C-t") 'ampc-tagger-dired)
+ map))
+
;;; **** menu
(easy-menu-define nil ampc-mode-map nil
`("ampc"
("Change view" ,@(loop for view in ampc-views
+ when (stringp (car view))
collect (vector (car view)
`(lambda ()
(interactive)
- (ampc-change-view ',view)))))
+ (ampc-change-view ',view)))
+ end))
+ ["Run tagger" ampc-tagger]
"--"
["Play" ampc-toggle-play
:visible (and ampc-status
@@ -481,17 +763,19 @@
"--"
["Increase volume" ampc-increase-volume]
["Decrease volume" ampc-decrease-volume]
+ ["Set volume" ampc-set-volume]
["Increase crossfade" ampc-increase-crossfade]
["Decrease crossfade" ampc-decrease-crossfade]
+ ["Set crossfade" ampc-set-crossfade]
["Toggle repeat" ampc-toggle-repeat
:style toggle
- :selected (equal (cdr-safe (assq 'repeat ampc-status)) "1")]
+ :selected (equal (cdr (assq 'repeat ampc-status)) "1")]
["Toggle random" ampc-toggle-random
:style toggle
- :selected (equal (cdr-safe (assq 'random ampc-status)) "1")]
+ :selected (equal (cdr (assq 'random ampc-status)) "1")]
["Toggle consume" ampc-toggle-consume
:style toggle
- :selected (equal (cdr-safe (assq 'consume ampc-status)) "1")]
+ :selected (equal (cdr (assq 'consume ampc-status)) "1")]
"--"
["Trigger update" ampc-trigger-update]
["Suspend" ampc-suspend]
@@ -543,25 +827,24 @@
(defmacro ampc-with-buffer (type &rest body)
(declare (indent 1) (debug t))
`(let* ((type- ,type)
- (b (loop for b in ampc-buffers
- when (with-current-buffer b
- (cond ((windowp type-)
- (eq (window-buffer type-)
- (current-buffer)))
- ((symbolp type-)
- (eq (car ampc-type) type-))
- (t
- (equal ampc-type type-))))
- return b
- end)))
- (when b
- (with-current-buffer b
- (let ((buffer-read-only))
- ,@(if (eq (car body) 'no-se)
- (cdr body)
- `((save-excursion
- (goto-char (point-min))
- ,@body))))))))
+ (w (if (windowp type-)
+ type-
+ (loop for w in (ampc-normalize-windows)
+ thereis (when (with-current-buffer
+ (window-buffer w)
+ (etypecase type-
+ (symbol (eq (car ampc-type) type-))
+ (cons (equal ampc-type type-))))
+ w)))))
+ (when w
+ (with-selected-window w
+ (with-current-buffer (window-buffer w)
+ (let ((inhibit-read-only t))
+ ,@(if (eq (car body) 'no-se)
+ (cdr body)
+ `((save-excursion
+ (goto-char (point-min))
+ ,@body)))))))))
(defmacro ampc-fill-skeleton (tag &rest body)
(declare (indent 1) (debug t))
@@ -569,82 +852,182 @@
(data-buffer (current-buffer)))
(ampc-with-buffer tag-
no-se
- (let ((point (point)))
- (goto-char (point-min))
- (loop until (eobp)
- do (put-text-property (point) (1+ (point)) 'updated t)
- (forward-line))
- (goto-char (point-min))
- ,@body
- (goto-char (point-min))
- (loop until (eobp)
- when (get-text-property (point) 'updated)
- do (delete-region (point) (1+ (line-end-position)))
- else
- do (add-text-properties
- (+ (point) 2)
- (progn (forward-line nil)
- (1- (point)))
- '(mouse-face highlight))
- end)
- (goto-char point)
- (ampc-align-point))
- (ampc-set-dirty nil)
- (with-selected-window (if (windowp tag-) tag- (ampc-get-window tag-))
- (recenter)))))
+ (unless (eq ampc-dirty 'keep-dirty)
+ (let ((old-point-data (get-text-property (point) 'cmp-data))
+ (old-window-start-offset
+ (1- (count-lines (window-start) (point)))))
+ (put-text-property (point-min) (point-max) 'not-updated t)
+ (when (eq ampc-dirty 'erase)
+ (put-text-property (point-min) (point-max) 'data nil))
+ (goto-char (point-min))
+ ,@body
+ (goto-char (point-min))
+ (loop until (eobp)
+ do (if (get-text-property (point) 'not-updated)
+ (kill-line 1)
+ (add-text-properties (+ (point) 2)
+ (progn (forward-line nil)
+ (1- (point)))
+ '(mouse-face highlight))))
+ (remove-text-properties (point-min) (point-max) '(not-updated))
+ (goto-char (point-min))
+ (when old-point-data
+ (loop until (eobp)
+ do (when (equal (get-text-property (point) 'cmp-data)
+ old-point-data)
+ (set-window-start
+ nil
+ (save-excursion
+ (forward-line (- old-window-start-offset))
+ (point))
+ t)
+ (return))
+ (forward-line)
+ finally do (goto-char (point-min)))))
+ (let ((effective-height (- (window-height)
+ (if mode-line-format 1 0)
+ (if header-line-format 1 0))))
+ (when (< (- (1- (line-number-at-pos (point-max)))
+ (line-number-at-pos (window-start)))
+ effective-height)
+ (set-window-start nil
+ (save-excursion
+ (goto-char (point-max))
+ (forward-line (- (1+ effective-height)))
+ (point))
+ t)))
+ (ampc-align-point)
+ (ampc-set-dirty nil)))))
(defmacro ampc-with-selection (arg &rest body)
(declare (indent 1) (debug t))
`(let ((arg- ,arg))
- (if (and (not arg-)
- (save-excursion
- (goto-char (point-min))
- (search-forward-regexp "^* " nil t)))
- (loop initially (goto-char (point-min))
- finally (ampc-align-point)
+ (if (or (and (not arg-)
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward-regexp "^* " nil t)))
+ (and arg- (symbolp arg-)))
+ (loop initially do (goto-char (point-min))
+ finally do (ampc-align-point)
while (search-forward-regexp "^* " nil t)
for index from 0
do (save-excursion
,@body))
+ (setf arg- (prefix-numeric-value arg-))
+ (ampc-align-point)
(loop until (eobp)
- for index from 0 to (1- (if (numberp arg-)
- arg-
- (prefix-numeric-value arg-)))
+ for index from 0 to (1- (abs arg-))
do (save-excursion
- (goto-char (line-end-position))
,@body)
- until (ampc-next-line)))))
+ until (if (< arg- 0) (ampc-previous-line) (ampc-next-line))))))
+
+(defmacro ampc-iterate-source (data-buffer delimiter bindings &rest body)
+ (declare (indent 3) (debug t))
+ (when (memq (intern delimiter) bindings)
+ (callf2 delq (intern delimiter) bindings)
+ (push (list (intern delimiter)
+ '(buffer-substring (point) (line-end-position)))
+ bindings))
+ `(,@(if data-buffer `(with-current-buffer ,data-buffer) '(progn))
+ (when (search-forward-regexp
+ ,(concat "^" (regexp-quote delimiter) ": ")
+ nil t)
+ (loop with next
+ do (save-restriction
+ (setf next (ampc-narrow-entry
+ ,(concat "^" (regexp-quote delimiter) ": ")))
+ (let ,(loop for binding in bindings
+ if (consp binding)
+ collect binding
+ else
+ collect `(,binding (ampc-extract
+ (ampc-extract-regexp
+ ,(symbol-name binding))))
+ end)
+ ,@body))
+ while next
+ do (goto-char next)))))
+
+(defmacro ampc-iterate-source-output (delimiter bindings pad-data &rest body)
+ (declare (indent 2) (debug t))
+ `(let ((output-buffer (current-buffer))
+ (tags (loop for (tag . props) in
+ (plist-get (cdr ampc-type) :properties)
+ collect (cons tag (ampc-extract-regexp tag)))))
+ (ampc-iterate-source
+ data-buffer ,delimiter ,bindings
+ (let ((pad-data ,pad-data))
+ (with-current-buffer output-buffer
+ (ampc-insert (ampc-pad pad-data) ,@body))))))
+
+(defmacro ampc-extract-regexp (tag)
+ (if (stringp tag)
+ (concat "^" (regexp-quote tag) ": \\(.*\\)$")
+ `(concat "^" (regexp-quote ,tag) ": \\(.*\\)$")))
+
+(defmacro ampc-tagger-log (&rest what)
+ (declare (indent 0) (debug t))
+ `(with-current-buffer (get-buffer-create "*Tagger Log*")
+ (ampc-tagger-log-mode)
+ (save-excursion
+ (goto-char (point-max))
+ (let ((inhibit-read-only t)
+ (what (concat ,@what)))
+ (when ampc-debug
+ (message "ampc: %s" what))
+ (insert what)))))
;;; *** modes
-(define-derived-mode ampc-outputs-mode ampc-item-mode "ampc-o"
- nil)
+(define-derived-mode ampc-outputs-mode ampc-item-mode "ampc-o")
-(define-derived-mode ampc-tag-song-mode ampc-item-mode "ampc-ts"
- nil)
+(define-derived-mode ampc-tag-song-mode ampc-item-mode "ampc-ts")
(define-derived-mode ampc-current-playlist-mode ampc-playlist-mode "ampc-cpl"
- nil)
-
-(define-derived-mode ampc-playlist-mode ampc-item-mode "ampc-pl"
- nil)
-
-(define-derived-mode ampc-playlists-mode ampc-item-mode "ampc-pls"
- nil)
-
-(define-derived-mode ampc-item-mode ampc-mode ""
- nil)
-
-(define-derived-mode ampc-mode special-mode "ampc"
- nil
- (buffer-disable-undo)
+ (ampc-highlight-current-song-mode))
+
+(define-derived-mode ampc-playlist-mode ampc-item-mode "ampc-pl")
+
+(define-derived-mode ampc-playlists-mode ampc-item-mode "ampc-pls")
+
+(define-derived-mode ampc-files-list-mode ampc-item-mode "ampc-files-list")
+
+(define-derived-mode ampc-tagger-mode nil "ampc-tagger"
(set (make-local-variable 'tool-bar-map) ampc-tool-bar-map)
+ (set (make-local-variable 'tab-stop-list)
+ (list (+ (loop for tag in ampc-tagger-tags
+ maximize (length (symbol-name tag)))
+ 2)))
+ (set (make-local-variable 'completion-at-point-functions)
+ '(ampc-tagger-complete-tag ampc-tagger-complete-value))
(setf truncate-lines ampc-truncate-lines
- font-lock-defaults '((("^\\(\\*\\)\\(.*\\)$"
+ font-lock-defaults
+ `(((,(concat "^\\([ \t]*\\(?:"
+ (mapconcat 'symbol-name ampc-tagger-tags "\\|")
+ "\\)[ \t]*:\\)"
+ "\\(\\(?:[ \t]*"
+ "\\(?:"
+ (mapconcat 'identity ampc-tagger-genres "\\|") "\\|<keep>"
+ "\\)"
+ "[ \t]*$\\)?\\)")
+ (1 'ampc-tagger-tag-face)
+ (2 'ampc-tagger-keyword-face)))
+ t)))
+
+(define-derived-mode ampc-tagger-log-mode nil "ampc-tagger-log")
+
+(define-derived-mode ampc-item-mode ampc-mode "ampc-item"
+ (setf font-lock-defaults '((("^\\(\\*\\)\\(.*\\)$"
(1 'ampc-mark-face)
(2 'ampc-marked-face))
- ("^ .*$" 0 'ampc-face))
+ ("" 0 'ampc-unmarked-face))
t)))
+(define-derived-mode ampc-mode special-mode "ampc"
+ (buffer-disable-undo)
+ (set (make-local-variable 'tool-bar-map) ampc-tool-bar-map)
+ (setf truncate-lines ampc-truncate-lines
+ mode-line-modified "--"))
+
(define-minor-mode ampc-highlight-current-song-mode ""
nil
nil
@@ -657,46 +1040,124 @@
(1 'ampc-current-song-mark-face)
(2 'ampc-current-song-marked-face)))))
+;;;###autoload
+(define-minor-mode ampc-tagger-dired-mode
+ "Minor mode that adds a audio file meta data tagging key binding to dired."
+ nil
+ " ampc-tagger"
+ nil
+ (assert (derived-mode-p 'dired-mode)))
+
;;; *** internal functions
+(defun ampc-tagger-report (args status)
+ (unless (zerop status)
+ (let ((message (format (concat "ampc_tagger (%s %s) returned with a "
+ "non-zero exit status (%s)")
+ ampc-tagger-executable
+ (mapconcat 'identity args " ")
+ status)))
+ (ampc-tagger-log message "\n")
+ (error message))))
+
+(defun ampc-tagger-call (&rest args)
+ (ampc-tagger-report
+ args
+ (apply 'call-process ampc-tagger-executable nil t nil args)))
+
+(defun ampc-int-insert-cmp (p1 p2)
+ (cond ((< p1 p2) 'insert)
+ ((eq p1 p2) 'overwrite)
+ (t (- p1 p2))))
+
+(defun ampc-normalize-windows ()
+ (setf ampc-windows
+ (loop for (window . buffer) in ampc-windows
+ collect (cons (if (and (window-live-p window)
+ (eq (window-buffer window) buffer))
+ window
+ (get-buffer-window buffer))
+ buffer)))
+ (delq nil (mapcar 'car ampc-windows)))
+
+(defun ampc-restore-window-configuration ()
+ (let ((windows
+ (sort (delq nil
+ (mapcar (lambda (w)
+ (when (eq (window-frame w)
+ (selected-frame))
+ w))
+ (ampc-normalize-windows)))
+ (lambda (w1 w2)
+ (loop for w in (window-list nil nil (frame-first-window))
+ do (when (eq w w1)
+ (return t))
+ (when (eq w w2)
+ (return nil)))))))
+ (when windows
+ (setf (window-dedicated-p (car windows)) nil)
+ (loop for w in (cdr windows)
+ do (delete-window w)))))
+
+(defun ampc-tagger-tags-modified (tags new-tags)
+ (loop with found-changed
+ for (tag . value) in new-tags
+ for prop = (assq tag tags)
+ do (unless (equal (cdr prop) value)
+ (setf (cdr prop) value
+ found-changed t))
+ finally return found-changed))
+
(defun ampc-change-view (view)
- (if (equal ampc-outstanding-commands '((idle)))
+ (if (equal ampc-outstanding-commands '((idle nil)))
(ampc-configure-frame (cddr view))
(message "ampc is busy, cannot change window layout")))
(defun ampc-quote (string)
(concat "\"" (replace-regexp-in-string "\"" "\\\"" string) "\""))
-(defun ampc-on-p ()
- (and ampc-connection
- (member (process-status ampc-connection) '(open run))))
-
-(defun ampc-in-ampc-p ()
- (when (ampc-on-p)
- ampc-type))
+(defun ampc-in-ampc-p (&optional or-in-tagger)
+ (or (when (ampc-on-p)
+ ampc-type)
+ (when or-in-tagger
+ (memq (car ampc-type) '(files-list tagger)))))
(defun ampc-add-impl (&optional data)
+ (ampc-on-files (lambda (file)
+ (if (ampc-playlist)
+ (ampc-send-command 'playlistadd
+ '(:keep-prev t)
+ (ampc-quote (ampc-playlist))
+ file)
+ (ampc-send-command 'add '(:keep-prev t) (ampc-quote
file)))
+ data)))
+
+(defun ampc-on-files (func &optional data)
(cond ((null data)
(loop for d in (get-text-property (line-end-position) 'data)
- do (ampc-add-impl d)))
+ do (ampc-on-files func d)))
((avl-tree-p data)
- (avl-tree-mapc (lambda (e) (ampc-add-impl (cdr e))) data))
+ (avl-tree-mapc (lambda (e) (ampc-on-files func (cdr e))) data))
((stringp data)
- (if (ampc-playlist)
- (ampc-send-command 'playlistadd
- t
- (ampc-quote (ampc-playlist))
- data)
- (ampc-send-command 'add t (ampc-quote data))))
+ (funcall func data))
(t
(loop for d in (reverse data)
- do (ampc-add-impl (cdr (assoc "file" d)))))))
+ do (ampc-on-files func (cdr (assoc "file" d)))))))
-(defun* ampc-skip (N &aux (song (cdr-safe (assq 'song ampc-status))))
- (when song
- (ampc-send-command 'play nil (max 0 (+ (string-to-number song) N)))))
+(defun ampc-skip (N)
+ (ampc-send-command
+ 'play
+ `(:callback ,(lambda ()
+ (ampc-send-command 'status '(:front t))))
+ (lambda ()
+ (let ((song (cdr (assq 'song ampc-status)))
+ (playlist-length (cdr (assq 'playlistlength ampc-status))))
+ (unless (and song playlist-length)
+ (throw 'skip nil))
+ (max 0 (min (+ (string-to-number song) N)
+ (1- (string-to-number playlist-length))))))))
(defun* ampc-find-current-song
- (limit &aux (point (point)) (song (cdr-safe (assq 'song ampc-status))))
+ (limit &aux (point (point)) (song (cdr (assq 'song ampc-status))))
(when (and song
(<= (1- (line-number-at-pos (point)))
(setf song (string-to-number song)))
@@ -707,97 +1168,109 @@
(narrow-to-region (max point (point)) (min limit (line-end-position)))
(search-forward-regexp "\\(?1:\\(\\`\\*\\)?\\)\\(?2:.*\\)$"))))
-(defun ampc-set-volume (arg func)
- (when (or arg ampc-status)
- (ampc-send-command
- 'setvol
- nil
- (or (and arg (prefix-numeric-value arg))
- (max (min (funcall func
+(defun ampc-set-volume-impl (arg &optional func)
+ (when arg
+ (setf arg (prefix-numeric-value arg)))
+ (ampc-send-command
+ 'setvol
+ `(:callback ,(lambda ()
+ (ampc-send-command 'status '(:front t))))
+ (lambda ()
+ (unless ampc-status
+ (throw 'skip nil))
+ (max (min (if func
+ (funcall func
(string-to-number
(cdr (assq 'volume ampc-status)))
- 5)
- 100)
- 0)))))
-
-(defun ampc-set-crossfade (arg func)
- (when (or arg ampc-status)
- (ampc-send-command
- 'crossfade
- nil
- (or (and arg (prefix-numeric-value arg))
- (max (funcall func
- (string-to-number (cdr (assq 'xfade ampc-status)))
- 5)
- 0)))))
-
-(defun* ampc-fix-pos (f &aux buffer-read-only)
- (save-excursion
- (move-beginning-of-line nil)
- (let* ((data (get-text-property (+ 2 (point)) 'data))
- (pos (assoc "Pos" data)))
- (setf (cdr pos) (funcall f (cdr pos)))
- (put-text-property (+ 2 (point))
- (line-end-position)
- 'data
- data))))
-
-(defun* ampc-move-impl (up &aux (line (1- (line-number-at-pos))))
- (when (or (and up (eq line 0))
- (and (not up) (eq (1+ line) (line-number-at-pos (1-
(point-max))))))
- (return-from ampc-move-impl t))
- (save-excursion
- (move-beginning-of-line nil)
- (if (ampc-playlist)
- (ampc-send-command 'playlistmove
- nil
- (ampc-quote (ampc-playlist))
- line
- (funcall (if up '1- '1+)
- line))
- (ampc-send-command 'move nil line (funcall (if up '1- '1+) line)))
- (unless up
- (forward-line))
- (unless (ampc-playlist)
- (save-excursion
- (forward-line -1)
- (ampc-fix-pos '1+))
- (ampc-fix-pos '1-))
- (let ((buffer-read-only))
- (transpose-lines 1)))
- (if up
- (ampc-align-point)
- (ampc-next-line))
- nil)
-
-(defun* ampc-move (up N &aux (point (point)))
- (goto-char (if up (point-min) (point-max)))
- (if (and (not N)
- (funcall (if up 'search-forward-regexp 'search-backward-regexp)
- "^* "
- nil
- t))
- (loop until (ampc-move-impl up)
- unless up
- do (search-backward-regexp "^* " nil t)
- end
- until (not (funcall (if up
- 'search-forward-regexp
- 'search-backward-regexp)
- "^* "
- nil
- t))
- finally (unless up
- (forward-char 2)))
- (goto-char point)
- (unless (eobp)
- (unless N
- (setf N 1))
- (unless up
- (unless (eq (1- N) 0)
- (setf N (- (- (forward-line (1- N)) (1- N))))))
- (loop repeat N
- until (ampc-move-impl up)))))
+ (or arg ampc-volume-step))
+ arg)
+ 100)
+ 0))))
+
+(defun ampc-set-crossfade-impl (arg &optional func)
+ (when arg
+ (setf arg (prefix-numeric-value arg)))
+ (ampc-send-command
+ 'crossfade
+ `(:callback ,(lambda ()
+ (ampc-send-command 'status '(:front t))))
+ (lambda ()
+ (unless ampc-status
+ (throw 'skip nil))
+ (max (if func
+ (funcall func
+ (string-to-number
+ (cdr (assq 'xfade ampc-status)))
+ (or arg ampc-crossfade-step))
+ arg)
+ 0))))
+
+(defun* ampc-tagger-make-backup (file)
+ (unless ampc-tagger-backup-directory
+ (return-from ampc-tagger-make-backup))
+ (when (functionp ampc-tagger-backup-directory)
+ (funcall ampc-tagger-backup-directory file)
+ (return-from ampc-tagger-make-backup))
+ (unless (file-directory-p ampc-tagger-backup-directory)
+ (make-directory ampc-tagger-backup-directory t))
+ (let* ((real-file
+ (loop with real-file = file
+ for target = (file-symlink-p real-file)
+ while target
+ do (setf real-file (expand-file-name
+ target (file-name-directory real-file)))
+ finally return real-file))
+ (target
+ (loop with base = (file-name-nondirectory real-file)
+ for i from 1
+ for file = (expand-file-name
+ (concat base ".~"
+ (int-to-string i)
+ "~")
+ ampc-tagger-backup-directory)
+ while (file-exists-p file)
+ finally return file)))
+ (ampc-tagger-log "\tBackup file: " (abbreviate-file-name target) "\n")
+ (copy-file real-file target nil t)))
+
+(defun* ampc-move (N &aux with-marks entries-to-move (up (< N 0)))
+ (save-excursion
+ (goto-char (point-min))
+ (loop while (search-forward-regexp "^* " nil t)
+ do (push (point) entries-to-move)))
+ (if entries-to-move
+ (setf with-marks t)
+ (push (point) entries-to-move))
+ (when (save-excursion
+ (loop with max = (1- (count-lines (point-min) (point-max)))
+ for p in entries-to-move
+ do (goto-char p)
+ for line = (+ (1- (line-number-at-pos)) N)
+ always (and (>= line 0) (<= line max))))
+ (when up
+ (setf entries-to-move (nreverse entries-to-move)))
+ (when with-marks
+ (ampc-unmark-all))
+ (loop for p in entries-to-move
+ do (goto-char p)
+ for line = (1- (line-number-at-pos))
+ do (if (and (not (eq (car ampc-type) 'current-playlist))
+ (ampc-playlist))
+ (ampc-send-command 'playlistmove
+ '(:keep-prev t)
+ (ampc-quote (ampc-playlist))
+ line
+ (+ line N))
+ (ampc-send-command 'move '(:keep-prev t) line (+ line N))))
+ (if with-marks
+ (loop for p in (nreverse entries-to-move)
+ do (goto-char p)
+ (forward-line N)
+ (save-excursion
+ (ampc-mark-impl t 1))
+ (ampc-align-point))
+ (forward-line N)
+ (ampc-align-point))))
(defun ampc-toggle-state (state arg)
(when (or arg ampc-status)
@@ -811,16 +1284,19 @@
((> (prefix-numeric-value arg) 0) 1)
(t 0)))))
-(defun ampc-playlist ()
+(defun ampc-playlist (&optional at-point)
(ampc-with-buffer 'playlists
- (if (search-forward-regexp "^* \\(.*\\)$" nil t)
- (match-string 1)
+ (if (and (not at-point)
+ (search-forward-regexp "^* \\(.*\\)$" nil t))
+ (let ((result (match-string 1)))
+ (set-text-properties 0 (length result) nil result)
+ result)
(unless (eobp)
(buffer-substring-no-properties
(+ (line-beginning-position) 2)
(line-end-position))))))
-(defun* ampc-mark-impl (select N &aux result buffer-read-only)
+(defun* ampc-mark-impl (select N &aux result (inhibit-read-only t))
(when (eq (car ampc-type) 'playlists)
(assert (or (not select) (null N) (eq N 1)))
(ampc-with-buffer 'playlists
@@ -841,44 +1317,157 @@
(playlists
(ampc-update-playlist))
((song tag)
- (loop for w in (ampc-windows)
- with found
- when found
- do (with-current-buffer (window-buffer w)
- (when (member (car ampc-type) '(song tag))
- (ampc-set-dirty t)))
- end
- if (eq w (selected-window))
- do (setf found t)
- end)
- (ampc-fill-tag-song))))
+ (loop
+ for w in
+ (loop for w on (ampc-normalize-windows)
+ thereis (when (or (eq (car w) (selected-window))
+ (and (eq (car ampc-type) 'tag)
+ (eq (with-current-buffer
+ (window-buffer (car w))
+ (car ampc-type))
+ 'song)))
+ (cdr w)))
+ do (with-current-buffer (window-buffer w)
+ (when (memq (car ampc-type) '(song tag))
+ (ampc-set-dirty t))))
+ (ampc-fill-tag-song))
+ (files-list
+ (ampc-tagger-update))))
+
+(defun* ampc-tagger-get-values (tag all-files &aux result)
+ (ampc-with-buffer 'files-list
+ no-se
+ (save-excursion
+ (macrolet
+ ((add-file
+ ()
+ `(let ((value (cdr (assq tag (get-text-property (point) 'data)))))
+ (unless (member value result)
+ (push value result)))))
+ (if all-files
+ (loop until (eobp)
+ initially do (goto-char (point-min))
+ (ampc-align-point)
+ do (add-file)
+ until (ampc-next-line))
+ (ampc-with-selection nil
+ (add-file))))))
+ result)
+
+(defun ampc-tagger-update ()
+ (ampc-with-buffer 'tagger
+ (loop
+ while (search-forward-regexp (concat "^[ \t]*\\("
+ (mapconcat 'symbol-name
+ ampc-tagger-tags
+ "\\|")
+ "\\)[ \t]*:"
+ "[ \t]*\\(<keep>[ \t]*?\\)"
+ "\\(?:\n\\)?$")
+ nil
+ t)
+ for tag = (intern (match-string 1))
+ do (when (memq tag ampc-tagger-tags)
+ (let ((values (save-match-data (ampc-tagger-get-values tag nil))))
+ (when (eq (length values) 1)
+ (replace-match (car values) nil t nil 2)))))))
+
+(defun ampc-tagger-complete-tag ()
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (line-beginning-position) (line-end-position))
+ (unless (search-backward-regexp "^.*:" nil t)
+ (when (search-backward-regexp "\\(^\\|[ \t]\\).*" nil t)
+ (when (looking-at "[ \t]")
+ (forward-char 1))
+ (list (point)
+ (search-forward-regexp ":\\|$")
+ (mapcar (lambda (tag) (concat (symbol-name tag) ":"))
+ ampc-tagger-tags)))))))
+
+(defun* ampc-tagger-complete-value (&aux tag)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (line-beginning-position) (line-end-position))
+ (save-excursion
+ (unless (search-backward-regexp (concat "^[ \t]*\\("
+ (mapconcat 'symbol-name
+ ampc-tagger-tags
+ "\\|")
+ "\\)[ \t]*:")
+ nil t)
+ (return-from ampc-tagger-complete-tag))
+ (setf tag (intern (match-string 1))))
+ (save-excursion
+ (search-backward-regexp "[: \t]")
+ (forward-char 1)
+ (list (point)
+ (search-forward-regexp "[ \t]\\|$")
+ (let ((values (cons "<keep>" (ampc-tagger-get-values
+ tag
+
ampc-tagger-completion-all-files))))
+ (when (eq tag 'Genre)
+ (loop for g in ampc-tagger-genres
+ do (unless (member g values)
+ (push g values))))
+ values))))))
(defun ampc-align-point ()
(unless (eobp)
(move-beginning-of-line nil)
- (forward-char 2)))
+ (forward-char 2)
+ (re-search-forward " *" nil t)))
-(defun ampc-pad (alist)
- (loop for (offset . data) in alist
+(defun* ampc-pad (tabs &optional dont-honour-item-mode)
+ (loop with new-tab-stop-list
+ with offset-dec = (if (and (not dont-honour-item-mode)
+ (derived-mode-p 'ampc-item-mode))
+ 2
+ 0)
+ for tab in tabs
+ for offset-cell on (if (derived-mode-p 'ampc-item-mode)
+ tab-stop-list
+ (cons 0 tab-stop-list))
+ for offset = (car offset-cell)
+ for props in (or (plist-get (cdr ampc-type) :properties)
+ '(nil . nil))
+ by (lambda (cell) (or (cdr cell) '(nil . nil)))
+ do (decf offset offset-dec)
with first = t
with current-offset = 0
when (<= current-offset offset)
- when (and (not first) (eq (- offset current-offset) 0))
- do (incf offset)
- end
- and concat (make-string (- offset current-offset) ? )
+ do (when (and (not first) (eq (- offset current-offset) 0))
+ (incf offset))
+ and concat (make-string (- offset current-offset) ? ) into result
and do (setf current-offset offset)
else
- concat " "
+ concat " " into result
and do (incf current-offset)
end
- concat data
- do (setf current-offset (+ current-offset (length data))
- first nil)))
+ do (unless tab
+ (setf tab ""))
+ (when (and (plist-get (cdr props) :shrink)
+ (cadr offset-cell)
+ (>= (+ current-offset (length tab) 1) (- (cadr offset-cell)
+ offset-dec)))
+ (setf tab (concat (substring tab 0 (max (- (cadr offset-cell)
+ offset-dec
+ current-offset
+ 4)
+ 3))
+ "...")))
+ concat tab into result
+ do (push (+ current-offset offset-dec) new-tab-stop-list)
+ (incf current-offset (length tab))
+ (setf first nil)
+ finally return
+ (if (equal (callf nreverse new-tab-stop-list) tab-stop-list)
+ result
+ (propertize result 'tab-stop-list new-tab-stop-list))))
(defun ampc-update-header ()
- (if (eq (car ampc-type) 'status)
- (setf header-line-format nil)
+ (when (or (memq (car ampc-type) '(tag playlists))
+ (plist-get (cdr ampc-type) :properties))
(setf header-line-format
(concat
(make-string (floor (fringe-columns 'left t)) ? )
@@ -888,27 +1477,24 @@
(playlists
" Playlists")
(t
- (ampc-pad (loop for p in (plist-get (cdr ampc-type) :properties)
- collect `(,(or (plist-get (cdr p) :offset) 2) .
- ,(or (plist-get (cdr p) :title)
- (car p)))))))
- (when ampc-dirty
- " [ Updating... ]")))))
+ (ampc-pad (loop for (name . props) in
+ (plist-get (cdr ampc-type) :properties)
+ collect (or (plist-get props :title) name))
+ t)))))))
(defun ampc-set-dirty (tag-or-dirty &optional dirty)
- (if (or (null tag-or-dirty) (eq tag-or-dirty t))
- (progn (setf ampc-dirty tag-or-dirty)
- (ampc-update-header))
- (loop for w in (ampc-windows)
+ (if (or (null tag-or-dirty) (memq tag-or-dirty '(t erase keep-dirty)))
+ (setf ampc-dirty tag-or-dirty)
+ (loop for w in (ampc-normalize-windows)
do (with-current-buffer (window-buffer w)
(when (eq (car ampc-type) tag-or-dirty)
(ampc-set-dirty dirty))))))
(defun ampc-update ()
(if ampc-status
- (loop for b in ampc-buffers
- do (with-current-buffer b
- (when ampc-dirty
+ (loop for w in (ampc-normalize-windows)
+ do (with-current-buffer (window-buffer w)
+ (when (and ampc-dirty (not (eq ampc-dirty 'keep-dirty)))
(ecase (car ampc-type)
(outputs
(ampc-send-command 'outputs))
@@ -917,7 +1503,9 @@
((tag song)
(if (assoc (ampc-tags) ampc-internal-db)
(ampc-fill-tag-song)
- (push `(,(ampc-tags) . nil) ampc-internal-db)
+ (push (cons (ampc-tags) nil) ampc-internal-db)
+ (ampc-set-dirty 'tag 'keep-dirty)
+ (ampc-set-dirty 'song 'keep-dirty)
(ampc-send-command 'listallinfo)))
(status
(ampc-send-command 'status)
@@ -936,44 +1524,95 @@
nil
(get-text-property (point) 'data))
(ampc-with-buffer 'playlist
- (delete-region (point-min) (point-max))
+ (erase-buffer)
(ampc-set-dirty nil)))))
(defun ampc-send-command-impl (command)
(when ampc-debug
- (message (concat "ampc: " command)))
- (process-send-string ampc-connection (concat command "\n")))
-
-(defun ampc-send-command (command &optional unique &rest args)
- (if (equal command 'idle)
- (when ampc-working-timer
+ (message "ampc: -> %s" command))
+ (when (ampc-on-p)
+ (process-send-string ampc-connection (concat command "\n"))))
+
+(defun* ampc-send-command (command &optional props &rest args)
+ (destructuring-bind (&key (front nil) (keep-prev nil) (full-remove nil)
+ (remove-other nil) &allow-other-keys
+ &aux idle)
+ props
+ (when (and (not keep-prev)
+ (eq (caar ampc-outstanding-commands) command)
+ (equal (cddar ampc-outstanding-commands) args))
+ (return-from ampc-send-command))
+ (unless ampc-working-timer
+ (setf ampc-yield 0
+ ampc-working-timer (run-at-time nil 0.1 'ampc-yield)))
+ (when (equal (caar ampc-outstanding-commands) 'idle)
+ (pop ampc-outstanding-commands)
+ (setf idle t))
+ (when (and (not keep-prev) (cdr ampc-outstanding-commands))
+ (setf (cdr ampc-outstanding-commands)
+ (loop for other-cmd in (cdr ampc-outstanding-commands)
+ unless (and (memq (car other-cmd) (list command
remove-other))
+ (or (not full-remove)
+ (progn
+ (assert (null remove-other))
+ (equal (cddr other-cmd) args))))
+ collect other-cmd
+ end)))
+ (setf command (apply 'list command props args))
+ (if front
+ (push command ampc-outstanding-commands)
+ (setf ampc-outstanding-commands
+ (nconc ampc-outstanding-commands
+ (list command))))
+ (when idle
+ (push '(noidle nil) ampc-outstanding-commands)
+ (ampc-send-command-impl "noidle"))))
+
+(defun ampc-send-next-command ()
+ (loop while ampc-outstanding-commands
+ for command =
+ (loop for command = (car ampc-outstanding-commands)
+ for command-id = (replace-regexp-in-string
+ "^.*?-" ""
+ (symbol-name (car command)))
+ thereis
+ (catch 'skip
+ (ampc-send-command-impl
+ (concat command-id
+ (loop for a in (cddr command)
+ concat " "
+ do (when (functionp a)
+ (callf funcall a))
+ concat (etypecase a
+ (integer (number-to-string a))
+ (string a)))))
+ (let ((callback (plist-get (cadar ampc-outstanding-commands)
+ :callback))
+ (old-head (pop ampc-outstanding-commands)))
+ (when callback (funcall callback))
+ (push old-head ampc-outstanding-commands))
+ command-id)
+ do (pop ampc-outstanding-commands)
+ while ampc-outstanding-commands)
+ while command
+ while (let ((member (memq (intern command) ampc-synchronous-commands)))
+ (if member
+ (not (eq (car ampc-synchronous-commands) t))
+ (eq (car ampc-synchronous-commands) t)))
+ do (loop with head = ampc-outstanding-commands
+ with ampc-no-implicit-next-dispatch = t
+ with ampc-yield-redisplay = t
+ while (ampc-on-p)
+ while (eq head ampc-outstanding-commands)
+ do (accept-process-output ampc-connection 0 100)))
+ (unless ampc-outstanding-commands
+ (when ampc-working-timer
(cancel-timer ampc-working-timer)
(setf ampc-yield nil
ampc-working-timer nil)
(ampc-fill-status))
- (unless ampc-working-timer
- (setf ampc-yield 0
- ampc-working-timer (run-at-time nil 0.1 'ampc-yield))))
- (setf command `(,command ,@args))
- (when (equal (car-safe ampc-outstanding-commands) '(idle))
- (setf (car ampc-outstanding-commands) '(noidle))
- (ampc-send-command-impl "noidle"))
- (setf ampc-outstanding-commands
- (nconc (if unique
- ampc-outstanding-commands
- (remove command ampc-outstanding-commands))
- `(,command))))
-
-(defun ampc-send-next-command ()
- (unless ampc-outstanding-commands
- (ampc-send-command 'idle))
- (ampc-send-command-impl (concat (symbol-name (caar
ampc-outstanding-commands))
- (loop for a in
- (cdar ampc-outstanding-commands)
- concat " "
- concat (cond ((integerp a)
- (number-to-string a))
- (t a))))))
+ (setf ampc-outstanding-commands '((idle nil)))
+ (ampc-send-command-impl "idle")))
(defun ampc-tree< (a b)
(string< (car a) (car b)))
@@ -981,79 +1620,105 @@
(defun ampc-create-tree ()
(avl-tree-create 'ampc-tree<))
-(defun ampc-extract (tag &optional buffer)
- (with-current-buffer (or buffer (current-buffer))
- (if (listp tag)
- (ampc-extract (plist-get tag :tag))
- (save-excursion
- (goto-char (point-min))
- (when (search-forward-regexp
- (concat "^" (regexp-quote tag) ": \\(.*\\)$")
- nil
- t)
- (let ((result (match-string 1)))
- (when (equal tag "Time")
- (setf result (ampc-transform-time result)))
- result))))))
-
-(defun ampc-insert (element data &optional cmp)
- (save-excursion
- (goto-char (point-min))
- (ecase
- (loop until (eobp)
- for tp = (get-text-property (+ (point) 2) 'data)
- finally return 'insert
- thereis
- (cond ((eq cmp t)
- (let ((s (buffer-substring-no-properties
- (+ (point) 2)
- (line-end-position))))
- (cond ((equal s element)
- (unless (member data tp)
- (put-text-property (+ (point) 2)
- (1+ (line-end-position))
- 'data
- `(,data . ,tp)))
- 'update)
- ((string< element s)
- 'insert))))
- (cmp
- (let ((r (funcall cmp data tp)))
- (if (memq r '(update insert))
- r
- (forward-line (1- r))
- nil)))
- ((equal tp data)
- 'update)
- (t
- (let ((s (buffer-substring-no-properties
- (+ (point) 2)
- (line-end-position))))
- (unless (string< s element)
- 'insert))))
- do (forward-line))
+(defsubst ampc-extract (regexp)
+ (goto-char (point-min))
+ (when (search-forward-regexp regexp nil t)
+ (match-string 1)))
+
+(defsubst ampc-clean-tag (tag value)
+ (if value
+ (let ((func (cdr (assoc tag ampc-tag-transform-funcs))))
+ (if func
+ (funcall func value)
+ value))
+ (unless (equal tag "Track")
+ "[Not Specified]")))
+
+(defun ampc-insert (element data &optional cmp cmp-data)
+ (goto-char (point-min))
+ (unless cmp-data
+ (setf cmp-data data))
+ (let ((action
+ (if (functionp cmp)
+ (loop until (eobp)
+ for tp = (get-text-property (+ (point) 2) 'cmp-data)
+ thereis (let ((r (funcall cmp cmp-data tp)))
+ (if (symbolp r)
+ r
+ (forward-line r)
+ nil))
+ finally return 'insert)
+ (loop with stringp-cmp-data = (stringp cmp-data)
+ with min = 1
+ with max = (1+ (count-lines (point-min) (point-max)))
+ with at-min = t
+ do (when (< (- max min) 20)
+ (unless at-min
+ (forward-line (- min max)))
+ (return (loop repeat (- max min)
+ for tp = (get-text-property (+ (point) 2)
+ 'cmp-data)
+ thereis
+ (if (equal tp cmp-data)
+ 'update
+ (unless (if stringp-cmp-data
+ (string< tp cmp-data)
+ (string<
+
(buffer-substring-no-properties
+ (+ (point) 2)
+ (line-end-position))
+ element))
+ 'insert))
+ do (forward-line)
+ finally return 'insert)))
+ do (forward-line (funcall (if at-min '+ '-) (/ (- max min)
2)))
+ for tp = (get-text-property (+ (point) 2) 'cmp-data)
+ thereis (when (equal tp cmp-data) 'update)
+ do (if (setf at-min (if stringp-cmp-data
+ (string< tp cmp-data)
+ (string< (buffer-substring-no-properties
+ (+ (point) 2)
+ (line-end-position))
+ element)))
+ (incf min (floor (/ (- max min) 2.0)))
+ (decf max (floor (/ (- max min) 2.0))))
+ finally return 'insert))))
+ (ecase action
(insert
- (insert " ")
- (let ((start (point)))
- (insert element "\n")
- (put-text-property start (point) 'data (if (eq cmp t)
- `(,data)
- data))))
- (update
- (remove-text-properties (point) (1+ (point)) '(updated))
- (equal (buffer-substring (point) (1+ (point))) "*")))))
+ (insert (propertize (concat " " element "\n")
+ 'data (if (eq cmp t) (list data) data)
+ 'cmp-data cmp-data)))
+ ((update overwrite)
+ (remove-text-properties (point) (1+ (point)) '(not-updated))
+ (when (or (eq ampc-dirty 'erase) (eq action 'overwrite))
+ (let ((origin (point)))
+ (forward-char 2)
+ (kill-line 1)
+ (insert element "\n")
+ (goto-char origin)))
+ (let ((next (1+ (line-end-position))))
+ (put-text-property (point) next 'cmp-data cmp-data)
+ (put-text-property
+ (point) next
+ 'data (cond ((eq cmp t)
+ (let ((rest (get-text-property (point) 'data)))
+ (if (memq data rest)
+ rest
+ (cons data rest))))
+ (t data))))
+ (eq (char-after) ?*)))))
(defun ampc-fill-tag (trees)
(put-text-property (point-min) (point-max) 'data nil)
(loop with new-trees
- finally return new-trees
for tree in trees
- when tree
- do (avl-tree-mapc (lambda (e)
- (when (ampc-insert (car e) (cdr e) t)
- (push (cdr e) new-trees)))
- tree)
- end))
+ do (when tree
+ (avl-tree-mapc
+ (lambda (e)
+ (when (ampc-insert (car e) (cdr e) t (car e))
+ (push (cdr e) new-trees)))
+ tree))
+ finally return new-trees))
(defun ampc-fill-song (trees)
(loop
@@ -1062,114 +1727,81 @@
do (ampc-insert
(ampc-pad
(loop for (p . v) in (plist-get (cdr ampc-type) :properties)
- collect `(,(- (or (plist-get v :offset) 2) 2)
- . ,(or (cdr-safe (assoc p song)) ""))))
+ collect (cdr (assoc p song))))
`((,song))))))
-(defun* ampc-narrow-entry (&optional (delimiter "file"))
- (narrow-to-region (move-beginning-of-line nil)
- (or (progn (goto-char (line-end-position))
- (when (search-forward-regexp
- (concat "^" (regexp-quote delimiter) ":
")
- nil
- t)
- (move-beginning-of-line nil)
- (1- (point))))
- (point-max))))
-
-(defun ampc-get-window (type)
- (loop for w in (ampc-windows)
- thereis (with-current-buffer (window-buffer w)
- (when (eq (car ampc-type) type)
- w))))
-
-(defun* ampc-fill-playlist (&aux properties)
+(defsubst ampc-narrow-entry (delimiter-regexp)
+ (let ((result))
+ (narrow-to-region
+ (line-beginning-position)
+ (or (save-excursion
+ (goto-char (line-end-position))
+ (when (search-forward-regexp delimiter-regexp nil t)
+ (setf result (point))
+ (1- (line-beginning-position))))
+ (point-max)))
+ result))
+
+(defun ampc-fill-playlist ()
(ampc-fill-skeleton 'playlist
- (setf properties (plist-get (cdr ampc-type) :properties))
- (with-current-buffer data-buffer
- (loop
- for i from 0
- while (search-forward-regexp "^file: " nil t)
- do (save-restriction
- (ampc-narrow-entry)
- (let ((file (ampc-extract "file"))
- (text
- (ampc-pad
- (loop for (tag . tag-properties) in properties
- collect `(,(- (or (plist-get tag-properties
- :offset)
- 2)
- 2)
- . ,(or (ampc-extract tag)
- "[Not Specified]"))))))
- (ampc-with-buffer 'playlist
- (ampc-insert text
- `(("file" . ,file)
- (index . ,i))
- (lambda (a b)
- (let ((p1 (cdr (assoc 'index a)))
- (p2 (cdr (assoc 'index b))))
- (cond ((< p1 p2) 'update)
- ((eq p1 p2)
- (if (equal (cdr (assoc "file" a))
- (cdr (assoc "file" b)))
- 'update
- 'insert))
- (t (- p1 p2)))))))))))))
+ (let ((index 0))
+ (ampc-iterate-source-output "file" (file)
+ (loop for (tag . tag-regexp) in tags
+ collect (ampc-clean-tag tag (ampc-extract tag-regexp)))
+ `(("file" . ,file)
+ (index . ,(1- (incf index))))
+ 'ampc-int-insert-cmp
+ index))))
-(defun* ampc-fill-outputs (&aux properties)
+(defun ampc-fill-outputs ()
(ampc-fill-skeleton 'outputs
- (setf properties (plist-get (cdr ampc-type) :properties))
- (with-current-buffer data-buffer
- (loop
- while (search-forward-regexp "^outputid: " nil t)
- do (save-restriction
- (ampc-narrow-entry "outputid")
- (let ((outputid (ampc-extract "outputid"))
- (outputenabled (ampc-extract "outputenabled"))
- (text
- (ampc-pad
- (loop for (tag . tag-properties) in properties
- collect `(,(- (or (plist-get tag-properties :offset)
- 2)
- 2)
- . ,(ampc-extract tag))))))
- (ampc-with-buffer 'outputs
- (ampc-insert text `(("outputid" . ,outputid)
- ("outputenabled" . ,outputenabled))))))))))
-
-(defun* ampc-fill-current-playlist (&aux properties)
+ (ampc-iterate-source-output "outputid" (outputid outputenabled)
+ (loop for (tag . tag-regexp) in tags
+ collect (ampc-clean-tag tag (ampc-extract tag-regexp)))
+ `(("outputid" . ,outputid)
+ ("outputenabled" . ,outputenabled)))))
+
+(defun* ampc-mini-impl (&aux songs)
+ (ampc-iterate-source
+ nil
+ "file"
+ (Title
+ Artist
+ (Pos (string-to-number (ampc-extract (ampc-extract-regexp "Pos")))))
+ (let ((entry (cons (concat Title
+ (when Artist
+ (concat " - " Artist)))
+ Pos)))
+ (loop with mentry = (cons (car entry) (cdr entry))
+ for index from 2
+ while (assoc (car mentry) songs)
+ do (setf (car mentry) (concat (car entry)
+ " (" (int-to-string index) ")"))
+ finally do (push mentry songs))))
+ (unless songs
+ (message "No song in the playlist")
+ (return-from ampc-mini-impl))
+ (let ((song (assoc (let ((inhibit-quit t))
+ (prog1
+ (with-local-quit
+ (completing-read "Song to play: " songs nil t))
+ (setf quit-flag nil)))
+ songs)))
+ (when song
+ (ampc-play-this (cdr song)))))
+
+(defun ampc-fill-current-playlist ()
(ampc-fill-skeleton 'current-playlist
- (setf properties (plist-get (cdr ampc-type) :properties))
- (with-current-buffer data-buffer
- (loop
- while (search-forward-regexp "^file: " nil t)
- do (save-restriction
- (ampc-narrow-entry)
- (let ((file (ampc-extract "file"))
- (pos (ampc-extract "Pos"))
- (text
- (ampc-pad
- (loop for (tag . tag-properties) in properties
- collect `(,(- (or (plist-get tag-properties :offset)
- 2)
- 2)
- . ,(or (ampc-extract tag)
- "[Not Specified]"))))))
- (ampc-with-buffer 'current-playlist
- (ampc-insert text
- `(("file" . ,file)
- ("Pos" . ,(string-to-number pos)))
- (lambda (a b)
- (let ((p1 (cdr (assoc "Pos" a)))
- (p2 (cdr (assoc "Pos" b))))
- (cond ((< p1 p2) 'insert)
- ((eq p1 p2)
- (if (equal (cdr (assoc "file" a))
- (cdr (assoc "file" b)))
- 'update
- 'insert))
- (t (- p1 p2)))))))))))))
+ (ampc-iterate-source-output
+ "file"
+ (file (pos (string-to-number (ampc-extract
+ (ampc-extract-regexp "Pos")))))
+ (loop for (tag . tag-regexp) in tags
+ collect (ampc-clean-tag tag (ampc-extract tag-regexp)))
+ `(("file" . ,file)
+ ("Pos" . ,pos))
+ 'ampc-int-insert-cmp
+ pos)))
(defun ampc-fill-playlists ()
(ampc-fill-skeleton 'playlists
@@ -1177,37 +1809,56 @@
(loop while (search-forward-regexp "^playlist: \\(.*\\)$" nil t)
for playlist = (match-string 1)
do (ampc-with-buffer 'playlists
- (ampc-insert playlist playlist))))))
+ (ampc-insert playlist playlist)))))
+ (ampc-set-dirty 'playlist t)
+ (ampc-update))
(defun ampc-yield ()
- (setf ampc-yield (1+ ampc-yield))
- (ampc-fill-status))
+ (incf ampc-yield)
+ (ampc-fill-status)
+ (when ampc-yield-redisplay
+ (redisplay t)))
(defun ampc-fill-status ()
(ampc-with-buffer 'status
- (delete-region (point-min) (point-max))
+ (erase-buffer)
(funcall (or (plist-get (cadr ampc-type) :filler)
(lambda (_)
- (insert (ampc-status) "\n")))
+ (insert (ampc-status t) "\n")))
ampc-status)
(ampc-set-dirty nil)))
(defun ampc-fill-tag-song ()
(loop
- with trees = `(,(cdr (assoc (ampc-tags) ampc-internal-db)))
- for w in (ampc-windows)
+ with trees = (list (cdr (assoc (ampc-tags) ampc-internal-db)))
+ for type in '(tag song)
do
- (ampc-with-buffer w
- (when (member (car ampc-type) '(tag song))
- (if ampc-dirty
- (ampc-fill-skeleton w
- (ecase (car ampc-type)
- (tag (setf trees (ampc-fill-tag trees)))
- (song (ampc-fill-song trees))))
- (setf trees nil)
- (loop while (search-forward-regexp "^* " nil t)
- do (setf trees (append (get-text-property (point) 'data)
- trees))))))))
+ (loop
+ for w in (ampc-normalize-windows)
+ do
+ (with-current-buffer (window-buffer w)
+ (when (eq (car ampc-type) type)
+ (if ampc-dirty
+ (if (and (not trees) (not (eq ampc-dirty 'keep-dirty)))
+ (progn
+ (let ((inhibit-read-only t))
+ (erase-buffer))
+ (ampc-set-dirty nil))
+ (ampc-fill-skeleton w
+ (if (eq type 'tag)
+ (setf trees (ampc-fill-tag trees))
+ (ampc-fill-song trees))))
+ (setf trees nil)
+ (save-excursion
+ (goto-char (point-min))
+ (loop while (search-forward-regexp "^* " nil t)
+ do (callf append trees
+ (get-text-property (point) 'data))))))))))
+
+(defun ampc-transform-track (track)
+ (when (eq (length track) 1)
+ (setf track (concat "0" track)))
+ track)
(defun* ampc-transform-time (data &aux (time (string-to-number data)))
(concat (number-to-string (/ time 60))
@@ -1219,25 +1870,24 @@
(defun ampc-handle-idle ()
(loop until (eobp)
for subsystem = (buffer-substring (point) (line-end-position))
- when (string-match "^changed: \\(.*\\)$" subsystem)
- do (case (intern (match-string 1 subsystem))
- (database
- (setf ampc-internal-db nil)
- (ampc-set-dirty 'tag t)
- (ampc-set-dirty 'song t))
- (output
- (ampc-set-dirty 'outputs t))
- ((player options mixer)
- (setf ampc-status nil)
- (ampc-set-dirty 'status t))
- (stored_playlist
- (ampc-set-dirty 'playlists t)
- (ampc-set-dirty 'playlist t))
- (playlist
- (ampc-set-dirty 'current-playlist t)
- (ampc-set-dirty 'status t)))
- end
- do (forward-line))
+ do (when (string-match "^changed: \\(.*\\)$" subsystem)
+ (case (intern (match-string 1 subsystem))
+ (database
+ (setf ampc-internal-db (list (cons (ampc-tags) nil)))
+ (ampc-set-dirty 'tag 'keep-dirty)
+ (ampc-set-dirty 'song 'keep-dirty)
+ (ampc-send-command 'listallinfo))
+ (output
+ (ampc-set-dirty 'outputs t))
+ ((player options mixer)
+ (setf ampc-status nil)
+ (ampc-set-dirty 'status t))
+ (stored_playlist
+ (ampc-set-dirty 'playlists t))
+ (playlist
+ (ampc-set-dirty 'current-playlist t)
+ (ampc-set-dirty 'status t))))
+ (forward-line))
(ampc-update))
(defun ampc-handle-setup (status)
@@ -1250,11 +1900,24 @@
(or (> version-a 0)
(>= version-b 15))))
(error (concat "Your version of MPD is not supported. "
- "ampc supports MPD (protocol version) 0.15.0 "
+ "ampc supports MPD protocol version 0.15.0 "
"and later"))))
(defun ampc-fill-internal-db (running)
- (loop for origin = (and (search-forward-regexp "^file: " nil t)
+ (loop with tree = (assoc (ampc-tags) ampc-internal-db)
+ with tags =
+ (loop for w in (ampc-normalize-windows)
+ for props = (with-current-buffer (window-buffer w)
+ (when (eq (car ampc-type) 'tag)
+ (ampc-set-dirty t)
+ (plist-get (cdr ampc-type) :tag)))
+ when props
+ collect props
+ end)
+ with song-props = (ampc-with-buffer 'song
+ (ampc-set-dirty t)
+ (plist-get (cdr ampc-type) :properties))
+ for origin = (and (search-forward-regexp "^file: " nil t)
(line-beginning-position))
then next
while origin
@@ -1264,13 +1927,13 @@
while (or (not running) next)
do (save-restriction
(narrow-to-region origin (or next (point-max)))
- (ampc-fill-internal-db-entry))
- do (when running
- (delete-region origin next)
- (setf next origin))))
+ (ampc-fill-internal-db-entry tree tags song-props))
+ (when running
+ (delete-region origin next)
+ (setf next origin))))
(defun ampc-tags ()
- (loop for w in (ampc-windows)
+ (loop for w in (ampc-normalize-windows)
for tag = (with-current-buffer (window-buffer w)
(when (eq (car ampc-type) 'tag)
(plist-get (cdr ampc-type) :tag)))
@@ -1278,52 +1941,47 @@
collect tag
end))
-(defun ampc-fill-internal-db-entry ()
- (loop
- with data-buffer = (current-buffer)
- with tree = (assoc (ampc-tags) ampc-internal-db)
- for w in (ampc-windows)
- do
- (with-current-buffer (window-buffer w)
- (ampc-set-dirty t)
- (ecase (car ampc-type)
- (tag
- (let ((data (or (ampc-extract (cdr ampc-type) data-buffer)
- "[Not Specified]")))
- (unless (cdr tree)
- (setf (cdr tree) (ampc-create-tree)))
- (setf tree (avl-tree-enter (cdr tree)
- `(,data . nil)
- (lambda (data match)
- match)))))
- (song
- (push (loop for p in `(("file")
- ,@(plist-get (cdr ampc-type) :properties))
- for data = (ampc-extract (car p) data-buffer)
+(defun ampc-fill-internal-db-entry (tree tags song-props)
+ (loop for tag in tags
+ for data = (ampc-clean-tag tag (ampc-extract (ampc-extract-regexp
tag)))
+ do (unless (cdr tree)
+ (setf (cdr tree) (ampc-create-tree)))
+ (setf tree (avl-tree-enter (cdr tree)
+ (cons data nil)
+ (lambda (_ match)
+ match))))
+ (push (cons (cons "file" (ampc-extract (ampc-extract-regexp "file")))
+ (loop for p in song-props
+ for data = (ampc-clean-tag (car p)
+ (ampc-extract
+ (ampc-extract-regexp (car p))))
when data
- collect `(,(car p) . ,data)
- end)
- (cdr tree))
- (return))))))
+ collect (cons (car p) data)
+ end))
+ (cdr tree)))
+
+(defun ampc-fill-status-var (tags)
+ (loop for k in tags
+ for v = (ampc-extract (ampc-extract-regexp k))
+ for s = (intern k)
+ do (if v
+ (setf (cdr (or (assq s ampc-status)
+ (car (push (cons s nil) ampc-status))))
+ v)
+ (callf2 assq-delete-all s ampc-status))))
(defun ampc-handle-current-song ()
- (loop for k in (append ampc-status-tags '("Artist" "Title"))
- for s = (ampc-extract k)
- when s
- do (push `(,(intern k) . ,s) ampc-status)
- end)
+ (ampc-fill-status-var (append ampc-status-tags '("Artist" "Title" "file")))
(ampc-fill-status)
(run-hook-with-args ampc-status-changed-hook ampc-status))
(defun ampc-handle-status ()
- (loop for k in '("volume" "repeat" "random" "consume" "xfade" "state" "song")
- for v = (ampc-extract k)
- when v
- do (push `(,(intern k) . ,v) ampc-status)
- end)
+ (ampc-fill-status-var '("volume" "repeat" "random" "consume" "xfade" "state"
+ "song" "playlistlength"))
(ampc-with-buffer 'current-playlist
(when ampc-highlight-current-song-mode
- (font-lock-fontify-region (point-min) (point-max)))))
+ (font-lock-fontify-buffer)))
+ (run-hook-with-args ampc-status-changed-hook ampc-status))
(defun ampc-handle-update ()
(message "Database update started"))
@@ -1336,52 +1994,79 @@
(case (caar ampc-outstanding-commands)
(listallinfo (ampc-fill-internal-db t))))
(t
- (case (car (pop ampc-outstanding-commands))
- (idle
- (ampc-handle-idle))
- (setup
- (ampc-handle-setup status))
- (currentsong
- (ampc-handle-current-song))
- (status
- (ampc-handle-status))
- (update
- (ampc-handle-update))
- (listplaylistinfo
- (ampc-fill-playlist))
- (listplaylists
- (ampc-fill-playlists))
- (playlistinfo
- (ampc-fill-current-playlist))
- (listallinfo
- (ampc-fill-internal-db nil))
- (outputs
- (ampc-fill-outputs)))
+ (let ((command (pop ampc-outstanding-commands)))
+ (case (car command)
+ (idle
+ (ampc-handle-idle))
+ (setup
+ (ampc-handle-setup status))
+ (currentsong
+ (ampc-handle-current-song))
+ (status
+ (ampc-handle-status))
+ (update
+ (ampc-handle-update))
+ (listplaylistinfo
+ (ampc-fill-playlist))
+ (listplaylists
+ (ampc-fill-playlists))
+ (playlistinfo
+ (ampc-fill-current-playlist))
+ (mini-playlistinfo
+ (ampc-mini-impl))
+ (mini-currentsong
+ (ampc-status))
+ (shuffle-listplaylistinfo
+ (ampc-shuffle-playlist (plist-get (cadr command) :playlist)))
+ (listallinfo
+ (ampc-handle-listallinfo))
+ (outputs
+ (ampc-fill-outputs))))
(unless ampc-outstanding-commands
(ampc-update)))))
+(defun* ampc-shuffle-playlist (playlist &aux songs)
+ (ampc-iterate-source nil "file" (file)
+ (push (cons file (random)) songs))
+ (ampc-send-command 'playlistclear '(:full-remove t) (ampc-quote playlist))
+ (loop for file in (mapcar 'car (sort songs
+ (lambda (a b) (< (cdr a) (cdr b)))))
+ do (ampc-send-command 'playlistadd
+ '(:keep-prev t)
+ (ampc-quote playlist)
+ file)))
+
+
+(defun ampc-handle-listallinfo ()
+ (ampc-fill-internal-db nil)
+ (ampc-set-dirty 'tag t)
+ (ampc-set-dirty 'song t))
+
(defun ampc-filter (_process string)
(assert (buffer-live-p (process-buffer ampc-connection)))
(with-current-buffer (process-buffer ampc-connection)
(when string
- (when ampc-debug
- (message "ampc: -> %s" string))
+ (when (and ampc-debug (not (eq ampc-debug t)))
+ (message "ampc: <- %s" string))
(goto-char (process-mark ampc-connection))
(insert string)
(set-marker (process-mark ampc-connection) (point)))
(save-excursion
(goto-char (point-min))
(let ((success))
- (if (or (and (search-forward-regexp
- "^ACK \\[\\(.*\\)\\] {.*} \\(.*\\)\n\\'"
- nil
- t)
- (message "ampc command error: %s (%s)"
- (match-string 2)
- (match-string 1))
- t)
- (and (search-forward-regexp "^OK\\(.*\\)\n\\'" nil t)
- (setf success t)))
+ (if (or (progn
+ (when (search-forward-regexp
+ "^ACK \\[\\(.*\\)\\] {.*} \\(.*\\)\n\\'"
+ nil
+ t)
+ (message "ampc command error: %s (%s; %s)"
+ (match-string 2)
+ (match-string 1)
+ (funcall (if ampc-debug 'identity 'car)
+ (car ampc-outstanding-commands)))
+ t))
+ (when (search-forward-regexp "^OK\\(.*\\)\n\\'" nil t)
+ (setf success t)))
(progn
(let ((match-end (match-end 0)))
(save-restriction
@@ -1389,116 +2074,351 @@
(goto-char (point-min))
(ampc-handle-command (if success (match-string 1) 'error)))
(delete-region (point-min) match-end))
- (ampc-send-next-command))
- (ampc-handle-command 'running))))))
+ (unless ampc-no-implicit-next-dispatch
+ (ampc-send-next-command))))
+ (ampc-handle-command 'running)))))
-;;; **** window management
-(defun ampc-windows (&optional unordered)
- (loop for f being the frame
- thereis (loop for w being the windows of f
- when (eq (window-buffer w) (car-safe ampc-buffers))
- return (loop for b in (if unordered
- ampc-buffers-unordered
- ampc-buffers)
- collect
- (loop for w being the windows of f
- thereis (and (eq (window-buffer w)
- b)
- w))))))
+(defun* ampc-set-tab-offsets
+ (&rest properties &aux (min 2) (optional-padding 0))
+ (unless properties
+ (return-from ampc-set-tab-offsets))
+ (set (make-local-variable 'tab-stop-list) nil)
+ (loop for (title . props) in properties
+ for min- = (plist-get props :min)
+ do (incf min (or (plist-get props :width) min-))
+ (when min-
+ (incf optional-padding (- (plist-get props :max) min-))))
+ (loop for (title . props) in properties
+ with offset = 2
+ do (push offset tab-stop-list)
+ (incf offset (or (plist-get props :width)
+ (let ((min- (plist-get props :min))
+ (max (plist-get props :max)))
+ (if (>= min (window-width))
+ min-
+ (min max
+ (+ min-
+ (floor (* (/ (float (- max min-))
+ optional-padding)
+ (- (window-width)
+ min))))))))))
+ (callf nreverse tab-stop-list))
(defun* ampc-configure-frame-1 (split &aux (split-type (car split)))
- (if (member split-type '(vertical horizontal))
+ (if (memq split-type '(vertical horizontal))
(let* ((sizes))
(loop with length = (if (eq split-type 'horizontal)
- (window-width)
- (window-height))
+ (window-total-width)
+ (window-total-height))
with rest = length
with rest-car
- for subsplit in (cdr split)
- for s = (car subsplit)
- if (equal s 1.0)
- do (push t sizes)
- and do (setf rest-car sizes)
- else
- do (let ((l (if (integerp s) s (floor (* s length)))))
- (setf rest (- rest l))
- (push l sizes))
+ for (size . subsplit) in (cdr split)
+ do (if (equal size 1.0)
+ (progn (push t sizes)
+ (setf rest-car sizes))
+ (let ((l (if (integerp size) size (round (* size length)))))
+ (decf rest l)
+ (push l sizes)))
finally do (setf (car rest-car) rest))
(let ((first-window (selected-window)))
- (setf sizes (nreverse sizes))
- (loop for size in (loop for s in sizes
- collect s)
+ (callf nreverse sizes)
+ (loop for size in (copy-sequence sizes)
for window on (cdr sizes)
do (select-window
(setf (car window)
- (split-window nil
- size
- (eq split-type 'horizontal)))))
+ (split-window nil size (eq split-type
'horizontal)))))
(setf (car sizes) first-window))
(loop for subsplit in (cdr split)
for window in sizes
+ with result
do (with-selected-window window
- (ampc-configure-frame-1 (cdr subsplit)))
- if (plist-get (cddr subsplit) :point)
- do (select-window window)
- end))
+ (setf result
+ (or (ampc-configure-frame-1 (cdr subsplit)) result)))
+ finally return result))
(setf (window-dedicated-p (selected-window)) nil)
- (ecase split-type
- ((tag song)
- (pop-to-buffer-same-window
- (get-buffer-create (concat "*ampc "
- (or (plist-get (cdr split) :tag) "Song")
- "*")))
- (ampc-tag-song-mode))
- (outputs
- (pop-to-buffer-same-window (get-buffer-create "*ampc Outputs*"))
- (ampc-outputs-mode))
- (current-playlist
- (pop-to-buffer-same-window (get-buffer-create "*ampc Current
Playlist*"))
- (ampc-current-playlist-mode)
- (ampc-highlight-current-song-mode 1))
- (playlist
- (pop-to-buffer-same-window (get-buffer-create "*ampc Playlist*"))
- (ampc-playlist-mode))
- (playlists
- (pop-to-buffer-same-window (get-buffer-create "*ampc Playlists*"))
- (ampc-playlists-mode))
- (status
- (pop-to-buffer-same-window (get-buffer-create "*ampc Status*"))
- (ampc-mode)))
- (destructuring-bind (&key (dedicated t) (mode-line t) &allow-other-keys)
+ (pop-to-buffer-same-window
+ (get-buffer-create
+ (concat "*"
+ (mapconcat (lambda (s) (concat (upcase (substring s 0 1))
+ (substring s 1)))
+ (if (memq split-type '(tag song))
+ (list (or (plist-get (cdr split) :tag) "song"))
+ (split-string (symbol-name split-type) "-"))
+ " ")
+ "*")))
+ (if (memq split-type '(tag song))
+ (ampc-tag-song-mode)
+ (let ((mode (intern (concat "ampc-" (symbol-name split-type) "-mode"))))
+ (unless (fboundp mode)
+ (setf mode 'ampc-mode))
+ (unless (eq major-mode 'mode)
+ (funcall mode))))
+ (destructuring-bind
+ (&key (properties nil) (dedicated t) (mode-line t) &allow-other-keys)
(cdr split)
- (setf (window-dedicated-p (selected-window)) dedicated)
- (unless mode-line
- (setf mode-line-format nil)))
- (setf ampc-type split)
+ (apply 'ampc-set-tab-offsets properties)
+ (setf ampc-type split
+ (window-dedicated-p (selected-window)) dedicated
+ mode-line-format (when mode-line
+ (default-value 'mode-line-format))))
+ (set (make-local-variable 'mode-line-buffer-identification)
+ '(:eval (let ((result
+ (concat (car-safe (propertized-buffer-identification
+ (buffer-name)))
+ (when ampc-dirty
+ " [Updating...]"))))
+ (if (< (length result) 12)
+ (concat result (make-string (- 12 (length result)) ? ))
+ result))))
+ (ampc-update-header)
(add-to-list 'ampc-all-buffers (current-buffer))
- (push `(,(or (plist-get (cdr split) :id)
- (if (eq (car ampc-type) 'song) 9998 9999))
- . ,(current-buffer))
- ampc-buffers)
- (ampc-set-dirty t)))
-
-(defun ampc-configure-frame (split)
- (if ampc-use-full-frame
- (progn (setf (window-dedicated-p (selected-window)) nil)
- (delete-other-windows))
- (loop with live-window = nil
- for w in (nreverse (ampc-windows t))
- if (window-live-p w)
- if (not live-window)
- do (setf live-window w)
- else
- do (delete-window w)
- end
- end
- finally do (if live-window (select-window live-window))))
- (setf ampc-buffers nil)
- (ampc-configure-frame-1 split)
- (setf ampc-buffers-unordered (mapcar 'cdr ampc-buffers)
- ampc-buffers (mapcar 'cdr (sort ampc-buffers
- (lambda (a b) (< (car a) (car b))))))
- (ampc-update))
+ (push (cons (or (plist-get (cdr split) :id) 9999) (selected-window))
+ ampc-windows)
+ (ampc-set-dirty t)
+ (when (plist-get (cdr split) :select)
+ (selected-window))))
+
+(defun* ampc-configure-frame
+ (split &optional no-update &aux (old-selection ampc-type)
old-window-starts)
+ (loop for w in (ampc-normalize-windows)
+ do (with-selected-window w
+ (with-current-buffer (window-buffer w)
+ (push (cons (current-buffer) (window-start))
+ old-window-starts))))
+ (if (not ampc-use-full-frame)
+ (ampc-restore-window-configuration)
+ (setf (window-dedicated-p (selected-window)) nil)
+ (delete-other-windows))
+ (setf ampc-windows nil)
+ (let ((select-window (ampc-configure-frame-1 split)))
+ (setf ampc-windows
+ (mapcar (lambda (window)
+ (cons window (window-buffer window)))
+ (mapcar 'cdr (sort ampc-windows
+ (lambda (a b) (< (car a) (car b)))))))
+ (loop for w in (ampc-normalize-windows)
+ do (with-selected-window w
+ (let ((old-window-start (cdr (assq (current-buffer)
+ old-window-starts))))
+ (when old-window-start
+ (set-window-start nil old-window-start)))
+ (when (and (derived-mode-p 'ampc-item-mode)
+ (> (length tab-stop-list) 1))
+ (ampc-set-dirty 'erase))))
+ (select-window (or (loop for w in (ampc-normalize-windows)
+ thereis
+ (when (equal (with-current-buffer (window-buffer
w)
+ ampc-type)
+ old-selection)
+ w))
+ select-window
+ (selected-window))))
+ (unless no-update
+ (ampc-update)))
+
+(defun ampc-tagger-rename-artist-title (_changed-tags data)
+ "Rename music file according to its tags.
+This function is meant to be inserted into
+`ampc-tagger-stored-hook'. The new file name is
+`Artist'_-_`Title'.`extension'. Characters within `Artist' and
+`Title' that are not alphanumeric are substituted with underscore."
+ (let* ((artist (replace-regexp-in-string
+ "[^a-zA-Z0-9]" "_"
+ (or (cdr (assq 'Artist (cdr data))) "")))
+ (title (replace-regexp-in-string
+ "[^a-zA-Z0-9]" "_"
+ (or (cdr (assq 'Title (cdr data))) "")))
+ (new-file
+ (expand-file-name (replace-regexp-in-string
+ "_\\(_\\)+"
+ "_"
+ (concat artist
+ (when (and (> (length artist) 0)
+ (> (length title) 0))
+ "_-_")
+ title
+ (file-name-extension (car data) t)))
+ (file-name-directory (car data)))))
+ (unless (equal (car data) new-file)
+ (ampc-tagger-log "Renaming file " (abbreviate-file-name (car data))
+ " to " (abbreviate-file-name new-file) "\n")
+ (rename-file (car data) new-file)
+ (setf (car data) new-file))))
+
+;;; *** interactives
+(defun ampc-tagger-completion-at-point (&optional all-files)
+ "Perform completion at point via `completion-at-point'.
+If optional prefix argument ALL-FILES is non-nil, use all files
+within the files list buffer as source for completion. The
+default behaviour is to use only the selected ones."
+ (interactive "P")
+ (let ((ampc-tagger-completion-all-files all-files))
+ (completion-at-point)))
+
+(defun ampc-tagger-reset (&optional reset-all-tags)
+ "Reset all tag values within the tagger, based on the selection of files.
+If optional prefix argument RESET-ALL-TAGS is non-nil, restore
+all tags."
+ (interactive "P")
+ (when reset-all-tags
+ (ampc-with-buffer 'tagger
+ no-se
+ (erase-buffer)
+ (loop for tag in ampc-tagger-tags
+ do (insert (ampc-pad (list (concat (symbol-name tag) ":") "dummy"))
+ "\n"))
+ (goto-char (point-min))
+ (re-search-forward ":\\( \\)+")))
+ (ampc-with-buffer 'tagger
+ (loop while (search-forward-regexp
+ (concat "^\\([ \t]*\\)\\("
+ (mapconcat 'symbol-name ampc-tagger-tags "\\|")
+ "\\)\\([ \t]*\\):\\([ \t]*.*\\)$")
+ nil
+ t)
+ do (replace-match "" nil nil nil 1)
+ (replace-match "" nil nil nil 3)
+ (replace-match (concat (make-string (- (car tab-stop-list)
+ (1+ (length (match-string
2))))
+ ? )
+ "<keep>")
+ nil nil nil 4)))
+ (ampc-tagger-update)
+ (ampc-with-buffer 'tagger
+ no-se
+ (when (looking-at "[ \t]+")
+ (goto-char (match-end 0)))))
+
+(defun* ampc-tagger-save (&optional quit &aux tags)
+ "Save tags.
+If optional prefix argument QUIT is non-nil, quit tagger
+afterwards. If the numeric value of QUIT is 16, quit tagger and
+do not trigger a database update"
+ (interactive "P")
+ (ampc-with-buffer 'tagger
+ (loop do (loop until (eobp)
+ while (looking-at "^[ \t]*$")
+ do (forward-line))
+ until (eobp)
+ do (unless (and (looking-at
+ (concat "^[ \t]*\\("
+ (mapconcat 'symbol-name
+ ampc-tagger-tags
+ "\\|")
+ "\\)[ \t]*:"
+ "[ \t]*\\(.*\\)[ \t]*$"))
+ (not (assq (intern (match-string 1)) tags)))
+ (error "Malformed line \"%s\""
+ (buffer-substring (line-beginning-position)
+ (line-end-position))))
+ (push (cons (intern (match-string 1))
+ (let ((val (match-string 2)))
+ (if (string= "<keep>" val)
+ t
+ (set-text-properties 0 (length val) nil val)
+ val)))
+ tags)
+ (forward-line)))
+ (callf2 rassq-delete-all t tags)
+ (with-temp-buffer
+ (loop for (tag . value) in tags
+ do (insert (symbol-name tag) "\n"
+ value "\n"))
+ (let ((input-buffer (current-buffer)))
+ (ampc-with-buffer 'files-list
+ no-se
+ (let ((reporter
+ (make-progress-reporter "Storing tags"
+ 0
+ (let ((count (count-matches "^\\* ")))
+ (if (zerop count)
+ 1
+ count))))
+ (step 0))
+ (ampc-with-selection nil
+ (let* ((data (get-text-property (point) 'data))
+ (old-tags (loop for (tag . data) in (cdr data)
+ collect (cons tag data)))
+ (found-changed (ampc-tagger-tags-modified (cdr data) tags)))
+ (let ((pre-hook-tags (cdr data)))
+ (run-hook-with-args 'ampc-tagger-store-hook found-changed data)
+ (setf found-changed
+ (or found-changed
+ (ampc-tagger-tags-modified pre-hook-tags
+ (cdr data)))))
+ (when found-changed
+ (ampc-tagger-log
+ "Storing tags for file "
+ (abbreviate-file-name (car data)) "\n"
+ "\tOld tags:\n"
+ (loop for (tag . value) in old-tags
+ concat (concat "\t\t"
+ (symbol-name tag) ": "
+ value "\n"))
+ "\tNew tags:\n"
+ (loop for (tag . value) in (cdr data)
+ concat (concat "\t\t"
+ (symbol-name tag) ": "
+ value "\n")))
+ (ampc-tagger-make-backup (car data))
+ (ampc-tagger-report
+ (list "--set" (car data))
+ (with-temp-buffer
+ (insert-buffer-substring input-buffer)
+ (prog1
+ (call-process-region (point-min) (point-max)
+ ampc-tagger-executable
+ nil t nil
+ "--set" (car data))
+ (when ampc-debug
+ (message "ampc-tagger: %s"
+ (buffer-substring
+ (point-min) (point))))))))
+ (run-hook-with-args 'ampc-tagger-stored-hook found-changed data)
+ (let ((inhibit-read-only t))
+ (move-beginning-of-line nil)
+ (forward-char 2)
+ (kill-line 1)
+ (insert
+ (ampc-pad (loop for p in (plist-get (cdr ampc-type)
+ :properties)
+ when (eq (car p) 'filename)
+ collect (file-name-nondirectory (car data))
+ else
+ collect (cdr (assq (intern (car p))
+ (cdr data)))
+ end))
+ "\n")
+ (forward-line -1)
+ (put-text-property (line-beginning-position)
+ (1+ (line-end-position))
+ 'data data))
+ (progress-reporter-update reporter (incf step))))
+ (progress-reporter-done reporter)))))
+ (when quit
+ (ampc-tagger-quit (eq (prefix-numeric-value quit) 16))))
+
+(defun ampc-tagger-quit (&optional no-update)
+ "Quit tagger and restore previous window configuration.
+With optional prefix NO-UPDATE, do not trigger a database update."
+ (interactive "P")
+ (set-window-configuration (or (car-safe ampc-tagger-previous-configuration)
+ ampc-tagger-previous-configuration))
+ (when (car-safe ampc-tagger-previous-configuration)
+ (unless no-update
+ (ampc-trigger-update))
+ (setf ampc-windows (cadr ampc-tagger-previous-configuration)))
+ (setf ampc-tagger-previous-configuration nil))
+
+(defun ampc-move-to-tab ()
+ "Move point to next logical tab stop."
+ (interactive)
+ (let ((tab (loop for tab in
+ (or (get-text-property (point) 'tab-stop-list)
tab-stop-list)
+ while (>= (current-column) tab)
+ finally return tab)))
+ (when tab
+ (goto-char (min (+ (line-beginning-position) tab)
(line-end-position))))))
(defun ampc-mouse-play-this (event)
(interactive "e")
@@ -1518,13 +2438,25 @@
(goto-char (posn-point (event-end event)))
(ampc-add-impl))
+(defun ampc-mouse-delete-playlist (event)
+ (interactive "e")
+ (select-window (posn-window (event-end event)))
+ (goto-char (posn-point (event-end event)))
+ (ampc-delete-playlist t))
+
+(defun ampc-mouse-load (event)
+ (interactive "e")
+ (select-window (posn-window (event-end event)))
+ (goto-char (posn-point (event-end event)))
+ (ampc-load t))
+
(defun ampc-mouse-toggle-output-enabled (event)
(interactive "e")
(select-window (posn-window (event-end event)))
(goto-char (posn-point (event-end event)))
(ampc-toggle-output-enabled 1))
-(defun* ampc-mouse-toggle-mark (event &aux buffer-read-only)
+(defun* ampc-mouse-toggle-mark (event &aux (inhibit-read-only t))
(interactive "e")
(let ((window (posn-window (event-end event))))
(when (with-selected-window window
@@ -1541,11 +2473,10 @@
(goto-char (posn-point (event-end event)))
(ampc-align-point))
-;;; *** interactives
-(defun* ampc-unmark-all (&aux buffer-read-only)
+(defun* ampc-unmark-all (&aux (inhibit-read-only t))
"Remove all marks."
(interactive)
- (assert (ampc-in-ampc-p))
+ (assert (ampc-in-ampc-p t))
(save-excursion
(goto-char (point-min))
(loop while (search-forward-regexp "^\\* " nil t)
@@ -1558,10 +2489,11 @@
(assert (ampc-on-p))
(ampc-send-command 'update))
-(defun* ampc-toggle-marks (&aux buffer-read-only)
- "Toggle marks. Marked entries become unmarked, and vice versa."
+(defun* ampc-toggle-marks (&aux (inhibit-read-only t))
+ "Toggle marks.
+Marked entries become unmarked, and vice versa."
(interactive)
- (assert (ampc-in-ampc-p))
+ (assert (ampc-in-ampc-p t))
(save-excursion
(loop for (a . b) in '(("* " . "T ")
(" " . "* ")
@@ -1574,62 +2506,74 @@
(ampc-post-mark-change-update))
(defun ampc-up (&optional arg)
- "Go to the previous ARG'th entry.
-With optional prefix ARG, move the next ARG entries after point
-rather than the selection."
- (interactive "P")
+ "Move selected entries ARG positions upwards.
+ARG defaults to one."
+ (interactive "p")
(assert (ampc-in-ampc-p))
- (ampc-move t arg))
+ (ampc-move (- (or arg 1))))
(defun ampc-down (&optional arg)
- "Go to the next ARG'th entry.
-With optional prefix ARG, move the next ARG entries after point
-rather than the selection."
- (interactive "P")
+ "Move selected entries ARG positions downwards.
+ARG defaults to one."
+ (interactive "p")
(assert (ampc-in-ampc-p))
- (ampc-move nil arg))
+ (ampc-move (or arg 1)))
(defun ampc-mark (&optional arg)
"Mark the next ARG'th entries.
ARG defaults to 1."
(interactive "p")
- (assert (ampc-in-ampc-p))
+ (assert (ampc-in-ampc-p t))
(ampc-mark-impl t arg))
(defun ampc-unmark (&optional arg)
"Unmark the next ARG'th entries.
ARG defaults to 1."
(interactive "p")
- (assert (ampc-in-ampc-p))
+ (assert (ampc-in-ampc-p t))
(ampc-mark-impl nil arg))
+(defun ampc-set-volume (&optional arg)
+ "Set volume to ARG percent.
+If ARG is nil, read ARG from minibuffer."
+ (interactive "P")
+ (assert (ampc-on-p))
+ (ampc-set-volume-impl (or arg (read-number "Volume: "))))
+
(defun ampc-increase-volume (&optional arg)
- "Decrease volume.
-With prefix argument ARG, set volume to ARG percent."
+ "Increase volume by prefix argument ARG or, if ARG is nil,
+`ampc-volume-step'."
(interactive "P")
(assert (ampc-on-p))
- (ampc-set-volume arg '+))
+ (ampc-set-volume-impl arg '+))
(defun ampc-decrease-volume (&optional arg)
- "Decrease volume.
-With prefix argument ARG, set volume to ARG percent."
- (interactive "P")
- (assert (ampc-on-p))
- (ampc-set-volume arg '-))
+ "Decrease volume by prefix argument ARG or, if ARG is nil,
+`ampc-volume-step'."
+ (interactive "P")
+ (assert (ampc-on-p))
+ (ampc-set-volume-impl arg '-))
+
+(defun ampc-set-crossfade (&optional arg)
+ "Set crossfade to ARG seconds.
+If ARG is nil, read ARG from minibuffer."
+ (interactive "P")
+ (assert (ampc-on-p))
+ (ampc-set-crossfade-impl (or arg (read-number "Crossfade: "))))
(defun ampc-increase-crossfade (&optional arg)
- "Increase crossfade.
-With prefix argument ARG, set crossfading to ARG seconds."
+ "Increase crossfade by prefix argument ARG or, if ARG is nil,
+`ampc-crossfade-step'."
(interactive "P")
(assert (ampc-on-p))
- (ampc-set-crossfade arg '+))
+ (ampc-set-crossfade-impl arg '+))
(defun ampc-decrease-crossfade (&optional arg)
- "Decrease crossfade.
-With prefix argument ARG, set crossfading to ARG seconds."
+ "Decrease crossfade by prefix argument ARG or, if ARG is nil,
+`ampc-crossfade-step'."
(interactive "P")
(assert (ampc-on-p))
- (ampc-set-crossfade arg '-))
+ (ampc-set-crossfade-impl arg '-))
(defun ampc-toggle-repeat (&optional arg)
"Toggle MPD's repeat state.
@@ -1656,44 +2600,50 @@
(interactive "P")
(ampc-toggle-state 'random arg))
-(defun ampc-play-this ()
- "Play selected song."
- (interactive)
- (assert (ampc-in-ampc-p))
- (unless (eobp)
- (ampc-send-command 'play nil (1- (line-number-at-pos)))
+(defun ampc-play-this (&optional arg)
+ "Play selected song.
+With prefix argument ARG, play the ARG'th song located at the
+zero-indexed position of the current playlist."
+ (interactive "P")
+ (assert (and (ampc-on-p) (or arg (ampc-in-ampc-p))))
+ (if (not arg)
+ (unless (eobp)
+ (ampc-send-command 'play nil (1- (line-number-at-pos)))
+ (ampc-send-command 'pause nil 0))
+ (ampc-send-command 'play nil arg)
(ampc-send-command 'pause nil 0)))
(defun* ampc-toggle-play
- (&optional arg &aux (state (cdr-safe (assq 'state ampc-status))))
+ (&optional arg &aux (state (cdr (assq 'state ampc-status))))
"Toggle play state.
-If mpd does not play a song already, start playing the song at
+If MPD does not play a song already, start playing the song at
point if the current buffer is the playlist buffer, otherwise
start at the beginning of the playlist.
If ARG is 4, stop player rather than pause if applicable."
(interactive "P")
(assert (ampc-on-p))
- (when state
- (when arg
- (setf arg (prefix-numeric-value arg)))
- (ecase (intern state)
- (stop
- (when (or (null arg) (> arg 0))
- (ampc-send-command
- 'play
- nil
- (if (and (eq (car ampc-type) 'current-playlist) (not (eobp)))
- (1- (line-number-at-pos))
- 0))))
- (pause
- (when (or (null arg) (> arg 0))
- (ampc-send-command 'pause nil 0)))
- (play
- (cond ((or (null arg) (< arg 0))
- (ampc-send-command 'pause nil 1))
- ((eq arg 4)
- (ampc-send-command 'stop)))))))
+ (unless state
+ (return-from ampc-toggle-play))
+ (when arg
+ (setf arg (prefix-numeric-value arg)))
+ (ecase (intern state)
+ (stop
+ (when (or (null arg) (> arg 0))
+ (ampc-send-command
+ 'play
+ '(:remove-other (pause))
+ (if (and (eq (car ampc-type) 'current-playlist) (not (eobp)))
+ (1- (line-number-at-pos))
+ 0))))
+ (pause
+ (when (or (null arg) (> arg 0))
+ (ampc-send-command 'pause '(:remove-other (play)) 0)))
+ (play
+ (cond ((or (null arg) (< arg 0))
+ (ampc-send-command 'pause '(:remove-other (play)) 1))
+ ((eq arg 4)
+ (ampc-send-command 'stop))))))
(defun ampc-next (&optional arg)
"Play next song.
@@ -1711,20 +2661,30 @@
(defun ampc-rename-playlist (new-name)
"Rename selected playlist to NEW-NAME.
-Interactively, read NEW-NAME from the minibuffer."
- (interactive "MNew name: ")
+If NEW-NAME is nil, read NEW-NAME from the minibuffer."
+ (interactive "M")
+ (unless new-name
+ (setf new-name (read-from-minibuffer (concat "New name for playlist "
+ (ampc-playlist)
+ ": "))))
(assert (ampc-in-ampc-p))
(if (ampc-playlist)
- (ampc-send-command 'rename nil (ampc-playlist) new-name)
- (error "No playlist selected")))
+ (ampc-send-command 'rename '(:full-remove t) (ampc-quote new-name))
+ (message "No playlist selected")))
-(defun ampc-load ()
- "Load selected playlist in the current playlist."
+(defun ampc-load (&optional at-point)
+ "Load selected playlist in the current playlist.
+If optional argument AT-POINT is non-nil (or if no playlist is
+selected), use playlist at point rather than the selected one."
(interactive)
(assert (ampc-in-ampc-p))
- (if (ampc-playlist)
- (ampc-send-command 'load nil (ampc-quote (ampc-playlist)))
- (error "No playlist selected")))
+ (if (ampc-playlist at-point)
+ (ampc-send-command
+ 'load '(:keep-prev t)
+ (ampc-quote (ampc-playlist at-point)))
+ (if at-point
+ (message "No playlist at point")
+ (message "No playlist selected"))))
(defun ampc-toggle-output-enabled (&optional arg)
"Toggle the next ARG outputs.
@@ -1736,7 +2696,7 @@
(ampc-send-command (if (equal (cdr (assoc "outputenabled" data)) "1")
'disableoutput
'enableoutput)
- nil
+ '(:full-remove t)
(cdr (assoc "outputid" data))))))
(defun ampc-delete (&optional arg)
@@ -1745,46 +2705,40 @@
all marks after point are removed nontheless."
(interactive "P")
(assert (ampc-in-ampc-p))
- (let ((point (point)))
+ (let ((first-del nil))
(ampc-with-selection arg
- (let ((val (1- (- (line-number-at-pos) index))))
- (if (ampc-playlist)
+ (unless (or first-del (when arg (< arg 0)))
+ (setf first-del (point)))
+ (let ((val (1- (- (line-number-at-pos) (if (or (not arg) (> arg 0))
+ index
+ 0)))))
+ (if (and (not (eq (car ampc-type) 'current-playlist)) (ampc-playlist))
(ampc-send-command 'playlistdelete
- t
+ '(:keep-prev t)
(ampc-quote (ampc-playlist))
val)
- (ampc-send-command 'delete t val))))
- (goto-char point)
- (ampc-align-point)))
+ (ampc-send-command 'delete '(:keep-prev t) val))
+ (ampc-mark-impl nil nil)))
+ (when first-del
+ (goto-char first-del))))
(defun ampc-shuffle ()
"Shuffle playlist."
(interactive)
(assert (ampc-on-p))
- (if (not (ampc-playlist))
- (ampc-send-command 'shuffle)
- (ampc-with-buffer 'playlist
- (let ((shuffled
- (mapcar
- 'car
- (sort (loop until (eobp)
- collect `(,(cdr (assoc "file" (get-text-property
- (+ 2 (point))
- 'data)))
- . ,(random))
- do (forward-line))
- (lambda (a b)
- (< (cdr a) (cdr b)))))))
- (ampc-clear)
- (loop for s in shuffled
- do (ampc-add-impl s))))))
+ (if (and (not (eq (car ampc-type) 'current-playlist)) (ampc-playlist))
+ (ampc-send-command 'shuffle-listplaylistinfo
+ `(:playlist ,(ampc-playlist))
+ (ampc-quote (ampc-playlist)))
+ (ampc-send-command 'shuffle)))
(defun ampc-clear ()
"Clear playlist."
(interactive)
(assert (ampc-on-p))
- (if (ampc-playlist)
- (ampc-send-command 'playlistclear nil (ampc-quote (ampc-playlist)))
+ (if (and (not (eq (car ampc-type) 'current-playlist)) (ampc-playlist))
+ (ampc-send-command 'playlistclear '(:full-remove t)
+ (ampc-quote (ampc-playlist)))
(ampc-send-command 'clear)))
(defun ampc-add (&optional arg)
@@ -1796,10 +2750,17 @@
(ampc-with-selection arg
(ampc-add-impl)))
-(defun ampc-status ()
- "Display the information that is displayed in the status window."
+(defun ampc-status (&optional no-print)
+ "Display and return the information that is displayed in the status window.
+If optional argument NO-PRINT is non-nil, just return the text.
+If NO-PRINT is nil, the display may be delayed if ampc does not
+have enough information yet."
(interactive)
(assert (ampc-on-p))
+ (unless (or ampc-status no-print)
+ (ampc-send-command 'status)
+ (ampc-send-command 'mini-currentsong)
+ (return-from ampc-status))
(let* ((flags (mapconcat
'identity
(loop for (f . n) in '((repeat . "Repeat")
@@ -1811,67 +2772,225 @@
"|"))
(state (cdr (assq 'state ampc-status)))
(status (concat "State: " state
- (when ampc-yield
+ (when (and ampc-yield no-print)
(concat (make-string (- 10 (length state)) ? )
(nth (% ampc-yield 4) '("|" "/" "-" "\\"))))
"\n"
(when (equal state "play")
(concat "Playing: "
- (or (cdr-safe (assq 'Artist ampc-status))
- "[Not Specified]")
+ (ampc-clean-tag
+ 'Artist
+ (cdr (assq 'Artist ampc-status)))
" - "
- (or (cdr-safe (assq 'Title ampc-status))
- "[Not Specified]")
+ (ampc-clean-tag
+ 'Title
+ (cdr (assq 'Title ampc-status)))
"\n"))
"Volume: " (cdr (assq 'volume ampc-status)) "\n"
"Crossfade: " (cdr (assq 'xfade ampc-status))
(unless (equal flags "")
(concat "\n" flags)))))
- (when (called-interactively-p 'interactive)
+ (unless no-print
(message "%s" status))
status))
-(defun ampc-delete-playlist ()
- "Delete selected playlist."
+(defun ampc-delete-playlist (&optional at-point)
+ "Delete selected playlist.
+If optional argument AT-POINT is non-nil (or if no playlist is
+selected), use playlist at point rather than the selected one."
(interactive)
(assert (ampc-in-ampc-p))
- (ampc-with-selection nil
- (let ((name (get-text-property (point) 'data)))
- (when (y-or-n-p (concat "Delete playlist " name "?"))
- (ampc-send-command 'rm nil (ampc-quote name))))))
-
-(defun ampc-store (name)
- "Store current playlist as NAME.
-Interactively, read NAME from the minibuffer."
- (interactive "MSave playlist as: ")
- (assert (ampc-in-ampc-p))
- (ampc-send-command 'save nil (ampc-quote name)))
-
-(defun* ampc-goto-current-song
- (&aux (song (cdr-safe (assq 'song ampc-status))))
+ (if (ampc-playlist at-point)
+ (when (y-or-n-p (concat "Delete playlist " (ampc-playlist at-point) "?"))
+ (ampc-send-command 'rm '(:full-remove t)
+ (ampc-quote (ampc-playlist at-point))))
+ (if at-point
+ (message "No playlist at point")
+ (message "No playlist selected"))))
+
+;;;###autoload
+(defun ampc-tagger-dired (&optional arg)
+ "Start the tagging subsystem on dired's marked files.
+With optional prefix argument ARG, use the next ARG files."
+ (interactive "P")
+ (assert (derived-mode-p 'dired-mode))
+ (ampc-tag-files
+ (loop for file in (dired-map-over-marks (dired-get-filename) arg)
+ unless (file-directory-p file)
+ collect file
+ end)))
+
+;;;###autoload
+(defun ampc-tag-files (files)
+ "Start the tagging subsystem.
+FILES should be a list of absolute file names, the files to tag."
+ (unless files
+ (message "No files specified")
+ (return-from ampc-tagger-files t))
+ (when (memq (car ampc-type) '(files-list tagger))
+ (message "You are already within the tagger")
+ (return-from ampc-tagger-files t))
+ (let ((reporter (make-progress-reporter "Grabbing tags" 0 (length files))))
+ (loop for file in-ref files
+ for i from 1
+ do (run-hook-with-args 'ampc-tagger-grab-hook file)
+ (with-temp-buffer
+ (ampc-tagger-call "--get" file)
+ (setf file
+ (apply 'list
+ file
+ (loop for tag in ampc-tagger-tags
+ collect
+ (cons tag (or (ampc-extract (ampc-extract-regexp
+ (symbol-name tag)))
+ ""))))))
+ (run-hook-with-args 'ampc-tagger-grabbed-hook file)
+ (progress-reporter-update reporter i))
+ (progress-reporter-done reporter))
+ (unless ampc-tagger-previous-configuration
+ (setf ampc-tagger-previous-configuration (current-window-configuration)))
+ (ampc-configure-frame (cdr (assq 'tagger ampc-views)) t)
+ (ampc-with-buffer 'files-list
+ (erase-buffer)
+ (loop for (file . props) in files
+ do (insert (propertize
+ (concat
+ " "
+ (ampc-pad
+ (loop for p in (plist-get (cdr ampc-type) :properties)
+ when (eq (car p) 'filename)
+ collect (file-name-nondirectory file)
+ else
+ collect (cdr (assq (intern (car p)) props))
+ end))
+ "\n")
+ 'data (cons file props))))
+ (ampc-set-dirty nil)
+ (ampc-toggle-marks))
+ (ampc-with-buffer 'tagger
+ no-se
+ (ampc-tagger-reset t)
+ (goto-char (point-min))
+ (search-forward-regexp ": *")
+ (ampc-set-dirty nil))
+ nil)
+
+(defun* ampc-tagger (&optional arg &aux files)
+ "Start the tagging subsystem.
+The files to tag are collected by using either the selected
+entries within the current buffer or the next ARG entries at
+point if numeric perfix argument ARG is non-nil, the file
+associated with the entry at point, or, if both sources did not
+provide any files, the audio file that is currently played by
+MPD."
+ (interactive "P")
+ (assert (ampc-in-ampc-p))
+ (unless ampc-tagger-version-verified
+ (with-temp-buffer
+ (ampc-tagger-call "--version")
+ (goto-char (point-min))
+ (let ((version (buffer-substring (line-beginning-position)
+ (line-end-position))))
+ (unless (equal version ampc-tagger-version)
+ (message (concat "The reported version of %s is not supported - "
+ "got \"%s\", want \"%s\"")
+ ampc-tagger-executable
+ version
+ ampc-tagger-version)
+ (return-from ampc-tagger))))
+ (setf ampc-tagger-version-verified t))
+ (unless ampc-tagger-genres
+ (with-temp-buffer
+ (ampc-tagger-call "--genres")
+ (loop while (search-backward-regexp "^\\(.+\\)$" nil t)
+ do (push (match-string 1) ampc-tagger-genres))))
+ (unless ampc-tagger-music-directories
+ (message (concat "ampc-tagger-music-directories is nil. Fill it via "
+ "M-x customize-variable RET ampc-tagger-music-directories
"
+ "RET"))
+ (return-from ampc-tagger))
+ (case (car ampc-type)
+ (current-playlist
+ (save-excursion
+ (ampc-with-selection arg
+ (callf nconc files (list (cdr (assoc "file" (get-text-property
+ (line-end-position)
+ 'data))))))))
+ ((playlist tag song)
+ (save-excursion
+ (ampc-with-selection arg
+ (ampc-on-files (lambda (file) (push file files)))))
+ (callf nreverse files))
+ (t
+ (let ((file (cdr (assoc 'file ampc-status))))
+ (when file
+ (setf files (list file))))))
+ (loop for file in-ref files
+ for read-file = (locate-file file ampc-tagger-music-directories)
+ do (unless read-file
+ (error "Cannot locate file %s in ampc-tagger-music-directories"
+ file)
+ (return-from ampc-tagger))
+ (setf file (expand-file-name read-file)))
+ (setf ampc-tagger-previous-configuration
+ (list (current-window-configuration) ampc-windows))
+ (when (ampc-tag-files files)
+ (setf ampc-tagger-previous-configuration nil)))
+
+(defun ampc-store (&optional name-or-append)
+ "Store current playlist as NAME-OR-APPEND.
+If NAME is non-nil and not a string, append selected entries
+within the current playlist buffer to the selected playlist. If
+NAME-OR-APPEND is a negative integer, append the next (-
+NAME-OR-APPEND) entries after point within the current playlist
+buffer to the selected playlist. If NAME-OR-APPEND is nil, read
+playlist name from the minibuffer."
+ (interactive "P")
+ (assert (ampc-in-ampc-p))
+ (unless name-or-append
+ (setf name-or-append (read-from-minibuffer "Save playlist as: ")))
+ (if (stringp name-or-append)
+ (ampc-send-command 'save '(:full-remove t) (ampc-quote name-or-append))
+ (if (not (ampc-playlist))
+ (message "No playlist selected")
+ (ampc-with-buffer 'current-playlist
+ (when name-or-append
+ (callf prefix-numeric-value name-or-append))
+ (ampc-with-selection (if (and name-or-append (< name-or-append 0))
+ (- name-or-append)
+ nil)
+ (ampc-send-command
+ 'playlistadd
+ '(:keep-prev t)
+ (ampc-quote (ampc-playlist))
+ (ampc-quote (cdr (assoc "file"
+ (get-text-property (point) 'data))))))))))
+
+(defun* ampc-goto-current-song (&aux (song (cdr (assq 'song ampc-status))))
"Select the current playlist window and move point to the current song."
(interactive)
(assert (ampc-in-ampc-p))
- (when song
- (ampc-with-buffer 'current-playlist
- no-se
- (select-window (ampc-get-window 'current-playlist))
- (goto-char (point-min))
- (forward-line (string-to-number song))
+ (let ((window (ampc-with-buffer 'current-playlist
+ (selected-window))))
+ (when window
+ (select-window window)
+ (when song
+ (goto-char (point-min))
+ (forward-line (string-to-number song)))
(ampc-align-point))))
(defun ampc-previous-line (&optional arg)
"Go to previous ARG'th entry in the current buffer.
ARG defaults to 1."
(interactive "p")
- (assert (ampc-in-ampc-p))
+ (assert (ampc-in-ampc-p t))
(ampc-next-line (* (or arg 1) -1)))
(defun ampc-next-line (&optional arg)
"Go to next ARG'th entry in the current buffer.
ARG defaults to 1."
(interactive "p")
- (assert (ampc-in-ampc-p))
+ (assert (ampc-in-ampc-p t))
(forward-line arg)
(if (eobp)
(progn (forward-line -1)
@@ -1883,45 +3002,43 @@
(defun* ampc-suspend (&optional (run-hook t))
"Suspend ampc.
This function resets the window configuration, but does not close
-the connection to mpd or destroy the internal cache of ampc.
+the connection to MPD or destroy the internal cache of ampc.
This means subsequent startups of ampc will be faster."
(interactive)
(when ampc-working-timer
(cancel-timer ampc-working-timer))
- (loop with found-window
- for w in (nreverse (ampc-windows t))
- when (window-live-p w)
- when found-window
- do (delete-window w)
- else
- do (setf found-window t
- (window-dedicated-p w) nil)
- end
- end)
+ (ampc-restore-window-configuration)
(loop for b in ampc-all-buffers
- when (buffer-live-p b)
- do (kill-buffer b)
- end)
- (setf ampc-buffers nil
+ do (when (buffer-live-p b)
+ (kill-buffer b)))
+ (setf ampc-windows nil
ampc-all-buffers nil
ampc-working-timer nil)
(when run-hook
(run-hooks 'ampc-suspend-hook)))
+(defun ampc-mini ()
+ "Select song to play via `completing-read'."
+ (interactive)
+ (assert (ampc-on-p))
+ (ampc-send-command 'mini-playlistinfo))
+
(defun ampc-quit (&optional arg)
"Quit ampc.
-If called with a prefix argument ARG, kill the mpd instance that
+If prefix argument ARG is non-nil, kill the MPD instance that
ampc is connected to."
(interactive "P")
(when (ampc-on-p)
(set-process-filter ampc-connection nil)
- (when (equal (car-safe ampc-outstanding-commands) '(idle))
+ (when (equal (car-safe ampc-outstanding-commands) '(idle nil))
(ampc-send-command-impl "noidle")
(with-current-buffer (process-buffer ampc-connection)
(loop do (goto-char (point-min))
until (search-forward-regexp "^\\(ACK\\)\\|\\(OK\\).*\n\\'" nil
t)
+ while (ampc-on-p)
do (accept-process-output ampc-connection nil 50))))
- (ampc-send-command-impl (if arg "kill" "close")))
+ (ampc-send-command-impl (if arg "kill" "close"))
+ (delete-process ampc-connection))
(when ampc-working-timer
(cancel-timer ampc-working-timer))
(ampc-suspend nil)
@@ -1932,18 +3049,32 @@
(run-hooks 'ampc-quit-hook))
;;;###autoload
-(defun ampc (&optional host port)
+(defun ampc-suspended-p ()
+ "Return non-nil if ampc is suspended."
+ (interactive)
+ (and (ampc-on-p) (not ampc-windows)))
+
+;;;###autoload
+(defun ampc-on-p ()
+ "Return non-nil if ampc is connected to the daemon."
+ (interactive)
+ (and ampc-connection (memq (process-status ampc-connection) '(open run))))
+
+;;;###autoload
+(defun ampc (&optional host port suspend)
"ampc is an asynchronous client for the MPD media player.
This function is the main entry point for ampc.
-Non-interactively, HOST and PORT specify the MPD instance to
-connect to. The values default to localhost:6600."
- (interactive "MHost (localhost): \nMPort (6600): ")
+HOST and PORT specify the MPD instance to connect to. The values
+default to the ones specified in `ampc-default-server'."
+ (interactive)
+ (unless (byte-code-function-p (symbol-function 'ampc))
+ (message "You should byte-compile ampc"))
(run-hooks 'ampc-before-startup-hook)
- (when (or (not host) (equal host ""))
- (setf host "localhost"))
- (when (or (not port) (equal port ""))
- (setf port 6600))
+ (unless host
+ (setf host (or (car ampc-default-server) (read-string "Host: "))))
+ (unless port
+ (setf port (or (cdr ampc-default-server) (read-string "Port: "))))
(when (and ampc-connection
(or (not (equal host ampc-host))
(not (equal port ampc-port))
@@ -1953,8 +3084,7 @@
(let ((connection (open-network-stream "ampc"
(with-current-buffer
(get-buffer-create " *ampc*")
- (delete-region (point-min)
- (point-max))
+ (erase-buffer)
(current-buffer))
host
port
@@ -1969,8 +3099,12 @@
(set-process-filter ampc-connection 'ampc-filter)
(set-process-query-on-exit-flag ampc-connection nil)
(setf ampc-outstanding-commands '((setup))))
- (ampc-configure-frame (cddar ampc-views))
+ (if suspend
+ (ampc-update)
+ (ampc-configure-frame (cddadr ampc-views)))
(run-hooks 'ampc-connected-hook)
+ (when suspend
+ (ampc-suspend))
(ampc-filter (process-buffer ampc-connection) nil))
(provide 'ampc)
@@ -1978,7 +3112,6 @@
;; Local Variables:
;; eval: (outline-minor-mode 1)
;; outline-regexp: ";;; \\*+"
-;; lexical-binding: t
;; fill-column: 80
;; indent-tabs-mode: nil
;; End:
=== added file 'packages/ampc/ampc_tagger.cpp'
--- a/packages/ampc/ampc_tagger.cpp 1970-01-01 00:00:00 +0000
+++ b/packages/ampc/ampc_tagger.cpp 2012-08-06 07:06:26 +0000
@@ -0,0 +1,218 @@
+// ampc_tagger.el --- Asynchronous Music Player Controller Tagger
+
+// Copyright (C) 2012 Free Software Foundation, Inc.
+
+// Author: Christopher Schmidt <address@hidden>
+// Maintainer: Christopher Schmidt <address@hidden>
+// Created: 2012-07-17
+
+// This file is part of ampc.
+
+// This program is free software; you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License
+// along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+#include <iostream>
+#include <sstream>
+
+#include <taglib/fileref.h>
+#include <taglib/tag.h>
+#include <taglib/id3v1genres.h>
+
+std::wstring const version=L"0.1";
+std::locale original_wcout_locale;
+
+bool get(std::string const& file)
+{
+ using namespace TagLib;
+
+ FileRef file_ref(file.c_str());
+ Tag* tag;
+ if(file_ref.isNull() || !(tag=file_ref.tag()))
+ {
+ std::wcerr << L"ERROR: Failed opening file." << std::endl;
+ return true;
+ }
+
+ std::wcout << L"Title: " << tag->title().toWString() << std::endl <<
+ L"Artist: " << tag->artist().toWString() << std::endl <<
+ L"Album: " << tag->album().toWString() << std::endl <<
+ L"Comment: " << tag->comment().toWString() << std::endl <<
+ L"Genre: " << tag->genre().toWString() << std::endl;
+ if(tag->year())
+ {
+ std::wcout << L"Year: ";
+ std::locale new_locale=std::wcout.imbue(original_wcout_locale);
+ std::wcout << tag->year();
+ std::wcout.imbue(new_locale);
+ std::wcout << std::endl;
+ }
+ if(tag->track())
+ {
+ std::wcout << L"Track: ";
+ std::locale new_locale=std::wcout.imbue(original_wcout_locale);
+ std::wcout << tag->track();
+ std::wcout.imbue(new_locale);
+ std::wcout << std::endl;
+ }
+
+ return false;
+}
+
+bool set(std::string const& file)
+{
+ using namespace TagLib;
+
+ FileRef file_ref(file.c_str());
+ Tag* tag;
+ if(file_ref.isNull() || !(tag=file_ref.tag()))
+ {
+ std::wcerr << L"ERROR: Failed opening file." << std::endl;
+ return true;
+ }
+
+ for(;;)
+ {
+ if(!std::wcin)
+ {
+ std::wcerr << L"ERROR: invalid input data." << std::endl;
+ return true;
+ }
+
+ std::wstring tag_to_set;
+ getline(std::wcin, tag_to_set);
+ if(tag_to_set == L"")
+ {
+ break;
+ }
+
+ std::wstring value;
+ getline(std::wcin, value);
+
+ std::wcout << L"Setting " << tag_to_set <<
+ L" to " << value << std::endl;
+
+ if(tag_to_set == L"Title")
+ {
+ tag->setTitle(value);
+ }
+ else if(tag_to_set == L"Artist")
+ {
+ tag->setArtist(value);
+ }
+ else if(tag_to_set == L"Album")
+ {
+ tag->setAlbum(value);
+ }
+ else if(tag_to_set == L"Comment")
+ {
+ tag->setComment(value);
+ }
+ else if(tag_to_set == L"Genre")
+ {
+ tag->setGenre(value);
+ }
+ else if(tag_to_set == L"Year")
+ {
+ unsigned int ival;
+ if(value == L"")
+ {
+ ival=0;
+ }
+ else
+ {
+ std::wistringstream val(value);
+ val >> ival;
+ }
+ tag->setYear(ival);
+ }
+ else if(tag_to_set == L"Track")
+ {
+ unsigned int ival;
+ if(value == L"")
+ {
+ ival=0;
+ }
+ else
+ {
+ std::wistringstream val(value);
+ val >> ival;
+ }
+ tag->setTrack(ival);
+ }
+ else
+ {
+ std::wcerr << L"Unknown tag " << tag_to_set << std::endl;
+ return true;
+ }
+ }
+
+ if(!file_ref.save())
+ {
+ std::wcerr << L"Failed saving file." << std::endl;
+ return true;
+ }
+
+ return false;
+}
+
+int main(int const argc, char**const argv)
+{
+ std::locale loc("");
+ original_wcout_locale=std::wcout.imbue(loc);
+ std::wcin.imbue(loc);
+ std::locale::global(loc);
+
+ std::string action;
+ if(argc >= 2)
+ {
+ action=argv[1];
+ }
+
+ if(action == "--version")
+ {
+ std::wcout << version << std::endl;
+ return 0;
+ }
+ else if(action == "--genres")
+ {
+ using namespace TagLib;
+ StringList genres=ID3v1::genreList();
+ for(StringList::ConstIterator genre=genres.begin();
+ genre!=genres.end();
+ ++genre)
+ {
+ std::wcout << genre->toWString() << std::endl;
+ }
+ return 0;
+ }
+ else if(action == "--get" && argc == 3)
+ {
+ return get(argv[2]) ? 1 : 0;
+ }
+ else if(action == "--set" && argc == 3)
+ {
+ return set(argv[2]) ? 1 : 0;
+ }
+ else
+ {
+ std::wcerr <<
+ L"Usage: ampc_tagger [--version|--genres|--set file|--get file]" <<
+ std::endl;
+ return 1;
+ }
+}
+
+// Local Variables:
+// fill-column: 80
+// indent-tabs-mode: nil
+// End:
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [ELPA-diffs] /srv/bzr/emacs/elpa r246: * ampc: Sync to version 0.2.,
Christopher Schmidt <=