code.delx.au - gnu-emacs-elpa/blob - ampc.el

   1 ;;; ampc.el --- Asynchronous Music Player Controller
   2
   3 ;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
   4
   5 ;; Author: Christopher Schmidt <christopher@ch.ristopher.com>
   6 ;; Maintainer: Christopher Schmidt <christopher@ch.ristopher.com>
   7 ;; Version: 0.1.3
   8 ;; Created: 2011-12-06
   9 ;; Keywords: ampc, mpc, mpd
  10 ;; Compatibility: GNU Emacs: 24.x
  11
  12 ;; This file is part of ampc.
  13
  14 ;; This program is free software; you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation, either version 3 of the License, or
  17 ;; (at your option) any later version.
  18
  19 ;; This program is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  26
  27 ;;; Commentary:
  28 ;;; * description
  29 ;; ampc is a controller for the Music Player Daemon (http://mpd.wikia.com/).
  30
  31 ;;; ** installation
  32 ;; If you use GNU ELPA, install ampc via M-x package-list-packages RET or
  33 ;; (package-install 'ampc).  Otherwise, grab this file and put it somewhere in
  34 ;; your load-path or add the directory the file is in to it, e.g.:
  35 ;;
  36 ;; (add-to-list 'load-path "~/.emacs.d/ampc")
  37 ;;
  38 ;; Then add one autoload definition:
  39 ;;
  40 ;; (autoload 'ampc "ampc" nil t)
  41 ;;
  42 ;; Optionally bind a key to this function, e.g.:
  43 ;;
  44 ;; (global-set-key (kbd "<f9>") 'ampc)
  45 ;;
  46 ;; or
  47 ;;
  48 ;; (global-set-key (kbd "<f9>") (lambda () (interactive) (ampc "host" "port")))
  49 ;;
  50 ;; Byte-compile ampc (M-x byte-compile-file RET /path/to/ampc.el RET) to improve
  51 ;; its performance!
  52
  53 ;;; ** usage
  54 ;; To invoke ampc, call the command `ampc', e.g. via M-x ampc RET.  When called
  55 ;; interactively, `ampc' reads host address and port from the minibuffer.  If
  56 ;; called non-interactively, the first argument to `ampc' is the host, the
  57 ;; second is the port.  Both values default to nil, which will make ampc connect
  58 ;; to localhost:6600.  If the optional third argument is non-nil and ampc is
  59 ;; connected to the daemon, it creates its window configuration in the selected
  60 ;; window.  To make ampc use the full frame rather than the selected window,
  61 ;; customise `ampc-use-full-frame'.  To check whether ampc is connected to the
  62 ;; daemon, call `ampc-is-on-p' and `ampc-suspended-p'.
  63 ;;
  64 ;; ampc offers three independent views which expose different parts of the user
  65 ;; interface.  The current playlist view, the default view at startup, may be
  66 ;; accessed using the `J' (that is `S-j') key.  The playlist view may be
  67 ;; accessed using the `K' key.  The outputs view may be accessed using the `L'
  68 ;; key.
  69
  70 ;;; *** current playlist view
  71 ;; The playlist view should look like this
  72 ;;
  73 ;; .........................
  74 ;; . 1      . 3  . 4  . 5  .
  75 ;; ..........    .    .    .
  76 ;; . 2      .    .    .    .
  77 ;; .        .    .    .    .
  78 ;; .        .    .    .    .
  79 ;; .        ................
  80 ;; .        . 6            .
  81 ;; .        .              .
  82 ;; .........................
  83 ;;
  84 ;; Window one exposes basic information about the daemon, such as the current
  85 ;; state (stop/play/pause), the song currently playing, or the volume.
  86 ;;
  87 ;; All windows, except the status window, contain a tabular list of items.  Each
  88 ;; item may be selected/marked.  There may be multiple selections.
  89 ;;
  90 ;; To mark an entry, move the point to the entry and press `m' (ampc-mark).  To
  91 ;; unmark an entry, press `u' (ampc-unmark).  To unmark all entries, press `U'
  92 ;; (ampc-unmark-all).  To toggle marks, press `t' (ampc-toggle-marks).  Pressing
  93 ;; `<down-mouse-1>' with the mouse mouse cursor on a list entry will move point
  94 ;; to the entry and toggle the mark.  To navigate to the next entry, press `n'
  95 ;; (ampc-next-line).  Analogous, pressing `p' (ampc-previous-line) moves the
  96 ;; point to the previous entry.
  97 ;;
  98 ;; Window two shows the current playlist.  The song that is currently played by
  99 ;; the daemon, if any, is highlighted.  To delete the selected songs from the
 100 ;; playlist, press `d' (ampc-delete).  Pressing `<down-mouse-3>' will move the
 101 ;; point to the entry under cursor and delete it from the playlist.  To move the
 102 ;; selected songs up, press `<up>' (ampc-up).  Analogous, press `<down>'
 103 ;; (ampc-down) to move the selected songs down.  Pressing `<return>'
 104 ;; (ampc-play-this) or `<down-mouse-2>' will play the song at point/cursor.
 105 ;;
 106 ;; Windows three to five are tag browsers.  You use them to narrow the song
 107 ;; database to certain songs.  Think of tag browsers as filters, analogous to
 108 ;; piping `grep' outputs through additional `grep' filters.  The property of the
 109 ;; songs that is filtered is displayed in the header line of the window.
 110 ;;
 111 ;; Window six shows the songs that match the filters defined by windows three to
 112 ;; five.  To add the selected song to the playlist, press `a' (ampc-add).
 113 ;; Pressing `<down-mouse-3>' will move the point to the entry under the cursor
 114 ;; and execute `ampc-add'.  These key bindings works in tag browsers as well.
 115 ;; Calling `ampc-add' in a tag browser adds all songs filtered up to the
 116 ;; selected browser to the playlist.
 117 ;;
 118 ;; The tag browsers of the (default) current playlist view (accessed via `J')
 119 ;; are `Genre' (window 3), `Artist' (window 4) and `Album' (window 5).  The key
 120 ;; `M' may be used to fire up a slightly modified current playlist view.  There
 121 ;; is no difference to the default current playlist view other than that the tag
 122 ;; browsers filter to `Genre' (window 3), `Album' (window 4) and `Artist'
 123 ;; (window 5).  Metaphorically speaking, the order of the `grep' filters defined
 124 ;; by the tag browsers is different.
 125
 126 ;;; *** playlist view
 127 ;; The playlist view resembles the current playlist view.  The window, which
 128 ;; exposes the playlist content, is split, though.  The bottom half shows a list
 129 ;; of stored playlists.  The upper half does not expose the current playlist
 130 ;; anymore.  Instead, the content of the selected (stored) playlist is shown.
 131 ;; All commands that used to work in the current playlist view and modify the
 132 ;; current playlist now modify the selected (stored) playlist.  The list of
 133 ;; stored playlists is the only view in ampc that may have only one marked
 134 ;; entry.
 135 ;;
 136 ;; To queue a playlist, press `l' (ampc-load) or `<down-mouse-2>'.  To delete a
 137 ;; playlist, press `d' (ampc-delete-playlist) or `<down-mouse-3>'.  The command
 138 ;; `ampc-rename-playlist', bound to `r', can be used to rename a playlist.
 139 ;;
 140 ;; Again, the key `<' may be used to setup a playlist view with a different
 141 ;; order of tag browsers.
 142
 143 ;;; *** outputs view
 144 ;; The outputs view contains a single list which shows the configured outputs of
 145 ;; mpd.  To toggle the enabled property of the selected outputs, press `a'
 146 ;; (ampc-toggle-output-enabled) or `<mouse-3>'.
 147
 148 ;;; *** global keys
 149 ;; Aside from `J', `M', `K', `<' and `L', which may be used to select different
 150 ;; views, ampc defines the following global keys, which may be used in every
 151 ;; window associated with ampc:
 152 ;;
 153 ;; `k' (ampc-toggle-play): Toggle play state.  If mpd does not play a song
 154 ;; already, start playing the song at point if the current buffer is the
 155 ;; playlist buffer, otherwise start at the beginning of the playlist.  With
 156 ;; prefix argument 4, stop player rather than pause if applicable.
 157 ;;
 158 ;; `l' (ampc-next): Play next song.
 159 ;; `j' (ampc-previous): Play previous song
 160 ;;
 161 ;; `c' (ampc-clear): Clear playlist.
 162 ;; `s' (ampc-shuffle): Shuffle playlist.
 163 ;;
 164 ;; `S' (ampc-store): Store playlist.
 165 ;; `O' (ampc-load): Load selected playlist in the current playlist.
 166 ;; `R' (ampc-rename-playlist): Rename selected playlist.
 167 ;; `D' (ampc-delete-playlist): Delete selected playlist.
 168 ;;
 169 ;; `y' (ampc-increase-volume): Increase volume.
 170 ;; `M-y' (ampc-decrease-volume): Decrease volume.
 171 ;; `h' (ampc-increase-crossfade): Increase crossfade.
 172 ;; `M-h' (ampc-decrease-crossfade): Decrease crossfade.
 173 ;;
 174 ;; `e' (ampc-toggle-repeat): Toggle repeat state.
 175 ;; `r' (ampc-toggle-random): Toggle random state.
 176 ;; `f' (ampc-toggle-consume): Toggle consume state.
 177 ;;
 178 ;; `P' (ampc-goto-current-song): Select the current playlist window and move
 179 ;; point to the current song.
 180 ;; `G' (ampc-mini): Select song to play via `completing-read'.
 181 ;;
 182 ;; `T' (ampc-trigger-update): Trigger a database update.
 183 ;; `Z' (ampc-suspend): Suspend ampc.
 184 ;; `q' (ampc-quit): Quit ampc.
 185 ;;
 186 ;; The keymap of ampc is designed to fit the QWERTY United States keyboard
 187 ;; layout.  If you use another keyboard layout, feel free to modify
 188 ;; `ampc-mode-map'.  For example, I use a regular QWERTZ German keyboard
 189 ;; (layout), so I modify `ampc-mode-map' in my init.el like this:
 190 ;;
 191 ;; (eval-after-load 'ampc
 192 ;;   '(flet ((substitute-ampc-key
 193 ;;            (from to)
 194 ;;            (define-key ampc-mode-map to (lookup-key ampc-mode-map from))
 195 ;;            (define-key ampc-mode-map from nil)))
 196 ;;      (substitute-ampc-key (kbd "z") (kbd "Z"))
 197 ;;      (substitute-ampc-key (kbd "y") (kbd "z"))
 198 ;;      (substitute-ampc-key (kbd "M-y") (kbd "M-z"))
 199 ;;      (substitute-ampc-key (kbd "<") (kbd ";"))))
 200 ;;
 201 ;; If ampc is suspended, you can still use every interactive command that does
 202 ;; not directly operate on or with the user interace of ampc.  For example it is
 203 ;; perfectly fine to call `ampc-increase-volume' or `ampc-toggle-play' via M-x
 204 ;; RET.  Especially the commands `ampc-status' and `ampc-mini' are predestinated
 205 ;; to be bound in the global keymap.  `ampc-status' messages the information
 206 ;; that is displayed by the status window of ampc.  `ampc-mini' lets you select
 207 ;; a song to play via `completing-read'.
 208 ;;
 209 ;; (global-set-key (kbd "<f7>")
 210 ;;                 (lambda ()
 211 ;;                   (interactive)
 212 ;;                   (unless (ampc-on-p)
 213 ;;                     (ampc nil nil t))
 214 ;;                   (ampc-status)))
 215 ;; (global-set-key (kbd "<f8>")
 216 ;;                 (lambda ()
 217 ;;                   (interactive)
 218 ;;                   (unless (ampc-on-p)
 219 ;;                     (ampc nil nil t))
 220 ;;                   (ampc-mini)))
 221
 222 ;;; Code:
 223 ;;; * code
 224 (eval-when-compile
 225   (require 'easymenu)
 226   (require 'cl))
 227 (require 'network-stream)
 228 (require 'avl-tree)
 229
 230 ;;; ** declarations
 231 ;;; *** variables
 232 (defgroup ampc ()
 233   "Asynchronous client for the Music Player Daemon."
 234   :prefix "ampc-"
 235   :group 'multimedia
 236   :group 'applications)
 237
 238 ;;; *** customs
 239 (defcustom ampc-debug nil
 240   "Non-nil means log communication between ampc and MPD."
 241   :type 'boolean)
 242
 243 (defcustom ampc-use-full-frame nil
 244   "If non-nil, ampc will use the entire Emacs screen."
 245   :type 'boolean)
 246
 247 (defcustom ampc-truncate-lines t
 248   "If non-nil, truncate lines in ampc buffers."
 249   :type 'boolean)
 250
 251 (defcustom ampc-status-tags nil
 252   "List of additional tags of the current song that are added to
 253 the internal status of ampc and thus are passed to the functions
 254 in `ampc-status-changed-hook'.  Each element may be a string that
 255 specifies a tag that is returned by MPD's `currentsong'
 256 command.")
 257
 258 ;;; **** hooks
 259 (defcustom ampc-before-startup-hook nil
 260   "A hook run before startup.
 261 This hook is called as the first thing when ampc is started."
 262   :type 'hook)
 263
 264 (defcustom ampc-connected-hook nil
 265   "A hook run after ampc connected to MPD."
 266   :type 'hook)
 267
 268 (defcustom ampc-suspend-hook nil
 269   "A hook run when suspending ampc."
 270   :type 'hook)
 271
 272 (defcustom ampc-quit-hook nil
 273   "A hook run when exiting ampc."
 274   :type 'hook)
 275
 276 (defcustom ampc-status-changed-hook nil
 277   "A hook run whenever the status of the daemon (that is volatile
 278 properties such as volume or current song) changes.  The hook is
 279 run with one arg, an alist that contains the new status.  The car
 280 of each entry is a symbol, the cdr is a string.  Valid keys are:
 281
 282     volume
 283     repeat
 284     random
 285     consume
 286     xfade
 287     state
 288     song
 289     Artist
 290     Title
 291
 292 and the keys in `ampc-status-tags'.  Not all keys may be present
 293 all the time!"
 294   :type 'hook)
 295
 296 ;;; *** faces
 297 (defface ampc-mark-face '((t (:inherit font-lock-constant-face)))
 298   "Face of the mark.")
 299 (defface ampc-marked-face '((t (:inherit warning)))
 300   "Face of marked entries.")
 301 (defface ampc-face '((t (:inerhit default)))
 302   "Face of unmarked entries.")
 303 (defface ampc-current-song-mark-face '((t (:inherit region)))
 304   "Face of mark of the current song.")
 305 (defface ampc-current-song-marked-face '((t (:inherit region)))
 306   "Face of the current song if marked.")
 307
 308 ;;; *** internal variables
 309 (defvar ampc-views
 310   (let* ((songs '(1.0 song :properties (("Track" :title "#" :width 4)
 311                                         ("Title" :min 15 :max 40)
 312                                         ("Time" :width 6))))
 313          (rs_a `(1.0 vertical
 314                      (0.7 horizontal
 315                           (0.33 tag :tag "Genre" :id 1)
 316                           (0.33 tag :tag "Artist" :id 2)
 317                           (1.0 tag :tag "Album" :id 3))
 318                      ,songs))
 319          (rs_b `(1.0 vertical
 320                      (0.7 horizontal
 321                           (0.33 tag :tag "Genre" :id 1)
 322                           (0.33 tag :tag "Album" :id 2)
 323                           (1.0 tag :tag "Artist" :id 3))
 324                      ,songs))
 325          (pl-prop '(:properties (("Title" :min 15 :max 40)
 326                                  ("Artist" :min 15 :max 40)
 327                                  ("Album" :min 15 :max 40)
 328                                  ("Time" :width 6)))))
 329     `(("Current playlist view (Genre|Artist|Album)"
 330        ,(kbd "J")
 331        horizontal
 332        (0.4 vertical
 333             (6 status)
 334             (1.0 current-playlist ,@pl-prop))
 335        ,rs_a)
 336       ("Current playlist view (Genre|Album|Artist)"
 337        ,(kbd "M")
 338        horizontal
 339        (0.4 vertical
 340             (6 status)
 341             (1.0 current-playlist ,@pl-prop))
 342        ,rs_b)
 343       ("Playlist view (Genre|Artist|Album)"
 344        ,(kbd "K")
 345        horizontal
 346        (0.4 vertical
 347             (6 status)
 348             (1.0 vertical
 349                  (0.8 playlist ,@pl-prop)
 350                  (1.0 playlists)))
 351        ,rs_a)
 352       ("Playlist view (Genre|Album|Artist)"
 353        ,(kbd "<")
 354        horizontal
 355        (0.4 vertical
 356             (6 status)
 357             (1.0 vertical
 358                  (0.8 playlist ,@pl-prop)
 359                  (1.0 playlists)))
 360        ,rs_b)
 361       ("Outputs view"
 362        ,(kbd "L")
 363        outputs :properties (("outputname" :title "Name" :min 10 :max 30)
 364                             ("outputenabled" :title "Enabled" :width 9))))))
 365
 366 (defvar ampc-connection nil)
 367 (defvar ampc-host nil)
 368 (defvar ampc-port nil)
 369 (defvar ampc-outstanding-commands nil)
 370
 371 (defvar ampc-working-timer nil)
 372 (defvar ampc-yield nil)
 373
 374 (defvar ampc-buffers nil)
 375 (defvar ampc-buffers-unordered nil)
 376 (defvar ampc-all-buffers nil)
 377
 378 (defvar ampc-tab-offsets nil)
 379 (make-variable-buffer-local 'ampc-tab-offsets)
 380
 381 (defvar ampc-type nil)
 382 (make-variable-buffer-local 'ampc-type)
 383 (defvar ampc-dirty nil)
 384 (make-variable-buffer-local 'ampc-dirty)
 385
 386 (defvar ampc-internal-db nil)
 387 (defvar ampc-status nil)
 388
 389 ;;; *** mode maps
 390 (defvar ampc-mode-map
 391   (let ((map (make-sparse-keymap)))
 392     (suppress-keymap map)
 393     (define-key map (kbd "k") 'ampc-toggle-play)
 394     (define-key map (kbd "l") 'ampc-next)
 395     (define-key map (kbd "j") 'ampc-previous)
 396     (define-key map (kbd "c") 'ampc-clear)
 397     (define-key map (kbd "s") 'ampc-shuffle)
 398     (define-key map (kbd "S") 'ampc-store)
 399     (define-key map (kbd "O") 'ampc-load)
 400     (define-key map (kbd "R") 'ampc-rename-playlist)
 401     (define-key map (kbd "D") 'ampc-delete-playlist)
 402     (define-key map (kbd "y") 'ampc-increase-volume)
 403     (define-key map (kbd "M-y") 'ampc-decrease-volume)
 404     (define-key map (kbd "h") 'ampc-increase-crossfade)
 405     (define-key map (kbd "M-h") 'ampc-decrease-crossfade)
 406     (define-key map (kbd "e") 'ampc-toggle-repeat)
 407     (define-key map (kbd "r") 'ampc-toggle-random)
 408     (define-key map (kbd "f") 'ampc-toggle-consume)
 409     (define-key map (kbd "P") 'ampc-goto-current-song)
 410     (define-key map (kbd "G") 'ampc-mini)
 411     (define-key map (kbd "q") 'ampc-quit)
 412     (define-key map (kbd "z") 'ampc-suspend)
 413     (define-key map (kbd "T") 'ampc-trigger-update)
 414     (loop for view in ampc-views
 415           do (define-key map (cadr view)
 416                `(lambda ()
 417                   (interactive)
 418                   (ampc-change-view ',view))))
 419     map))
 420
 421 (defvar ampc-item-mode-map
 422   (let ((map (make-sparse-keymap)))
 423     (suppress-keymap map)
 424     (define-key map (kbd "m") 'ampc-mark)
 425     (define-key map (kbd "u") 'ampc-unmark)
 426     (define-key map (kbd "U") 'ampc-unmark-all)
 427     (define-key map (kbd "n") 'ampc-next-line)
 428     (define-key map (kbd "p") 'ampc-previous-line)
 429     (define-key map [remap next-line] 'ampc-next-line)
 430     (define-key map [remap previous-line] 'ampc-previous-line)
 431     (define-key map (kbd "<down-mouse-1>") 'ampc-mouse-toggle-mark)
 432     (define-key map (kbd "<mouse-1>") 'ampc-mouse-align-point)
 433     map))
 434
 435 (defvar ampc-current-playlist-mode-map
 436   (let ((map (make-sparse-keymap)))
 437     (suppress-keymap map)
 438     (define-key map (kbd "<return>") 'ampc-play-this)
 439     (define-key map (kbd "<down-mouse-2>") 'ampc-mouse-play-this)
 440     (define-key map (kbd "<mouse-2>") 'ampc-mouse-align-point)
 441     (define-key map (kbd "<down-mouse-3>") 'ampc-mouse-delete)
 442     (define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
 443     map))
 444
 445 (defvar ampc-playlist-mode-map
 446   (let ((map (make-sparse-keymap)))
 447     (suppress-keymap map)
 448     (define-key map (kbd "t") 'ampc-toggle-marks)
 449     (define-key map (kbd "d") 'ampc-delete)
 450     (define-key map (kbd "<up>") 'ampc-up)
 451     (define-key map (kbd "<down>") 'ampc-down)
 452     (define-key map (kbd "<down-mouse-3>") 'ampc-mouse-delete)
 453     (define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
 454     map))
 455
 456 (defvar ampc-playlists-mode-map
 457   (let ((map (make-sparse-keymap)))
 458     (suppress-keymap map)
 459     (define-key map (kbd "l") 'ampc-load)
 460     (define-key map (kbd "r") 'ampc-rename-playlist)
 461     (define-key map (kbd "d") 'ampc-delete-playlist)
 462     (define-key map (kbd "<down-mouse-2>") 'ampc-mouse-load)
 463     (define-key map (kbd "<mouse-2>") 'ampc-mouse-align-point)
 464     (define-key map (kbd "<down-mouse-3>") 'ampc-mouse-delete-playlist)
 465     (define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
 466     map))
 467
 468 (defvar ampc-tag-song-mode-map
 469   (let ((map (make-sparse-keymap)))
 470     (suppress-keymap map)
 471     (define-key map (kbd "t") 'ampc-toggle-marks)
 472     (define-key map (kbd "a") 'ampc-add)
 473     (define-key map (kbd "<down-mouse-3>") 'ampc-mouse-add)
 474     (define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
 475     map))
 476
 477 (defvar ampc-outputs-mode-map
 478   (let ((map (make-sparse-keymap)))
 479     (suppress-keymap map)
 480     (define-key map (kbd "t") 'ampc-toggle-marks)
 481     (define-key map (kbd "a") 'ampc-toggle-output-enabled)
 482     (define-key map (kbd "<down-mouse-3>") 'ampc-mouse-toggle-output-enabled)
 483     (define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
 484     map))
 485
 486 ;;; **** menu
 487 (easy-menu-define nil ampc-mode-map nil
 488   `("ampc"
 489     ("Change view" ,@(loop for view in ampc-views
 490                            collect (vector (car view)
 491                                            `(lambda ()
 492                                               (interactive)
 493                                               (ampc-change-view ',view)))))
 494     "--"
 495     ["Play" ampc-toggle-play
 496      :visible (and ampc-status
 497                    (not (equal (cdr (assq 'state ampc-status)) "play")))]
 498     ["Pause" ampc-toggle-play
 499      :visible (and ampc-status
 500                    (equal (cdr (assq 'state ampc-status)) "play"))]
 501     ["Stop" (lambda () (interactive) (ampc-toggle-play 4))
 502      :visible (and ampc-status
 503                    (equal (cdr (assq 'state ampc-status)) "play"))]
 504     ["Next" ampc-next]
 505     ["Previous" ampc-previous]
 506     "--"
 507     ["Clear playlist" ampc-clear]
 508     ["Shuffle playlist" ampc-shuffle]
 509     ["Store playlist" ampc-store]
 510     ["Queue Playlist" ampc-load :visible (ampc-playlist)]
 511     ["Rename Playlist" ampc-rename-playlist :visible (ampc-playlist)]
 512     ["Delete Playlist" ampc-delete-playlist :visible (ampc-playlist)]
 513     "--"
 514     ["Increase volume" ampc-increase-volume]
 515     ["Decrease volume" ampc-decrease-volume]
 516     ["Increase crossfade" ampc-increase-crossfade]
 517     ["Decrease crossfade" ampc-decrease-crossfade]
 518     ["Toggle repeat" ampc-toggle-repeat
 519      :style toggle
 520      :selected (equal (cdr-safe (assq 'repeat ampc-status)) "1")]
 521     ["Toggle random" ampc-toggle-random
 522      :style toggle
 523      :selected (equal (cdr-safe (assq 'random ampc-status)) "1")]
 524     ["Toggle consume" ampc-toggle-consume
 525      :style toggle
 526      :selected (equal (cdr-safe (assq 'consume ampc-status)) "1")]
 527     "--"
 528     ["Trigger update" ampc-trigger-update]
 529     ["Suspend" ampc-suspend]
 530     ["Quit" ampc-quit]))
 531
 532 (easy-menu-define ampc-selection-menu ampc-item-mode-map
 533   "Selection menu for ampc"
 534   '("ampc Mark"
 535     ["Add to playlist" ampc-add
 536      :visible (not (eq (car ampc-type) 'outputs))]
 537     ["Toggle enabled" ampc-toggle-output-enabled
 538      :visible (eq (car ampc-type) 'outputs)]
 539     "--"
 540     ["Next line" ampc-next-line]
 541     ["Previous line" ampc-previous-line]
 542     ["Mark" ampc-mark]
 543     ["Unmark" ampc-unmark]
 544     ["Unmark all" ampc-unmark-all]
 545     ["Toggle marks" ampc-toggle-marks
 546      :visible (not (eq (car ampc-type) 'playlists))]))
 547
 548 (defvar ampc-tool-bar-map
 549   (let ((map (make-sparse-keymap)))
 550     (tool-bar-local-item
 551      "mpc/prev" 'ampc-previous 'previous map
 552      :help "Previous")
 553     (tool-bar-local-item
 554      "mpc/play" 'ampc-toggle-play 'play map
 555      :help "Play"
 556      :visible '(and ampc-status
 557                     (not (equal (cdr (assq 'state ampc-status)) "play"))))
 558     (tool-bar-local-item
 559      "mpc/pause" 'ampc-toggle-play 'pause map
 560      :help "Pause"
 561      :visible '(and ampc-status
 562                     (equal (cdr (assq 'state ampc-status)) "play")))
 563     (tool-bar-local-item
 564      "mpc/stop" (lambda () (interactive) (ampc-toggle-play 4)) 'stop map
 565      :help "Stop"
 566      :visible '(and ampc-status
 567                     (equal (cdr (assq 'state ampc-status)) "play")))
 568     (tool-bar-local-item
 569      "mpc/next" 'ampc-next 'next map
 570      :help "Next")
 571     map))
 572
 573 ;;; ** code
 574 ;;; *** macros
 575 (defmacro ampc-with-buffer (type &rest body)
 576   (declare (indent 1) (debug t))
 577   `(let* ((type- ,type)
 578           (b (loop for b in ampc-buffers
 579                    when (with-current-buffer b
 580                           (etypecase type-
 581                             (window
 582                              (eq (window-buffer type-)
 583                                  (current-buffer)))
 584                             (symbol
 585                              (eq (car ampc-type) type-))))
 586                    return b
 587                    end)))
 588      (when b
 589        (with-current-buffer b
 590          (let ((buffer-read-only))
 591            ,@(if (eq (car body) 'no-se)
 592                  (cdr body)
 593                `((save-excursion
 594                    (goto-char (point-min))
 595                    ,@body))))))))
 596
 597 (defmacro ampc-fill-skeleton (tag &rest body)
 598   (declare (indent 1) (debug t))
 599   `(let ((tag- ,tag)
 600          (data-buffer (current-buffer)))
 601      (ampc-with-buffer tag-
 602        no-se
 603        (let ((point (point)))
 604          (goto-char (point-min))
 605          (loop until (eobp)
 606                do (put-text-property (point) (1+ (point)) 'updated t)
 607                (forward-line))
 608          (goto-char (point-min))
 609          ,@body
 610          (goto-char (point-min))
 611          (loop until (eobp)
 612                when (get-text-property (point) 'updated)
 613                do (delete-region (point) (1+ (line-end-position)))
 614                else
 615                do (add-text-properties
 616                    (+ (point) 2)
 617                    (progn (forward-line nil)
 618                           (1- (point)))
 619                    '(mouse-face highlight))
 620                end)
 621          (goto-char point)
 622          (ampc-align-point))
 623        (ampc-set-dirty nil)
 624        (with-selected-window (if (windowp tag-) tag- (ampc-get-window tag-))
 625          (recenter)))))
 626
 627 (defmacro ampc-with-selection (arg &rest body)
 628   (declare (indent 1) (debug t))
 629   `(let ((arg- ,arg))
 630      (if (and (not arg-)
 631               (save-excursion
 632                 (goto-char (point-min))
 633                 (search-forward-regexp "^* " nil t)))
 634          (loop initially (goto-char (point-min))
 635                finally (ampc-align-point)
 636                while (search-forward-regexp "^* " nil t)
 637                for index from 0
 638                do (save-excursion
 639                     ,@body))
 640        (loop until (eobp)
 641              for index from 0 to (1- (if (numberp arg-)
 642                                          arg-
 643                                        (prefix-numeric-value arg-)))
 644              do (save-excursion
 645                   (goto-char (line-end-position))
 646                   ,@body)
 647              until (ampc-next-line)))))
 648
 649 ;;; *** modes
 650 (define-derived-mode ampc-outputs-mode ampc-item-mode "ampc-o"
 651   nil)
 652
 653 (define-derived-mode ampc-tag-song-mode ampc-item-mode "ampc-ts"
 654   nil)
 655
 656 (define-derived-mode ampc-current-playlist-mode ampc-playlist-mode "ampc-cpl"
 657   nil)
 658
 659 (define-derived-mode ampc-playlist-mode ampc-item-mode "ampc-pl"
 660   nil)
 661
 662 (define-derived-mode ampc-playlists-mode ampc-item-mode "ampc-pls"
 663   nil)
 664
 665 (define-derived-mode ampc-item-mode ampc-mode ""
 666   nil)
 667
 668 (define-derived-mode ampc-mode special-mode "ampc"
 669   nil
 670   (buffer-disable-undo)
 671   (set (make-local-variable 'tool-bar-map) ampc-tool-bar-map)
 672   (setf truncate-lines ampc-truncate-lines
 673         font-lock-defaults '((("^\\(\\*\\)\\(.*\\)$"
 674                                (1 'ampc-mark-face)
 675                                (2 'ampc-marked-face))
 676                               ("^ .*$" 0 'ampc-face))
 677                              t)))
 678
 679 (define-minor-mode ampc-highlight-current-song-mode ""
 680   nil
 681   nil
 682   nil
 683   (funcall (if ampc-highlight-current-song-mode
 684                'font-lock-add-keywords
 685              'font-lock-remove-keywords)
 686            nil
 687            '((ampc-find-current-song
 688               (1 'ampc-current-song-mark-face)
 689               (2 'ampc-current-song-marked-face)))))
 690
 691 ;;; *** internal functions
 692 (defun ampc-change-view (view)
 693   (if (equal ampc-outstanding-commands '((idle)))
 694       (ampc-configure-frame (cddr view))
 695     (message "ampc is busy, cannot change window layout")))
 696
 697 (defun ampc-quote (string)
 698   (concat "\"" (replace-regexp-in-string "\"" "\\\"" string) "\""))
 699
 700 (defun ampc-in-ampc-p ()
 701   (when (ampc-on-p)
 702     ampc-type))
 703
 704 (defun ampc-add-impl (&optional data)
 705   (cond ((null data)
 706          (loop for d in (get-text-property (line-end-position) 'data)
 707                do (ampc-add-impl d)))
 708         ((avl-tree-p data)
 709          (avl-tree-mapc (lambda (e) (ampc-add-impl (cdr e))) data))
 710         ((stringp data)
 711          (if (ampc-playlist)
 712              (ampc-send-command 'playlistadd
 713                                 t
 714                                 (ampc-quote (ampc-playlist))
 715                                 data)
 716            (ampc-send-command 'add t (ampc-quote data))))
 717         (t
 718          (loop for d in (reverse data)
 719                do (ampc-add-impl (cdr (assoc "file" d)))))))
 720
 721 (defun* ampc-skip (N &aux (song (cdr-safe (assq 'song ampc-status))))
 722   (when song
 723     (ampc-send-command 'play nil (max 0 (+ (string-to-number song) N)))))
 724
 725 (defun* ampc-find-current-song
 726     (limit &aux (point (point)) (song (cdr-safe (assq 'song ampc-status))))
 727   (when (and song
 728              (<= (1- (line-number-at-pos (point)))
 729                  (setf song (string-to-number song)))
 730              (>= (1- (line-number-at-pos limit)) song))
 731     (goto-char (point-min))
 732     (forward-line song)
 733     (save-restriction
 734       (narrow-to-region (max point (point)) (min limit (line-end-position)))
 735       (search-forward-regexp "\\(?1:\\(\\`\\*\\)?\\)\\(?2:.*\\)$"))))
 736
 737 (defun ampc-set-volume (arg func)
 738   (when (or arg ampc-status)
 739     (ampc-send-command
 740      'setvol
 741      nil
 742      (or (and arg (prefix-numeric-value arg))
 743          (max (min (funcall func
 744                             (string-to-number
 745                              (cdr (assq 'volume ampc-status)))
 746                             5)
 747                    100)
 748               0)))))
 749
 750 (defun ampc-set-crossfade (arg func)
 751   (when (or arg ampc-status)
 752     (ampc-send-command
 753      'crossfade
 754      nil
 755      (or (and arg (prefix-numeric-value arg))
 756          (max (funcall func
 757                        (string-to-number (cdr (assq 'xfade ampc-status)))
 758                        5)
 759               0)))))
 760
 761 (defun* ampc-fix-pos (f &aux buffer-read-only)
 762   (save-excursion
 763     (move-beginning-of-line nil)
 764     (let* ((data (get-text-property (+ 2 (point)) 'data))
 765            (pos (assoc "Pos" data)))
 766       (setf (cdr pos) (funcall f (cdr pos)))
 767       (put-text-property (+ 2 (point))
 768                          (line-end-position)
 769                          'data
 770                          data))))
 771
 772 (defun* ampc-move-impl (up &aux (line (1- (line-number-at-pos))))
 773   (when (or (and up (eq line 0))
 774             (and (not up) (eq (1+ line) (line-number-at-pos (1- (point-max))))))
 775     (return-from ampc-move-impl t))
 776   (save-excursion
 777     (move-beginning-of-line nil)
 778     (if (ampc-playlist)
 779         (ampc-send-command 'playlistmove
 780                            nil
 781                            (ampc-quote (ampc-playlist))
 782                            line
 783                            (funcall (if up '1- '1+)
 784                                     line))
 785       (ampc-send-command 'move nil line (funcall (if up '1- '1+) line)))
 786     (unless up
 787       (forward-line))
 788     (unless (ampc-playlist)
 789       (save-excursion
 790         (forward-line -1)
 791         (ampc-fix-pos '1+))
 792       (ampc-fix-pos '1-))
 793     (let ((buffer-read-only))
 794       (transpose-lines 1)))
 795   (if up
 796       (ampc-align-point)
 797     (ampc-next-line))
 798   nil)
 799
 800 (defun* ampc-move (up N &aux (point (point)))
 801   (goto-char (if up (point-min) (point-max)))
 802   (if (and (not N)
 803            (funcall (if up 'search-forward-regexp 'search-backward-regexp)
 804                     "^* "
 805                     nil
 806                     t))
 807       (loop until (ampc-move-impl up)
 808             unless up
 809             do (search-backward-regexp "^* " nil t)
 810             end
 811             until (not (funcall (if up
 812                                     'search-forward-regexp
 813                                   'search-backward-regexp)
 814                                 "^* "
 815                                 nil
 816                                 t))
 817             finally (unless up
 818                       (forward-char 2)))
 819     (goto-char point)
 820     (unless (eobp)
 821       (unless N
 822         (setf N 1))
 823       (unless up
 824         (unless (eq (1- N) 0)
 825           (setf N (- (- (forward-line (1- N)) (1- N))))))
 826       (loop repeat N
 827             until (ampc-move-impl up)))))
 828
 829 (defun ampc-toggle-state (state arg)
 830   (when (or arg ampc-status)
 831     (ampc-send-command
 832      state
 833      nil
 834      (cond ((null arg)
 835             (if (equal (cdr (assq state ampc-status)) "1")
 836                 0
 837               1))
 838            ((> (prefix-numeric-value arg) 0) 1)
 839            (t 0)))))
 840
 841 (defun ampc-playlist (&optional at-point)
 842   (ampc-with-buffer 'playlists
 843     (if (and (not at-point)
 844              (search-forward-regexp "^* \\(.*\\)$" nil t))
 845         (match-string 1)
 846       (unless (eobp)
 847         (buffer-substring-no-properties
 848          (+ (line-beginning-position) 2)
 849          (line-end-position))))))
 850
 851 (defun* ampc-mark-impl (select N &aux result buffer-read-only)
 852   (when (eq (car ampc-type) 'playlists)
 853     (assert (or (not select) (null N) (eq N 1)))
 854     (ampc-with-buffer 'playlists
 855       (loop while (search-forward-regexp "^\\* " nil t)
 856             do (replace-match "  " nil nil))))
 857   (loop repeat (or N 1)
 858         until (eobp)
 859         do (move-beginning-of-line nil)
 860         (delete-char 1)
 861         (insert (if select "*" " "))
 862         (setf result (ampc-next-line nil)))
 863   (ampc-post-mark-change-update)
 864   result)
 865
 866 (defun ampc-post-mark-change-update ()
 867   (ecase (car ampc-type)
 868     ((current-playlist playlist outputs))
 869     (playlists
 870      (ampc-update-playlist))
 871     ((song tag)
 872      (loop for w in (ampc-windows)
 873            with found
 874            when found
 875            do (with-current-buffer (window-buffer w)
 876                 (when (member (car ampc-type) '(song tag))
 877                   (ampc-set-dirty t)))
 878            end
 879            if (eq w (selected-window))
 880            do (setf found t)
 881            end)
 882      (ampc-fill-tag-song))))
 883
 884 (defun ampc-align-point ()
 885   (unless (eobp)
 886     (move-beginning-of-line nil)
 887     (forward-char 2)))
 888
 889 (defun* ampc-pad (tabs &optional (sub 0))
 890   (loop for tab in tabs
 891         for offset in ampc-tab-offsets
 892         do (setf offset (- offset sub))
 893         with first = t
 894         with current-offset = 0
 895         when (<= current-offset offset)
 896         when (and (not first) (eq (- offset current-offset) 0))
 897         do (incf offset)
 898         end
 899         and concat (make-string (- offset current-offset) ? )
 900         and do (setf current-offset offset)
 901         else
 902         concat " "
 903         and do (incf current-offset)
 904         end
 905         concat tab
 906         do (setf current-offset (+ current-offset (length tab))
 907                  first nil)))
 908
 909 (defun ampc-update-header ()
 910   (setf header-line-format
 911         (unless (eq (car ampc-type) 'status)
 912           (concat
 913            (when ampc-dirty
 914              "  [ Updating... ]")
 915            (make-string (floor (fringe-columns 'left t)) ? )
 916            (ecase (car ampc-type)
 917              (tag
 918               (concat "  " (plist-get (cdr ampc-type) :tag)))
 919              (playlists
 920               "  Playlists")
 921              (t
 922               (ampc-pad (loop for p in (plist-get (cdr ampc-type) :properties)
 923                               collect (or (plist-get (cdr p) :title)
 924                                           (car p))))))))))
 925
 926 (defun ampc-set-dirty (tag-or-dirty &optional dirty)
 927   (if (or (null tag-or-dirty) (eq tag-or-dirty t))
 928       (progn (setf ampc-dirty tag-or-dirty)
 929              (ampc-update-header))
 930     (loop for w in (ampc-windows)
 931           do (with-current-buffer (window-buffer w)
 932                (when (eq (car ampc-type) tag-or-dirty)
 933                  (ampc-set-dirty dirty))))))
 934
 935 (defun ampc-update ()
 936   (if ampc-status
 937       (loop for b in ampc-buffers
 938             do (with-current-buffer b
 939                  (when ampc-dirty
 940                    (ecase (car ampc-type)
 941                      (outputs
 942                       (ampc-send-command 'outputs))
 943                      (playlist
 944                       (ampc-update-playlist))
 945                      ((tag song)
 946                       (if (assoc (ampc-tags) ampc-internal-db)
 947                           (ampc-fill-tag-song)
 948                         (push `(,(ampc-tags) . nil) ampc-internal-db)
 949                         (ampc-send-command 'listallinfo)))
 950                      (status
 951                       (ampc-send-command 'status)
 952                       (ampc-send-command 'currentsong))
 953                      (playlists
 954                       (ampc-send-command 'listplaylists))
 955                      (current-playlist
 956                       (ampc-send-command 'playlistinfo))))))
 957     (ampc-send-command 'status)
 958     (ampc-send-command 'currentsong)))
 959
 960 (defun ampc-update-playlist ()
 961   (ampc-with-buffer 'playlists
 962     (if (search-forward-regexp "^\\* " nil t)
 963         (ampc-send-command 'listplaylistinfo
 964                            nil
 965                            (get-text-property (point) 'data))
 966       (ampc-with-buffer 'playlist
 967         (delete-region (point-min) (point-max))
 968         (ampc-set-dirty nil)))))
 969
 970 (defun ampc-send-command-impl (command)
 971   (when ampc-debug
 972     (message (concat "ampc: " command)))
 973   (process-send-string ampc-connection (concat command "\n")))
 974
 975 (defun ampc-send-command (command &optional unique &rest args)
 976   (if (equal command 'idle)
 977       (when ampc-working-timer
 978         (cancel-timer ampc-working-timer)
 979         (setf ampc-yield nil
 980               ampc-working-timer nil)
 981         (ampc-fill-status))
 982     (unless ampc-working-timer
 983       (setf ampc-yield 0
 984             ampc-working-timer (run-at-time nil 0.1 'ampc-yield))))
 985   (setf command `(,command ,@args))
 986   (when (equal (car-safe ampc-outstanding-commands) '(idle))
 987     (setf (car ampc-outstanding-commands) '(noidle))
 988     (ampc-send-command-impl "noidle"))
 989   (setf ampc-outstanding-commands
 990         (nconc (if unique
 991                    ampc-outstanding-commands
 992                  (remove command ampc-outstanding-commands))
 993                `(,command))))
 994
 995 (defun ampc-send-next-command ()
 996   (unless ampc-outstanding-commands
 997     (ampc-send-command 'idle))
 998   (ampc-send-command-impl
 999    (concat (replace-regexp-in-string
1000             "^.*-" "" (symbol-name (caar ampc-outstanding-commands)))
1001            (loop for a in (cdar ampc-outstanding-commands)
1002                  concat " "
1003                  concat (cond ((integerp a) (number-to-string a))
1004                               (t a))))))
1005
1006 (defun ampc-tree< (a b)
1007   (string< (car a) (car b)))
1008
1009 (defun ampc-create-tree ()
1010   (avl-tree-create 'ampc-tree<))
1011
1012 (defun ampc-extract (tag &optional buffer)
1013   (with-current-buffer (or buffer (current-buffer))
1014     (if (listp tag)
1015         (ampc-extract (plist-get tag :tag))
1016       (save-excursion
1017         (goto-char (point-min))
1018         (when (search-forward-regexp
1019                (concat "^" (regexp-quote tag) ": \\(.*\\)$")
1020                nil
1021                t)
1022           (let ((result (match-string 1)))
1023             (when (equal tag "Time")
1024               (setf result (ampc-transform-time result)))
1025             result))))))
1026
1027 (defun ampc-insert (element data &optional cmp)
1028   (save-excursion
1029     (goto-char (point-min))
1030     (ecase
1031         (loop until (eobp)
1032               for tp = (get-text-property (+ (point) 2) 'data)
1033               finally return 'insert
1034               thereis
1035               (cond ((eq cmp t)
1036                      (let ((s (buffer-substring-no-properties
1037                                (+ (point) 2)
1038                                (line-end-position))))
1039                        (cond ((equal s element)
1040                               (unless (member data tp)
1041                                 (put-text-property (+ (point) 2)
1042                                                    (1+ (line-end-position))
1043                                                    'data
1044                                                    `(,data . ,tp)))
1045                               'update)
1046                              ((string< element s)
1047                               'insert))))
1048                     (cmp
1049                      (let ((r (funcall cmp data tp)))
1050                        (if (memq r '(update insert))
1051                            r
1052                          (forward-line (1- r))
1053                          nil)))
1054                     ((equal tp data)
1055                      'update)
1056                     (t
1057                      (let ((s (buffer-substring-no-properties
1058                                (+ (point) 2)
1059                                (line-end-position))))
1060                        (unless (string< s element)
1061                          'insert))))
1062               do (forward-line))
1063       (insert
1064        (insert "  ")
1065        (let ((start (point)))
1066          (insert element "\n")
1067          (put-text-property start (point) 'data (if (eq cmp t)
1068                                                     `(,data)
1069                                                   data))))
1070       (update
1071        (remove-text-properties (point) (1+ (point)) '(updated))
1072        (equal (buffer-substring (point) (1+ (point))) "*")))))
1073
1074 (defun ampc-fill-tag (trees)
1075   (put-text-property (point-min) (point-max) 'data nil)
1076   (loop with new-trees
1077         finally return new-trees
1078         for tree in trees
1079         when tree
1080         do (avl-tree-mapc (lambda (e)
1081                             (when (ampc-insert (car e) (cdr e) t)
1082                               (push (cdr e) new-trees)))
1083                           tree)
1084         end))
1085
1086 (defun ampc-fill-song (trees)
1087   (loop
1088    for songs in trees
1089    do (loop for song in songs
1090             do (ampc-insert
1091                 (ampc-pad
1092                  (loop for (p . v) in (plist-get (cdr ampc-type) :properties)
1093                        collect (or (cdr-safe (assoc p song)) ""))
1094                  2)
1095                 `((,song))))))
1096
1097 (defun* ampc-narrow-entry (&optional (delimiter "file") &aux result)
1098   (narrow-to-region
1099    (move-beginning-of-line nil)
1100    (or (progn (goto-char (line-end-position))
1101               (when (setf result (search-forward-regexp
1102                                   (concat "^" (regexp-quote delimiter) ": ")
1103                                   nil
1104                                   t))
1105                 (move-beginning-of-line nil)
1106                 (1- (point))))
1107        (point-max)))
1108   result)
1109
1110 (defun ampc-get-window (type)
1111   (loop for w in (ampc-windows)
1112         thereis (with-current-buffer (window-buffer w)
1113                   (when (eq (car ampc-type) type)
1114                     w))))
1115
1116 (defun* ampc-fill-playlist (&aux properties)
1117   (ampc-fill-skeleton 'playlist
1118     (setf properties (plist-get (cdr ampc-type) :properties))
1119     (with-current-buffer data-buffer
1120       (loop
1121        for i from 0
1122        with next
1123        while (or (when next (goto-char next) t)
1124                  (search-forward-regexp "^file: " nil t))
1125        do (save-restriction
1126             (setf next (ampc-narrow-entry))
1127             (let ((file (ampc-extract "file"))
1128                   (pad-data (loop for (tag . tag-properties) in properties
1129                                    collect (or (ampc-extract tag)
1130                                                "[Not Specified]"))))
1131               (ampc-with-buffer 'playlist
1132                 (ampc-insert (ampc-pad pad-data 2)
1133                              `(("file" . ,file)
1134                                (index . ,i))
1135                              (lambda (a b)
1136                                (let ((p1 (cdr (assoc 'index a)))
1137                                      (p2 (cdr (assoc 'index b))))
1138                                  (cond ((< p1 p2) 'update)
1139                                        ((eq p1 p2)
1140                                         (if (equal (cdr (assoc "file" a))
1141                                                    (cdr (assoc "file" b)))
1142                                             'update
1143                                           'insert))
1144                                        (t (- p1 p2)))))))))))))
1145
1146 (defun* ampc-fill-outputs (&aux properties)
1147   (ampc-fill-skeleton 'outputs
1148     (setf properties (plist-get (cdr ampc-type) :properties))
1149     (with-current-buffer data-buffer
1150       (loop
1151        with next
1152        while (or (when next (goto-char next) t)
1153                  (search-forward-regexp "^outputid: " nil t))
1154        do (save-restriction
1155             (setf next (ampc-narrow-entry "outputid"))
1156             (let ((outputid (ampc-extract "outputid"))
1157                   (outputenabled (ampc-extract "outputenabled")))
1158               (ampc-with-buffer 'outputs
1159                 (ampc-insert (ampc-pad
1160                               (loop for (tag . tag-properties) in properties
1161                                     collect (with-current-buffer data-buffer
1162                                               (ampc-extract tag)))
1163                               2)
1164                              `(("outputid" . ,outputid)
1165                                ("outputenabled" . ,outputenabled))))))))))
1166
1167 (defun* ampc-mini-impl (&aux songs)
1168   (loop with next
1169         while (or (when next (goto-char next) t)
1170                   (search-forward-regexp "^file: " nil t))
1171         for entry = (save-restriction
1172                       (setf next (ampc-narrow-entry))
1173                       `(,(concat (ampc-extract "Title") " - "
1174                                  (ampc-extract "Artist"))
1175                         . ,(string-to-number (ampc-extract "Pos"))))
1176         do (loop with mentry = `(,(car entry) . ,(cdr entry))
1177                  for index from 2
1178                  while (assoc (car mentry) songs)
1179                  do (setf (car mentry) (concat (car entry)
1180                                                " (" (int-to-string index) ")"))
1181                  finally do (push mentry songs)))
1182   (unless songs
1183     (message "No song in the playlist")
1184     (return-from ampc-mini-impl))
1185   (let ((song (assoc (let ((inhibit-quit t))
1186                        (prog1
1187                            (with-local-quit
1188                              (completing-read "Song to play: " songs nil t))
1189                          (setf quit-flag nil)))
1190                      songs)))
1191     (when song
1192       (ampc-play-this (cdr song)))))
1193
1194 (defun* ampc-fill-current-playlist (&aux properties)
1195   (ampc-fill-skeleton 'current-playlist
1196     (setf properties (plist-get (cdr ampc-type) :properties))
1197     (with-current-buffer data-buffer
1198       (loop
1199        with next
1200        while (or (when next (goto-char next) t)
1201                  (search-forward-regexp "^file: " nil t))
1202        do (save-restriction
1203             (setf next (ampc-narrow-entry))
1204             (let ((file (ampc-extract "file"))
1205                   (pos (ampc-extract "Pos")))
1206               (ampc-with-buffer 'current-playlist
1207                 (ampc-insert
1208                  (ampc-pad
1209                   (loop for (tag . tag-properties) in properties
1210                         collect (or (with-current-buffer data-buffer
1211                                       (ampc-extract tag))
1212                                     "[Not Specified]"))
1213                   2)
1214                  `(("file" . ,file)
1215                    ("Pos" . ,(string-to-number pos)))
1216                  (lambda (a b)
1217                    (let ((p1 (cdr (assoc "Pos" a)))
1218                          (p2 (cdr (assoc "Pos" b))))
1219                      (cond ((< p1 p2) 'insert)
1220                            ((eq p1 p2)
1221                             (if (equal (cdr (assoc "file" a))
1222                                        (cdr (assoc "file" b)))
1223                                 'update
1224                               'insert))
1225                            (t (- p1 p2)))))))))))))
1226
1227 (defun ampc-fill-playlists ()
1228   (ampc-fill-skeleton 'playlists
1229     (with-current-buffer data-buffer
1230       (loop while (search-forward-regexp "^playlist: \\(.*\\)$" nil t)
1231             for playlist = (match-string 1)
1232             do (ampc-with-buffer 'playlists
1233                  (ampc-insert playlist playlist))))))
1234
1235 (defun ampc-yield ()
1236   (setf ampc-yield (1+ ampc-yield))
1237   (ampc-fill-status))
1238
1239 (defun ampc-fill-status ()
1240   (ampc-with-buffer 'status
1241     (delete-region (point-min) (point-max))
1242     (funcall (or (plist-get (cadr ampc-type) :filler)
1243                  (lambda (_)
1244                    (insert (ampc-status t) "\n")))
1245              ampc-status)
1246     (ampc-set-dirty nil)))
1247
1248 (defun ampc-fill-tag-song ()
1249   (loop
1250    with trees = `(,(cdr (assoc (ampc-tags) ampc-internal-db)))
1251    for w in (ampc-windows)
1252    do
1253    (ampc-with-buffer w
1254      (when (member (car ampc-type) '(tag song))
1255        (if ampc-dirty
1256            (ampc-fill-skeleton w
1257              (ecase (car ampc-type)
1258                (tag (setf trees (ampc-fill-tag trees)))
1259                (song (ampc-fill-song trees))))
1260          (setf trees nil)
1261          (loop while (search-forward-regexp "^* " nil t)
1262                do (setf trees (append (get-text-property (point) 'data)
1263                                       trees))))))))
1264
1265 (defun* ampc-transform-time (data &aux (time (string-to-number data)))
1266   (concat (number-to-string (/ time 60))
1267           ":"
1268           (when (< (% time 60) 10)
1269             "0")
1270           (number-to-string (% time 60))))
1271
1272 (defun ampc-handle-idle ()
1273   (loop until (eobp)
1274         for subsystem = (buffer-substring (point) (line-end-position))
1275         when (string-match "^changed: \\(.*\\)$" subsystem)
1276         do (case (intern (match-string 1 subsystem))
1277              (database
1278               (setf ampc-internal-db nil)
1279               (ampc-set-dirty 'tag t)
1280               (ampc-set-dirty 'song t))
1281              (output
1282               (ampc-set-dirty 'outputs t))
1283              ((player options mixer)
1284               (setf ampc-status nil)
1285               (ampc-set-dirty 'status t))
1286              (stored_playlist
1287               (ampc-set-dirty 'playlists t)
1288               (ampc-set-dirty 'playlist t))
1289              (playlist
1290               (ampc-set-dirty 'current-playlist t)
1291               (ampc-set-dirty 'status t)))
1292         end
1293         do (forward-line))
1294   (ampc-update))
1295
1296 (defun ampc-handle-setup (status)
1297   (unless (and (string-match "^ MPD \\(.+\\)\\.\\(.+\\)\\.\\(.+\\)$"
1298                              status)
1299                (let ((version-a (string-to-number (match-string 1 status)))
1300                      (version-b (string-to-number (match-string 2 status)))
1301                      ;; (version-c (string-to-number (match-string 2 status)))
1302                      )
1303                  (or (> version-a 0)
1304                      (>= version-b 15))))
1305     (error (concat "Your version of MPD is not supported.  "
1306                    "ampc supports MPD (protocol version) 0.15.0 "
1307                    "and later"))))
1308
1309 (defun ampc-fill-internal-db (running)
1310   (loop for origin = (and (search-forward-regexp "^file: " nil t)
1311                           (line-beginning-position))
1312         then next
1313         while origin
1314         do (goto-char (1+ origin))
1315         for next = (and (search-forward-regexp "^file: " nil t)
1316                         (line-beginning-position))
1317         while (or (not running) next)
1318         do (save-restriction
1319              (narrow-to-region origin (or next (point-max)))
1320              (ampc-fill-internal-db-entry))
1321         do (when running
1322              (delete-region origin next)
1323              (setf next origin))))
1324
1325 (defun ampc-tags ()
1326   (loop for w in (ampc-windows)
1327         for tag = (with-current-buffer (window-buffer w)
1328                     (when (eq (car ampc-type) 'tag)
1329                       (plist-get (cdr ampc-type) :tag)))
1330         when tag
1331         collect tag
1332         end))
1333
1334 (defun ampc-fill-internal-db-entry ()
1335   (loop
1336    with data-buffer = (current-buffer)
1337    with tree = (assoc (ampc-tags) ampc-internal-db)
1338    for w in (ampc-windows)
1339    do
1340    (with-current-buffer (window-buffer w)
1341      (ampc-set-dirty t)
1342      (ecase (car ampc-type)
1343        (tag
1344         (let ((data (or (ampc-extract (cdr ampc-type) data-buffer)
1345                         "[Not Specified]")))
1346           (unless (cdr tree)
1347             (setf (cdr tree) (ampc-create-tree)))
1348           (setf tree (avl-tree-enter (cdr tree)
1349                                      `(,data . nil)
1350                                      (lambda (data match)
1351                                        match)))))
1352        (song
1353         (push (loop for p in `(("file")
1354                                ,@(plist-get (cdr ampc-type) :properties))
1355                     for data = (ampc-extract (car p) data-buffer)
1356                     when data
1357                     collect `(,(car p) . ,data)
1358                     end)
1359               (cdr tree))
1360         (return))))))
1361
1362 (defun ampc-handle-current-song ()
1363   (loop for k in (append ampc-status-tags '("Artist" "Title"))
1364         for s = (ampc-extract k)
1365         when s
1366         do (push `(,(intern k) . ,s) ampc-status)
1367         end)
1368   (ampc-fill-status)
1369   (run-hook-with-args ampc-status-changed-hook ampc-status))
1370
1371 (defun ampc-handle-status ()
1372   (loop for k in '("volume" "repeat" "random" "consume" "xfade" "state" "song")
1373         for v = (ampc-extract k)
1374         when v
1375         do (push `(,(intern k) . ,v) ampc-status)
1376         end)
1377   (ampc-with-buffer 'current-playlist
1378     (when ampc-highlight-current-song-mode
1379       (font-lock-fontify-region (point-min) (point-max)))))
1380
1381 (defun ampc-handle-update ()
1382   (message "Database update started"))
1383
1384 (defun ampc-handle-command (status)
1385   (cond
1386    ((eq status 'error)
1387     (pop ampc-outstanding-commands))
1388    ((eq status 'running)
1389     (case (caar ampc-outstanding-commands)
1390       (listallinfo (ampc-fill-internal-db t))))
1391    (t
1392     (case (car (pop ampc-outstanding-commands))
1393       (idle
1394        (ampc-handle-idle))
1395       (setup
1396        (ampc-handle-setup status))
1397       (currentsong
1398        (ampc-handle-current-song))
1399       (status
1400        (ampc-handle-status))
1401       (update
1402        (ampc-handle-update))
1403       (listplaylistinfo
1404        (ampc-fill-playlist))
1405       (listplaylists
1406        (ampc-fill-playlists))
1407       (playlistinfo
1408        (ampc-fill-current-playlist))
1409       (mini-playlistinfo
1410        (ampc-mini-impl))
1411       (mini-currentsong
1412        (ampc-status))
1413       (listallinfo
1414        (ampc-fill-internal-db nil))
1415       (outputs
1416        (ampc-fill-outputs)))
1417     (unless ampc-outstanding-commands
1418       (ampc-update)))))
1419
1420 (defun ampc-filter (_process string)
1421   (assert (buffer-live-p (process-buffer ampc-connection)))
1422   (with-current-buffer (process-buffer ampc-connection)
1423     (when string
1424       (when ampc-debug
1425         (message "ampc: -> %s" string))
1426       (goto-char (process-mark ampc-connection))
1427       (insert string)
1428       (set-marker (process-mark ampc-connection) (point)))
1429     (save-excursion
1430       (goto-char (point-min))
1431       (let ((success))
1432         (if (or (and (search-forward-regexp
1433                       "^ACK \\[\\(.*\\)\\] {.*} \\(.*\\)\n\\'"
1434                       nil
1435                       t)
1436                      (message "ampc command error: %s (%s)"
1437                               (match-string 2)
1438                               (match-string 1))
1439                      t)
1440                 (and (search-forward-regexp "^OK\\(.*\\)\n\\'" nil t)
1441                      (setf success t)))
1442             (progn
1443               (let ((match-end (match-end 0)))
1444                 (save-restriction
1445                   (narrow-to-region (point-min) match-end)
1446                   (goto-char (point-min))
1447                   (ampc-handle-command (if success (match-string 1) 'error)))
1448                 (delete-region (point-min) match-end))
1449               (ampc-send-next-command))
1450           (ampc-handle-command 'running))))))
1451
1452 ;;; **** window management
1453 (defun ampc-windows (&optional unordered)
1454   (loop for f being the frame
1455         thereis (loop for w being the windows of f
1456                       when (eq (window-buffer w) (car-safe ampc-buffers))
1457                       return (loop for b in (if unordered
1458                                                 ampc-buffers-unordered
1459                                               ampc-buffers)
1460                                    collect
1461                                    (loop for w being the windows of f
1462                                          thereis (and (eq (window-buffer w)
1463                                                           b)
1464                                                       w))))))
1465
1466 (defun* ampc-set-tab-offsets
1467     (&rest properties &aux (min 2) (optional-padding 0))
1468   (loop for (title . props) in properties
1469         for min- = (plist-get props :min)
1470         do (setf min (+ min (or (plist-get props :width) min-)))
1471         when min-
1472         do (setf optional-padding (+ optional-padding
1473                                      (- (plist-get props :max) min-)))
1474         end)
1475   (setf ampc-tab-offsets nil)
1476   (loop for (title . props) in properties
1477         with offset = 2
1478         do (add-to-list 'ampc-tab-offsets offset t)
1479         (setf offset
1480               (+ offset (or (plist-get props :width)
1481                             (let ((min- (plist-get props :min))
1482                                   (max (plist-get props :max)))
1483                               (if (>= min (window-width))
1484                                   min-
1485                                 (min max
1486                                      (+ min-
1487                                         (floor (* (/ (float (- max min-))
1488                                                      optional-padding)
1489                                                   (- (window-width)
1490                                                      min))))))))))))
1491
1492 (defun* ampc-configure-frame-1 (split &aux (split-type (car split)))
1493   (if (member split-type '(vertical horizontal))
1494       (let* ((sizes))
1495         (loop with length = (if (eq split-type 'horizontal)
1496                                 (window-width)
1497                               (window-height))
1498               with rest = length
1499               with rest-car
1500               for subsplit in (cdr split)
1501               for s = (car subsplit)
1502               if (equal s 1.0)
1503               do (push t sizes)
1504               and do (setf rest-car sizes)
1505               else
1506               do (let ((l (if (integerp s) s (floor (* s length)))))
1507                    (setf rest (- rest l))
1508                    (push l sizes))
1509               finally do (setf (car rest-car) rest))
1510         (let ((first-window (selected-window)))
1511           (setf sizes (nreverse sizes))
1512           (loop for size in (loop for s in sizes
1513                                   collect s)
1514                 for window on (cdr sizes)
1515                 do (select-window
1516                     (setf (car window)
1517                           (split-window nil
1518                                         size
1519                                         (eq split-type 'horizontal)))))
1520           (setf (car sizes) first-window))
1521         (loop for subsplit in (cdr split)
1522               for window in sizes
1523               do (with-selected-window window
1524                    (ampc-configure-frame-1 (cdr subsplit)))
1525               if (plist-get (cddr subsplit) :point)
1526               do (select-window window)
1527               end))
1528     (setf (window-dedicated-p (selected-window)) nil)
1529     (ecase split-type
1530       ((tag song)
1531        (pop-to-buffer-same-window
1532         (get-buffer-create (concat "*ampc "
1533                                    (or (plist-get (cdr split) :tag) "Song")
1534                                    "*")))
1535        (ampc-tag-song-mode))
1536       (outputs
1537        (pop-to-buffer-same-window (get-buffer-create "*ampc Outputs*"))
1538        (ampc-outputs-mode))
1539       (current-playlist
1540        (pop-to-buffer-same-window (get-buffer-create "*ampc Current Playlist*"))
1541        (ampc-current-playlist-mode)
1542        (ampc-highlight-current-song-mode 1))
1543       (playlist
1544        (pop-to-buffer-same-window (get-buffer-create "*ampc Playlist*"))
1545        (ampc-playlist-mode))
1546       (playlists
1547        (pop-to-buffer-same-window (get-buffer-create "*ampc Playlists*"))
1548        (ampc-playlists-mode))
1549       (status
1550        (pop-to-buffer-same-window (get-buffer-create "*ampc Status*"))
1551        (ampc-mode)))
1552     (destructuring-bind
1553         (&key (properties nil) (dedicated t) (mode-line t) &allow-other-keys)
1554         (cdr split)
1555       (if properties
1556           (apply 'ampc-set-tab-offsets properties)
1557         (setf ampc-tab-offsets '(2)))
1558       (setf ampc-type split
1559             (window-dedicated-p (selected-window)) dedicated
1560             mode-line-format (when mode-line
1561                                (default-value 'mode-line-format))))
1562     (add-to-list 'ampc-all-buffers (current-buffer))
1563     (push `(,(or (plist-get (cdr split) :id)
1564                  (if (eq (car ampc-type) 'song) 9998 9999))
1565             . ,(current-buffer))
1566           ampc-buffers)
1567     (ampc-set-dirty t)))
1568
1569 (defun ampc-configure-frame (split)
1570   (if ampc-use-full-frame
1571       (progn (setf (window-dedicated-p (selected-window)) nil)
1572              (delete-other-windows))
1573     (loop with live-window = nil
1574           for w in (nreverse (ampc-windows t))
1575           if (window-live-p w)
1576           if (not live-window)
1577           do (setf live-window w)
1578           else
1579           do (delete-window w)
1580           end
1581           end
1582           finally do (if live-window (select-window live-window))))
1583   (setf ampc-buffers nil)
1584   (ampc-configure-frame-1 split)
1585   (setf ampc-buffers-unordered (mapcar 'cdr ampc-buffers)
1586         ampc-buffers (mapcar 'cdr (sort ampc-buffers
1587                                         (lambda (a b) (< (car a) (car b))))))
1588   (ampc-update)
1589   ;; fill the song, current-playlist and outputs buffer again as the tab offsets
1590   ;; might have changed
1591   (ampc-with-buffer 'song
1592     (delete-region (point-min) (point-max)))
1593   (ampc-with-buffer 'current-playlist
1594     (delete-region (point-min) (point-max)))
1595   (ampc-with-buffer 'outputs
1596     (delete-region (point-min) (point-max))))
1597
1598 (defun ampc-mouse-play-this (event)
1599   (interactive "e")
1600   (select-window (posn-window (event-end event)))
1601   (goto-char (posn-point (event-end event)))
1602   (ampc-play-this))
1603
1604 (defun ampc-mouse-delete (event)
1605   (interactive "e")
1606   (select-window (posn-window (event-end event)))
1607   (goto-char (posn-point (event-end event)))
1608   (ampc-delete 1))
1609
1610 (defun ampc-mouse-add (event)
1611   (interactive "e")
1612   (select-window (posn-window (event-end event)))
1613   (goto-char (posn-point (event-end event)))
1614   (ampc-add-impl))
1615
1616 (defun ampc-mouse-delete-playlist (event)
1617   (interactive "e")
1618   (select-window (posn-window (event-end event)))
1619   (goto-char (posn-point (event-end event)))
1620   (ampc-delete-playlist t))
1621
1622 (defun ampc-mouse-load (event)
1623   (interactive "e")
1624   (select-window (posn-window (event-end event)))
1625   (goto-char (posn-point (event-end event)))
1626   (ampc-load t))
1627
1628 (defun ampc-mouse-toggle-output-enabled (event)
1629   (interactive "e")
1630   (select-window (posn-window (event-end event)))
1631   (goto-char (posn-point (event-end event)))
1632   (ampc-toggle-output-enabled 1))
1633
1634 (defun* ampc-mouse-toggle-mark (event &aux buffer-read-only)
1635   (interactive "e")
1636   (let ((window (posn-window (event-end event))))
1637     (when (with-selected-window window
1638             (goto-char (posn-point (event-end event)))
1639             (unless (eobp)
1640               (move-beginning-of-line nil)
1641               (ampc-mark-impl (not (eq (char-after) ?*)) 1)
1642               t))
1643       (select-window window))))
1644
1645 (defun ampc-mouse-align-point (event)
1646   (interactive "e")
1647   (select-window (posn-window (event-end event)))
1648   (goto-char (posn-point (event-end event)))
1649   (ampc-align-point))
1650
1651 ;;; *** interactives
1652 (defun* ampc-unmark-all (&aux buffer-read-only)
1653   "Remove all marks."
1654   (interactive)
1655   (assert (ampc-in-ampc-p))
1656   (save-excursion
1657     (goto-char (point-min))
1658     (loop while (search-forward-regexp "^\\* " nil t)
1659           do (replace-match "  " nil nil)))
1660   (ampc-post-mark-change-update))
1661
1662 (defun ampc-trigger-update ()
1663   "Trigger a database update."
1664   (interactive)
1665   (assert (ampc-on-p))
1666   (ampc-send-command 'update))
1667
1668 (defun* ampc-toggle-marks (&aux buffer-read-only)
1669   "Toggle marks.  Marked entries become unmarked, and vice versa."
1670   (interactive)
1671   (assert (ampc-in-ampc-p))
1672   (save-excursion
1673     (loop for (a . b) in '(("* " . "T ")
1674                            ("  " . "* ")
1675                            ("T " . "  "))
1676           do (goto-char (point-min))
1677           (loop while (search-forward-regexp (concat "^" (regexp-quote a))
1678                                              nil
1679                                              t)
1680                 do (replace-match b nil nil))))
1681   (ampc-post-mark-change-update))
1682
1683 (defun ampc-up (&optional arg)
1684   "Go to the previous ARG'th entry.
1685 With optional prefix ARG, move the next ARG entries after point
1686 rather than the selection."
1687   (interactive "P")
1688   (assert (ampc-in-ampc-p))
1689   (ampc-move t arg))
1690
1691 (defun ampc-down (&optional arg)
1692   "Go to the next ARG'th entry.
1693 With optional prefix ARG, move the next ARG entries after point
1694 rather than the selection."
1695   (interactive "P")
1696   (assert (ampc-in-ampc-p))
1697   (ampc-move nil arg))
1698
1699 (defun ampc-mark (&optional arg)
1700   "Mark the next ARG'th entries.
1701 ARG defaults to 1."
1702   (interactive "p")
1703   (assert (ampc-in-ampc-p))
1704   (ampc-mark-impl t arg))
1705
1706 (defun ampc-unmark (&optional arg)
1707   "Unmark the next ARG'th entries.
1708 ARG defaults to 1."
1709   (interactive "p")
1710   (assert (ampc-in-ampc-p))
1711   (ampc-mark-impl nil arg))
1712
1713 (defun ampc-increase-volume (&optional arg)
1714   "Decrease volume.
1715 With prefix argument ARG, set volume to ARG percent."
1716   (interactive "P")
1717   (assert (ampc-on-p))
1718   (ampc-set-volume arg '+))
1719
1720 (defun ampc-decrease-volume (&optional arg)
1721   "Decrease volume.
1722 With prefix argument ARG, set volume to ARG percent."
1723   (interactive "P")
1724   (assert (ampc-on-p))
1725   (ampc-set-volume arg '-))
1726
1727 (defun ampc-increase-crossfade (&optional arg)
1728   "Increase crossfade.
1729 With prefix argument ARG, set crossfading to ARG seconds."
1730   (interactive "P")
1731   (assert (ampc-on-p))
1732   (ampc-set-crossfade arg '+))
1733
1734 (defun ampc-decrease-crossfade (&optional arg)
1735   "Decrease crossfade.
1736 With prefix argument ARG, set crossfading to ARG seconds."
1737   (interactive "P")
1738   (assert (ampc-on-p))
1739   (ampc-set-crossfade arg '-))
1740
1741 (defun ampc-toggle-repeat (&optional arg)
1742   "Toggle MPD's repeat state.
1743 With prefix argument ARG, enable repeating if ARG is positive,
1744 otherwise disable it."
1745   (interactive "P")
1746   (assert (ampc-on-p))
1747   (ampc-toggle-state 'repeat arg))
1748
1749 (defun ampc-toggle-consume (&optional arg)
1750   "Toggle MPD's consume state.
1751 With prefix argument ARG, enable consuming if ARG is positive,
1752 otherwise disable it.
1753
1754 When consume is activated, each song played is removed from the playlist."
1755   (interactive "P")
1756   (assert (ampc-on-p))
1757   (ampc-toggle-state 'consume arg))
1758
1759 (defun ampc-toggle-random (&optional arg)
1760   "Toggle MPD's random state.
1761 With prefix argument ARG, enable random playing if ARG is positive,
1762 otherwise disable it."
1763   (interactive "P")
1764   (ampc-toggle-state 'random arg))
1765
1766 (defun ampc-play-this (&optional arg)
1767   "Play selected song.
1768 With prefix argument ARG, play the ARG'th song located at the
1769 zero-indexed position of the current playlist."
1770   (interactive "P")
1771   (assert (and (ampc-on-p) (or arg (ampc-in-ampc-p))))
1772   (if (not arg)
1773       (unless (eobp)
1774         (ampc-send-command 'play nil (1- (line-number-at-pos)))
1775         (ampc-send-command 'pause nil 0))
1776     (ampc-send-command 'play nil arg)
1777     (ampc-send-command 'pause nil 0)))
1778
1779 (defun* ampc-toggle-play
1780     (&optional arg &aux (state (cdr-safe (assq 'state ampc-status))))
1781   "Toggle play state.
1782 If mpd does not play a song already, start playing the song at
1783 point if the current buffer is the playlist buffer, otherwise
1784 start at the beginning of the playlist.
1785
1786 If ARG is 4, stop player rather than pause if applicable."
1787   (interactive "P")
1788   (assert (ampc-on-p))
1789   (when state
1790     (when arg
1791       (setf arg (prefix-numeric-value arg)))
1792     (ecase (intern state)
1793       (stop
1794        (when (or (null arg) (> arg 0))
1795          (ampc-send-command
1796           'play
1797           nil
1798           (if (and (eq (car ampc-type) 'current-playlist) (not (eobp)))
1799               (1- (line-number-at-pos))
1800             0))))
1801       (pause
1802        (when (or (null arg) (> arg 0))
1803          (ampc-send-command 'pause nil 0)))
1804       (play
1805        (cond ((or (null arg) (< arg 0))
1806               (ampc-send-command 'pause nil 1))
1807              ((eq arg 4)
1808               (ampc-send-command 'stop)))))))
1809
1810 (defun ampc-next (&optional arg)
1811   "Play next song.
1812 With prefix argument ARG, skip ARG songs."
1813   (interactive "p")
1814   (assert (ampc-on-p))
1815   (ampc-skip (or arg 1)))
1816
1817 (defun ampc-previous (&optional arg)
1818   "Play previous song.
1819 With prefix argument ARG, skip ARG songs."
1820   (interactive "p")
1821   (assert (ampc-on-p))
1822   (ampc-skip (- (or arg 1))))
1823
1824 (defun ampc-rename-playlist (new-name)
1825   "Rename selected playlist to NEW-NAME.
1826 Interactively, read NEW-NAME from the minibuffer."
1827   (interactive "MNew name: ")
1828   (assert (ampc-in-ampc-p))
1829   (if (ampc-playlist)
1830       (ampc-send-command 'rename nil (ampc-playlist) new-name)
1831     (error "No playlist selected")))
1832
1833 (defun ampc-load (&optional at-point)
1834   "Load selected playlist in the current playlist.
1835 If optional argument AT-POINT is non-nil (or if no playlist is
1836 selected), use playlist at point rather than the selected one."
1837   (interactive)
1838   (assert (ampc-in-ampc-p))
1839   (if (ampc-playlist at-point)
1840       (ampc-send-command 'load nil (ampc-quote (ampc-playlist at-point)))
1841     (if at-point
1842         (error "No playlist at point")
1843       (error "No playlist selected"))))
1844
1845 (defun ampc-toggle-output-enabled (&optional arg)
1846   "Toggle the next ARG outputs.
1847 If ARG is omitted, use the selected entries."
1848   (interactive "P")
1849   (assert (ampc-in-ampc-p))
1850   (ampc-with-selection arg
1851     (let ((data (get-text-property (point) 'data)))
1852       (ampc-send-command (if (equal (cdr (assoc "outputenabled" data)) "1")
1853                              'disableoutput
1854                            'enableoutput)
1855                          nil
1856                          (cdr (assoc "outputid" data))))))
1857
1858 (defun ampc-delete (&optional arg)
1859   "Delete the next ARG songs from the playlist.
1860 If ARG is omitted, use the selected entries.  If ARG is non-nil,
1861 all marks after point are removed nontheless."
1862   (interactive "P")
1863   (assert (ampc-in-ampc-p))
1864   (let ((point (point)))
1865     (ampc-with-selection arg
1866       (let ((val (1- (- (line-number-at-pos) index))))
1867         (if (ampc-playlist)
1868             (ampc-send-command 'playlistdelete
1869                                t
1870                                (ampc-quote (ampc-playlist))
1871                                val)
1872           (ampc-send-command 'delete t val))))
1873     (goto-char point)
1874     (ampc-align-point)))
1875
1876 (defun ampc-shuffle ()
1877   "Shuffle playlist."
1878   (interactive)
1879   (assert (ampc-on-p))
1880   (if (not (ampc-playlist))
1881       (ampc-send-command 'shuffle)
1882     (ampc-with-buffer 'playlist
1883       (let ((shuffled
1884              (mapcar
1885               'car
1886               (sort (loop until (eobp)
1887                           collect `(,(cdr (assoc "file" (get-text-property
1888                                                          (+ 2 (point))
1889                                                          'data)))
1890                                     . ,(random))
1891                           do (forward-line))
1892                     (lambda (a b)
1893                       (< (cdr a) (cdr b)))))))
1894         (ampc-clear)
1895         (loop for s in shuffled
1896               do (ampc-add-impl s))))))
1897
1898 (defun ampc-clear ()
1899   "Clear playlist."
1900   (interactive)
1901   (assert (ampc-on-p))
1902   (if (ampc-playlist)
1903       (ampc-send-command 'playlistclear nil (ampc-quote (ampc-playlist)))
1904     (ampc-send-command 'clear)))
1905
1906 (defun ampc-add (&optional arg)
1907   "Add the songs associated with the next ARG entries after point
1908 to the playlist.
1909 If ARG is omitted, use the selected entries in the current buffer."
1910   (interactive "P")
1911   (assert (ampc-in-ampc-p))
1912   (ampc-with-selection arg
1913     (ampc-add-impl)))
1914
1915 (defun* ampc-status (&optional no-print)
1916   "Display and return the information that is displayed in the status window.
1917 If optional argument NO-PRINT is non-nil, just return the text.
1918 If NO-PRINT is nil, the display may be delayed if ampc does not
1919 have enough information yet."
1920   (interactive)
1921   (assert (ampc-on-p))
1922   (unless (or ampc-status no-print)
1923     (ampc-send-command 'status t)
1924     (ampc-send-command 'mini-currentsong t)
1925     (return-from ampc-status))
1926   (let* ((flags (mapconcat
1927                  'identity
1928                  (loop for (f . n) in '((repeat . "Repeat")
1929                                         (random . "Random")
1930                                         (consume . "Consume"))
1931                        when (equal (cdr (assq f ampc-status)) "1")
1932                        collect n
1933                        end)
1934                  "|"))
1935          (state (cdr (assq 'state ampc-status)))
1936          (status (concat "State:     " state
1937                          (when (and ampc-yield no-print)
1938                            (concat (make-string (- 10 (length state)) ? )
1939                                    (nth (% ampc-yield 4) '("|" "/" "-" "\\"))))
1940                          "\n"
1941                          (when (equal state "play")
1942                            (concat "Playing:   "
1943                                    (or (cdr-safe (assq 'Artist ampc-status))
1944                                        "[Not Specified]")
1945                                    " - "
1946                                    (or (cdr-safe (assq 'Title ampc-status))
1947                                        "[Not Specified]")
1948                                    "\n"))
1949                          "Volume:    " (cdr (assq 'volume ampc-status)) "\n"
1950                          "Crossfade: " (cdr (assq 'xfade ampc-status))
1951                          (unless (equal flags "")
1952                            (concat "\n" flags)))))
1953     (unless no-print
1954       (message "%s" status))
1955     status))
1956
1957 (defun ampc-delete-playlist (&optional at-point)
1958   "Delete selected playlist.
1959 If optional argument AT-POINT is non-nil (or if no playlist is
1960 selected), use playlist at point rather than the selected one."
1961   (interactive)
1962   (assert (ampc-in-ampc-p))
1963   (if (ampc-playlist at-point)
1964       (when (y-or-n-p (concat "Delete playlist " (ampc-playlist at-point) "?"))
1965         (ampc-send-command 'rm nil (ampc-quote (ampc-playlist at-point))))
1966     (if at-point
1967         (error "No playlist at point")
1968       (error "No playlist selected"))))
1969
1970 (defun ampc-store (name)
1971   "Store current playlist as NAME.
1972 Interactively, read NAME from the minibuffer."
1973   (interactive "MSave playlist as: ")
1974   (assert (ampc-in-ampc-p))
1975   (ampc-send-command 'save nil (ampc-quote name)))
1976
1977 (defun* ampc-goto-current-song
1978     (&aux (song (cdr-safe (assq 'song ampc-status))))
1979   "Select the current playlist window and move point to the current song."
1980   (interactive)
1981   (assert (ampc-in-ampc-p))
1982   (when song
1983     (ampc-with-buffer 'current-playlist
1984       no-se
1985       (select-window (ampc-get-window 'current-playlist))
1986       (goto-char (point-min))
1987       (forward-line (string-to-number song))
1988       (ampc-align-point))))
1989
1990 (defun ampc-previous-line (&optional arg)
1991   "Go to previous ARG'th entry in the current buffer.
1992 ARG defaults to 1."
1993   (interactive "p")
1994   (assert (ampc-in-ampc-p))
1995   (ampc-next-line (* (or arg 1) -1)))
1996
1997 (defun ampc-next-line (&optional arg)
1998   "Go to next ARG'th entry in the current buffer.
1999 ARG defaults to 1."
2000   (interactive "p")
2001   (assert (ampc-in-ampc-p))
2002   (forward-line arg)
2003   (if (eobp)
2004       (progn (forward-line -1)
2005              (forward-char 2)
2006              t)
2007     (ampc-align-point)
2008     nil))
2009
2010 (defun* ampc-suspend (&optional (run-hook t))
2011   "Suspend ampc.
2012 This function resets the window configuration, but does not close
2013 the connection to mpd or destroy the internal cache of ampc.
2014 This means subsequent startups of ampc will be faster."
2015   (interactive)
2016   (when ampc-working-timer
2017     (cancel-timer ampc-working-timer))
2018   (loop with found-window
2019         for w in (nreverse (ampc-windows t))
2020         when (window-live-p w)
2021         when found-window
2022         do (delete-window w)
2023         else
2024         do (setf found-window t
2025                  (window-dedicated-p w) nil)
2026         end
2027         end)
2028   (loop for b in ampc-all-buffers
2029         when (buffer-live-p b)
2030         do (kill-buffer b)
2031         end)
2032   (setf ampc-buffers nil
2033         ampc-all-buffers nil
2034         ampc-working-timer nil)
2035   (when run-hook
2036     (run-hooks 'ampc-suspend-hook)))
2037
2038 (defun ampc-mini ()
2039   "Select song to play via `completing-read'."
2040   (interactive)
2041   (assert (ampc-on-p))
2042   (ampc-send-command 'mini-playlistinfo t))
2043
2044 (defun ampc-quit (&optional arg)
2045   "Quit ampc.
2046 If called with a prefix argument ARG, kill the mpd instance that
2047 ampc is connected to."
2048   (interactive "P")
2049   (when (ampc-on-p)
2050     (set-process-filter ampc-connection nil)
2051     (when (equal (car-safe ampc-outstanding-commands) '(idle))
2052       (ampc-send-command-impl "noidle")
2053       (with-current-buffer (process-buffer ampc-connection)
2054         (loop do (goto-char (point-min))
2055               until (search-forward-regexp "^\\(ACK\\)\\|\\(OK\\).*\n\\'" nil t)
2056               do (accept-process-output ampc-connection nil 50))))
2057     (ampc-send-command-impl (if arg "kill" "close")))
2058   (when ampc-working-timer
2059     (cancel-timer ampc-working-timer))
2060   (ampc-suspend nil)
2061   (setf ampc-connection nil
2062         ampc-internal-db nil
2063         ampc-outstanding-commands nil
2064         ampc-status nil)
2065   (run-hooks 'ampc-quit-hook))
2066
2067 ;;;###autoload
2068 (defun ampc-suspended-p ()
2069   "Return non-nil if ampc is suspended."
2070   (interactive)
2071   (and (ampc-on-p)
2072        (not ampc-buffers)))
2073
2074 ;;;###autoload
2075 (defun ampc-on-p ()
2076   "Return non-nil if ampc is connected to the daemon."
2077   (interactive)
2078   (and ampc-connection (memq (process-status ampc-connection) '(open run))))
2079
2080 ;;;###autoload
2081 (defun ampc (&optional host port suspend)
2082   "ampc is an asynchronous client for the MPD media player.
2083 This function is the main entry point for ampc.
2084
2085 Non-interactively, HOST and PORT specify the MPD instance to
2086 connect to.  The values default to localhost:6600."
2087   (interactive "MHost (localhost): \nMPort (6600): ")
2088   (unless (byte-code-function-p (symbol-function 'ampc))
2089     (message "You should byte-compile ampc"))
2090   (run-hooks 'ampc-before-startup-hook)
2091   (when (or (not host) (equal host ""))
2092     (setf host "localhost"))
2093   (when (or (not port) (equal port ""))
2094     (setf port 6600))
2095   (when (and ampc-connection
2096              (or (not (equal host ampc-host))
2097                  (not (equal port ampc-port))
2098                  (not (ampc-on-p))))
2099     (ampc-quit))
2100   (unless ampc-connection
2101     (let ((connection (open-network-stream "ampc"
2102                                            (with-current-buffer
2103                                                (get-buffer-create " *ampc*")
2104                                              (delete-region (point-min)
2105                                                             (point-max))
2106                                              (current-buffer))
2107                                            host
2108                                            port
2109                                            :type 'plain :return-list t)))
2110       (unless (car connection)
2111         (error "Failed connecting to server: %s"
2112                (plist-get ampc-connection :error)))
2113       (setf ampc-connection (car connection)
2114             ampc-host host
2115             ampc-port port))
2116     (set-process-coding-system ampc-connection 'utf-8-unix 'utf-8-unix)
2117     (set-process-filter ampc-connection 'ampc-filter)
2118     (set-process-query-on-exit-flag ampc-connection nil)
2119     (setf ampc-outstanding-commands '((setup))))
2120   (if suspend
2121       (ampc-update)
2122     (ampc-configure-frame (cddar ampc-views)))
2123   (run-hooks 'ampc-connected-hook)
2124   (when suspend
2125     (ampc-suspend))
2126   (ampc-filter (process-buffer ampc-connection) nil))
2127
2128 (provide 'ampc)
2129
2130 ;; Local Variables:
2131 ;; eval: (outline-minor-mode 1)
2132 ;; outline-regexp: ";;; \\*+"
2133 ;; lexical-binding: t
2134 ;; fill-column: 80
2135 ;; indent-tabs-mode: nil
2136 ;; End: