From 7a41af580fcabe55f28a1432c39d34bd9a5a827b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 13 Feb 2016 17:02:15 -0500 Subject: [PATCH] * ampc: Re-add, since I cannot find it anywhere else --- packages/ampc/ampc.el | 3118 +++++++++++++++++++++++++++++++++ packages/ampc/ampc_tagger.cpp | 218 +++ 2 files changed, 3336 insertions(+) create mode 100644 packages/ampc/ampc.el create mode 100644 packages/ampc/ampc_tagger.cpp diff --git a/packages/ampc/ampc.el b/packages/ampc/ampc.el new file mode 100644 index 000000000..bce7a9370 --- /dev/null +++ b/packages/ampc/ampc.el @@ -0,0 +1,3118 @@ +;;; ampc.el --- Asynchronous Music Player Controller -*- lexical-binding: t -*- + +;; Copyright (C) 2011-2012 Free Software Foundation, Inc. + +;; Author: Christopher Schmidt +;; Maintainer: Christopher Schmidt +;; Version: 0.2 +;; Created: 2011-12-06 +;; Keywords: ampc, mpc, mpd +;; Compatibility: GNU Emacs: 24.x + +;; 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 . + +;;; Commentary: +;;; * description +;; ampc is a controller for the Music Player Daemon (http://mpd.wikia.com/). + +;;; ** installation +;; If you use GNU ELPA, install ampc via M-x package-list-packages RET or +;; (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") +;; (autoload 'ampc "ampc" nil t) +;; +;; 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. 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' 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 looks like this: +;; +;; ......................... +;; . 1 . 3 . 4 . 5 . +;; .......... . . . +;; . 2 . . . . +;; . . . . . +;; . . . . . +;; . ................ +;; . . 6 . +;; . . . +;; ......................... +;; +;; Window one exposes basic information about the daemon, such as the current +;; 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. +;; +;; To mark an entry, move the point to the entry and press `m' (ampc-mark). To +;; unmark an entry, press `u' (ampc-unmark). To unmark all entries, press `U' +;; (ampc-unmark-all). To toggle marks, press `t' (ampc-toggle-marks). Pressing +;; `' with the mouse mouse cursor on a list entry will move point +;; to the entry and toggle the mark. To navigate to the next entry, press `n' +;; (ampc-next-line). Analogous, pressing `p' (ampc-previous-line) moves the +;; point to the previous entry. +;; +;; Window two shows the current playlist. The song that is currently played by +;; the daemon, if any, is highlighted. To delete the selected songs from the +;; playlist, press `d' (ampc-delete). Pressing `' will move the +;; point to the entry under cursor and delete it from the playlist. To move the +;; selected songs up, press `' (ampc-up). Analogous, press `' +;; (ampc-down) to move the selected songs down. Pressing `' +;; (ampc-play-this) or `' will play the song at point/cursor. +;; +;; Windows three to five are tag browsers. You use them to narrow the song +;; database to certain songs. Think of tag browsers as filters, analogous to +;; piping `grep' outputs through additional `grep' filters. The property of the +;; songs that is filtered is displayed in the header line of the window. +;; +;; Window six shows the songs that match the filters defined by windows three to +;; five. To add the selected song to the playlist, press `a' (ampc-add). +;; Pressing `' will move the point to the entry under the cursor +;; and execute `ampc-add'. These key bindings works in tag browsers as well. +;; Calling `ampc-add' in a tag browser adds all songs filtered up to the +;; selected browser to the playlist. +;; +;; 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 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 `'. To delete a +;; playlist, press `d' (ampc-delete-playlist) or `'. 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' +;; (ampc-toggle-output-enabled) or `'. + +;;; ** 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 "", 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, 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, +;; 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 +;; +;; `c' (ampc-clear): Clear playlist. +;; `s' (ampc-shuffle): Shuffle playlist. +;; +;; `S' (ampc-store): Store 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. +;; `f' (ampc-toggle-consume): Toggle consume state. +;; +;; `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. +;; `q' (ampc-quit): Quit ampc. +;; +;; The keymap of ampc is designed to fit the QWERTY United States keyboard +;; layout. If you use another keyboard layout, feel free to modify +;; `ampc-mode-map'. For example, I use a regular QWERTZ German keyboard +;; (layout), so I modify `ampc-mode-map' in my init.el like this: +;; +;; (eval-after-load 'ampc +;; '(flet ((substitute-ampc-key +;; (from to) +;; (define-key ampc-mode-map to (lookup-key ampc-mode-map from)) +;; (define-key ampc-mode-map from nil))) +;; (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. 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 "") +;; (lambda () +;; (interactive) +;; (unless (ampc-on-p) +;; (ampc nil nil t)) +;; (ampc-status))) +;; (global-set-key (kbd "") +;; (lambda () +;; (interactive) +;; (unless (ampc-on-p) +;; (ampc nil nil t)) +;; (ampc-mini))) + +;;; Code: +;;; * code +(eval-when-compile + (require 'cl)) +(require 'network-stream) +(require 'avl-tree) + +;;; ** declarations +(defgroup ampc () + "Asynchronous client for the Music Player Daemon." + :prefix "ampc-" + :group 'multimedia + :group 'applications) + +;;; *** customs +(defcustom ampc-debug nil + "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." + :type 'boolean) + +(defcustom ampc-truncate-lines t + "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." + :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 + "A hook run before startup. +This hook is called as the first thing when ampc is started." + :type 'hook) + +(defcustom ampc-connected-hook nil + "A hook run after ampc connected to MPD." + :type 'hook) + +(defcustom ampc-suspend-hook nil + "A hook run when suspending ampc." + :type 'hook) + +(defcustom ampc-quit-hook nil + "A hook run when exiting ampc." + :type 'hook) + +(defcustom ampc-status-changed-hook nil + "A hook run whenever the status of the daemon (that is volatile +properties such as volume or current song) changes. The hook is +run with one arg, an alist that contains the new status. The car +of each entry is a symbol, the cdr is a string. Valid keys are: + + volume + repeat + random + consume + xfade + state + song + Artist + Title + +and the keys in `ampc-status-tags'. Not all keys may be present +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-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 "#" :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 :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 :select t) + (0.33 tag :tag "Album" :id 2) + (1.0 tag :tag "Artist" :id 3)) + ,songs)) + (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 ,@pl-prop)) + ,rs_a) + ("Current playlist view (Genre|Album|Artist)" + ,(kbd "M") + horizontal + (0.4 vertical + (6 status) + (1.0 current-playlist ,@pl-prop)) + ,rs_b) + ("Playlist view (Genre|Artist|Album)" + ,(kbd "K") + horizontal + (0.4 vertical + (6 status) + (1.0 vertical + (0.4 current-playlist ,@pl-prop) + (0.4 playlist ,@pl-prop) + (1.0 playlists))) + ,rs_a) + ("Playlist view (Genre|Album|Artist)" + ,(kbd "<") + horizontal + (0.4 vertical + (6 status) + (1.0 vertical + (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" :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-windows nil) +(defvar ampc-all-buffers nil) + +(defvar ampc-type nil) +(make-variable-buffer-local 'ampc-type) +(defvar ampc-dirty nil) +(make-variable-buffer-local 'ampc-dirty) + +(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))) + (suppress-keymap map) + (define-key map (kbd "k") 'ampc-toggle-play) + (define-key map (kbd "l") 'ampc-next) + (define-key map (kbd "j") 'ampc-previous) + (define-key map (kbd "c") 'ampc-clear) + (define-key map (kbd "s") 'ampc-shuffle) + (define-key map (kbd "S") 'ampc-store) + (define-key map (kbd "O") 'ampc-load) + (define-key map (kbd "R") 'ampc-rename-playlist) + (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 (when (stringp (car view)) + (define-key map (cadr view) + `(lambda () + (interactive) + (ampc-change-view ',view))))) + map)) + +(defvar ampc-item-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map (kbd "m") 'ampc-mark) + (define-key map (kbd "u") 'ampc-unmark) + (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 "") 'ampc-mouse-toggle-mark) + (define-key map (kbd "") '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 [remap tab-to-tab-stop] 'ampc-move-to-tab) + map)) + +(defvar ampc-current-playlist-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map (kbd "") 'ampc-play-this) + (define-key map (kbd "") 'ampc-mouse-play-this) + (define-key map (kbd "") 'ampc-mouse-align-point) + (define-key map (kbd "") 'ampc-mouse-delete) + (define-key map (kbd "") 'ampc-mouse-align-point) + map)) + +(defvar ampc-playlist-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map (kbd "t") 'ampc-toggle-marks) + (define-key map (kbd "d") 'ampc-delete) + (define-key map (kbd "") 'ampc-up) + (define-key map (kbd "") 'ampc-down) + (define-key map (kbd "") 'ampc-mouse-delete) + (define-key map (kbd "") 'ampc-mouse-align-point) + map)) + +(defvar ampc-playlists-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (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 "") 'ampc-mouse-load) + (define-key map (kbd "") 'ampc-mouse-align-point) + (define-key map (kbd "") 'ampc-mouse-delete-playlist) + (define-key map (kbd "") 'ampc-mouse-align-point) + map)) + +(defvar ampc-tag-song-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map (kbd "t") 'ampc-toggle-marks) + (define-key map (kbd "a") 'ampc-add) + (define-key map (kbd "") 'ampc-mouse-add) + (define-key map (kbd "") 'ampc-mouse-align-point) + map)) + +(defvar ampc-outputs-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map (kbd "t") 'ampc-toggle-marks) + (define-key map (kbd "a") 'ampc-toggle-output-enabled) + (define-key map (kbd "") 'ampc-mouse-toggle-output-enabled) + (define-key map (kbd "") '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 "") '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))) + end)) + ["Run tagger" ampc-tagger] + "--" + ["Play" ampc-toggle-play + :visible (and ampc-status + (not (equal (cdr (assq 'state ampc-status)) "play")))] + ["Pause" ampc-toggle-play + :visible (and ampc-status + (equal (cdr (assq 'state ampc-status)) "play"))] + ["Stop" (lambda () (interactive) (ampc-toggle-play 4)) + :visible (and ampc-status + (equal (cdr (assq 'state ampc-status)) "play"))] + ["Next" ampc-next] + ["Previous" ampc-previous] + "--" + ["Clear playlist" ampc-clear] + ["Shuffle playlist" ampc-shuffle] + ["Store playlist" ampc-store] + ["Queue Playlist" ampc-load :visible (ampc-playlist)] + ["Rename Playlist" ampc-rename-playlist :visible (ampc-playlist)] + ["Delete Playlist" ampc-delete-playlist :visible (ampc-playlist)] + "--" + ["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 (assq 'repeat ampc-status)) "1")] + ["Toggle random" ampc-toggle-random + :style toggle + :selected (equal (cdr (assq 'random ampc-status)) "1")] + ["Toggle consume" ampc-toggle-consume + :style toggle + :selected (equal (cdr (assq 'consume ampc-status)) "1")] + "--" + ["Trigger update" ampc-trigger-update] + ["Suspend" ampc-suspend] + ["Quit" ampc-quit])) + +(easy-menu-define ampc-selection-menu ampc-item-mode-map + "Selection menu for ampc" + '("ampc Mark" + ["Add to playlist" ampc-add + :visible (not (eq (car ampc-type) 'outputs))] + ["Toggle enabled" ampc-toggle-output-enabled + :visible (eq (car ampc-type) 'outputs)] + "--" + ["Next line" ampc-next-line] + ["Previous line" ampc-previous-line] + ["Mark" ampc-mark] + ["Unmark" ampc-unmark] + ["Unmark all" ampc-unmark-all] + ["Toggle marks" ampc-toggle-marks + :visible (not (eq (car ampc-type) 'playlists))])) + +(defvar ampc-tool-bar-map + (let ((map (make-sparse-keymap))) + (tool-bar-local-item + "mpc/prev" 'ampc-previous 'previous map + :help "Previous") + (tool-bar-local-item + "mpc/play" 'ampc-toggle-play 'play map + :help "Play" + :visible '(and ampc-status + (not (equal (cdr (assq 'state ampc-status)) "play")))) + (tool-bar-local-item + "mpc/pause" 'ampc-toggle-play 'pause map + :help "Pause" + :visible '(and ampc-status + (equal (cdr (assq 'state ampc-status)) "play"))) + (tool-bar-local-item + "mpc/stop" (lambda () (interactive) (ampc-toggle-play 4)) 'stop map + :help "Stop" + :visible '(and ampc-status + (equal (cdr (assq 'state ampc-status)) "play"))) + (tool-bar-local-item + "mpc/next" 'ampc-next 'next map + :help "Next") + map)) + +;;; ** code +;;; *** macros +(defmacro ampc-with-buffer (type &rest body) + (declare (indent 1) (debug t)) + `(let* ((type- ,type) + (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)) + `(let ((tag- ,tag) + (data-buffer (current-buffer))) + (ampc-with-buffer tag- + no-se + (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 (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- (abs arg-)) + do (save-excursion + ,@body) + 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") + +(define-derived-mode ampc-tag-song-mode ampc-item-mode "ampc-ts") + +(define-derived-mode ampc-current-playlist-mode ampc-playlist-mode "ampc-cpl" + (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 + `(((,(concat "^\\([ \t]*\\(?:" + (mapconcat 'symbol-name ampc-tagger-tags "\\|") + "\\)[ \t]*:\\)" + "\\(\\(?:[ \t]*" + "\\(?:" + (mapconcat 'identity ampc-tagger-genres "\\|") "\\|" + "\\)" + "[ \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-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 + nil + (funcall (if ampc-highlight-current-song-mode + 'font-lock-add-keywords + 'font-lock-remove-keywords) + nil + '((ampc-find-current-song + (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 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-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-on-files func d))) + ((avl-tree-p data) + (avl-tree-mapc (lambda (e) (ampc-on-files func (cdr e))) data)) + ((stringp data) + (funcall func data)) + (t + (loop for d in (reverse data) + do (ampc-on-files func (cdr (assoc "file" d))))))) + +(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 (assq 'song ampc-status)))) + (when (and song + (<= (1- (line-number-at-pos (point))) + (setf song (string-to-number song))) + (>= (1- (line-number-at-pos limit)) song)) + (goto-char (point-min)) + (forward-line song) + (save-restriction + (narrow-to-region (max point (point)) (min limit (line-end-position))) + (search-forward-regexp "\\(?1:\\(\\`\\*\\)?\\)\\(?2:.*\\)$")))) + +(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))) + (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) + (ampc-send-command + state + nil + (cond ((null arg) + (if (equal (cdr (assq state ampc-status)) "1") + 0 + 1)) + ((> (prefix-numeric-value arg) 0) 1) + (t 0))))) + +(defun ampc-playlist (&optional at-point) + (ampc-with-buffer 'playlists + (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 (inhibit-read-only t)) + (when (eq (car ampc-type) 'playlists) + (assert (or (not select) (null N) (eq N 1))) + (ampc-with-buffer 'playlists + (loop while (search-forward-regexp "^\\* " nil t) + do (replace-match " " nil nil)))) + (loop repeat (or N 1) + until (eobp) + do (move-beginning-of-line nil) + (delete-char 1) + (insert (if select "*" " ")) + (setf result (ampc-next-line nil))) + (ampc-post-mark-change-update) + result) + +(defun ampc-post-mark-change-update () + (ecase (car ampc-type) + ((current-playlist playlist outputs)) + (playlists + (ampc-update-playlist)) + ((song tag) + (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]*\\([ \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 "" (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) + (re-search-forward " *" nil t))) + +(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) + 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 " " into result + and do (incf current-offset) + end + 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 () + (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)) ? ) + (ecase (car ampc-type) + (tag + (concat " " (plist-get (cdr ampc-type) :tag))) + (playlists + " Playlists") + (t + (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) (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 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)) + (playlist + (ampc-update-playlist)) + ((tag song) + (if (assoc (ampc-tags) ampc-internal-db) + (ampc-fill-tag-song) + (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) + (ampc-send-command 'currentsong)) + (playlists + (ampc-send-command 'listplaylists)) + (current-playlist + (ampc-send-command 'playlistinfo)))))) + (ampc-send-command 'status) + (ampc-send-command 'currentsong))) + +(defun ampc-update-playlist () + (ampc-with-buffer 'playlists + (if (search-forward-regexp "^\\* " nil t) + (ampc-send-command 'listplaylistinfo + nil + (get-text-property (point) 'data)) + (ampc-with-buffer 'playlist + (erase-buffer) + (ampc-set-dirty nil))))) + +(defun ampc-send-command-impl (command) + (when ampc-debug + (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)) + (setf ampc-outstanding-commands '((idle nil))) + (ampc-send-command-impl "idle"))) + +(defun ampc-tree< (a b) + (string< (car a) (car b))) + +(defun ampc-create-tree () + (avl-tree-create 'ampc-tree<)) + +(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 (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 + for tree in trees + 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 + for songs in trees + do (loop for song in songs + do (ampc-insert + (ampc-pad + (loop for (p . v) in (plist-get (cdr ampc-type) :properties) + collect (cdr (assoc p song)))) + `((,song)))))) + +(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 + (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 () + (ampc-fill-skeleton 'outputs + (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 + (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 + (with-current-buffer data-buffer + (loop while (search-forward-regexp "^playlist: \\(.*\\)$" nil t) + for playlist = (match-string 1) + do (ampc-with-buffer 'playlists + (ampc-insert playlist playlist))))) + (ampc-set-dirty 'playlist t) + (ampc-update)) + +(defun ampc-yield () + (incf ampc-yield) + (ampc-fill-status) + (when ampc-yield-redisplay + (redisplay t))) + +(defun ampc-fill-status () + (ampc-with-buffer 'status + (erase-buffer) + (funcall (or (plist-get (cadr ampc-type) :filler) + (lambda (_) + (insert (ampc-status t) "\n"))) + ampc-status) + (ampc-set-dirty nil))) + +(defun ampc-fill-tag-song () + (loop + with trees = (list (cdr (assoc (ampc-tags) ampc-internal-db))) + for type in '(tag song) + do + (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)) + ":" + (when (< (% time 60) 10) + "0") + (number-to-string (% time 60)))) + +(defun ampc-handle-idle () + (loop until (eobp) + for subsystem = (buffer-substring (point) (line-end-position)) + 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) + (unless (and (string-match "^ MPD \\(.+\\)\\.\\(.+\\)\\.\\(.+\\)$" + status) + (let ((version-a (string-to-number (match-string 1 status))) + (version-b (string-to-number (match-string 2 status))) + ;; (version-c (string-to-number (match-string 2 status))) + ) + (or (> version-a 0) + (>= version-b 15)))) + (error (concat "Your version of MPD is not supported. " + "ampc supports MPD protocol version 0.15.0 " + "and later")))) + +(defun ampc-fill-internal-db (running) + (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 + do (goto-char (1+ origin)) + for next = (and (search-forward-regexp "^file: " nil t) + (line-beginning-position)) + while (or (not running) next) + do (save-restriction + (narrow-to-region origin (or next (point-max))) + (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-normalize-windows) + for tag = (with-current-buffer (window-buffer w) + (when (eq (car ampc-type) 'tag) + (plist-get (cdr ampc-type) :tag))) + when tag + collect tag + end)) + +(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 (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 () + (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 () + (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-buffer))) + (run-hook-with-args ampc-status-changed-hook ampc-status)) + +(defun ampc-handle-update () + (message "Database update started")) + +(defun ampc-handle-command (status) + (cond + ((eq status 'error) + (pop ampc-outstanding-commands)) + ((eq status 'running) + (case (caar ampc-outstanding-commands) + (listallinfo (ampc-fill-internal-db t)))) + (t + (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 (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 (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 + (narrow-to-region (point-min) match-end) + (goto-char (point-min)) + (ampc-handle-command (if success (match-string 1) 'error))) + (delete-region (point-min) match-end)) + (unless ampc-no-implicit-next-dispatch + (ampc-send-next-command)))) + (ampc-handle-command 'running))))) + +(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 (memq split-type '(vertical horizontal)) + (let* ((sizes)) + (loop with length = (if (eq split-type 'horizontal) + (window-total-width) + (window-total-height)) + with rest = length + with rest-car + 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))) + (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))))) + (setf (car sizes) first-window)) + (loop for subsplit in (cdr split) + for window in sizes + with result + do (with-selected-window window + (setf result + (or (ampc-configure-frame-1 (cdr subsplit)) result))) + finally return result)) + (setf (window-dedicated-p (selected-window)) nil) + (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) + (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 (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)))) + ? ) + "") + 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= "" 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") + (select-window (posn-window (event-end event))) + (goto-char (posn-point (event-end event))) + (ampc-play-this)) + +(defun ampc-mouse-delete (event) + (interactive "e") + (select-window (posn-window (event-end event))) + (goto-char (posn-point (event-end event))) + (ampc-delete 1)) + +(defun ampc-mouse-add (event) + (interactive "e") + (select-window (posn-window (event-end event))) + (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 (inhibit-read-only t)) + (interactive "e") + (let ((window (posn-window (event-end event)))) + (when (with-selected-window window + (goto-char (posn-point (event-end event))) + (unless (eobp) + (move-beginning-of-line nil) + (ampc-mark-impl (not (eq (char-after) ?*)) 1) + t)) + (select-window window)))) + +(defun ampc-mouse-align-point (event) + (interactive "e") + (select-window (posn-window (event-end event))) + (goto-char (posn-point (event-end event))) + (ampc-align-point)) + +(defun* ampc-unmark-all (&aux (inhibit-read-only t)) + "Remove all marks." + (interactive) + (assert (ampc-in-ampc-p t)) + (save-excursion + (goto-char (point-min)) + (loop while (search-forward-regexp "^\\* " nil t) + do (replace-match " " nil nil))) + (ampc-post-mark-change-update)) + +(defun ampc-trigger-update () + "Trigger a database update." + (interactive) + (assert (ampc-on-p)) + (ampc-send-command 'update)) + +(defun* ampc-toggle-marks (&aux (inhibit-read-only t)) + "Toggle marks. +Marked entries become unmarked, and vice versa." + (interactive) + (assert (ampc-in-ampc-p t)) + (save-excursion + (loop for (a . b) in '(("* " . "T ") + (" " . "* ") + ("T " . " ")) + do (goto-char (point-min)) + (loop while (search-forward-regexp (concat "^" (regexp-quote a)) + nil + t) + do (replace-match b nil nil)))) + (ampc-post-mark-change-update)) + +(defun ampc-up (&optional arg) + "Move selected entries ARG positions upwards. +ARG defaults to one." + (interactive "p") + (assert (ampc-in-ampc-p)) + (ampc-move (- (or arg 1)))) + +(defun ampc-down (&optional arg) + "Move selected entries ARG positions downwards. +ARG defaults to one." + (interactive "p") + (assert (ampc-in-ampc-p)) + (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 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 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) + "Increase 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-decrease-volume (&optional 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 by prefix argument ARG or, if ARG is nil, +`ampc-crossfade-step'." + (interactive "P") + (assert (ampc-on-p)) + (ampc-set-crossfade-impl arg '+)) + +(defun ampc-decrease-crossfade (&optional arg) + "Decrease crossfade by prefix argument ARG or, if ARG is nil, +`ampc-crossfade-step'." + (interactive "P") + (assert (ampc-on-p)) + (ampc-set-crossfade-impl arg '-)) + +(defun ampc-toggle-repeat (&optional arg) + "Toggle MPD's repeat state. +With prefix argument ARG, enable repeating if ARG is positive, +otherwise disable it." + (interactive "P") + (assert (ampc-on-p)) + (ampc-toggle-state 'repeat arg)) + +(defun ampc-toggle-consume (&optional arg) + "Toggle MPD's consume state. +With prefix argument ARG, enable consuming if ARG is positive, +otherwise disable it. + +When consume is activated, each song played is removed from the playlist." + (interactive "P") + (assert (ampc-on-p)) + (ampc-toggle-state 'consume arg)) + +(defun ampc-toggle-random (&optional arg) + "Toggle MPD's random state. +With prefix argument ARG, enable random playing if ARG is positive, +otherwise disable it." + (interactive "P") + (ampc-toggle-state 'random arg)) + +(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 (assq 'state ampc-status)))) + "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. + +If ARG is 4, stop player rather than pause if applicable." + (interactive "P") + (assert (ampc-on-p)) + (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. +With prefix argument ARG, skip ARG songs." + (interactive "p") + (assert (ampc-on-p)) + (ampc-skip (or arg 1))) + +(defun ampc-previous (&optional arg) + "Play previous song. +With prefix argument ARG, skip ARG songs." + (interactive "p") + (assert (ampc-on-p)) + (ampc-skip (- (or arg 1)))) + +(defun ampc-rename-playlist (new-name) + "Rename selected playlist to NEW-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 '(:full-remove t) (ampc-quote new-name)) + (message "No playlist selected"))) + +(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 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. +If ARG is omitted, use the selected entries." + (interactive "P") + (assert (ampc-in-ampc-p)) + (ampc-with-selection arg + (let ((data (get-text-property (point) 'data))) + (ampc-send-command (if (equal (cdr (assoc "outputenabled" data)) "1") + 'disableoutput + 'enableoutput) + '(:full-remove t) + (cdr (assoc "outputid" data)))))) + +(defun ampc-delete (&optional arg) + "Delete the next ARG songs from the playlist. +If ARG is omitted, use the selected entries. If ARG is non-nil, +all marks after point are removed nontheless." + (interactive "P") + (assert (ampc-in-ampc-p)) + (let ((first-del nil)) + (ampc-with-selection arg + (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 + '(:keep-prev t) + (ampc-quote (ampc-playlist)) + val) + (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 (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 (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) + "Add the songs associated with the next ARG entries after point +to the playlist. +If ARG is omitted, use the selected entries in the current buffer." + (interactive "P") + (assert (ampc-in-ampc-p)) + (ampc-with-selection arg + (ampc-add-impl))) + +(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") + (random . "Random") + (consume . "Consume")) + when (equal (cdr (assq f ampc-status)) "1") + collect n + end) + "|")) + (state (cdr (assq 'state ampc-status))) + (status (concat "State: " state + (when (and ampc-yield no-print) + (concat (make-string (- 10 (length state)) ? ) + (nth (% ampc-yield 4) '("|" "/" "-" "\\")))) + "\n" + (when (equal state "play") + (concat "Playing: " + (ampc-clean-tag + 'Artist + (cdr (assq 'Artist ampc-status))) + " - " + (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))))) + (unless no-print + (message "%s" status)) + status)) + +(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)) + (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)) + (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 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 t)) + (forward-line arg) + (if (eobp) + (progn (forward-line -1) + (forward-char 2) + t) + (ampc-align-point) + nil)) + +(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. +This means subsequent startups of ampc will be faster." + (interactive) + (when ampc-working-timer + (cancel-timer ampc-working-timer)) + (ampc-restore-window-configuration) + (loop for b in ampc-all-buffers + 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 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 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")) + (delete-process ampc-connection)) + (when ampc-working-timer + (cancel-timer ampc-working-timer)) + (ampc-suspend nil) + (setf ampc-connection nil + ampc-internal-db nil + ampc-outstanding-commands nil + ampc-status nil) + (run-hooks 'ampc-quit-hook)) + +;;;###autoload +(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. + +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) + (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 + (not (and (equal host ampc-host) + (equal port ampc-port) + (ampc-on-p)))) + (ampc-quit)) + (unless ampc-connection + (let ((connection (open-network-stream "ampc" + (with-current-buffer + (get-buffer-create " *ampc*") + (erase-buffer) + (current-buffer)) + host + port + :type 'plain :return-list t))) + (unless (car connection) + (error "Failed connecting to server: %s" + (plist-get ampc-connection :error))) + (setf ampc-connection (car connection) + ampc-host host + ampc-port port)) + (set-process-coding-system ampc-connection 'utf-8-unix 'utf-8-unix) + (set-process-filter ampc-connection 'ampc-filter) + (set-process-query-on-exit-flag ampc-connection nil) + (setf ampc-outstanding-commands '((setup)))) + (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) + +;; Local Variables: +;; eval: (outline-minor-mode 1) +;; outline-regexp: ";;; \\*+" +;; fill-column: 80 +;; indent-tabs-mode: nil +;; End: +;;; ampc.el ends here diff --git a/packages/ampc/ampc_tagger.cpp b/packages/ampc/ampc_tagger.cpp new file mode 100644 index 000000000..b62de7c00 --- /dev/null +++ b/packages/ampc/ampc_tagger.cpp @@ -0,0 +1,218 @@ +// ampc_tagger.el --- Asynchronous Music Player Controller Tagger + +// Copyright (C) 2012 Free Software Foundation, Inc. + +// Author: Christopher Schmidt +// Maintainer: Christopher Schmidt +// 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 . + +#include +#include + +#include +#include +#include + +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: -- 2.39.2