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

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