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