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