From: Christopher Schmidt Date: Mon, 11 Feb 2013 17:23:04 +0000 (+0100) Subject: Remove ampc. X-Git-Url: https://code.delx.au/gnu-emacs-elpa/commitdiff_plain/b4af186119636f4ebe23adfe526cea2509c3846e Remove ampc. * ampc.el, ampc_tagger.cpp: Remove files. --- diff --git a/packages/ampc/ampc.el b/packages/ampc/ampc.el deleted file mode 100644 index bce7a9370..000000000 --- a/packages/ampc/ampc.el +++ /dev/null @@ -1,3118 +0,0 @@ -;;; 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 deleted file mode 100644 index b62de7c00..000000000 --- a/packages/ampc/ampc_tagger.cpp +++ /dev/null @@ -1,218 +0,0 @@ -// 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: