;;; ampc.el --- Asynchronous Music Player Controller
-;; Copyright (C) 2011-2012 Christopher Schmidt
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Christopher Schmidt <christopher@ch.ristopher.com>
;; Maintainer: Christopher Schmidt <christopher@ch.ristopher.com>
+;; Version: 0.1.3
;; Created: 2011-12-06
-;; Keywords: mpc
+;; Keywords: ampc, mpc, mpd
;; Compatibility: GNU Emacs: 24.x
-;; This file is NOT part of GNU Emacs.
+;; 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
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;;; Commentary:
;;; * description
-;; ampc is a controller for the Music Player Daemon.
+;; ampc is a controller for the Music Player Daemon (http://mpd.wikia.com/).
;;; ** installation
-;; Put this file somewhere in your load-path or add the directory the file is in
-;; to it, e.g.:
+;; If you use GNU ELPA, install ampc via M-x package-list-packages RET or
+;; (package-install 'ampc). Otherwise, grab this file and put it somewhere in
+;; your load-path or add the directory the file is in to it, e.g.:
;;
;; (add-to-list 'load-path "~/.emacs.d/ampc")
-;;
-;; Then add one autoload definition:
-;;
;; (autoload 'ampc "ampc" nil t)
;;
-;; Optionally bind a key to this function, e.g.:
-;;
-;; (global-set-key (kbd "<f9>") 'ampc)
+;; Byte-compile ampc (M-x byte-compile-file RET /path/to/ampc.el RET) to improve
+;; its performance!
;;; ** usage
-;; To invoke ampc, call the command `ampc', e.g. via M-x ampc RET. Once ampc is
+;; To invoke ampc, call the command `ampc', e.g. via M-x ampc RET. When called
+;; interactively, `ampc' reads host address and port from the minibuffer. If
+;; called non-interactively, the first argument to `ampc' is the host, the
+;; second is the port. Both values default to nil, which will make ampc connect
+;; to localhost:6600. If the optional third argument is non-nil and ampc is
;; connected to the daemon, it creates its window configuration in the selected
;; window. To make ampc use the full frame rather than the selected window,
-;; customize `ampc-use-full-frame'.
+;; customise `ampc-use-full-frame'. To check whether ampc is connected to the
+;; daemon, call `ampc-is-on-p' and `ampc-suspended-p'.
;;
;; ampc offers three independent views which expose different parts of the user
;; interface. The current playlist view, the default view at startup, may be
;;
;; 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). To
-;; navigate to the next entry, press `n' (ampc-next-line). Analogous, pressing
-;; `p' (ampc-previous-line) moves the point to the previous entry.
+;; (ampc-unmark-all). To toggle marks, press `t' (ampc-toggle-marks). Pressing
+;; `<down-mouse-1>' 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). To move the selected songs up, press
-;; `<up>' (ampc-up). Analogous, press `<down>' (ampc-down) to move the selected
-;; songs down.
+;; playlist, press `d' (ampc-delete). Pressing `<down-mouse-3>' will move the
+;; point to the entry under cursor and delete it from the playlist. To move the
+;; selected songs up, press `<up>' (ampc-up). Analogous, press `<down>'
+;; (ampc-down) to move the selected songs down. Pressing `<return>'
+;; (ampc-play-this) or `<down-mouse-2>' 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
;; 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). This
-;; key binding 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.
+;; five. To add the selected song to the playlist, press `a' (ampc-add).
+;; Pressing `<down-mouse-3>' 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 (default) current playlist view (accessed via `J')
+;; are `Genre' (window 3), `Artist' (window 4) and `Album' (window 5). The key
+;; `M' may be used to fire up a slightly modified current playlist view. There
+;; is no difference to the default current playlist view other than that the tag
+;; 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
;; current playlist now modify the selected (stored) playlist. The list of
;; stored playlists is the only view in ampc that may have only one marked
;; entry.
+;;
+;; To queue a playlist, press `l' (ampc-load) or `<down-mouse-2>'. To delete a
+;; playlist, press `d' (ampc-delete-playlist) or `<down-mouse-3>'. The command
+;; `ampc-rename-playlist', bound to `r', can be used to rename a playlist.
+;;
+;; Again, the key `<' may be used to setup a playlist view with a different
+;; order of tag browsers.
;;; *** outputs view
;; The outputs view contains a single list which shows the configured outputs of
-;; mpd. To toggle the enabled property of the selected outputs, press `a'
-;; (ampc-toggle-output-enabled).
+;; MPD. To toggle the enabled property of the selected outputs, press `a'
+;; (ampc-toggle-output-enabled) or `<mouse-3>'.
;;; *** global keys
-;; ampc defines the following global keys, which may be used in every window
-;; associated with ampc:
+;; Aside from `J', `M', `K', `<' and `L', which may be used to select different
+;; views, ampc defines the following global keys, which may be used in every
+;; window associated with ampc:
;;
-;; `k' (ampc-toggle-play): Toggle play state. If mpd does not play a song
+;; `k' (ampc-toggle-play): Toggle play state. If MPD does not play a song
;; already, start playing the song at point if the current buffer is the
;; playlist buffer, otherwise start at the beginning of the playlist. With
;; prefix argument 4, stop player rather than pause if applicable.
;;
;; `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.
;;
;;
;; `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 predestinated
+;; to be bound in the global keymap. `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'.
+;;
+;; (global-set-key (kbd "<f7>")
+;; (lambda ()
+;; (interactive)
+;; (unless (ampc-on-p)
+;; (ampc nil nil t))
+;; (ampc-status)))
+;; (global-set-key (kbd "<f8>")
+;; (lambda ()
+;; (interactive)
+;; (unless (ampc-on-p)
+;; (ampc nil nil t))
+;; (ampc-mini)))
+
+;;; Code:
;;; * code
(eval-when-compile
(require 'easymenu)
(require 'avl-tree)
;;; ** declarations
-;;; *** variables
(defgroup ampc ()
"Asynchronous client for the Music Player Daemon."
:prefix "ampc-"
(defcustom ampc-debug nil
"Non-nil means log communication between ampc and MPD."
:type 'boolean)
+
(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 specifiying 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)
+ "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' to change the volume."
+ :type 'integer)
+
;;; **** hooks
(defcustom ampc-before-startup-hook nil
- "A hook called before startup.
+ "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 called after ampc connected to MPD."
+ "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 called when exiting ampc."
+ "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)
;;; *** faces
;;; *** internal variables
(defvar ampc-views
- (let ((rs '(1.0 vertical
- (0.7 horizontal
- (0.33 tag :tag "Genre" :id 1)
- (0.33 tag :tag "Artist" :id 2)
- (1.0 tag :tag "Album" :id 3))
- (1.0 song :properties (("Track" :title "#")
- ("Title" :offset 6)
- ("Time" :offset 26)))))
- (pl-prop '(("Title")
- ("Artist" :offset 20)
- ("Album" :offset 40)
- ("Time" :offset 60))))
- `((,(kbd "J")
+ (let* ((songs '(1.0 song :properties (("Track" :title "#" :width 4)
+ ("Title" :min 15 :max 40)
+ ("Time" :width 6))))
+ (rs_a `(1.0 vertical
+ (0.7 horizontal
+ (0.33 tag :tag "Genre" :id 1)
+ (0.33 tag :tag "Artist" :id 2)
+ (1.0 tag :tag "Album" :id 3))
+ ,songs))
+ (rs_b `(1.0 vertical
+ (0.7 horizontal
+ (0.33 tag :tag "Genre" :id 1)
+ (0.33 tag :tag "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)))))
+ `(("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 :properties ,pl-prop))
- ,rs)
- (,(kbd "K")
+ (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.8 playlist :properties ,pl-prop)
+ (0.8 playlist ,@pl-prop)
(1.0 playlists)))
- ,rs)
- (,(kbd "L")
- outputs :properties (("outputname" :title "Name")
- ("outputenabled" :title "Enabled" :offset 10))))))
+ ,rs_a)
+ ("Playlist view (Genre|Album|Artist)"
+ ,(kbd "<")
+ horizontal
+ (0.4 vertical
+ (6 status)
+ (1.0 vertical
+ (0.8 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-buffers-unordered nil)
(defvar ampc-all-buffers nil)
+(defvar ampc-tab-offsets nil)
+(make-variable-buffer-local 'ampc-tab-offsets)
+
(defvar ampc-type nil)
(make-variable-buffer-local 'ampc-type)
(defvar ampc-dirty nil)
(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 "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)
(loop for view in ampc-views
- do (define-key map (car view)
+ do (define-key map (cadr view)
`(lambda ()
(interactive)
- (ampc-configure-frame ',(cdr view)))))
+ (ampc-change-view ',view))))
map))
(defvar ampc-item-mode-map
(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 [remap next-line] 'ampc-next-line)
+ (define-key map [remap previous-line] 'ampc-previous-line)
+ (define-key map (kbd "<down-mouse-1>") 'ampc-mouse-toggle-mark)
+ (define-key map (kbd "<mouse-1>") 'ampc-mouse-align-point)
map))
(defvar ampc-current-playlist-mode-map
(let ((map (make-sparse-keymap)))
(suppress-keymap map)
(define-key map (kbd "<return>") 'ampc-play-this)
+ (define-key map (kbd "<down-mouse-2>") 'ampc-mouse-play-this)
+ (define-key map (kbd "<mouse-2>") 'ampc-mouse-align-point)
+ (define-key map (kbd "<down-mouse-3>") 'ampc-mouse-delete)
+ (define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
map))
(defvar ampc-playlist-mode-map
(define-key map (kbd "d") 'ampc-delete)
(define-key map (kbd "<up>") 'ampc-up)
(define-key map (kbd "<down>") 'ampc-down)
+ (define-key map (kbd "<down-mouse-3>") 'ampc-mouse-delete)
+ (define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
map))
(defvar ampc-playlists-mode-map
(define-key map (kbd "l") 'ampc-load)
(define-key map (kbd "r") 'ampc-rename-playlist)
(define-key map (kbd "d") 'ampc-delete-playlist)
+ (define-key map (kbd "<down-mouse-2>") 'ampc-mouse-load)
+ (define-key map (kbd "<mouse-2>") 'ampc-mouse-align-point)
+ (define-key map (kbd "<down-mouse-3>") 'ampc-mouse-delete-playlist)
+ (define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
map))
(defvar ampc-tag-song-mode-map
(suppress-keymap map)
(define-key map (kbd "t") 'ampc-toggle-marks)
(define-key map (kbd "a") 'ampc-add)
+ (define-key map (kbd "<down-mouse-3>") 'ampc-mouse-add)
+ (define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
map))
(defvar ampc-outputs-mode-map
(suppress-keymap map)
(define-key map (kbd "t") 'ampc-toggle-marks)
(define-key map (kbd "a") 'ampc-toggle-output-enabled)
+ (define-key map (kbd "<down-mouse-3>") 'ampc-mouse-toggle-output-enabled)
+ (define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
map))
;;; **** menu
-(easy-menu-define ampc-menu ampc-mode-map
- "Main Menu for ampc"
- '("ampc"
+(easy-menu-define nil ampc-mode-map nil
+ `("ampc"
+ ("Change view" ,@(loop for view in ampc-views
+ collect (vector (car view)
+ `(lambda ()
+ (interactive)
+ (ampc-change-view ',view)))))
+ "--"
["Play" ampc-toggle-play
:visible (and ampc-status
- (not (equal (cdr (assoc "state" ampc-status))"play")))]
+ (not (equal (cdr (assq 'state ampc-status)) "play")))]
["Pause" ampc-toggle-play
:visible (and ampc-status
- (equal (cdr (assoc "state" ampc-status)) "play"))]
+ (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]
"--"
["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]
- ["Toggle repeat" ampc-toggle-repeat]
- ["Toggle random" ampc-toggle-random]
- ["Toggle consume" ampc-toggle-consume]
+ ["Toggle repeat" ampc-toggle-repeat
+ :style toggle
+ :selected (equal (cdr-safe (assq 'repeat ampc-status)) "1")]
+ ["Toggle random" ampc-toggle-random
+ :style toggle
+ :selected (equal (cdr-safe (assq 'random ampc-status)) "1")]
+ ["Toggle consume" ampc-toggle-consume
+ :style toggle
+ :selected (equal (cdr-safe (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
["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)
`(let* ((type- ,type)
(b (loop for b in ampc-buffers
when (with-current-buffer b
- (cond ((windowp type-)
- (eq (window-buffer type-)
- (current-buffer)))
- ((symbolp type-)
- (eq (car ampc-type) type-))
- (t
- (equal ampc-type type-))))
+ (etypecase type-
+ (window
+ (eq (window-buffer type-)
+ (current-buffer)))
+ (symbol
+ (eq (car ampc-type) type-))))
return b
end)))
(when b
when (get-text-property (point) 'updated)
do (delete-region (point) (1+ (line-end-position)))
else
- do (forward-line nil)
+ do (add-text-properties
+ (+ (point) 2)
+ (progn (forward-line nil)
+ (1- (point)))
+ '(mouse-face highlight))
end)
(goto-char point)
(ampc-align-point))
do (save-excursion
,@body))
(loop until (eobp)
- for index from 0 to (1- (prefix-numeric-value arg-))
+ for index from 0 to (1- (if (numberp arg-)
+ arg-
+ (prefix-numeric-value arg-)))
do (save-excursion
(goto-char (line-end-position))
,@body)
(define-derived-mode ampc-item-mode ampc-mode ""
nil)
-(define-derived-mode ampc-mode fundamental-mode "ampc"
+(define-derived-mode ampc-mode special-mode "ampc"
nil
(buffer-disable-undo)
- (setf buffer-read-only t
- truncate-lines ampc-truncate-lines
+ (set (make-local-variable 'tool-bar-map) ampc-tool-bar-map)
+ (setf truncate-lines ampc-truncate-lines
font-lock-defaults '((("^\\(\\*\\)\\(.*\\)$"
(1 'ampc-mark-face)
(2 'ampc-marked-face))
(2 'ampc-current-song-marked-face)))))
;;; *** internal functions
+(defun ampc-change-view (view)
+ (if (equal ampc-outstanding-commands '((idle)))
+ (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 ()
+ (when (ampc-on-p)
+ ampc-type))
+
(defun ampc-add-impl (&optional data)
(cond ((null data)
(loop for d in (get-text-property (line-end-position) 'data)
(avl-tree-mapc (lambda (e) (ampc-add-impl (cdr e))) data))
((stringp data)
(if (ampc-playlist)
- (ampc-send-command 'playlistadd t (ampc-playlist) data)
- (ampc-send-command 'add t data)))
+ (ampc-send-command 'playlistadd
+ t
+ (ampc-quote (ampc-playlist))
+ data)
+ (ampc-send-command 'add t (ampc-quote data))))
(t
- (loop for d in data
+ (loop for d in (reverse data)
do (ampc-add-impl (cdr (assoc "file" d)))))))
-(defun* ampc-skip (N &aux (song (cdr-safe (assoc "song" ampc-status))))
- (when song
- (ampc-send-command 'play nil (max 0 (+ (string-to-number song) N)))))
+(defun* ampc-skip (N)
+ (ampc-send-command 'play
+ nil
+ (let ((N N))
+ (lambda ()
+ (let ((song (cdr-safe (assq 'song ampc-status))))
+ (unless song
+ (throw 'skip nil))
+ (max 0 (+ (string-to-number song) N))))))
+ (ampc-send-command 'currentsong))
(defun* ampc-find-current-song
- (limit &aux (point (point)) (song (cdr-safe (assoc "song" ampc-status))))
+ (limit &aux (point (point)) (song (cdr-safe (assq 'song ampc-status))))
(when (and song
(<= (1- (line-number-at-pos (point)))
(setf song (string-to-number song)))
(narrow-to-region (max point (point)) (min limit (line-end-position)))
(search-forward-regexp "\\(?1:\\(\\`\\*\\)?\\)\\(?2:.*\\)$"))))
-(defun ampc-set-volume (arg func)
- (when (or arg ampc-status)
+(defun ampc-setvol (arg &optional func)
+ (when ampc-status
+ (when arg
+ (setf arg (prefix-numeric-value arg)))
(ampc-send-command
'setvol
nil
- (or (and arg (prefix-numeric-value arg))
- (max (min (funcall func
+ (max (min (if func
+ (funcall func
(string-to-number
- (cdr (assoc "volume" ampc-status)))
- 5)
- 100)
- 0)))))
+ (cdr (assq 'volume ampc-status)))
+ (or arg ampc-volume-step))
+ arg)
+ 100)
+ 0))
+ (ampc-send-command 'status)))
(defun ampc-set-crossfade (arg func)
(when (or arg ampc-status)
nil
(or (and arg (prefix-numeric-value arg))
(max (funcall func
- (string-to-number (cdr (assoc "xfade" ampc-status)))
+ (string-to-number (cdr (assq 'xfade ampc-status)))
5)
0)))))
(if (ampc-playlist)
(ampc-send-command 'playlistmove
nil
- (ampc-playlist)
+ (ampc-quote (ampc-playlist))
line
(funcall (if up '1- '1+)
line))
state
nil
(cond ((null arg)
- (if (equal (cdr (assoc (symbol-name state) ampc-status)) "1")
+ (if (equal (cdr (assq state ampc-status)) "1")
0
1))
((> (prefix-numeric-value arg) 0) 1)
(t 0)))))
-(defun ampc-playlist ()
+(defun ampc-playlist (&optional at-point)
(ampc-with-buffer 'playlists
- (if (search-forward-regexp "^* \\(.*\\)$" nil t)
+ (if (and (not at-point)
+ (search-forward-regexp "^* \\(.*\\)$" nil t))
(match-string 1)
(unless (eobp)
(buffer-substring-no-properties
end)
(ampc-fill-tag-song))))
-(defun ampc-pad (alist)
- (loop for (offset . data) in alist
+(defun ampc-align-point ()
+ (unless (eobp)
+ (move-beginning-of-line nil)
+ (forward-char 2)))
+
+(defun* ampc-pad (tabs &optional (sub 0))
+ (loop for tab in tabs
+ for offset in ampc-tab-offsets
+ do (setf offset (- offset sub))
with first = t
with current-offset = 0
when (<= current-offset offset)
concat " "
and do (incf current-offset)
end
- concat data
- do (setf current-offset (+ current-offset (length data))
- first nil)))
+ concat tab
+ do (incf current-offset (length tab))
+ (setf first nil)))
(defun ampc-update-header ()
- (if (eq (car ampc-type) 'status)
- (setf header-line-format nil)
- (setf header-line-format
+ (setf header-line-format
+ (unless (eq (car ampc-type) 'status)
(concat
+ (when ampc-dirty
+ " [ Updating... ]")
(make-string (floor (fringe-columns 'left t)) ? )
(ecase (car ampc-type)
(tag
" Playlists")
(t
(ampc-pad (loop for p in (plist-get (cdr ampc-type) :properties)
- collect `(,(or (plist-get (cdr p) :offset) 2) .
- ,(or (plist-get (cdr p) :title)
- (car p)))))))
- (when ampc-dirty
- " [ Updating... ]")))))
+ collect (or (plist-get (cdr p) :title)
+ (car p))))))))))
(defun ampc-set-dirty (tag-or-dirty &optional dirty)
(if (or (null tag-or-dirty) (eq tag-or-dirty t))
(ampc-set-dirty dirty))))))
(defun ampc-update ()
- (loop for b in ampc-buffers
- do (with-current-buffer b
- (when ampc-dirty
- (ecase (car ampc-type)
- (outputs
- (ampc-send-command 'outputs))
- (playlist
- (ampc-update-playlist))
- ((tag song)
- (if ampc-internal-db
- (ampc-fill-tag-song)
- (ampc-send-command 'listallinfo)))
- (status
- (ampc-send-command 'status)
- (ampc-send-command 'currentsong))
- (playlists
- (ampc-send-command 'listplaylists))
- (current-playlist
- (ampc-send-command 'playlistinfo)))))))
+ (if ampc-status
+ (loop for b in ampc-buffers
+ do (with-current-buffer b
+ (when ampc-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 `(,(ampc-tags) . nil) ampc-internal-db)
+ (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
nil
(get-text-property (point) 'data))
(ampc-with-buffer 'playlist
- (delete-region (point-min) (point-max))
+ (erase-buffer)
(ampc-set-dirty nil)))))
(defun ampc-send-command-impl (command)
(when ampc-debug
- (message (concat "ampc: " command)))
+ (message "ampc: -> %s" command))
(process-send-string ampc-connection (concat command "\n")))
(defun ampc-send-command (command &optional unique &rest args)
(setf ampc-outstanding-commands
(nconc (if unique
ampc-outstanding-commands
- (remove command ampc-outstanding-commands))
+ (delete command ampc-outstanding-commands))
`(,command))))
(defun ampc-send-next-command ()
+ (loop while ampc-outstanding-commands
+ for command = (replace-regexp-in-string
+ "^.*?-" ""
+ (symbol-name (caar ampc-outstanding-commands)))
+ do
+ (loop until (catch 'skip
+ (ampc-send-command-impl
+ (concat command
+ (loop for a in (cdar ampc-outstanding-commands)
+ concat " "
+ do (when (functionp a)
+ (setf a (funcall a)))
+ concat (typecase a
+ (integer (number-to-string a))
+ (t a)))))
+ t)
+ do (pop ampc-outstanding-commands))
+ while (and ampc-outstanding-commands (not (eq (intern command) 'idle)))
+ while
+ (let ((member (member (intern command) ampc-synchronous-commands)))
+ (when (or (and (not (eq (car ampc-synchronous-commands) t)) member)
+ (and (eq (car ampc-synchronous-commands) t) (not member)))
+ (loop with head = ampc-outstanding-commands
+ with ampc-no-implicit-next-dispatch = t
+ while (eq head ampc-outstanding-commands)
+ do (accept-process-output ampc-connection 0 100))
+ t)))
(unless ampc-outstanding-commands
- (ampc-send-command 'idle))
- (ampc-send-command-impl (concat (symbol-name (caar ampc-outstanding-commands))
- (loop for a in
- (cdar ampc-outstanding-commands)
- concat " "
- concat (cond ((integerp a)
- (number-to-string a))
- (t a))))))
+ (ampc-send-command 'idle)
+ (ampc-send-next-command)))
(defun ampc-tree< (a b)
- (not (string< (if (listp a) (car a) a) (if (listp b) (car b) b))))
+ (string< (car a) (car b)))
(defun ampc-create-tree ()
(avl-tree-create 'ampc-tree<))
(insert element "\n")
(put-text-property start (point) 'data (if (eq cmp t)
`(,data)
- data)))
- nil)
- (update t
- (remove-text-properties (point) (1+ (point)) '(updated))
- (equal (buffer-substring (point) (1+ (point))) "*")))))
+ data))))
+ (update
+ (remove-text-properties (point) (1+ (point)) '(updated))
+ (equal (buffer-substring (point) (1+ (point))) "*")))))
(defun ampc-fill-tag (trees)
(put-text-property (point-min) (point-max) 'data nil)
(loop with new-trees
finally return new-trees
for tree in trees
+ when tree
do (avl-tree-mapc (lambda (e)
(when (ampc-insert (car e) (cdr e) t)
(push (cdr e) new-trees)))
- tree)))
+ tree)
+ end))
(defun ampc-fill-song (trees)
(loop
do (ampc-insert
(ampc-pad
(loop for (p . v) in (plist-get (cdr ampc-type) :properties)
- collect `(,(- (or (plist-get v :offset) 2) 2)
- . ,(or (cdr-safe (assoc p song)) ""))))
+ collect (or (cdr-safe (assoc p song)) ""))
+ 2)
`((,song))))))
-(defun* ampc-narrow-entry (&optional (delimiter "file"))
- (narrow-to-region (move-beginning-of-line nil)
- (or (progn (goto-char (line-end-position))
- (when (search-forward-regexp
- (concat "^" (regexp-quote delimiter) ": ")
- nil
- t)
- (move-beginning-of-line nil)
- (1- (point))))
- (point-max))))
+(defun* ampc-narrow-entry (&optional (delimiter "file") &aux result)
+ (narrow-to-region
+ (move-beginning-of-line nil)
+ (or (progn (goto-char (line-end-position))
+ (when (setf result (search-forward-regexp
+ (concat "^" (regexp-quote delimiter) ": ")
+ nil
+ t))
+ (move-beginning-of-line nil)
+ (1- (point))))
+ (point-max)))
+ result)
(defun ampc-get-window (type)
(loop for w in (ampc-windows)
(with-current-buffer data-buffer
(loop
for i from 0
- while (search-forward-regexp "^file: " nil t)
+ with next
+ while (or (when next (goto-char next) t)
+ (search-forward-regexp "^file: " nil t))
do (save-restriction
- (ampc-narrow-entry)
+ (setf next (ampc-narrow-entry))
(let ((file (ampc-extract "file"))
- (text
- (ampc-pad
- (loop for (tag . tag-properties) in properties
- collect `(,(- (or (plist-get tag-properties
- :offset)
- 2)
- 2)
- . ,(ampc-extract tag))))))
+ (pad-data (loop for (tag . tag-properties) in properties
+ collect (or (ampc-extract tag)
+ "[Not Specified]"))))
(ampc-with-buffer 'playlist
- (ampc-insert text
+ (ampc-insert (ampc-pad pad-data 2)
`(("file" . ,file)
(index . ,i))
(lambda (a b)
(setf properties (plist-get (cdr ampc-type) :properties))
(with-current-buffer data-buffer
(loop
- while (search-forward-regexp "^outputid: " nil t)
+ with next
+ while (or (when next (goto-char next) t)
+ (search-forward-regexp "^outputid: " nil t))
do (save-restriction
- (ampc-narrow-entry "outputid")
+ (setf next (ampc-narrow-entry "outputid"))
(let ((outputid (ampc-extract "outputid"))
- (outputenabled (ampc-extract "outputenabled"))
- (text
- (ampc-pad
- (loop for (tag . tag-properties) in properties
- collect `(,(- (or (plist-get tag-properties :offset)
- 2)
- 2)
- . ,(ampc-extract tag))))))
+ (outputenabled (ampc-extract "outputenabled")))
(ampc-with-buffer 'outputs
- (ampc-insert text `(("outputid" . ,outputid)
- ("outputenabled" . ,outputenabled))))))))))
+ (ampc-insert (ampc-pad
+ (loop for (tag . tag-properties) in properties
+ collect (with-current-buffer data-buffer
+ (ampc-extract tag)))
+ 2)
+ `(("outputid" . ,outputid)
+ ("outputenabled" . ,outputenabled))))))))))
+
+(defun* ampc-mini-impl (&aux songs)
+ (loop with next
+ while (or (when next (goto-char next) t)
+ (search-forward-regexp "^file: " nil t))
+ for entry = (save-restriction
+ (setf next (ampc-narrow-entry))
+ `(,(concat (ampc-extract "Title") " - "
+ (ampc-extract "Artist"))
+ . ,(string-to-number (ampc-extract "Pos"))))
+ do (loop with mentry = `(,(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 (&aux properties)
(ampc-fill-skeleton 'current-playlist
(setf properties (plist-get (cdr ampc-type) :properties))
(with-current-buffer data-buffer
(loop
- while (search-forward-regexp "^file: " nil t)
+ with next
+ while (or (when next (goto-char next) t)
+ (search-forward-regexp "^file: " nil t))
do (save-restriction
- (ampc-narrow-entry)
+ (setf next (ampc-narrow-entry))
(let ((file (ampc-extract "file"))
- (pos (ampc-extract "Pos"))
- (text
- (ampc-pad
- (loop for (tag . tag-properties) in properties
- collect `(,(- (or (plist-get tag-properties :offset)
- 2)
- 2)
- . ,(ampc-extract tag))))))
+ (pos (ampc-extract "Pos")))
(ampc-with-buffer 'current-playlist
- (ampc-insert text
- `(("file" . ,file)
- ("Pos" . ,(string-to-number pos)))
- (lambda (a b)
- (let ((p1 (cdr (assoc "Pos" a)))
- (p2 (cdr (assoc "Pos" b))))
- (cond ((< p1 p2) 'insert)
- ((eq p1 p2)
- (if (equal (cdr (assoc "file" a))
- (cdr (assoc "file" b)))
- 'update
- 'insert))
- (t (- p1 p2)))))))))))))
+ (ampc-insert
+ (ampc-pad
+ (loop for (tag . tag-properties) in properties
+ collect (or (with-current-buffer data-buffer
+ (ampc-extract tag))
+ "[Not Specified]"))
+ 2)
+ `(("file" . ,file)
+ ("Pos" . ,(string-to-number pos)))
+ (lambda (a b)
+ (let ((p1 (cdr (assoc "Pos" a)))
+ (p2 (cdr (assoc "Pos" b))))
+ (cond ((< p1 p2) 'insert)
+ ((eq p1 p2)
+ (if (equal (cdr (assoc "file" a))
+ (cdr (assoc "file" b)))
+ 'update
+ 'insert))
+ (t (- p1 p2)))))))))))))
(defun ampc-fill-playlists ()
(ampc-fill-skeleton 'playlists
(ampc-insert playlist playlist))))))
(defun ampc-yield ()
- (setf ampc-yield (1+ ampc-yield))
- (ampc-fill-status))
+ (incf ampc-yield)
+ (ampc-fill-status)
+ (redisplay t))
(defun ampc-fill-status ()
(ampc-with-buffer 'status
- (delete-region (point-min) (point-max))
+ (erase-buffer)
(funcall (or (plist-get (cadr ampc-type) :filler)
- 'ampc-fill-status-default))
+ (lambda (_)
+ (insert (ampc-status t) "\n")))
+ ampc-status)
(ampc-set-dirty nil)))
-(defun ampc-fill-status-default ()
- (let ((flags (mapconcat
- 'identity
- (loop for (f . n) in '(("repeat" . "Repeat")
- ("random" . "Random")
- ("consume" . "Consume"))
- when (equal (cdr (assoc f ampc-status)) "1")
- collect n
- end)
- "|"))
- (state (cdr (assoc "state" ampc-status))))
- (insert (concat "State: " state
- (when ampc-yield
- (concat (make-string (- 10 (length state)) ? )
- (ecase (% ampc-yield 4)
- (0 "|")
- (1 "/")
- (2 "-")
- (3 "\\"))))
- "\n"
- (when (equal state "play")
- (concat "Playing: "
- (cdr (assoc "Artist" ampc-status))
- " - "
- (cdr (assoc "Title" ampc-status))
- "\n"))
- "Volume: " (cdr (assoc "volume" ampc-status)) "\n"
- "Crossfade: " (cdr (assoc "xfade" ampc-status)) "\n"
- (unless (equal flags "")
- (concat flags "\n"))))))
-
(defun ampc-fill-tag-song ()
(loop
- with trees = `(,ampc-internal-db)
+ with trees = `(,(cdr (assoc (ampc-tags) ampc-internal-db)))
for w in (ampc-windows)
do
(ampc-with-buffer w
(or (> version-a 0)
(>= version-b 15))))
(error (concat "Your version of MPD is not supported. "
- "ampc supports MPD 0.15.0 and later"))))
-
-(defun ampc-fill-internal-db ()
- (setf ampc-internal-db (ampc-create-tree))
- (loop while (search-forward-regexp "^file: " nil t)
+ "ampc supports MPD (protocol version) 0.15.0 "
+ "and later"))))
+
+(defun ampc-fill-internal-db (running)
+ (loop for origin = (and (search-forward-regexp "^file: " nil t)
+ (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
- (ampc-narrow-entry)
- (ampc-fill-internal-db-entry)))
- (ampc-fill-tag-song))
+ (narrow-to-region origin (or next (point-max)))
+ (ampc-fill-internal-db-entry))
+ do (when running
+ (delete-region origin next)
+ (setf next origin))))
+
+(defun ampc-tags ()
+ (loop for w in (ampc-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 ()
(loop
with data-buffer = (current-buffer)
- with tree = `(nil . ,ampc-internal-db)
+ with tree = (assoc (ampc-tags) ampc-internal-db)
for w in (ampc-windows)
do
(with-current-buffer (window-buffer w)
(ampc-set-dirty t)
(ecase (car ampc-type)
(tag
- (let* ((data (ampc-extract (cdr ampc-type) data-buffer))
- (member (and (cdr tree) (avl-tree-member (cdr tree) data))))
- (assert data)
- (cond (member (setf tree member))
- ((cdr tree)
- (setf member `(,data . nil))
- (avl-tree-enter (cdr tree) member)
- (setf tree member))
- (t
- (setf (cdr tree) (ampc-create-tree) member`(,data . nil))
- (avl-tree-enter (cdr tree) member)
- (setf tree member)))))
+ (let ((data (or (ampc-extract (cdr ampc-type) data-buffer)
+ "[Not Specified]")))
+ (unless (cdr tree)
+ (setf (cdr tree) (ampc-create-tree)))
+ (setf tree (avl-tree-enter (cdr tree)
+ `(,data . nil)
+ (lambda (data match)
+ match)))))
(song
(push (loop for p in `(("file")
,@(plist-get (cdr ampc-type) :properties))
(return))))))
(defun ampc-handle-current-song ()
- (loop for k in '("Artist" "Title")
+ (loop for k in (append ampc-status-tags '("Artist" "Title"))
for s = (ampc-extract k)
when s
- do (push `(,k . ,s) ampc-status)
+ do (push `(,(intern k) . ,s) ampc-status)
end)
- (ampc-fill-status))
+ (ampc-fill-status)
+ (run-hook-with-args ampc-status-changed-hook ampc-status))
(defun ampc-handle-status ()
(loop for k in '("volume" "repeat" "random" "consume" "xfade" "state" "song")
for v = (ampc-extract k)
when v
- do (push `(,k . ,v) ampc-status)
+ do (push `(,(intern k) . ,v) ampc-status)
end)
(ampc-with-buffer 'current-playlist
(when ampc-highlight-current-song-mode
(message "Database update started"))
(defun ampc-handle-command (status)
- (if (eq status 'error)
- (pop ampc-outstanding-commands)
+ (cond
+ ((eq status 'error)
+ (pop ampc-outstanding-commands))
+ ((eq status 'running)
+ (case (caar ampc-outstanding-commands)
+ (listallinfo (ampc-fill-internal-db t))))
+ (t
(case (car (pop ampc-outstanding-commands))
(idle
(ampc-handle-idle))
(ampc-fill-playlists))
(playlistinfo
(ampc-fill-current-playlist))
+ (mini-playlistinfo
+ (ampc-mini-impl))
+ (mini-currentsong
+ (ampc-status))
(listallinfo
- (ampc-fill-internal-db))
+ (ampc-fill-internal-db nil))
(outputs
- (ampc-fill-outputs))))
- (unless ampc-outstanding-commands
- (ampc-update))
- (ampc-send-next-command))
+ (ampc-fill-outputs)))
+ (unless ampc-outstanding-commands
+ (ampc-update)))))
(defun ampc-filter (_process string)
(assert (buffer-live-p (process-buffer ampc-connection)))
(with-current-buffer (process-buffer ampc-connection)
(when string
(when ampc-debug
- (message "ampc: -> %s" string))
+ (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))
- (when (or (and (search-forward-regexp
- "^ACK \\[\\(.*\\)\\] {.*} \\(.*\\)\n\\'"
- nil
- t)
- (message "ampc command error: %s (%s)"
- (match-string 2)
- (match-string 1))
- t)
- (and (search-forward-regexp "^OK\\(.*\\)\n\\'" nil t)
- (setf success t)))
- (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)))))))
+ (if (or (progn
+ (when (search-forward-regexp
+ "^ACK \\[\\(.*\\)\\] {.*} \\(.*\\)\n\\'"
+ nil
+ t)
+ (message "ampc command error: %s (%s)"
+ (match-string 2)
+ (match-string 1))
+ t))
+ (and (search-forward-regexp "^OK\\(.*\\)\n\\'" nil t)
+ (setf success t)))
+ (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)))))
;;; **** window management
(defun ampc-windows (&optional unordered)
(loop for f being the frame
thereis (loop for w being the windows of f
- when (eq (window-buffer w) (car ampc-buffers))
+ when (eq (window-buffer w) (car-safe ampc-buffers))
return (loop for b in (if unordered
ampc-buffers-unordered
ampc-buffers)
b)
w))))))
+(defun* ampc-set-tab-offsets
+ (&rest properties &aux (min 2) (optional-padding 0))
+ (loop for (title . props) in properties
+ for min- = (plist-get props :min)
+ do (incf min (or (plist-get props :width) min-))
+ when min-
+ do (incf optional-padding (- (plist-get props :max) min-))
+ end)
+ (setf ampc-tab-offsets nil)
+ (loop for (title . props) in properties
+ with offset = 2
+ do (add-to-list 'ampc-tab-offsets offset t)
+ (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)))))))))))
+
(defun* ampc-configure-frame-1 (split &aux (split-type (car split)))
(if (member split-type '(vertical horizontal))
(let* ((sizes))
(window-height))
with rest = length
with rest-car
- for subsplit in (cdr split)
- for s = (car subsplit)
- if (equal s 1.0)
+ for (size . subsplit) in (cdr split)
+ if (equal size 1.0)
do (push t sizes)
and do (setf rest-car sizes)
else
- do (let ((l (if (integerp s) s (floor (* s length)))))
+ do (let ((l (if (integerp size) size (floor (* size length)))))
(setf rest (- rest l))
(push l sizes))
finally do (setf (car rest-car) rest))
(status
(pop-to-buffer-same-window (get-buffer-create "*ampc Status*"))
(ampc-mode)))
- (destructuring-bind (&key (dedicated t) (mode-line t) &allow-other-keys)
+ (destructuring-bind
+ (&key (properties nil) (dedicated t) (mode-line t) &allow-other-keys)
(cdr split)
- (setf (window-dedicated-p (selected-window)) dedicated)
- (unless mode-line
- (setf mode-line-format nil)))
- (setf ampc-type split)
+ (if properties
+ (apply 'ampc-set-tab-offsets properties)
+ (setf ampc-tab-offsets '(2)))
+ (setf ampc-type split
+ (window-dedicated-p (selected-window)) dedicated
+ mode-line-format (when mode-line
+ (default-value 'mode-line-format))))
(add-to-list 'ampc-all-buffers (current-buffer))
(push `(,(or (plist-get (cdr split) :id)
(if (eq (car ampc-type) 'song) 9998 9999))
(delete-other-windows))
(loop with live-window = nil
for w in (nreverse (ampc-windows t))
- if (window-live-p w)
- if (not live-window)
- do (setf live-window w)
- else
- do (delete-window w)
- end
- end
+ do (when (window-live-p w)
+ (if (not live-window)
+ (setf live-window w)
+ (delete-window w)))
finally do (if live-window (select-window live-window))))
(setf ampc-buffers nil)
(ampc-configure-frame-1 split)
(setf ampc-buffers-unordered (mapcar 'cdr ampc-buffers)
ampc-buffers (mapcar 'cdr (sort ampc-buffers
(lambda (a b) (< (car a) (car b))))))
+ ;; fill the song, current-playlist and outputs buffers again as the tab
+ ;; offsets might have changed
+ (ampc-with-buffer 'song
+ (erase-buffer))
+ (ampc-with-buffer 'current-playlist
+ (erase-buffer))
+ (ampc-with-buffer 'outputs
+ (erase-buffer))
(ampc-update))
+(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 buffer-read-only)
+ (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))
+
;;; *** interactives
(defun* ampc-unmark-all (&aux buffer-read-only)
"Remove all marks."
(interactive)
+ (assert (ampc-in-ampc-p))
(save-excursion
(goto-char (point-min))
(loop while (search-forward-regexp "^\\* " nil t)
(defun ampc-trigger-update ()
"Trigger a database update."
(interactive)
+ (assert (ampc-on-p))
(ampc-send-command 'update))
(defun* ampc-toggle-marks (&aux buffer-read-only)
"Toggle marks. Marked entries become unmarked, and vice versa."
(interactive)
+ (assert (ampc-in-ampc-p))
(save-excursion
(loop for (a . b) in '(("* " . "T ")
(" " . "* ")
With optional prefix ARG, move the next ARG entries after point
rather than the selection."
(interactive "P")
+ (assert (ampc-in-ampc-p))
(ampc-move t arg))
(defun ampc-down (&optional arg)
With optional prefix ARG, move the next ARG entries after point
rather than the selection."
(interactive "P")
+ (assert (ampc-in-ampc-p))
(ampc-move nil arg))
(defun ampc-mark (&optional arg)
"Mark the next ARG'th entries.
ARG defaults to 1."
(interactive "p")
+ (assert (ampc-in-ampc-p))
(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))
(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-setvol (or arg (read-number "Volume: "))))
+
(defun ampc-increase-volume (&optional arg)
- "Decrease volume.
-With prefix argument ARG, set volume to ARG percent."
+ "Increase volume by prefix argument ARG or, if ARG is nil,
+`ampc-volume-step'."
(interactive "P")
- (ampc-set-volume arg '+))
+ (assert (ampc-on-p))
+ (ampc-setvol arg '+))
(defun ampc-decrease-volume (&optional arg)
- "Decrease volume.
-With prefix argument ARG, set volume to ARG percent."
+ "Decrease volume by prefix argument ARG or, if ARG is nil,
+`ampc-volume-step'."
(interactive "P")
- (ampc-set-volume arg '-))
+ (assert (ampc-on-p))
+ (ampc-setvol arg '-))
(defun ampc-increase-crossfade (&optional arg)
"Increase crossfade.
With prefix argument ARG, set crossfading to ARG seconds."
(interactive "P")
+ (assert (ampc-on-p))
(ampc-set-crossfade arg '+))
(defun ampc-decrease-crossfade (&optional arg)
"Decrease crossfade.
With prefix argument ARG, set crossfading to ARG seconds."
(interactive "P")
+ (assert (ampc-on-p))
(ampc-set-crossfade arg '-))
(defun ampc-toggle-repeat (&optional arg)
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)
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)
(interactive "P")
(ampc-toggle-state 'random arg))
-(defun ampc-play-this ()
- "Play selected song."
- (interactive)
- (unless (eobp)
- (ampc-send-command 'play nil (1- (line-number-at-pos)))
+(defun ampc-play-this (&optional arg)
+ "Play selected song.
+With prefix argument ARG, play the ARG'th song located at the
+zero-indexed position of the current playlist."
+ (interactive "P")
+ (assert (and (ampc-on-p) (or arg (ampc-in-ampc-p))))
+ (if (not arg)
+ (unless (eobp)
+ (ampc-send-command 'play nil (1- (line-number-at-pos)))
+ (ampc-send-command 'pause nil 0))
+ (ampc-send-command 'play nil arg)
(ampc-send-command 'pause nil 0)))
(defun* ampc-toggle-play
- (&optional arg &aux (state (cdr-safe (assoc "state" ampc-status))))
+ (&optional arg &aux (state (cdr-safe (assq 'state ampc-status))))
"Toggle play state.
-If mpd does not play a song already, start playing the song at
+If MPD does not play a song already, start playing the song at
point if the current buffer is the playlist buffer, otherwise
start at the beginning of the playlist.
If ARG is 4, stop player rather than pause if applicable."
(interactive "P")
+ (assert (ampc-on-p))
(when state
(when arg
(setf arg (prefix-numeric-value arg)))
"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.
Interactively, read NEW-NAME from the minibuffer."
(interactive "MNew name: ")
+ (assert (ampc-in-ampc-p))
(if (ampc-playlist)
(ampc-send-command 'rename nil (ampc-playlist) new-name)
(error "No playlist selected")))
-(defun ampc-load ()
- "Load selected playlist in the current playlist."
+(defun ampc-load (&optional at-point)
+ "Load selected playlist in the current playlist.
+If optional argument AT-POINT is non-nil (or if no playlist is
+selected), use playlist at point rather than the selected one."
(interactive)
- (if (ampc-playlist)
- (ampc-send-command 'load nil (ampc-playlist))
- (error "No playlist selected")))
+ (assert (ampc-in-ampc-p))
+ (if (ampc-playlist at-point)
+ (ampc-send-command 'load nil (ampc-quote (ampc-playlist at-point)))
+ (if at-point
+ (error "No playlist at point")
+ (error "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")
(defun ampc-delete (&optional arg)
"Delete the next ARG songs from the playlist.
-If ARG is omitted, use the selected entries."
+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 ((point (point)))
(ampc-with-selection arg
(let ((val (1- (- (line-number-at-pos) index))))
(if (ampc-playlist)
- (ampc-send-command 'playlistdelete t (ampc-playlist) val)
+ (ampc-send-command 'playlistdelete
+ t
+ (ampc-quote (ampc-playlist))
+ val)
(ampc-send-command 'delete t val))))
(goto-char point)
(ampc-align-point)))
-(defun ampc-align-point ()
- (unless (eobp)
- (move-beginning-of-line nil)
- (forward-char 2)))
-
(defun ampc-shuffle ()
"Shuffle playlist."
(interactive)
+ (assert (ampc-on-p))
(if (not (ampc-playlist))
(ampc-send-command 'shuffle)
(ampc-with-buffer 'playlist
(defun ampc-clear ()
"Clear playlist."
(interactive)
+ (assert (ampc-on-p))
(if (ampc-playlist)
- (ampc-send-command 'playlistclear nil (ampc-playlist))
+ (ampc-send-command 'playlistclear nil (ampc-quote (ampc-playlist)))
(ampc-send-command 'clear)))
(defun ampc-add (&optional arg)
- "Add the next ARG songs associated with the entries after point
+ "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-delete-playlist ()
- "Delete selected playlist."
+(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 t)
+ (ampc-send-command 'mini-currentsong t)
+ (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: "
+ (or (cdr-safe (assq 'Artist ampc-status))
+ "[Not Specified]")
+ " - "
+ (or (cdr-safe (assq 'Title ampc-status))
+ "[Not Specified]")
+ "\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)
- (ampc-with-selection nil
- (let ((name (get-text-property (point) 'data)))
- (when (y-or-n-p (concat "Delete playlist " name "?"))
- (ampc-send-command 'rm nil name)))))
+ (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 nil (ampc-quote (ampc-playlist at-point))))
+ (if at-point
+ (error "No playlist at point")
+ (error "No playlist selected"))))
(defun ampc-store (name)
"Store current playlist as NAME.
Interactively, read NAME from the minibuffer."
(interactive "MSave playlist as: ")
- (ampc-send-command 'save nil name))
+ (assert (ampc-in-ampc-p))
+ (ampc-send-command 'save nil (ampc-quote name)))
(defun* ampc-goto-current-song
- (&aux (song (cdr-safe (assoc "song" ampc-status))))
+ (&aux (song (cdr-safe (assq 'song ampc-status))))
"Select the current playlist window and move point to the current song."
(interactive)
- (when song
- (ampc-with-buffer 'current-playlist
- no-se
- (select-window (ampc-get-window 'current-playlist))
+ (assert (ampc-in-ampc-p))
+ (ampc-with-buffer 'current-playlist
+ no-se
+ (select-window (ampc-get-window 'current-playlist))
+ (when song
(goto-char (point-min))
- (forward-line (string-to-number song))
- (ampc-align-point))))
+ (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))
(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))
(forward-line arg)
(if (eobp)
(progn (forward-line -1)
(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))
+ (loop with found-window
+ for w in (nreverse (ampc-windows t))
+ do (when (window-live-p w)
+ (if found-window
+ (delete-window w)
+ (setf found-window t
+ (window-dedicated-p w) nil))))
+ (loop for b in ampc-all-buffers
+ do (when (buffer-live-p b)
+ (kill-buffer b)))
+ (setf ampc-buffers 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 t))
+
(defun ampc-quit (&optional arg)
"Quit ampc.
-If called with a prefix argument ARG, kill the mpd instance that
+If called with a prefix argument ARG, kill the MPD instance that
ampc is connected to."
(interactive "P")
- (when (and ampc-connection (member (process-status ampc-connection)
- '(open run)))
+ (when (ampc-on-p)
(set-process-filter ampc-connection nil)
(when (equal (car-safe ampc-outstanding-commands) '(idle))
(ampc-send-command-impl "noidle")
(ampc-send-command-impl (if arg "kill" "close")))
(when ampc-working-timer
(cancel-timer ampc-working-timer))
- (loop with found-window
- for w in (nreverse (ampc-windows t))
- when (window-live-p w)
- when found-window
- do (delete-window w)
- else
- do (setf found-window t
- (window-dedicated-p w) nil)
- end
- end)
- (loop for b in ampc-all-buffers
- when (buffer-live-p b)
- do (kill-buffer b)
- end)
+ (ampc-suspend nil)
(setf ampc-connection nil
- ampc-buffers nil
- ampc-all-buffers nil
ampc-internal-db nil
- ampc-working-timer nil
ampc-outstanding-commands nil
ampc-status nil)
(run-hooks 'ampc-quit-hook))
;;;###autoload
-(defun ampc (&optional host port)
+(defun ampc-suspended-p ()
+ "Return non-nil if ampc is suspended."
+ (interactive)
+ (and (ampc-on-p)
+ (not ampc-buffers)))
+
+;;;###autoload
+(defun ampc-on-p ()
+ "Return non-nil if ampc is connected to the daemon."
+ (interactive)
+ (and ampc-connection (memq (process-status ampc-connection) '(open run))))
+
+;;;###autoload
+(defun ampc (&optional host port suspend)
"ampc is an asynchronous client for the MPD media player.
This function is the main entry point for ampc.
-Non-interactively, HOST and PORT specify the MPD instance to
-connect to. The values default to localhost:6600."
- (interactive "MHost (localhost): \nMPort (6600): ")
- (when ampc-connection
- (ampc-quit))
+HOST and PORT specify the MPD instance to connect to. The values
+default to the ones specified in `ampc-default-server'."
+ (interactive)
+ (unless (byte-code-function-p (symbol-function 'ampc))
+ (message "You should byte-compile ampc"))
(run-hooks 'ampc-before-startup-hook)
- (when (equal host "")
- (setf host nil))
- (when (equal port "")
- (setf port nil))
- (let ((connection (open-network-stream "ampc"
- (with-current-buffer
- (get-buffer-create " *mpc*")
- (delete-region (point-min)
- (point-max))
- (current-buffer))
- (or host "localhost")
- (or port 6600)
- :type 'plain :return-list t)))
- (unless (car connection)
- (error "Failed connecting to server: %s"
- (plist-get ampc-connection :error)))
- (setf ampc-connection (car connection)))
- (setf ampc-outstanding-commands '((setup)))
- (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)
- (ampc-configure-frame (cdar ampc-views))
+ (unless host
+ (setf host (or (car ampc-default-server)
+ (read-string "Host: "))))
+ (unless port
+ (setf port (or (cdr ampc-default-server)
+ (read-string "Port: "))))
+ (when (and ampc-connection
+ (or (not (equal host ampc-host))
+ (not (equal port ampc-port))
+ (not (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 (cddar ampc-views)))
(run-hooks 'ampc-connected-hook)
+ (when suspend
+ (ampc-suspend))
(ampc-filter (process-buffer ampc-connection) nil))
(provide 'ampc)