1 ;;;; vim: set fenc=utf-8 lisp ic wm=0 et tw=0 sm para=lpppipnpbp sect=shuh ai :
   2 ;;;; ---------------------------------------------------------------------------
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:      mpdclient.lisp
   6 ;;;; Purpose:   A Common Lisp interface to MPD.
   7 ;;;; Author:    Stephen P. Horner
   8 ;;;; Started:   2006-03-28
   9 ;;;;
  10 ;;;; Copyright © 2006 by Stephen P. Horner - All Rights Reserved.
  11 ;;;;
  12 ;;;; This project's homepage is: http://www.common-lisp.net/project/cl-mpd
  13 ;;;;
  14 ;;;; Redistribution and use in source and binary forms, with or without
  15 ;;;; modification, are permitted provided that the following conditions
  16 ;;;; are met:
  17 ;;;;
  18 ;;;; - Redistributions of source code must retain the above copyright
  19 ;;;; notice, this list of conditions and the following disclaimer.
  20 ;;;;
  21 ;;;; - Redistributions in binary form must reproduce the above copyright
  22 ;;;; notice, this list of conditions and the following disclaimer in the
  23 ;;;; documentation and/or other materials provided with the distribution.
  24 ;;;;
  25 ;;;; - Neither the name of CL-MPD nor the names of its contributors may 
  26 ;;;; be used to endorse or promote products derived from this software 
  27 ;;;; without specific prior written permission.
  28 ;;;;
  29 ;;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  30 ;;;; ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  31 ;;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
  32 ;;;; A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE FOUNDATION OR
  33 ;;;; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  34 ;;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  35 ;;;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
  36 ;;;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
  37 ;;;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  38 ;;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  39 ;;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  40 ;;;;
  41 ;;;; ---------------------------------------------------------------------------
  42 
  43 ;;; TODO
  44 ;;; Add the code to the primary methods that execute mpd commands that checks
  45 ;;; for an active connection to mpd before executing commands, and reconnect
  46 ;;; to MPD if necessary.
  47 ;;;
  48 ;;; TODO
  49 ;;; Rewrite my parsers; all of them! This multi-STRING= method needs replacing.
  50 ;;;
  51 ;;; TODO
  52 ;;; Rewrite all the code that is using SUBSEQ to analyze parts of a sequence,
  53 ;;; because SUBSEQ conses.
  54 
  55 
  56 (eval-when (:compile-toplevel :load-toplevel)
  57   (declaim (optimize (speed 0) (space 0) (safety 1) (debug 3) (compilation-speed 0))))
  58 
  59 (in-package #:mpd)
  60 
  61 ;;; Find out when a REQUIRE is normally evaluated.
  62 (eval-when (:compile-toplevel :load-toplevel :execute)
  63   #+sbcl (require :sb-bsd-sockets)
  64   #+lispworks (require "comm"))
  65 
  66 ;;; Don't touch this.
  67 (defparameter *mpd-welcome-message*      "OK MPD ")
  68 
  69 ;;; These aren't used yet, but will be soon.
  70 (defconstant +mpd-error-not-list+        1)
  71 
  72 (defconstant +mpd-error-arg+             2)
  73 (defconstant +mpd-error-password+        3)
  74 (defconstant +mpd-error-permission+      4)
  75 (defconstant +mpd-error-unknown-cmd+     5)
  76 (defconstant +mpd-error-no-exist+       50)
  77 (defconstant +mpd-error-playlist_max+   51)
  78 (defconstant +mpd-error-system+         52)
  79 (defconstant +mpd-error-playlist-load+  53)
  80 (defconstant +mpd-error-update-already+ 54)
  81 (defconstant +mpd-error-player-sync+    55)
  82 (defconstant +mpd-error-exist+          56)
  83 
  84 (eval-when (:compile-toplevel :load-toplevel :execute)
  85   (defparameter *debug-on* t
  86   "Either NIL or T, determines if debug routines run or not."))
  87 
  88 
  89 ;;; --------------------------
  90 ;;; Utilities
  91 ;;; --------------------------
  92 
  93 (defmacro fprint (strm &body body)
  94   "FPRINT equates to forced print, since FORMAT is to dumb to print automagically."
  95   `(progn
  96      (format ,strm ,@body)
  97      (finish-output)))
  98 
  99 
 100 (defmacro dprint (&body body)
 101   "Prints debug info if code was compiled with *DEBUG-ON* set to T."
 102   (if *debug-on*
 103     `(progn
 104        (format *debug-io* ,@body)
 105        (finish-output))))
 106 
 107 
 108 (defun quit ()
 109   #+sbcl (sb-ext:quit)
 110   #+clisp (ext:quit)
 111   )
 112 
 113 (defun fullgc ()
 114   #+sbcl (sb-ext:gc :full t)
 115   #+clisp (ext:gc)
 116   )
 117 
 118 
 119 ;;; --------------------------
 120 ;;; Backend code
 121 ;;; --------------------------
 122 
 123 (defun scrub-newline-chars (str &key verbose)
 124   (when verbose
 125     (write-line "SCRUB-NEWLINE-CHARS was passed...")
 126     (let ((tmp (map 'vector #'(lambda (x)
 127                                 (format t "~@C " x))
 128                     str)))))
 129   (substitute #\Space #\Newline str :test #'char=))
 130 
 131 
 132 (declaim (inline append-newline-char))
 133 (defun append-newline-char (str)
 134   (declare (type simple-string str))
 135   (concatenate 'string str '(#\Newline)))
 136 
 137 
 138 #+sbcl
 139 (defun lookup-hostname (host &key ignore-cache)
 140   (when (stringp host)
 141     (sb-bsd-sockets:host-ent-address
 142       (sb-bsd-sockets:get-host-by-name host))))
 143 
 144 
 145 ;;; Find out how to pass the raw socket as a VALUES on clisp
 146 (defun make-active-socket (server port)
 147   "Returns (VALUES STREAM SOCKET)"
 148   #+clisp
 149   (let ((iostream (socket:socket-connect port server :external-format :unix)))
 150     (values iostream iostream))
 151   #+lispworks
 152   (let ((sock (comm:open-tcp-stream server port)))
 153     (values sock sock))
 154   #+sbcl
 155   (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
 156                                :type :stream
 157                                :protocol :tcp))
 158         (hostname (lookup-hostname server)))
 159     (sb-bsd-sockets:socket-connect socket hostname port)
 160     (values
 161       (sb-bsd-sockets:socket-make-stream socket
 162                                          :input t
 163                                          :output t
 164                                          :element-type 'base-char)
 165       socket))
 166   #-(or clisp sbcl lispworks) (error "CL-MPD is not implemented on this lisp."))
 167 
 168 
 169 (defun read-buf-nonblock (buffer stream)
 170   "Like READ-SEQUENCE, but returns early if the full quantity of data isn't there to be read.
 171   Blocks if no input at all"
 172   (let ((eof (gensym)))
 173     (do ((i 0 (1+ i))
 174          (c (read-char stream nil eof)
 175             (read-char-no-hang stream nil eof)))
 176       ((or (>= i (length buffer)) (not c) (eq c eof)) i)
 177       (setf (elt buffer i) c))))
 178 
 179 
 180 ;;; TODO
 181 ;;; 1) What is preventing this from getting the mpd welcome message in MPD-MAKE-CONNECTION?
 182 ;;; 2) What is preventing mpd-get-return-elements from getting the end OK\n?
 183 ;;; 3) Does the EOF set to OK\n work correctly?
 184 ;;; 
 185 ;;; TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO
 186 ;;; This needs to be rewritten to call another function which calls
 187 ;;; READ-BUF-NONBLOCK, so that I can then take the return of that function and
 188 ;;; pass it to CHECK-FOR-ERRORS. Then have this function do it's normat
 189 ;;; splitting the return elements into (key:value) pairs. I think this will
 190 ;;; also fix the above.
 191 (defun mpd-get-return-elements (iostream)
 192   "Returns a list of MPD return elements, each cons cell being key:value."
 193   (let ((ret ())
 194         (eof (append-newline-char "OK")))
 195     (do ((c (read-line iostream nil eof) (read-line iostream nil eof)))
 196       ((null (listen iostream)) (nreverse ret))
 197       #+nil
 198       (dprint "~&## DEBUG: in MPD-GET-RETURN-ELEMENTS pushing ~D on RET" c)
 199       (push (list c) ret))))
 200 
 201 
 202 (defun split-mpd-key-value-pair (str)
 203   (let ((pos (position #\: str)))
 204     (list (subseq str 0 pos) (subseq str (1+ pos)))))
 205 
 206 
 207 ;;; UNTESTED
 208 #+nil
 209 (defun flush-return-elements (iostream)
 210   (loop while (mpd-get-return-elements iostream)))
 211 
 212 
 213 (defun mpd-get-port ()
 214   "Get the environment variable MPD_PORT."
 215   #+clisp
 216   (let ((port (parse-integer (ext:getenv "MPD_PORT"))))
 217     (if (not (null port))
 218       port
 219       6600))
 220   #+sbcl
 221   (let ((port (parse-integer (sb-ext:posix-getenv "MPD_PORT"))))
 222     (if (not (null port))
 223       port
 224       6600))
 225   #+lispworks
 226   6600
 227   )
 228 
 229 
 230 (defun mpd-get-host ()
 231   "Get the environment variable MPD_HOST."
 232   #+clisp
 233   (let ((host (ext:getenv "MPD_HOST")))
 234     (if (not (null host))
 235       host
 236       "localhost"))
 237   #+sbcl
 238   (let ((host (sb-ext:posix-getenv "MPD_HOST")))
 239     (if (not (null host))
 240         host
 241       "localhost"))
 242   #+lispworks
 243   "localhost"
 244   )
 245 
 246 
 247 (defun mpd-make-connection (host port &key (timeout 1))
 248   "Creates a connection to MPD. Returns (VALUES STREAM SOCKET)."
 249   (let ((data (make-string 200)))
 250     (multiple-value-bind (iostream sock) (make-active-socket host port)
 251       (if (null iostream)
 252           (error "~&Failed to establish a connection with MPD, IOSTREAM was null.~%"))
 253       (sleep timeout)
 254       (let ((data (subseq data 0 (read-buf-nonblock data iostream))))
 255         (dprint "~&## DEBUG: Recieved [~D] from MPD~%" (scrub-newline-chars data))
 256         (if (not (string= *mpd-welcome-message* (subseq data 0 7)))
 257           (error "~&Failed to establish a connection with MPD, *MPD-WELCOME-MESSAGE* was bad.~%"))
 258         (values iostream sock)))))
 259 
 260 
 261 ;;; TODO Get this working with MPD-GET-RETURN-ELEMENTS
 262 #+nil
 263 (defun mpd-make-connection (host port &key (timeout 1))
 264   "Creates a connection to MPD. Returns (VALUES STREAM SOCKET)."
 265   (multiple-value-bind (iostream sock) (make-active-socket host port)
 266     (if (null iostream)
 267       (error "~&Failed to establish a connection with MPD~%"))
 268     (sleep timeout)
 269     (dprint "~&## DEBUG: LISTEN returns ~S" (listen iostream))
 270     (let ((ret (mpd-get-return-elements iostream)))
 271       (dprint "~&## DEBUG: MPD sent us... ~S." (car ret))
 272       (values iostream sock))))
 273 
 274 
 275 
 276 ;;; --------------------------
 277 ;;; MPD Commands
 278 ;;; --------------------------
 279 
 280 ;;; test if this declare helps at all
 281 (defun mpd-send-command (iostream command)
 282   (declare (optimize (speed 3) (safety 1))
 283            (type string command) (type iostream iostream))
 284   (if (open-stream-p iostream)
 285     (progn
 286       (write-string (append-newline-char command) iostream)
 287       (force-output iostream))
 288     (error "MPD-SEND-COMMAND was passed a closed stream.")))
 289 
 290 
 291 (defun mpd-send-add-command (iostream path)
 292   (let ((command (format nil "add \"~D\"" path)))
 293     (mpd-send-command iostream command)))
 294 
 295 
 296 (defun mpd-send-addid-command (iostream id)
 297   (let ((command (format nil "addid \"~S\"" id)))
 298     (mpd-send-command iostream command)))
 299 
 300 
 301 (defun mpd-send-clear-command (iostream)
 302   "Clears the current playlist."
 303   (mpd-send-command iostream "clear"))
 304 
 305 
 306 (defun mpd-send-clearerror-command (iostream)
 307   (mpd-send-command iostream "clearerror"))
 308 
 309 
 310 (defun mpd-send-close-command (iostream)
 311   "Closes the connection to MPD."
 312   (mpd-send-command iostream "close"))
 313 
 314 
 315 (defun mpd-send-commands-command (iostream)
 316   "Get list of MPD commands."
 317   (mpd-send-command iostream "commands"))
 318 
 319 
 320 (defun mpd-send-crossfade-command (iostream seconds)
 321   "Sets crossfading between songs."
 322   (let ((command (format nil "crossfade \"~S\"" seconds)))
 323     (mpd-send-command iostream command)))
 324 
 325 
 326 (defun mpd-send-currentsong-command (iostream)
 327   (mpd-send-command iostream "currentsong"))
 328 
 329 
 330 (defun mpd-send-delete-command (iostream song)
 331   "Delete the song in the playlist at SONG position."
 332   (let ((command (format nil "delete \"~D\"" song)))
 333     (mpd-send-command iostream command)))
 334 
 335 
 336 (defun mpd-send-deleteid-command (iostream songid)
 337   "Deletes SONGID in the playlist."
 338   (let ((command (format nil "deleteid \"~D\"" songid)))
 339     (mpd-send-command iostream command)))
 340 
 341 
 342 ;;; MPD-SEND-DISABLEOUPUT-COMMAND
 343 
 344 
 345 ;;; MPD-SEND-ENABLEOUTPUT-COMMAND
 346 
 347 
 348 (defun mpd-send-find-command (iostream type what)
 349   (let ((command (format nil "find \"~D\" \"~D\"" type what)))
 350     (mpd-send-command iostream command)))
 351 
 352 
 353 (defun mpd-send-kill-command (iostream)
 354   "Kills MPD."
 355   (mpd-send-command iostream "kill"))
 356 
 357 
 358 ;;; untested
 359 (defun mpd-send-list-command (iostream type &optional (arg nil arg-supplied-p))
 360   "Lists all tags of TYPE, ARG is an optional specifier such as an artist."
 361   (if arg-supplied-p
 362     (progn
 363       (let ((command (format nil "list \"~D\" \"~D\"" type arg)))
 364         (mpd-send-command iostream command)))
 365     (progn
 366       (let ((command (format nil "list \"~D\"" type)))
 367         (mpd-send-command iostream command)))))
 368 
 369 
 370 (defun mpd-send-listall-command (iostream dir)
 371   "Lists all songs and directories in DIR recursively."
 372   (let ((command (format nil "listall \"~D\"" dir)))
 373     (mpd-send-command iostream command)))
 374 
 375 
 376 (defun mpd-send-listallinfo-command (iostream dir)
 377   "Lists contents of DIR recursively, including song metadata."
 378   (let ((command (format nil "listallinfo \"~D\"" dir)))
 379     (mpd-send-command iostream command)))
 380 
 381 
 382 (defun mpd-send-load-command (iostream name)
 383   "Loads the playlist NAME.m3u from the playlist dir."
 384   (let ((command (format nil "load \"~D\"" name)))
 385     (mpd-send-command iostream command)))
 386 
 387 
 388 (defun mpd-send-lsinfo-command (iostream dir)
 389   "Lists contents of DIR from the db, including song metadata."
 390   (let ((command (format nil "lsinfo \"~D\"" dir)))
 391     (mpd-send-command iostream command)))
 392 
 393 
 394 (defun mpd-send-move-command (iostream from to)
 395   "Moves song at position FROM to position TO."
 396   (let ((command (format nil "move \"~S\" \"~S\"" from to)))
 397     (mpd-send-command iostream command)))
 398 
 399 
 400 (defun mpd-send-moveid-command (iostream songid to)
 401   "Moves the song with the id SONGID to position TO in the playlist."
 402   (let ((command (format nil "moveid \"~S\" \"~S\"" songid to)))
 403     (mpd-send-command iostream command)))
 404 
 405 
 406 (defun mpd-send-next-command (iostream)
 407   (mpd-send-command iostream "next"))
 408 
 409 
 410 (defun mpd-send-notcommands-command (iostream)
 411   (mpd-send-command iostream "notcommands"))
 412 
 413 
 414 (defun mpd-send-outputs-command (iostream)
 415   (mpd-send-command iostream "outputs"))
 416 
 417 
 418 (defun mpd-send-password-command (iostream password)
 419   "Authenticate with the server with PASSWORD."
 420   (let ((command (format nil "password \"~D\"" password)))
 421     (mpd-send-command iostream command)))
 422 
 423 
 424 (defun mpd-send-pause-command (iostream mode)
 425   "Toggles the pause state of mpd to 1 on, or 0 off."
 426   (let ((command (format nil "pause \"~S\"" mode)))
 427     (mpd-send-command iostream command)))
 428 
 429 
 430 (defun mpd-send-ping-command (iostream)
 431   (mpd-send-command iostream "ping"))
 432 
 433 
 434 (defun mpd-send-play-command (iostream song)
 435   "Plays song position number SONG in the playlist."
 436   (let ((command (format nil "play \"~S\"" song)))
 437     (mpd-send-command iostream command)))
 438 
 439 
 440 (defun mpd-send-playid-command (iostream id)
 441   "Plays song associated with ID from the playlist."
 442   (let ((command (format nil "playid \"~S\"" id)))
 443     (mpd-send-command iostream command)))
 444 
 445 
 446 ;;; don't use this, use playlistinfo instead.
 447 (defun mpd-send-playlist-command (iostream)
 448   (mpd-send-command iostream "playlist"))
 449 
 450 
 451 (defun mpd-send-playlistid-command (iostream &key songid)
 452   "Displays list of songs in the playlist, :SONG specializes on a single song id."
 453   (if songid
 454     (progn
 455       (let ((command (format nil "playlistid \"~S\"" songid)))
 456         (mpd-send-command iostream command)))
 457     (mpd-send-command iostream "playlistinfo ")))
 458 
 459 
 460 ;;; I need to totally re-write this, since this thing returns a 
 461 ;;; shit tonne of info. Also SONG is not the ID in this case, 
 462 ;;; rather it is the numerical position in the playlist.
 463 (defun mpd-send-playlistinfo-command (iostream &optional song)
 464   "Displays list of songs in the playlist, :SONG specializes on a single song."
 465   (if song
 466     (progn
 467       (let ((command (format nil "playlistinfo \"~S\"" song)))
 468         (mpd-send-command iostream command)))
 469     (mpd-send-command iostream "playlistinfo ")))
 470 
 471 
 472 (defun mpd-send-plchanges-command (iostream pls)
 473   "Displays changed songs currently in the playlist since PLS version."
 474   (let ((command (format nil "plchanges \"~S\"" pls)))
 475     (mpd-send-command iostream command)))
 476 
 477 
 478 (defun mpd-send-prev-command (iostream)
 479   (mpd-send-command iostream "previous"))
 480 
 481 
 482 (defun mpd-send-random-command (iostream mode)
 483   "Set random state to MODE, which is either 0 or 1."
 484   (let ((command (format nil "random \"~S\"" mode)))
 485     (mpd-send-command iostream command)))
 486 
 487 
 488 (defun mpd-send-repeat-command (iostream mode)
 489   "Set repeat state to MODE, which is either 0 or 1."
 490   (let ((command (format nil "repeat \"~S\"" mode)))
 491     (mpd-send-command iostream command)))
 492 
 493 
 494 (defun mpd-send-rm-command (iostream name)
 495   "Removes the playlist NAME.m3u from the playlist dir."
 496   (let ((command (format nil "rm \"~D\"" name)))
 497     (mpd-send-command iostream command)))
 498 
 499 
 500 (defun mpd-send-save-command (iostream name)
 501   "Saves the current playlist to NAME.m3u in the playlist dir."
 502   (let ((command (format nil "save \"~D\"" name)))
 503     (mpd-send-command iostream command)))
 504 
 505 
 506 (defun mpd-send-search-command (iostream type what)
 507   "Search for song containing WHAT, not case sensitive; TYPE is title, artist, album, of filename." ;
 508   (let ((command (format nil "search \"~D\" \"~D\"" type what)))
 509     (mpd-send-command iostream command)))
 510 
 511 
 512 (defun mpd-send-seek-command (iostream song time)
 513   "Seeks to position TIME in seconds of entry SONG, in the playlist."
 514   (let ((command (format nil "seek \"~S\" \"~S\"" song time)))
 515     (mpd-send-command iostream command)))
 516 
 517 
 518 (defun mpd-send-seekid-command (iostream songid time)
 519   "Seeks to the position TIME (in seconds) of the song with SONGID."
 520   (let ((command (format nil "seekid \"~S\" \"~S\"" songid time)))
 521     (mpd-send-command iostream command)))
 522 
 523 
 524 (defun mpd-send-setvol-command (iostream vol)
 525   "Set volume to VOL, with range being 0-100."
 526   (let ((command (format nil "setvol \"~S\"" vol)))
 527     (mpd-send-command iostream command)))
 528 
 529 
 530 (defun mpd-send-shuffle-command (iostream)
 531   (mpd-send-command iostream "shuffle"))
 532 
 533 
 534 (defun mpd-send-stats-command (iostream)
 535   (mpd-send-command iostream "stats"))
 536 
 537 
 538 (defun mpd-send-status-command (iostream)
 539   (mpd-send-command iostream "status"))
 540 
 541 
 542 (defun mpd-send-stop-command (iostream)
 543   (mpd-send-command iostream "stop"))
 544 
 545 
 546 (defun mpd-send-swap-command (iostream song1 song2)
 547   "Swap positions of SONG1 and SONG2."
 548   (let ((command (format nil "swap \"~S\" \"~S\"" song1 song2)))
 549     (mpd-send-command iostream command)))
 550 
 551 
 552 (defun mpd-send-swapid-command (iostream songid1 songid2)
 553   "Swap positions of SONG1 and SONG2."
 554   (let ((command (format nil "swapid \"~S\" \"~S\"" songid1 songid2)))
 555     (mpd-send-command iostream command)))
 556 
 557 
 558 (defun mpd-send-update-command (iostream &optional (path nil path-supplied-p))
 559   "Searches music directory for new music and removes old music from the db. :PATH is optional."
 560   (if path-supplied-p
 561     (progn
 562       (let ((command (format nil "update \"~D\"" path)))
 563         (mpd-send-command iostream command)))
 564     (mpd-send-command iostream "update")))
 565 
 566 
 567 (defun mpd-send-urlhandlers-command (iostream)
 568   (mpd-send-command iostream "urlhandlers"))
 569 
 570 
 571 ;;; Supposedly this is deprecated; is this true?
 572 (defun mpd-send-volume-command (iostream vol)
 573   "Increment or decrement the volume by VOL."
 574   (let ((command (format nil "volume \"~S\"" vol)))
 575     (mpd-send-command iostream command)))
 576 
 577 
 578 
 579 ;;; --------------------------
 580 ;;; MPD Command Lists
 581 ;;; --------------------------
 582 
 583 ;;; The new and improved, and 'lispy' way to implement command lists.
 584 (defmacro mpd-command-list (client &body forms)
 585   "Takes an MPD-CLIENT instance and mpd-send-command forms, then sends a command list to mpd."
 586   (let ((conn (gensym)))
 587     `(let ((,conn (mpd-iostream ,client)))
 588        (mpd-send-command ,conn "command_list_begin")
 589        ,@forms
 590        (mpd-send-command ,conn "command_list_end"))))
 591 
 592 
 593 
 594 ;;; --------------------------
 595 ;;; Classes and Methods
 596 ;;; --------------------------
 597 
 598 
 599 (deftype iostream-type ()
 600   #+sbcl 'sb-sys:fd-stream
 601   #+clisp 'stream
 602   #+lispworks 'comm:socket-stream
 603   )
 604 
 605 (deftype socket-type ()
 606   #+sbcl 'sb-bsd-sockets:inet-socket
 607   #+clisp 'stream
 608   #+lispworks 'comm:socket-stream
 609   )
 610 
 611 (defclass mpd-client ()
 612   ((iostream
 613      :initform nil
 614      :initarg :iostream
 615      :accessor mpd-iostream
 616      :type iostream-type
 617      :documentation "The input/output stream to MPD.")
 618    (socket
 619      :initform nil
 620      :initarg :socket
 621      :accessor mpd-socket
 622      :type socket-type
 623      :documentation "The raw socket to MPD.")
 624    (io-timeout
 625      :initform 1
 626      :initarg :io-timeout
 627      :accessor mpd-io-timeout
 628      :type integer
 629      :documentation "The connection timeout period in seconds")
 630    (command-list-mode
 631      :initform 0
 632      :accessor mpd-command-list-mode
 633      :type integer
 634      :documentation "Not used: 1 if we're in, 0 if not.")
 635    (host
 636      :initform (mpd-get-host)
 637      :accessor mpd-host
 638      :type string
 639      :documentation "Used to keep tabs of the host of MPD.")
 640    (port
 641      :initform (mpd-get-port)
 642      :accessor mpd-port
 643      :type integer
 644      :documentation "Used to keep tabs of the port of MPD.")))
 645 
 646 
 647 ;;; Dangerous abstraction, use with caution.
 648 (defmacro with-mpd-client-slots ((conn) &body body)
 649   `(with-slots (iostream socket io-timeout command-list-mode host port) ,conn
 650     ,@body))
 651 
 652 
 653 ;;; TODO find out if using MULTIPLE-VALUE-BIND is considered to much work for
 654 ;;; such a simple use.
 655 ;;;
 656 ;;; Create a socket and fd-stream, then setup our mpd-client appropriate object variables.
 657 (defmethod initialize-instance :after ((conn mpd-client) &rest initargs)
 658   (with-mpd-client-slots (conn)
 659     (multiple-value-bind (io sock) (mpd-make-connection host port :timeout io-timeout)
 660       (setf iostream io)
 661       (setf socket sock))))
 662 
 663 
 664 ;;; TODO
 665 ;;; Check and make sure that this works on LispWorks
 666 (defgeneric mpd-client-disconnect (mpd-client))
 667 
 668 (defmethod mpd-client-disconnect ((client mpd-client))
 669   "Closes the connection to MPD and performs any necessary cleanup."
 670   (with-mpd-client-slots (client)
 671     (mpd-send-close-command iostream)
 672     #+clisp (close socket)
 673     #+sbcl  (sb-bsd-sockets:socket-close socket)
 674     #+lispworks (close socket)
 675     ))
 676 
 677 
 678 ;;; --------------------------
 679 ;;; MPD stats
 680 ;;; --------------------------
 681 
 682 (defclass mpd-stats ()
 683   ((artists
 684      :initform 0
 685      :initarg :artists
 686      :accessor mpd-stats-artists
 687      :type integer
 688      :documentation "Number of artists.")
 689    (albums
 690      :initform 0
 691      :initarg :albums
 692      :accessor mpd-stats-albums
 693      :type integer
 694      :documentation "Number of albums.")
 695    (songs
 696      :initform 0
 697      :initarg :songs
 698      :accessor mpd-stats-songs
 699      :type integer
 700      :documentation "Number of songs.")
 701    (uptime
 702      :initform 0
 703      :initarg :uptime
 704      :accessor mpd-stats-uptime
 705      :type integer
 706      :documentation "Daemon uptime in seconds.")
 707    (db-playtime
 708      :initform 0
 709      :initarg :db-playtime
 710      :accessor mpd-stats-db-playtime
 711      :type integer
 712      :documentation "Sum of all song times in db.")
 713    (db-update
 714      :initform 0
 715      :initarg :db-update
 716      :accessor mpd-stats-db-update
 717      :type integer
 718      :documentation "Last db update in UNIX time.")
 719    (playtime
 720      :initform 0
 721      :initarg :playtime
 722      :accessor mpd-stats-playtime
 723      :type integer
 724      :documentation "Time length of music played.")))
 725 
 726 
 727 ;;; Dangerous abstraction, use with caution.
 728 (defmacro with-mpd-stats-slots ((stats) &body body)
 729   `(with-slots (artists albums songs uptime db-playtime db-update playtime) ,stats
 730     ,@body))
 731 
 732 
 733 (defgeneric mpd-update-stats (mpd-client mpd-stats))
 734 
 735 ;;; I want to know WTF the point of having STRING= when EQUAL works just as well,
 736 ;;; and is MUCH faster?
 737 (defmethod mpd-update-stats ((client mpd-client) (stats mpd-stats))
 738   (with-mpd-client-slots (client)
 739     (with-mpd-stats-slots (stats)
 740       (mpd-send-stats-command iostream)
 741       (let* ((response (mpd-get-return-elements iostream))
 742              (key-values (map 'list #'(lambda (x)
 743                                         (split-mpd-key-value-pair (car x)))
 744                               response)))
 745         #+nil
 746         (format t "~&~{~A ~}" key-values)
 747         (dolist (i key-values)
 748           (let ((key (car i))
 749                 (value (parse-integer (cadr i) :junk-allowed nil)))
 750             (cond ((string= key "artists") (setf artists value))
 751                   ((string= key "albums") (setf albums value))
 752                   ((string= key "songs") (setf songs value))
 753                   ((string= key "uptime") (setf uptime value))
 754                   ((string= key "db_playtime") (setf db-playtime value))
 755                   ((string= key "db_update") (setf db-update value))
 756                   ((string= key "playtime") (setf playtime value))
 757                   (t (warn "~&MPD-UPDATE-STATS error, Key == ~S Value == ~S"
 758                              key value)))))))))
 759 
 760 
 761 ;;; This is an EVIL! optimization, but I want to get this to work.
 762 #|
 763 (declaim (inline my-string=))
 764 (defun my-string= (str-a str-b)
 765   (declare (optimize (debug 0) (safety 0) (speed 3))
 766            (type (simple-base-string *) str-a)
 767            (type (simple-base-string *) str-b))
 768   #+(not sbcl) (equal str-a str-b)
 769   #+sbcl (string= str-a str-b))
 770 |#
 771 
 772 
 773 ;;; --------------------------
 774 ;;; MPD status
 775 ;;; --------------------------
 776 
 777 ;;; some of this shit never gets returned when I issue status; why?
 778 (defclass mpd-status ()
 779   ((volume
 780      :initform 0
 781      :initarg :volume
 782      :accessor mpd-status-volume
 783      :type integer
 784      :documentation "Volume level 0-100")
 785    (repeat
 786      :initform 0
 787      :initarg :repeat
 788      :accessor mpd-status-repeat
 789      :type integer
 790      :documentation "Repeat state 0 or 1.")
 791    (random
 792      :initform 0
 793      :initarg :random
 794      :accessor mpd-status-random
 795      :type integer
 796      :documentation "Random state 0 or 1.")
 797    (playlist
 798      :initform 0
 799      :initarg :playlist
 800      :accessor mpd-status-playlist
 801      :type integer
 802      :documentation "31-bit unsigned integer, the playlist version number.")
 803    (playlist-length
 804      :initform 0
 805      :initarg :playlist-length
 806      :accessor mpd-status-playlist-length
 807      :type integer
 808      :documentation "Integer, the length of the playlist.")
 809    (state
 810      :initform ""
 811      :initarg :state
 812      :accessor mpd-status-state
 813      :type string
 814      :documentation "play, stop, or pause")
 815    (song
 816      :initform 0
 817      :initarg :song
 818      :accessor mpd-status-song
 819      :type integer
 820      :documentation "Current song stopped on or playing, playlist song number.")
 821    (songid
 822      :initform 0
 823      :initarg :songid
 824      :accessor mpd-status-songid
 825      :type integer
 826      :documentation "Current song stopped on or playing, playlist songid.")
 827    (time
 828      :initform 0
 829      :initarg :time
 830      :accessor mpd-status-time
 831      :type string
 832      :documentation "Represents elapsed:total of current playing/paused song.")
 833    (bitrate
 834      :initform 0
 835      :initarg :bitrate
 836      :accessor mpd-status-bitrate
 837      :type integer
 838      :documentation "Instantaneous bitrate in kbps.")
 839    (xfade
 840      :initform 0
 841      :initarg :xfade
 842      :accessor mpd-status-xfade
 843      :type integer
 844      :documentation "Crossfade in seconds.")
 845    (audio
 846      :initform nil
 847      :initarg :audio
 848      :accessor mpd-status-audio
 849      :type string
 850      :documentation "sample-rate:bits:channels")
 851    (updating-db
 852      :initform 0
 853      :initarg :updating-db
 854      :accessor mpd-status-updating-db
 855      :type integer
 856      :documentation "1 if MPD is updating its db, 0 if not.")
 857    (error
 858      :initform ""
 859      :initarg :error
 860      :accessor mpd-status-error
 861      :type string
 862      :documentation "If there is an error, the message will be here.")))
 863 
 864 
 865 ;;; Dangerous abstraction, use with caution.
 866 (defmacro with-mpd-status-slots ((status) &body body)
 867   `(with-slots (volume repeat random playlist playlist-length state song songid
 868                 time bitrate xfade audio updating-db error) ,status
 869     ,@body))
 870 
 871 
 872 (defgeneric mpd-update-status (mpd-client mpd-status))
 873 
 874 ;;; I need to parse-integer the lists in AUDIO and TIME
 875 (defmethod mpd-update-status ((client mpd-client) (status mpd-status))
 876   (with-mpd-client-slots (client)
 877     (with-mpd-status-slots (status)
 878       (mpd-send-status-command iostream)
 879       (let* ((response (mpd-get-return-elements iostream))
 880              (key-values (map 'list #'(lambda (x)
 881                                         (split-mpd-key-value-pair (car x)))
 882                               response)))
 883         #+nil
 884         (format t "~&~{~A ~}" key-values)
 885         (dolist (i key-values)
 886           (let ((key (car i))
 887                 (value (string-trim '(#\Space) (cadr i))))
 888             (cond ((string= key "volume") (setf volume (parse-integer value)))
 889                   ((string= key "repeat") (setf repeat (parse-integer value)))
 890                   ((string= key "random") (setf random (parse-integer value)))
 891                   ((string= key "playlist") (setf playlist (parse-integer value)))
 892                   ((string= key "playlistlength") (setf playlist-length (parse-integer value)))
 893                   ((string= key "xfade") (setf xfade (parse-integer value)))
 894                   ((string= key "state") (setf state value))
 895                   ((string= key "song") (setf song (parse-integer value)))
 896                   ((string= key "songid") (setf songid (parse-integer value)))
 897                   ((string= key "time") (setf time value))
 898                   ((string= key "bitrate") (setf bitrate (parse-integer value)))
 899                   ((string= key "audio") (setf audio value))
 900                   ((string= key "updating_db") (setf updating-db (parse-integer value)))
 901                   ((string= key "error") (setf error value))
 902                   (t (warn "~&MPD-UPDATE-STATUS error, Key == ~S Value == ~S"
 903                              key value)))))))))
 904 
 905 ;;; TODO 
 906 ;;; write generic update MPD-STATUS obj method, and the INITIALIZE-INSTANCE
 907 ;;; :after method
 908 
 909 
 910 
 911 ;;; --------------------------
 912 ;;; MPD songs/currentsong
 913 ;;; --------------------------
 914 
 915 ;;; Big TODO, need to mention to MPD dev's that on these slots that are integer only slots, that I really need MPD to not pass me non integers like Track: 9/12
 916 
 917 (defclass mpd-song ()
 918   ((file
 919      :initform nil
 920      :initarg :file
 921      :accessor mpd-song-file
 922      :type string
 923      :documentation "Relative pathname of the the current playing/paused song.")
 924    (artist
 925      :initform nil
 926      :initarg :artist
 927      :accessor mpd-song-artist
 928      :type string
 929      :documentation "Song artist, may be nil.")
 930    (title
 931      :initform nil
 932      :initarg :title
 933      :accessor mpd-song-title
 934      :type string
 935      :documentation "Song title, may be nil.")
 936    (album
 937      :initform nil
 938      :initarg :album
 939      :accessor mpd-song-album
 940      :type string
 941      :documentation "Song album, may be nil.")
 942    (track
 943      :initform nil
 944      :initarg :track
 945      :accessor mpd-song-track
 946      :type string
 947      :documentation "Song track, may be nil.")
 948    (name
 949      :initform nil
 950      :initarg :name
 951      :accessor mpd-song-name
 952      :type string
 953      :documentation "Song name, may be nil.")
 954    (date
 955      :initform nil
 956      :initarg :date
 957      :accessor mpd-song-date
 958      :type string
 959      :documentation "I'm not sure wtf this is here for...?")
 960    (genre
 961      :initform nil
 962      :initarg :genre
 963      :accessor mpd-song-genre
 964      :type string
 965      :documentation "Song's genre.")
 966    (composer
 967      :initform nil
 968      :initarg :composer
 969      :accessor mpd-song-composer
 970      :type string
 971      :documentation "Songs composer.")
 972    (time
 973      :initform 0
 974      :initarg :time
 975      :accessor mpd-song-time
 976      :type integer
 977      :documentation "Song length in seconds.")
 978    (position
 979      :initform nil
 980      :initarg :position
 981      :accessor mpd-song-position
 982      :type integer
 983      :documentation "The position of the song in the playlist.")
 984    (id
 985      :initform 0
 986      :initarg :id
 987      :accessor mpd-song-id
 988      :type integer
 989      :documentation "Song ID for a song in the playlist.")
 990    (initialized
 991      :initform nil
 992      :accessor mpd-song-initialized
 993      :type integer
 994      :documentation "0 or 1: Keeps tabs on if this object has been initialized.")))
 995 
 996 
 997 ;;; Dangerous abstraction, use with caution.
 998 (defmacro with-mpd-song-slots ((song) &body body)
 999   `(with-slots (file artist title album track name date genre composer time position id initialized) ,song
1000     ,@body))
1001 
1002 ;;; Write an INITIALIZE-INSTANCE :AFTER method that allows you to initialize the song to
1003 ;;; SONG or SONGID by using :POSITION for song and :ID for songid
1004 
1005 ;;; NOTES/TODOS/BUGS:
1006 ;;;
1007 ;;; 1) Write this so that it can get the key/values from a song or songid, but
1008 ;;; default to MPD-SEND-CURRENTSONG-COMMAND.
1009 ;;;
1010 ;;; 2) Find out and complain! about the key discrepensies with songs, which
1011 ;;; really should be completely lowercase like status and stats keys.
1012 ;;;
1013 ;;; Ok at the moment this only allows the object to be initialized to either 
1014 ;;;   A) the current song, or 
1015 ;;;   B) the song in the playlist held in MPD-SONG-POSITION.
1016 
1017 ;;; Why doesn't this clear out my slots? I want to use this in my :before method
1018 ;;; for MPD-UPDATE-SONG.
1019 #+nil
1020 (defmacro unbind-slot (obj slot)
1021   `(if (