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