vlc.rkt
#lang racket/base
;; For legal info, see file "info.rkt".

(require (for-syntax racket/base)
         net/uri-codec
         net/url
         racket/port
         racket/tcp
         (planet neil/mcfly))

(module+ test
  (require (planet neil/overeasy)))

(doc (section "Introduction")
     
     (para "This "
           (racket vlc)
           " package permit Racket programs to start and control a "
           (hyperlink "http://www.videolan.org/vlc/" "VideoLAN VLC")
           " media player, for playing video and audio.")
     
     (para "VLC itself is a separate computer program, and must be installed
separately.")
     
     (para "This package uses the "
           (hyperlink
            "http://www.videolan.org/doc/play-howto/en/ch04.html#id590986"
            "VLC RC interface")
           " over TCP.  The Racket host OS process's address space is isolated
from potential memory-handling defects in the various native code libraries
involved in media playing.")
     
     (para "For a simple example of using this package, imagine that you are
studying how to improve a corporate training video, and you have a theory that
the video would be more efficacious, were minimum-wage new hires not bored to
catatonia by the CEO's rambling 10-minute introduction.  Fortunately, you have
human subjects available, since the new hires all use a Racket-based training
system that can be modified quickly to add scientific experiments, showing the
CEO's intro to some subjects but not to others.  Unfortunately, you can't just
edit the training video to make an alternate version without the CEO's intro,
since the CEO is an aspiring Hollywood actor, who negotiated ``points'' on DVD
sales.  Fortunately, you can use VLC and this Racket "
           (tt "vlc")
           " package, to launch the pertinent DVD chapter and seek past the
initial 10 minutes of Valium:")
     
     (racketblock
      (start-vlc "dvd:///dev/dvd#1:2")
      (wait-for-vlc-active-playing)
      (vlc-seek 594))
     
     (para "In addition to highly contrived examples like that, this package is
being used as part of a Racket-based home theatre system being developed.")
     
     (para "This package is currently developed using VLC 2.0.3, on Debian
GNU/Linux, and has been observed to also work on Mac OS X.  MS Windows is not
currently supported (since, on MS Windows, VLC 2.0.3 does not support the RC
interface, and instead uses something called "
           (tt "oldrc")
           ")."))

(doc (section "Exceptions")
     
     (para "In addition to "
           (racket exn:fail)
           ", this package raises a few package-specific exceptions:")
     
     (itemlist (item (racket exn:fail:vlc)
                     (itemlist (item (racket exn:fail:vlc:command))
                               (item (racket exn:fail:vlc:protocol))
                               (item (racket exn:fail:vlc:process))))))

(doc (defstruct* (exn:fail:vlc? exn:fail)
       ()
       (para "Exception regarding VLC. This is an abstract supertype for other
exceptions.")))
(provide exn:fail:vlc?)
(define-struct (exn:fail:vlc exn:fail) ())

(doc (defstruct* (exn:fail:vlc:command? exn:fail:vlc)
       ((input  (or/c #f string?))
        (output (or/c #f string?)))
       (para "Exception regarding receiving a presumed error message in
response to a VLC RC command.")))
(provide exn:fail:vlc:command?
         exn:fail:vlc:command-input
         exn:fail:vlc:command-output)
(define-struct (exn:fail:vlc:command exn:fail:vlc)
  (input output))

(doc (defstruct* (exn:fail:vlc:protocol? exn:fail:vlc)
       ()
       (para "Exception regarding receiving seemingly bad RC protocol from a
VLC process, but that is not necessarily an error message.  For example, a
hypothetical VLC version might change the behavior of a particular command to
return a floating-point number when an integer is expected.  When these
exceptions occur, it may be that the process and connection are still viable,
just that this particular command cannot be performed.")))
(provide exn:fail:vlc:protocol?)
(define-struct (exn:fail:vlc:protocol exn:fail:vlc)
  (input output))

(doc (defstruct* (exn:fail:vlc:process? exn:fail:vlc)
       ()
       (para "Exception regarding running a VLC process or communicating with
with a VLC process.  These generally mean that further communication with the
process is futile.")))
(provide exn:fail:vlc:process?)
(define-struct (exn:fail:vlc:process exn:fail:vlc) ())

(doc (section "Processes & Connections")
     
     (para "A connection to a VLC process is represented by the "
           (racket vlc)
           " object.  This connection can be to a process that is started by
the "
           (racket start-vlc)
           " procedure, or an existing VLC process (possibly on a host
elsewhere on the network)."))

(define (%vlc:vlc-custom-write vlc port mode)
  (fprintf port
           "#<vlc :live? ~S :hostname ~S :port ~S ~A>"
           (vlc-live?    vlc)
           (vlc-hostname vlc)
           (vlc-port     vlc)
           (if (vlc-command-line vlc)
               (format " :pid ~S :command-line ~S"
                       (subprocess-pid (vlc-subprocess vlc))
                       (vlc-command-line vlc))
               "")))

(doc (defproc (vlc? (x any/c))
       boolean?
       (para "Predicate for whether or not "
             (racket x)
             " is a "
             (racket vlc)
             " object.")))
(provide vlc?)

(define-struct vlc
  (sema
   (live? #:mutable)
   hostname
   port
   in
   out
   in-buf
   prompt-key
   command-line
   subprocess)
  #:methods gen:custom-write
  ((define write-proc %vlc:vlc-custom-write)))

(define-syntax %vlc:make-vlc-object/kw
  (syntax-rules ()
    ((_ #:sema         SEMA
        #:live?        LIVE?
        #:hostname     HOSTNAME
        #:port         PORT
        #:in           IN
        #:out          OUT
        #:in-buf       IN-BUF
        #:prompt-key   PROMPT-KEY
        #:command-line COMMAND-LINE
        #:subprocess   SUBPROCESS)
     (make-vlc SEMA
               LIVE?
               HOSTNAME
               PORT
               IN
               OUT
               IN-BUF
               PROMPT-KEY
               COMMAND-LINE
               SUBPROCESS))))

(define %vlc:in-buf-size 8192)

(doc (defparam current-vlc
       vlc
       (or/c vlc? #f)
       (para "Parameter for the "
             (racket vlc)
             " to use as the default for most procedures in this package
when the optional "
             (racket #:vlc)
             " argument is not supplied to the procedure.")))
(provide current-vlc)
(define current-vlc (make-parameter #f))

;; TODO: !!! finish converting errors to new exception types

(define (%vlc:connect #:error-name         error-name
                      #:port               port
                      #:hostname           hostname
                      #:connecting-timeout connecting-timeout
                      #:command-line       command-line
                      #:subprocess         subprocess)
  (log-debug (format "~S: connecting to ~S:~S ..."
                     error-name
                     hostname
                     port))
  (let*-values (((end-ms) (+ (current-inexact-milliseconds)
                             (* 1e3 connecting-timeout)))
                ((in out)
                 (let loop ((attempt 1))
                   (with-handlers* ((exn:fail:network?
                                     (lambda (e)
                                       (if (> (current-inexact-milliseconds)
                                              end-ms)
                                           (raise (exn:fail:vlc:process
                                                   (format "~S: could not connect to VLC RC at ~S:~S within timeout ~S seconds after ~S attempts: ~S"
                                                           error-name
                                                           hostname
                                                           port
                                                           connecting-timeout
                                                           attempt
                                                           (exn-message e))
                                                   (current-continuation-marks)))
                                           (begin (log-debug (format "~S: connect attempt ~S failed; reattempting..."
                                                                     error-name
                                                                     attempt))
                                                  (sleep 0.1)
                                                  (loop (+ 1 attempt)))))))
                     (tcp-connect/enable-break hostname port))))
                ((in-buf)       (make-bytes %vlc:in-buf-size))
                ((prompt-key)   (string->bytes/latin-1 (number->string (random 4294967087))))
                ((prompt-bytes) (bytes-append #"RACKET-VLC-RC-PROMPT-"
                                              prompt-key
                                              #"> "))
                ((vlc)          (%vlc:make-vlc-object/kw
                                 #:sema         (make-semaphore 1)
                                 #:live?        #t
                                 #:hostname     hostname
                                 #:port         port
                                 #:in           in
                                 #:out          out
                                 #:in-buf       in-buf
                                 #:prompt-key   prompt-key
                                 #:command-line command-line
                                 #:subprocess   subprocess)))
    (log-debug (format "~S: connected"
                       error-name))
    (let loop-consume-any-input ((seen-any?    #f)
                                 (have-prompt? #f))
      (log-debug (format "~S: syncing waiting for input..."
                         error-name))
      (let ((evt (with-handlers* ((exn:fail? (lambda (e)
                                               (raise (exn:fail:vlc:process
                                                       (format "~S: error during sync: ~S"
                                                               error-name
                                                               (exn-message e))
                                                       (exn-continuation-marks e))))))
                   (sync/timeout/enable-break (if seen-any?
                                                  1
                                                  (max 1
                                                       (- end-ms
                                                          (current-inexact-milliseconds))))
                                              in))))
        (if evt
            (begin (log-debug (format "~S: syncing on ~S"
                                      error-name
                                      evt))
                   (let ((count-or-eof (with-handlers* ((exn:fail? (lambda (e)
                                                                     (raise (exn:fail:vlc:process
                                                                             (format "~S: error reading during syncing: ~S"
                                                                                     error-name
                                                                                     (exn-message e))
                                                                             (exn-continuation-marks e))))))
                                         (read-bytes-avail!/enable-break in-buf in))))
                     (if (eof-object? count-or-eof)
                         (raise (exn:fail:vlc:process
                                 (format "~S: got EOF while syncing"
                                         error-name)
                                 (current-continuation-marks)))
                         (begin (log-debug (format "~S: syncing skipped ~S"
                                                   error-name
                                                   (subbytes in-buf 0 count-or-eof)))
                                (if (and (>= count-or-eof 1)
                                         (regexp-match? #rx#"> ?$" in-buf
                                                        (max 0 (- count-or-eof 2))
                                                        count-or-eof))
                                    (loop-consume-any-input #t #t)
                                    (loop-consume-any-input #t #f))))))
            (begin
              (if seen-any?
                  (if have-prompt?
                      (log-debug (format "~S: syncing timeout without any more input"
                                         error-name))
                      (log-warning (format "~S: syncing saw some input but not a prompt"
                                           error-name)))
                  (log-warning (format "~S: syncing did not see any input"
                                       error-name)))
              (%vlc:command-without-output error-name
                                           vlc
                                           (bytes-append #"set prompt \""
                                                         prompt-bytes
                                                         #"\"\n"))
              vlc))))))

(doc (defproc (connect-to-vlc
               (#:port               port               (and/c exact-nonnegative-integer?
                                                               (integer-in 1 65535)))
               (#:hostname           hostname           string? "localhost")
               (#:connecting-timeout connecting-timeout (and/c real? (not/c negative?)) 5.0)
               (#:set-current-vlc?   set-current-vlc?   boolean?               #t))
       vlc?
       (para "Connect to the RC interface on an existing process, at TCP "
             (racket hostname)
             " and "
             (racket port)
             ", and return a "
             (racket vlc)
             " object.  If "
             (racket set-current-vlc?)
             " is true, which is the default, then the "
             (racket current-vlc)
             " parameter is also set.")
       (para (racket connecting-timeout)
             " is a guideline of the maximum number of seconds total that
should be spend attempting to get a TCP connection to the VLC process and then
exchange certain initial protocol.  It is not a hard limit, however.  Note that
multiple attempts at the TCP connection may be tried within that limit, for
situations such as waiting for a VLC process to start up.")))
(provide connect-to-vlc)
(define (connect-to-vlc #:port               port
                        #:hostname           (hostname           "localhost")
                        #:connecting-timeout (connecting-timeout 0.5)
                        #:set-current-vlc?   (set-current-vlc?   #t))
  (let ((vlc (%vlc:connect #:error-name           'connect-to-vlc
                           #:port                 port
                           #:hostname             hostname
                           #:connecting-timeout connecting-timeout
                           #:command-line         #f
                           #:subprocess           #f)))
    (and set-current-vlc? (current-vlc vlc))
    vlc))

(define (%vlc:get-unused-tcp-port-number (hostname "localhost"))
  ;; TODO: Turn any exception into an exn:fail:vlc:process?
  (let ((listener (tcp-listen 0 1 #f hostname)))
    (let-values (((local-hostname local-port remote-hostname remote-port)
                  (tcp-addresses listener #t)))
      (tcp-close listener)
      local-port)))

(define (%vlc:do-process-logger pid logger level stdout-in stderr-in)
  (let* ((buf-size 256)
         (buf      (make-bytes buf-size)))
    (if logger
        (log-debug (format "vlc: logging process ~S stdout and stderr to ~S"
                           pid
                           logger))
        (log-debug (format "vlc: discarding process ~S stdout and stderr"
                           pid)))
    (let loop ((evts (list stdout-in stderr-in)))
      (if (null? evts)
          (log-debug (format "vlc: process ~S stdout and stderr done"
                             pid))
          (let ((evt (apply sync/enable-break evts)))
            (let ((port-name (cond ((eq? evt stdout-in) 'stdout)
                                   ((eq? evt stderr-in) 'stderr)
                                   (else (error '%vlc:do-process-logger
                                                "got unknown event ~S from PID ~S"
                                                evt
                                                pid)))))
              (let ((num (read-bytes-avail!/enable-break buf evt 0 buf-size)))
                (cond ((number? num)
                       (and logger
                            (parameterize ((current-logger logger))
                              (log-message logger
                                           level
                                           (format "vlc ~S ~S: ~S"
                                                   pid
                                                   port-name
                                                   (subbytes buf 0 num))
                                           #f)))
                       (loop evts))
                      ((eof-object? num)
                       (log-debug (format "vlc: process ~S ~S EOF"
                                          pid
                                          port-name))
                       (loop (remq evt evts)))
                      ((procedure? num)
                       (log-warning (format "vlc: process ~S ~S special object ~S"
                                            pid
                                            port-name
                                            num))
                       (loop evts))
                      (else
                       (error '%vlc:do-process-logger
                              "process ~S ~S unknown object ~S"
                              pid
                              port-name
                              num))))))))))

(doc (defproc (start-vlc
               (#:port               port               (or/c #f
                                                              (and/c exact-nonnegative-integer?
                                                                     (integer-in 1 65535)))
                                     #f)
               (#:hostname           hostname           string?                "localhost")
               (#:connecting-timeout connecting-timeout (or/c #f (and/c real? (not/c negative?)))
                                     60.0)
               (#:logger             logger             (or/c #f logger?)      (current-logger))
               (#:logger-level       logger-level       (or/c 'fatal 'error 'warning 'info 'debug) 'info)
               (#:set-current-vlc?   set-current-vlc?   boolean?               #t)
               (#:command            command            (or/c #f path-string?) #f)
               (                     extra-args         (listof (or/c string? path?)) '())
               ...)
       vlc?
       (para "Start a VLC process on the same machine on which this Racket
program is running, with RC enabled, and connect to it.  A "
             (racket vlc)
             " object is returned.  If "
             (racket set-current-vlc?)
             " is true, which is the default, then the "
             (racket current-vlc)
             " parameter is also set.")
       (para (racket command)
             " is a string or "
             (racket path)
             " object for the complete path to the VLC executable; or, if the default of "
             (racket #f)
             ", then this package attempts to find the VLC executable.")
       (para "This package supplies some command-line arguments to VLC, to set
up the RC interface.  Additional command-line arguments can be supplied as
strings and/or "
             (racket path)
             " objects to the "
             (racket extra-args)
             " argument of this procedure.")
       (racketblock
        (start-vlc "--snapshot-path=/home/me/film-class/review-screenshots"
                   "dvd:///dev/dvd"))
       (para "If "
             (racket logger)
             " is "
             (racket #f)
             ", then "
             (tt "stdout")
             " and "
             (tt "stderr")
             " output is consumed and ignored.  Otherwise, such output is
redirected to the logger, with the log level specified by "
             (racket logger-level)
             ".")
       (para "If "
             (racket port)
             " is "
             (racket #f)
             ", which is the default, then this package attempts to select a
TCP port in the ephemeral range for VLC to use for RC; otherwise, "
             (racket port)
             " is the port number to use.")
       (para (racket hostname)
             " is the string hostname (or the IP address as a string) on which
VLC should listen on the TCP port for RC.  By default, this is "
             (racket "localhost")
             ", which is what you normally want with "
             (racket start-vlc)
             " rather than "
             (racket connect-to-vlc)
             ".  In the unlikely event that you wish for the RC port of this
VLC process to also be accessible from other hosts, you may supply the hostname
or IP address for a non-"
             (tt "localhost")
             " interface.")
       (para (racket connecting-timeout)
             " is as documented for "
             (racket connect-to-vlc)
             ".")
       (para "The VLC process is started under the current custodian.  If you are calling "
             (racket start-vlc)
             " from a short-lived thread with its own custodian that you
shutdown as the thread exits, such as for an HTTP request that triggers
starting of VLC, you might want to do something like:")
       (racketblock
        (parameterize ((current-custodian #,(italic "<long-lived-custodian>")))
          (start-vlc)))))
(provide start-vlc)
(define (start-vlc
         #:hostname           (hostname           "localhost")
         #:port               (port               0)
         #:connecting-timeout (connecting-timeout 60.0)
         #:logger             (logger             (current-logger))
         #:logger-level       (logger-level       'info)
         #:set-current-vlc?   (set-current-vlc?   #t)
         #:command            (command            #f)
         . extra-args)
  (let*-values
      (((port)
        (if (zero? port)
            (with-handlers* ((exn:fail? (lambda (e)
                                          (raise (exn:fail:vlc:process
                                                  (format "start-vlc: could not get unused TCP port number: ~S"
                                                          (exn-message e))
                                                  (exn-continuation-marks e))))))
              (%vlc:get-unused-tcp-port-number hostname))
            port))
       ((command)
        (cond ((not command)
               (cond ((find-executable-path "vlc") => path->string)
                     ((find-executable-path "VLC") => path->string)
                     (else (let loop ((lst '("/usr/local/bin/vlc"
                                             "/Applications/VLC.app/Contents/MacOS/VLC"
                                             "\\Program Files\\VideoLAN\\VLC\\vlc.exe"
                                             "C:\\Program Files\\VideoLAN\\VLC\\vlc.exe")))
                             (if (null? lst)
                                 (raise (exn:fail:vlc:process
                                         "start-vlc: #:command was #f and could not find VLC executable"
                                         (current-continuation-marks)))
                                 (let ((str (car lst)))
                                   (if (file-exists? str)
                                       (begin (log-debug (format "start-vlc: VLC was not in executable search path, but found it in ~S"
                                                                 str))
                                              str)
                                       (loop (cdr lst)))))))))
              ((string? command) command)
              ((path?   command) (path->string command))
              (else (raise-type-error 'start-vlc
                                      "(or/c #f string? path?)"
                                      command))))
       ((args)
        `("-I"
          "rc"
          ,(string-append "--rc-host="
                          hostname
                          ":"
                          (number->string port))
          ,@(map (lambda (arg)
                   (cond ((path? arg) (path->string arg))
                         (else arg)))
                 extra-args)))
       ((subproc stdout-in stdin-out stderr-in)
        (parameterize ((subprocess-group-enabled          #t)
                       (current-subprocess-custodian-mode 'kill))
          (with-handlers* ((exn:fail? (lambda (e)
                                        (raise (exn:fail:vlc:process
                                                (format "start-vlc: subprocess call failed: ~S"
                                                        (exn-message e)))
                                               (exn-continuation-marks e)))))
            (apply subprocess
                   #f ; stdout
                   #f ; stdin
                   #f ; stderr
                   (cons command args))))))
    (with-handlers* ((exn:fail? (lambda (e)
                                  (log-debug "start-vlc: attempting to kill subprocess due to exception")
                                  (with-handlers* ((exn:fail? (lambda (e)
                                                                (log-debug (format "start-vlc: subprocess kill failed: ~S"
                                                                                   (exn-message e))))))
                                    (subprocess-kill subproc #t)
                                    (raise e)))))
      (log-debug (format "start-vlc: process PID is ~S"
                         (subprocess-pid subproc)))
      (let ((vlc (%vlc:connect #:error-name         'start-vlc
                               #:port               port
                               #:hostname           hostname
                               #:connecting-timeout connecting-timeout
                               #:command-line       (cons command args)
                               #:subprocess         subproc)))
        (thread (lambda ()
                  (%vlc:do-process-logger (subprocess-pid subproc)
                                          logger
                                          logger-level
                                          stdout-in
                                          stderr-in)))
        (and set-current-vlc? (current-vlc vlc))
        vlc))))

(doc (section "URLs")
     
     (para "URLs may be provided to VLC commands in any of a few different
formats.  See documentation for "
           (racket vlc-url?)
           "."))

(define %vlc:fully-url-escape-byte-string
  (let ((hex-ascii-bytes-vector
         '#(48 49 50 51 52 53 54 55 56 57 97 98 99 100 101 102)))
    (lambda (bstr)
      (let* ((bstr-len (bytes-length bstr))
             (result   (make-bytes (* 3 bstr-len) 37)))
        (let loop ((i 0))
          (if (= i bstr-len)
              result
              (let ((byte  (bytes-ref bstr i))
                    (start (+ 1 (* 3 i))))
                (bytes-set! result
                            start
                            (vector-ref hex-ascii-bytes-vector
                                        (quotient byte 16)))
                (bytes-set! result
                            (+ 1 start)
                            (vector-ref hex-ascii-bytes-vector
                                        (remainder byte 16)))
                (loop (+ 1 i)))))))))

(define %vlc:char->fully-url-escaped-utf-8-byte-string
  (let* ((compute    (lambda (chr)
                       (%vlc:fully-url-escape-byte-string
                        (string->bytes/utf-8 (string chr)))))
         (cache-size 256)
         (cache      (for/vector ((i (in-range 0 256)))
                       (compute (integer->char i)))))
    (lambda (chr)
      (let ((num (char->integer chr)))
        (if (< num cache-size)
            (vector-ref cache num)
            (compute chr))))))

(define (%vlc:path-string->file-url-escaped-bytes str)
  (let ((str-len (string-length str)))
    (let loop ((start          0)
               (reverse-result '()))
      (cond ((= start str-len)
             (if (null? reverse-result)
                 (string->bytes/latin-1 str)
                 (apply string-append
                        (reverse reverse-result))))
            ((regexp-match-positions #rx"[^-_./0-9A-Za-z]" str start)
             => (lambda (m)
                  (let ((char-pos   (caar m))
                        (next-start (cdar m)))
                    (loop next-start
                          (cons (%vlc:char->fully-url-escaped-utf-8-byte-string (string-ref str char-pos))
                                (if (= char-pos start)
                                    reverse-result
                                    (cons (string->bytes/latin-1 (substring str start char-pos))
                                          reverse-result)))))))
            ((null? reverse-result) (string->bytes/latin-1 str))
            (else (apply bytes-append
                         (reverse (cons (string->bytes/latin-1 (substring str start str-len))
                                        reverse-result))))))))

(define (%vlc:string->vlc-rc-url-bytes str)
  (if (regexp-match? #rx"^[a-z][-a-z0-9]+:" str)
      (string->bytes/latin-1 str)
      (%vlc:path-string->vlc-rc-url-bytes str)))

(define (%vlc:path-string->vlc-rc-url-bytes path-str)
  (let ((file-url-escaped-bytes (%vlc:path-string->file-url-escaped-bytes path-str)))
    (if (regexp-match? #rx#"^/"  file-url-escaped-bytes)
        (bytes-append #"file://" file-url-escaped-bytes)
        (bytes-append #"file:"   file-url-escaped-bytes))))

(doc (defproc (vlc-url? (x any/c))
       boolean?
       (para "Predicate for whether or not "
             (racket x)
             " can (likely) be used as a URL argument to procedures like "
             (racket vlc-add)
             " and "
             (racket vlc-enqueue)
             ".  Specifically, URLs can be represented as one of the following:")
       (itemlist
        ;; TODO: Document UTF-8.
        
        (item "String starting with a URL scheme, such as "
              (racket "http://example.com/foo.mp4")
              ".  Note that this string must contain a "
              (tt "%")
              "-escaped URL, with no spaces or other problematic characters.")
        
        (item (racket url)
              " object, such as is produced by "
              (racket (string->url "http://example.com/bar/foo.mp4"))
              ".")
        
        (item "String "
              (italic "not")
              " starting with a URL scheme, such as "
              (racket "/home/billybob/tractors.mp4")
              ", which is a file path.")
        
        (item (racket path)
              " object, such as is produced by "
              (racket (string->path "/home/scotty/sheep.wav"))
              ".")
        
        (item "Byte string of a complete URL in UTF-8 encoding, including "
              (tt "%")
              "-escaping.  This is passed verbatim in the RC protocol."))
       
       (para "Note that URLs provided to commands are processed by the VLC
program, which might be on a different computer than the Racket program that is
sending commands.  URLs that may be accessed from one computer can't
necessarily be accessed by another.")))
(provide vlc-url?)
(define (vlc-url? x)
  ;; TODO: Maybe do some sanity-checking on the "bytes?" one, like it begins
  ;; with a URL scheme.
  (or (string? x) (path? x) (url? x) (bytes? x)))

(doc (defproc (to-vlc-rc-url-bytes (x (or/c string? path? url? bytes?)))
       bytes?
       (para "Accepts a VLC URL as described in the documentation for "
             (racket vlc-url?)
             " and yields a byte string representation.  Note that, if "
             (racket x)
             " is a byte string, then it is returned verbatim.  This procedure
will not be called directly by most programs using this package.")))
(provide to-vlc-rc-url-bytes)
(define (to-vlc-rc-url-bytes x)
  (cond ((string? x) (%vlc:string->vlc-rc-url-bytes x))
        ((path?   x) (%vlc:path-string->vlc-rc-url-bytes (path->string x)))
        ((url?    x) (string->bytes/latin-1
                      (parameterize ((current-alist-separator-mode 'amp))
                        (url->string x))))
        ((bytes?  x) x)
        (else (raise-type-error 'to-vlc-rc-url-bytes
                                "(or/c string? bytes? path? url)"
                                x))))

(module+ test
  (test (to-vlc-rc-url-bytes "foo.mp4")     #"file:foo.mp4")
  (test (to-vlc-rc-url-bytes "foo bar.mp4") #"file:foo%20bar.mp4")
  (test (to-vlc-rc-url-bytes "/foo.mp4")     #"file:///foo.mp4")
  (test (to-vlc-rc-url-bytes "/foo bar.mp4")       #"file:///foo%20bar.mp4")
  (test (to-vlc-rc-url-bytes "http://foo/bar.mp4") #"http://foo/bar.mp4")
  (test (to-vlc-rc-url-bytes #"http://foo/bar.mp4") #"http://foo/bar.mp4")
  (test (to-vlc-rc-url-bytes (string->url "http://foo/bar.mp4")) #"http://foo/bar.mp4"))

(doc (section "Commands")
     
     (para "This section lists the various command procedures.  Generally, each
procedure corresponds to a VLC RC command.  For example, "
           (racket vlc-add)
           " corresponds to the RC "
           (tt "add")
           " command.  For the most part, these procedures are defined to ``do
whatever the RC command does.'' The RC command itself might not be
well-documented.  So, for example, if, in the version of VLC being used, the "
           (tt "add")
           " command results in the the specified URL both being prepended to
the playlist and being played, then that's what the "
           (racket vlc-add)
           " command will do.")
     
     (para "Note that some of these commands have asynchronous effects, due to
the design of VLC or of the VLC RC protocol.  For example, the "
           (racket vlc-play)
           " procedure can return before VLC is actually playing the media."))

(define (%vlc:format-float-rc-bytes n)
  (string->bytes/utf-8 (number->string (real->double-flonum n))))

(define (%vlc:format-fixnum-rc-bytes n)
  (string->bytes/utf-8 (number->string n)))

(define (%vlc:parse-rc-bytes-to-number bstr)
  (cond ((regexp-match #rx"^[ \t\r\n]*([0-9]+(?:\\.[0-9]+)?)[ \t\r\n]*$"
                       (bytes->string/utf-8 bstr))
         => (lambda (m)
              (string->number (cadr m))))
        (else (raise (exn:fail:vlc:protocol
                      (format "%vlc:parse-rc-bytes-to-number: RC bytes ~S is not a number"
                              bstr)
                      (current-continuation-marks))))))

(define (%vlc:parse-rc-bytes-to-boolean bstr)
  (cond ((regexp-match #rx"^[ \t\r\n]*([01])[ \t\r\n]*$"
                       (bytes->string/utf-8 bstr))
         => (lambda (m)
              (if (equal? "1" (cadr m))
                  #t
                  #f)))
        (else (raise (exn:fail:vlc:protocol
                      (format "%vlc:parse-rc-bytes-to-boolean: RC bytes ~S is not a boolean"
                              bstr)
                      (current-continuation-marks))))))

(define (%vlc:parse-vlc-bar-output bstr)
  (let ((in (open-input-bytes bstr)))
    (let loop-section ()
      (cond ((eof-object? (peek-char in))
             '())
            ((regexp-try-match #rx"^\\+----\\[ ([^]]+) ]\r?\n" in)
             => (lambda (m)
                  (let ((section-name (bytes->string/utf-8 (list-ref m 1))))
                    (if (eof-object? (peek-char in))
                        '()
                        (cons (cons section-name
                                    (let loop-row ()
                                      (cond ((regexp-try-match #rx"^\\| +([^\r\n]*)\r?\n" in)
                                             => (lambda (m)
                                                  (cons (bytes->string/utf-8 (list-ref m 1))
                                                        (loop-row))))
                                            ((eqv? #\+ (peek-char in))
                                             '())
                                            (else (raise (exn:fail:vlc:protocol
                                                          (format "%vlc:parse-vlc-bar-output: could not match row in ~S"
                                                                  bstr)
                                                          (current-continuation-marks)))))))
                              (loop-section))))))
            (else (raise (exn:fail:vlc:protocol
                          (format "%vlc:parse-vlc-bar-output: could not match section start in ~S"
                                  bstr)
                          (current-continuation-marks))))))))

(module+ test
  
  (test (%vlc:parse-vlc-bar-output
         (bytes-append
          #"+----[ spu-es ]\r\n"
          #"| -1 - Disable *\r\n"
          #"| 14 - Track 1 - [Fran\303\247ais]\r\n"
          #"| 15 - Track 2 - [Espa\303\261ol]\r\n"
          #"| 17 - Closed captions 1\r\n"
          #"| 18 - Closed captions 2\r\n"
          #"| 19 - Closed captions 3\r\n"
          #"| 20 - Closed captions 4\r\n"
          #"+----[ end of spu-es ]\r\n"))
        '(("spu-es"
           "-1 - Disable *"
           "14 - Track 1 - [Fran\u00e7ais]"
           "15 - Track 2 - [Espa\u00f1ol]"
           "17 - Closed captions 1"
           "18 - Closed captions 2"
           "19 - Closed captions 3"
           "20 - Closed captions 4"))))

(define (%vlc:command-with-output error-name
                                  rc
                                  command-bytes-including-newline)
  ;; TODO: did we get all cases in which exn:fail:vlc:process should be raised?
  (log-debug (format "~S: semaphore wait. command is ~S"
                     error-name
                     command-bytes-including-newline))
  (call-with-semaphore/enable-break
   (vlc-sema rc)
   (lambda ()
     (log-debug (format "~S: writing..."
                        error-name))
     ;; TODO: Make sure no bytes available for reading. also be careful about
     ;; an eof-object available for reading, in case that can happen.
     (with-handlers* ((exn:fail? (lambda (e)
                                   (raise (exn:fail:vlc:process
                                           (format "~S: error sending command to vlc: ~S"
                                                   error-name
                                                   (exn-message e))
                                           (exn-continuation-marks e))))))
       (write-bytes command-bytes-including-newline
                    (vlc-out rc))
       (flush-output (vlc-out rc)))
     (log-debug (format "~S: waiting for response"
                        error-name))
     (let* ((result-ob (open-output-bytes)))
       (cond ((with-handlers* ((exn:fail? (lambda (e)
                                            (raise (exn:fail:vlc:process
                                                    (format "~S: error reading command response from vlc: ~S"
                                                            error-name
                                                            (exn-message e)))
                                                   (exn-continuation-marks e)))))
                (regexp-match #rx#"RACKET-VLC-RC-PROMPT-([0-9]+)> "
                              (vlc-in rc)
                              0
                              #f
                              result-ob))
              => (lambda (m)
                   (let ((expected-key (vlc-prompt-key rc))
                         (actual-key   (cadr m)))
                     (if (equal? expected-key actual-key)
                         (let ((bstr (get-output-bytes result-ob)))
                           (log-debug (format "~S: received response ~S"
                                              error-name
                                              bstr))
                           bstr)
                         (raise (exn:fail:vlc:process
                                 (format "~S: received prompt key ~S does not match expected ~S. multiple remotes for one vlc?"
                                         error-name
                                         actual-key
                                         expected-key)
                                 (current-continuation-marks)))))))
             (else (raise (exn:fail:vlc:process
                           (format "~S: no prompt-terminated response to command ~S"
                                   error-name
                                   command-bytes-including-newline)
                           (current-continuation-marks)))))))))

(define (%vlc:command-with-string-output error-name
                                         rc
                                         command-bytes-including-newline)
  (bytes->string/utf-8
   (regexp-replace #rx#"\r?\n$"
                   (%vlc:command-with-output error-name
                                             rc
                                             command-bytes-including-newline)
                   #"")))

(define (%vlc:command-with-number-output error-name
                                         rc
                                         command-bytes-including-newline)
  (let ((result (%vlc:parse-rc-bytes-to-number
                 (%vlc:command-with-output error-name
                                           rc
                                           command-bytes-including-newline))))
    (log-debug (format "~S: number response is: ~S"
                       error-name
                       result))
    result))

(define (%vlc:command-with-boolean-output error-name
                                          rc
                                          command-bytes-including-newline)
  (let ((result (%vlc:parse-rc-bytes-to-boolean
                 (%vlc:command-with-output error-name
                                           rc
                                           command-bytes-including-newline))))
    (log-debug (format "~S: boolean response is: ~S"
                       error-name
                       result))
    result))

(define (%vlc:command-with-ignored-output error-name
                                          rc
                                          command-bytes-including-newline)
  (%vlc:command-with-output error-name
                            rc
                            command-bytes-including-newline)
  (void))

(define (%vlc:command-without-output error-name
                                     rc
                                     command-bytes-including-newline)
  (let ((result-bytes (%vlc:command-with-output error-name
                                                rc
                                                command-bytes-including-newline)))
    (if (equal? #"" result-bytes)
        (void)
        (raise (exn:fail:vlc:command
                (format "~S: did not expect command ~S to return output, but received ~S"
                        error-name
                        command-bytes-including-newline
                        result-bytes)
                (current-continuation-marks)
                command-bytes-including-newline
                result-bytes)))))

(doc (subsection "Playlist"))

(doc (defproc (vlc-clear (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Clear all items from the playlist.")))
(provide vlc-clear)
(define (vlc-clear #:vlc (rc (current-vlc)))
  (%vlc:command-without-output 'vlc-clear
                               rc
                               #"clear\n"))

(doc (defproc (vlc-add (thing vlc-url?) (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Adds the URL "
             (racket thing)
             " to the playlist. This command seems to also cause VLC to start
playing the item.")))
(provide vlc-add)
(define (vlc-add thing #:vlc (rc (current-vlc)))
  (%vlc:command-without-output
   'vlc-add
   rc
   (bytes-append #"add "
                 (to-vlc-rc-url-bytes thing)
                 #"\n")))

(doc (defproc (vlc-enqueue (thing vlc-url?) (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Enqueues the URL "
             (racket thing)
             " in the playlist.")))
(provide vlc-enqueue)
(define (vlc-enqueue thing #:vlc (vlc (current-vlc)))
  (%vlc:command-without-output
   'vlc-enqueue
   vlc
   (bytes-append #"enqueue "
                 (to-vlc-rc-url-bytes thing)
                 #"\n")))

(doc (defproc (vlc-next (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Start playing the next item in the playlist.")))
(provide vlc-next)
(define (vlc-next #:vlc (rc (current-vlc)))
  (%vlc:command-without-output 'vlc-next
                               rc
                               #"next\n"))

(doc (defproc (vlc-prev (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Start playing the previous item in the playlist.")))
(provide vlc-prev)
(define (vlc-prev #:vlc (rc (current-vlc)))
  (%vlc:command-without-output 'vlc-prev
                               rc
                               #"prev\n"))

;; TODO: Implement: | playlist . . . . . . . . . . . . . .show items currently in playlist

;; TODO: Implement: | goto . . . . . . . . . . . . . . . . . . . . . .  goto item at index

;; Note: We don't implement the "search" or "sort" commands, seem they seem
;; irrelevant to this programmatic interface.

(doc (subsection "Repeat / Loop / Random"))

(doc (defproc (vlc-repeat (on? boolean)
                          (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Set whether VLC should repeat playing the current stream continuously.")))
(provide vlc-repeat)
(define (vlc-repeat on? #:vlc (rc (current-vlc)))
  ;; TODO: Make this permit querying, if we can do that.
  (%vlc:command-without-output 'vlc-repeat
                               rc
                               (if on?
                                   #"repeat on\r\n"
                                   #"repeat off\r\n")))

(doc (defproc (vlc-loop (on? boolean)
                        (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Set whether VLC should repeat playing the playlist continuously.")))
(provide vlc-loop)
(define (vlc-loop on? #:vlc (rc (current-vlc)))
  ;; TODO: Make this permit querying, if we can do that.
  (%vlc:command-without-output 'vlc-loop
                               rc
                               (if on?
                                   #"loop on\r\n"
                                   #"loop off\r\n")))

(doc (defproc (vlc-random (on? boolean)
                          (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Set whether VLC should select streams from the playlist randomly,
rather than in order.")))
(provide vlc-random)
(define (vlc-random on? #:vlc (rc (current-vlc)))
  (%vlc:command-without-output 'vlc-random
                               rc
                               (if on?
                                   #"random on\r\n"
                                   #"random off\r\n")))

(doc (subsection "Title and Chapter"))

;; TODO: Implement: | title [X]  . . . . . . . . . . . . . . set/get title in current item

(doc (defproc (vlc-title-n (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Switch to the next title of the current stream.")))
(provide vlc-title-n)
(define (vlc-title-n #:vlc (rc (current-vlc)))
  (%vlc:command-without-output 'vlc-title-n
                               rc
                               #"title_n\n"))

(doc (defproc (vlc-title-p (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Switch to the previous title of the current stream.")))
(provide vlc-title-p)
(define (vlc-title-p #:vlc (rc (current-vlc)))
  (%vlc:command-without-output 'vlc-title-p
                               rc
                               #"title_p\n"))

;; TODO: Implement: | chapter [X]  . . . . . . . . . . . . set/get chapter in current item
;;
;;> chapter
;;1

(doc (defproc (vlc-chapter-n (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Switch to the next chapter of the current stream.")))
(provide vlc-chapter-n)
(define (vlc-chapter-n #:vlc (rc (current-vlc)))
  (%vlc:command-without-output 'vlc-chapter-n
                               rc
                               #"chapter_n\n"))

(doc (defproc (vlc-chapter-p (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Switch to the previous chapter of the current stream.")))
(provide vlc-chapter-p)
(define (vlc-chapter-p #:vlc (rc (current-vlc)))
  (%vlc:command-without-output 'vlc-chapter-p
                               rc
                               #"chapter_p\n"))

(doc (subsection "Play, Pause, and Stop"))

(doc (defproc (vlc-play (#:vlc vlc vlc? (current-vlc)))
       void?
       ;; TODO: Does it play the next stream or the current one?
       (para "Play the next stream, if not already playing one.")))
(provide vlc-play)
(define (vlc-play #:vlc (rc (current-vlc)))
  (%vlc:command-without-output 'vlc-play
                               rc
                               #"play\n"))

(doc (defproc (vlc-pause (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Toggle the playing pause state.")))
(provide vlc-pause)
(define (vlc-pause #:vlc (rc (current-vlc)))
  (%vlc:command-without-output 'vlc-pause
                               rc
                               #"pause\n"))

(doc (defproc (vlc-stop (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Stop playing the current stream, if playing or paused.")))
(provide vlc-stop)
(define (vlc-stop #:vlc (rc (current-vlc)))
  (%vlc:command-without-output 'vlc-stop
                               rc
                               #"stop\n"))

(doc (defproc (vlc-is-playing (#:vlc vlc vlc? (current-vlc)))
       number?
       (para "Yields a boolean value for whether or not a stream is
playing.")))
(provide vlc-is-playing)
(define (vlc-is-playing #:vlc (rc (current-vlc)))
  (%vlc:command-with-boolean-output 'vlc-is-playing
                                    rc
                                    #"is_playing\r\n"))

(doc (subsection "Rate"))

(doc (defproc (vlc-fastforward (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Set rate of playing to maximum.")))
(provide vlc-fastforward)
(define (vlc-fastforward #:vlc (rc (current-vlc)))
  (%vlc:command-without-output 'vlc-fastforward
                               rc
                               #"fastforward\n"))

(doc (defproc (vlc-rewind (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Set rate of playing to maximum reverse.")))
(provide vlc-rewind)
(define (vlc-rewind #:vlc (rc (current-vlc)))
  (%vlc:command-without-output 'vlc-rewind
                               rc
                               #"rewind\n"))

(doc (defproc (vlc-faster (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Increase the rate of playing of the current stream.")))
(provide vlc-faster)
(define (vlc-faster #:vlc (rc (current-vlc)))
  (%vlc:command-without-output 'vlc-faster
                               rc
                               #"faster\n"))

(doc (defproc (vlc-slower (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Lower the rate of playing of the current stream.")))
(provide vlc-slower)
(define (vlc-slower #:vlc (rc (current-vlc)))
  (%vlc:command-without-output 'vlc-slower
                               rc
                               #"slower\n"))

(doc (defproc (vlc-normal (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Play the current stream, and at normal speed.")))
(provide vlc-normal)
(define (vlc-normal #:vlc (rc (current-vlc)))
  (%vlc:command-without-output 'vlc-normal
                               rc
                               #"normal\n"))

(doc (defproc (vlc-frame (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Set current stream playing to frame-by-frame, or advance one
frame.")))
(provide vlc-frame)
(define (vlc-frame #:vlc (rc (current-vlc)))
  (%vlc:command-without-output 'vlc-frame
                               rc
                               #"frame\n"))

(doc (defproc (vlc-rate (rate real?)
                        (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Set playing rate to "
             (racket rate)
             ".")))
(provide vlc-rate)
(define (vlc-rate seconds #:vlc (rc (current-vlc)))
  (if (real? seconds)
      (%vlc:command-without-output 'vlc-rate
                                   rc
                                   (bytes-append #"rate "
                                                 (%vlc:format-float-rc-bytes seconds)
                                                 #"\r\n"))
      (raise-type-error 'vlc-rate
                        "real?"
                        seconds)))

(doc (subsection "Absolute Position"))

(doc (defproc (vlc-get-time (#:vlc vlc vlc? (current-vlc)))
       number?
       (para "Get the time position of the current stream, in seconds.")))
(provide vlc-get-time)
(define (vlc-get-time #:vlc (rc (current-vlc)))
  (%vlc:command-with-number-output 'vlc-get-time
                                   rc
                                   #"get_time\r\n"))

(doc (defproc (vlc-get-length (#:vlc vlc vlc? (current-vlc)))
       number?
       (para "Get the length of the current stream, in seconds.")))
(provide vlc-get-length)
(define (vlc-get-length #:vlc (rc (current-vlc)))
  (%vlc:command-with-number-output 'vlc-get-length
                                   rc
                                   #"get_length\r\n"))

(doc (defproc (vlc-seek (seconds exact-nonnegative-integer?)
                        (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Seek playing to position "
             (racket seconds)
             ".")))
(provide vlc-seek)
(define (vlc-seek seconds #:vlc (rc (current-vlc)))
  (if (exact-nonnegative-integer? seconds)
      (%vlc:command-without-output 'vlc-seek
                                   rc
                                   (bytes-append #"seek "
                                                 (%vlc:format-fixnum-rc-bytes seconds)
                                                 #"\r\n"))
      (raise-type-error 'vlc-seek
                        "exact-nonnegative-integer?"
                        seconds)))

(doc (subsection "Audio, Video, and Subtitle Tracks"))

(define (%vlc:parse-vlc-track-output bstr)
  (let ((sections (%vlc:parse-vlc-bar-output bstr)))
    (let loop-sections ((sections sections)
                        (selected #f)
                        (reverse-out-sections '()))
      (if (null? sections)
          (values selected (reverse reverse-out-sections))
          (let* ((section      (car sections))
                 (section-name (car section)))
            (let loop-rows ((rows             (cdr section))
                            (selected         selected)
                            (reverse-out-rows '()))
              
              (if (null? rows)
                  (loop-sections (cdr sections)
                                 selected
                                 (cons (cons section-name
                                             (reverse reverse-out-rows))
                                       reverse-out-sections))
                  (let ((row (car rows)))
                    (cond ((regexp-match #rx"^(-?[0-9]+) +- +(.*)$" row)
                           => (lambda (m)
                                (let ((id       (string->number (list-ref m 1)))
                                      (row-name (list-ref m 2)))
                                  (cond ((regexp-match #rx"^(.*[^ ])( +\\*)$" row-name)
                                         => (lambda (m)
                                              (loop-rows (cdr rows)
                                                         id
                                                         (cons (cons (list-ref m 1)
                                                                     id)
                                                               reverse-out-rows))))
                                        (else (loop-rows (cdr rows)
                                                         selected
                                                         (cons (cons row-name id)
                                                               reverse-out-rows)))))))
                          (else (raise (exn:fail:vlc:protocol
                                        (format "%vlc:parse-vlc-track-output: could not match row ~S in ~S"
                                                row
                                                bstr)
                                        (current-continuation-marks)))))))))))))

;; TODO: Confirm that "*" marks the selected item.

(module+ test
  
  (test (%vlc:parse-vlc-track-output
         (bytes-append
          #"+----[ spu-es ]\r\n"
          #"| -1 - Disable *\r\n"
          #"| 14 - Track 1 - [Fran\303\247ais]\r\n"
          #"| 15 - Track 2 - [Espa\303\261ol]\r\n"
          #"| 17 - Closed captions 1\r\n"
          #"| 18 - Closed captions 2\r\n"
          #"| 19 - Closed captions 3\r\n"
          #"| 20 - Closed captions 4\r\n"
          #"+----[ end of spu-es ]\r\n"))
        (values -1
                '(("spu-es"
                   . (("Disable"                   . -1)
                      ("Track 1 - [Fran\u00e7ais]" . 14)
                      ("Track 2 - [Espa\u00f1ol]"  . 15)
                      ("Closed captions 1"         . 17)
                      ("Closed captions 2"         . 18)
                      ("Closed captions 3"         . 19)
                      ("Closed captions 4"         . 20)))))))

(define-syntax %vlc:track-lambda
  (syntax-rules ()
    ((_ #:error-name    ERROR-NAME
        #:command-bytes COMMAND-BYTES)
     (lambda ((num (void))
              #:vlc (vlc (current-vlc)))
       (if (void? num)
           (%vlc:parse-vlc-track-output
            (%vlc:command-with-output ERROR-NAME
                                      vlc
                                      #"strack\n"))
           (if (exact-integer? num)
               (%vlc:command-without-output ERROR-NAME
                                            vlc
                                            (bytes-append COMMAND-BYTES
                                                          #" "
                                                          (%vlc:format-fixnum-rc-bytes num)
                                                          #"\r\n"))
               (raise-type-error ERROR-NAME
                                 "exact-integer?"
                                 num)))))))

(doc (defproc* (((vlc-atrack (#:vlc vlc vlc? (current-vlc)))
                 (values integer?
                         (listof (cons/c string? (listof (cons/c string? integer?))))))
                ((vlc-atrack (num integer?) (#:vlc vlc vlc? (current-vlc)))
                 void?))
       (para "If "
             (racket num)
             " is "
             (italic "not")
             " provided, yields information about current and available audio
tracks for the current stream.")
       (para "If "
             (racket num)
             " "
             (italic "is")
             " provided, switches the audio to that track.")))
(provide vlc-atrack)
(define vlc-atrack
  (%vlc:track-lambda #:error-name    'vlc-atrack
                     #:command-bytes #"atrack"))

(doc (defproc* (((vlc-vtrack (#:vlc vlc vlc? (current-vlc)))
                 (values integer?
                         (listof (cons/c string? (listof (cons/c string? integer?))))))
                ((vlc-vtrack (num integer?) (#:vlc vlc vlc? (current-vlc)))
                 void?))
       (para "If "
             (racket num)
             " is "
             (italic "not")
             " provided, yields information about current and available video
tracks for the current stream.")
       (para "If "
             (racket num)
             " "
             (italic "is")
             " provided, switches the audio to that track.")))
(provide vlc-vtrack)
(define vlc-vtrack
  (%vlc:track-lambda #:error-name    'vlc-vtrack
                     #:command-bytes #"vtrack"))

(doc (defproc* (((vlc-strack (#:vlc vlc vlc? (current-vlc)))
                 (values integer?
                         (listof (cons/c string? (listof (cons/c string? integer?))))))
                ((vlc-strack (num integer?) (#:vlc vlc vlc? (current-vlc)))
                 void?))
       (para "If "
             (racket num)
             " is "
             (italic "not")
             " provided, yields information about current and available
subtitles and captions tracks for the current stream.  For example, for one
DVD: ")
       (racketinput
        (vlc-strack))
       (racketresultblock
        -1
        '(("spu-es"
           ("Disable"              . -1)
           ("Track 1 - [Fran\u00e7ais]" . 14)
           ("Track 2 - [Espa\u00f1ol]"  . 15)
           ("Closed captions 1"    . 17)
           ("Closed captions 2"    . 18)
           ("Closed captions 3"    . 19)
           ("Closed captions 4"    . 20))))
       (para "If "
             (racket num)
             " "
             (italic "is")
             " provided, switches the subtitles/captions to that track.")))
(provide vlc-strack)
(define vlc-strack
  (%vlc:track-lambda #:error-name    'vlc-strack
                     #:command-bytes #"strack"))

;; TODO: Implement: | info . . . . . . . . . . . . . .information about the current stream
;;
;;+----[ Stream 0 ]
;;|
;;| Codec: DVD Subtitles (spu )
;;| Type: Subtitle
;;|
;;+----[ Stream 1 ]
;;|
;;| Codec: MPEG-1/2 Video (mpgv)
;;| Type: Video
;;|
;;+----[ Stream 3 ]
;;|
;;| Type: Subtitle
;;| Language: Français
;;| Codec: DVD Subtitles (spu )
;;|
;;+----[ Stream 13 ]
;;|
;;| Bitrate: 192 kb/s
;;| Type: Audio
;;| Channels: Stereo
;;| Sample rate: 48000 Hz
;;| Codec: A52 Audio (aka AC3) (a52 )
;;|
;;+----[ Stream 12 ]
;;|
;;| Codec: DVD Subtitles (spu )
;;| Type: Subtitle
;;|
;;+----[ Stream 4 ]
;;|
;;| Type: Subtitle
;;| Language: Español
;;| Codec: DVD Subtitles (spu )
;;|
;;+----[ Stream 10 ]
;;|
;;| Codec: DVD Subtitles (spu )
;;| Type: Subtitle
;;|
;;+----[ Stream 11 ]
;;|
;;| Type: Video
;;| Frame rate: 59.940059
;;| Decoded format: Planar 4:2:0 YUV
;;| Codec: MPEG-1/2 Video (mpgv)
;;| Resolution: 720x480
;;|
;;+----[ Stream 6 ]
;;|
;;| Type: Subtitle
;;| Description: Closed captions 1
;;| Codec:  (cc1 )
;;|
;;+----[ Stream 8 ]
;;|
;;| Type: Subtitle
;;| Description: Closed captions 3
;;| Codec:  (cc3 )
;;|
;;+----[ Stream 7 ]
;;|
;;| Type: Subtitle
;;| Description: Closed captions 2
;;| Codec:  (cc2 )
;;|
;;+----[ Stream 5 ]
;;|
;;| Type: Video
;;| Frame rate: 59.940059
;;| Decoded format: Planar 4:2:0 YUV
;;| Codec: MPEG-1/2 Video (mpgv)
;;| Resolution: 720x480
;;|
;;+----[ Stream 9 ]
;;|
;;| Type: Subtitle
;;| Description: Closed captions 4
;;| Codec:  (cc4 )
;;|
;;+----[ Stream 2 ]
;;|
;;| Bitrate: 192 kb/s
;;| Type: Audio
;;| Channels: Stereo
;;| Sample rate: 48000 Hz
;;| Codec: A52 Audio (aka AC3) (a52 )
;;|
;;+----[ end of stream info ]

(doc (subsection "Audio Options"))

;; TODO: Implement: | volume [X] . . . . . . . . . . . . . . . . . .  set/get audio volume

;; TODO: Implement: | volup [X]  . . . . . . . . . . . . . . . .raise audio volume X steps
;; > volup 1
;; ( audio volume: 383 )

;; TODO: Implement: | voldown [X]  . . . . . . . . . . . . . .  lower audio volume X steps

;; TODO: Implement: | adev [X] . . . . . . . . . . . . . . . . . . . .set/get audio device

;; TODO: Implement: | achan [X]  . . . . . . . . . . . . . . . . . .set/get audio channels

(doc (subsection "Video Options"))

;;| fullscreen, f, F [on|off]  . . . . . . . . . . . . toggle fullscreen
(doc (defproc (vlc-fullscreen (on? boolean?)
                              (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Set whether VLC is in fullscreen mode.")))
(provide vlc-fullscreen)
(define (vlc-fullscreen on? #:vlc (vlc (current-vlc)))
  ;; TODO: Make this permit querying, if we can do that.
  (%vlc:command-without-output 'vlc-fullscreen
                               vlc
                               (if on?
                                   #"fullscreen on\r\n"
                                   #"fullscreen off\r\n")))

;; TODO: Implement: | vratio [X] . . . . . . . . . . . . . . . .set/get video aspect ratio

;; TODO: Implement: | vcrop, crop [X]  . . . . . . . . . . . . . . . .  set/get video crop

;; TODO: Implement: | vzoom, zoom [X]  . . . . . . . . . . . . . . . .  set/get video zoom

(doc (subsection "Misc. Info"))

(doc (defproc (vlc-get-title (#:vlc vlc vlc? (current-vlc)))
       string?
       (para "Get the title of the current stream.  For example, a particular
DVD, might give behavior like:")
       (racketinput
        (vlc-get-title)
        #,(racketresult "WEST_WING_S7_D3"))
       (para "Warning: Season 7 is not the best season for West Wing.")))
(provide vlc-get-title)
(define (vlc-get-title #:vlc (vlc (current-vlc)))
  (%vlc:command-with-string-output 'vlc-get-title
                                   vlc
                                   #"get_title\n"))

(define (%vlc:parse-vlc-status-output bstr)
  (let ((bstr-len (bytes-length bstr)))
    (let loop ((start 0))
      (if (= start bstr-len)
          '()
          (cond ((regexp-match-positions #rx#"^\\( ([^ :][^:]*): *"
                                         bstr
                                         start)
                 => (lambda (m)
                      (let ((val-start (cdar m))
                            (name-posn (list-ref m 1)))
                        (cond ((regexp-match-positions #rx#" \\)\r?\n" bstr val-start)
                               => (lambda (m)
                                    (let ((val-end (caar m))
                                          (start   (cdar m)))
                                      (cons (cons (subbytes bstr (car name-posn) (cdr name-posn))
                                                  (subbytes bstr val-start       val-end))
                                            (loop start)))))
                              (else (raise (exn:fail:vlc:protocol
                                            (format "%vlc:parse-vlc-status-output: could not match end of colon line at position ~S in ~S"
                                                    val-start
                                                    bstr)
                                            (current-continuation-marks))))))))
                ((regexp-match-positions #rx#"^\\( ([a-z]+) ([a-z]+) \\)\r?\n"
                                         bstr
                                         start)
                 => (lambda (m)
                      (let ((name-posn (list-ref m 1))
                            (val-posn  (list-ref m 2))
                            (start     (cdar m)))
                        (cons (cons (subbytes bstr (car name-posn) (cdr name-posn))
                                    (subbytes bstr (car val-posn)  (cdr val-posn)))
                              (loop start)))))
                (else (raise (exn:fail:vlc:protocol
                              (format "%vlc:parse-vlc-status-output: could not match line at position ~S in ~S"
                                      start
                                      bstr)
                              (current-continuation-marks)))))))))

(module+ test
  (test (%vlc:parse-vlc-status-output
         (bytes-append
          #"( new input: file:///home/scotty/sheep.mp4 )\r\n"
          #"( audio volume: 287 )\r\n"
          #"( state paused )\r\n"))
        '((#"new input"    . #"file:///home/scotty/sheep.mp4")
          (#"audio volume" . #"287")
          (#"state"        . #"paused"))))

(doc (defproc (vlc-status (#:vlc vlc vlc? (current-vlc)))
       (list-of (cons/c bytes? bytes?))
       (para "Yields an alist of some information about current status.  The "
             (italic "car")
             " of each pair of the alist is a byte string of one of the
following attribute names, and the "
             (italic "cdr")
             " is a byte string of the attribute value:")
       (itemlist
        
        (item (racket #"new input")
              " -- URL of the current playlist item.")
        
        (item (racket #"audio volume")
              " -- number representing the audio volume.")
        
        (item (racket #"state")
              " -- play state; possibly including the following values: "
              (racket #"playing")
              ", "
              (racket #"paused")
              ", "
              (racket #"stopped")
              "."))
       (para "Which attributes are included depends on VLC.")))
;; TODO: Maybe make this convert the byte strings to strings?
(provide vlc-status)
(define (vlc-status #:vlc (vlc (current-vlc)))
  (%vlc:parse-vlc-status-output
   (%vlc:command-with-output 'vlc-status
                             vlc
                             #"status\n")))

;; TODO: Implement: | stats  . . . . . . . . . . . . . . . .  show statistical information

;; TODO: Implement: | sd [sd]  . . . . . . . . . . . . . show services discovery or toggle

(doc (section "Snapshots"))

(doc (defproc (vlc-snapshot (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Write a snapshot still image of the current video display to a
file.  See VLC documentation for command line arguments for controlling where
and how these files are written, such as "
             (tt "--snapshot-path")
             ".")))
(provide vlc-snapshot)
(define (vlc-snapshot #:vlc (vlc (current-vlc)))
  (%vlc:command-without-output 'vlc-snapshot
                               vlc
                               #"snapshot\n"))

(doc (section "Exiting"))

(doc (defproc (vlc-shutdown (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Terminate the VLC process in an orderly fashion.")))
(provide vlc-shutdown)
(define (vlc-shutdown #:vlc (vlc (current-vlc)))
  ;; TODO: !!! Can we ever not see the prompt, like does any VLC version ever
  ;; terminate before the prompt has been sent to at least the RC connection
  ;; that gave the "shutdown" command?
  (%vlc:command-with-ignored-output 'vlc-shutdown
                                    vlc
                                    #"shutdown\n")
  (set-vlc-live?! vlc #f)
  ;; Note: We don't currently do anything with the "live?" field of the struct,
  ;; but we are setting it for future use.
  (void))

(doc (section "Keys")
     
     (para "In the RC protocol, some important additional operations are
available through the "
           (tt "key")
           " command, especially for DVD menu navigation."))

(doc (defproc (vlc-key (key (or/c bytes? string?))
                       (#:vlc vlc vlc? (current-vlc)))
       void?
       (para "Send a "
             (tt "key")
             " command to VLC.")))
(provide vlc-key)
(define (vlc-key key #:vlc (vlc (current-vlc)))
  (%vlc:command-with-ignored-output 'vlc-key
                                    vlc
                                    (bytes-append #"key "
                                                  (cond ((bytes?  key) key)
                                                        ((string? key) (string->bytes/utf-8 key))
                                                        (else (raise-type-error 'vlc-key
                                                                                "(or/c bytes? string?)"
                                                                                key)))
                                                  "\n")))


;; TODO: This version and earlier versions of it (including that have only
;; KEY-SYM argument synthesize PROC-SYM) definitely crash Racket Macro-Stepper.
;;
;;(define-syntax (%vlc:define-and-provide-key-proc stx)
;;  (syntax-case stx ()
;;    ((_ PROC-SYM KEY-SYM)
;;     (let* ((key-sym       (syntax-e #'KEY-SYM))
;;            (key-str       (symbol->string key-sym))
;;            ;; (proc-sym      (string->symbol (string-append "vlc-" key-str)))
;;            ;; (proc-sym-stx  (datum->syntax stx proc-sym))
;;            (command-bytes (bytes-append #"key"
;;                                         (string->bytes/utf-8 key-str)
;;                                         #"\n"))
;;            (command-bytes-stx (datum->syntax stx command-bytes)))
;;       #`(begin (provide PROC-SYM)
;;                (define (PROC-SYM #:vlc (vlc (current-vlc)))
;;                  (%vlc:command-with-ignored-output (quote PROC-SYM)
;;                                                    vlc
;;                                                    #,command-bytes-stx)
;;                  ))))))

(define-syntax (%vlc:define-and-provide-key-proc stx)
  (syntax-case stx ()
    ((_ PROC-SYM KEY-SYM)
     #`(begin (provide PROC-SYM)
              (define (PROC-SYM #:vlc (vlc (current-vlc)))
                (%vlc:command-with-ignored-output
                 (quote PROC-SYM)
                 vlc
                 #,(datum->syntax stx
                                  (bytes-append #"key "
                                                (string->bytes/utf-8 (symbol->string (syntax-e #'KEY-SYM)))
                                                #"\n"))))))))

(doc (defproc*
       (
        ((vlc-key-toggle-fullscreen (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-play-pause        (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-pause             (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-play              (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-faster            (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-slower            (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-next              (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-prev              (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-stop              (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-position          (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-jump-extrashort   (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-jump+extrashort   (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-jump-short        (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-jump+short        (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-jump-medium       (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-jump+medium       (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-jump-long         (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-jump+long         (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-nav-activate      (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-nav-up            (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-nav-down          (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-nav-left          (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-nav-right         (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-disc-menu         (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-title-prev        (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-title-next        (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-chapter-prev      (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-chapter-next      (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-quit              (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-vol-up            (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-vol-down          (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-vol-mute          (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-subdelay-up       (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-subdelay-down     (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-audiodelay-up     (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-audiodelay-down   (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-audio-track       (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-subtitle-track    (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-aspect-ratio      (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-crop              (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-deinterlace       (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-intf-show         (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-intf-hide         (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-snapshot          (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-history-back      (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-history-forward   (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-record            (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-dump              (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-crop-top          (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-uncrop-top        (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-crop-left         (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-uncrop-left       (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-crop-bottom       (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-uncrop-bottom     (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-crop-right        (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-uncrop-right      (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-set-bookmark1     (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-set-bookmark2     (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-set-bookmark3     (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-set-bookmark4     (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-set-bookmark5     (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-set-bookmark6     (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-set-bookmark7     (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-set-bookmark8     (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-set-bookmark9     (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-set-bookmark10    (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-play-bookmark1    (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-play-bookmark2    (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-play-bookmark3    (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-play-bookmark4    (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-play-bookmark5    (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-play-bookmark6    (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-play-bookmark7    (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-play-bookmark8    (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-play-bookmark9    (#:vlc vlc vlc? (current-vlc))) void?)
        ((vlc-key-play-bookmark10   (#:vlc vlc vlc? (current-vlc))) void?)
        )
       (para "Execute a particular RC "
             (tt "key")
             " command.  For example, the "
             (racket vlc-key-nav-up)
             " procedure executes the RC "
             (tt "key key-nav-up")
             " command.")
       (para "The exact keys here are taken from a list of key names from "
             (hyperlink "http://wiki.videolan.org/How_to_Use_Lirc"
                        "VideoLAN Wiki ``How to Use Lirc''")
             " page, as viewed on 2012-10-03, which said ``This is the complet
[sic] list of supported keys in VLC 0.8.6.''")))
(%vlc:define-and-provide-key-proc vlc-key-toggle-fullscreen key-toggle-fullscreen)
(%vlc:define-and-provide-key-proc vlc-key-play-pause key-play-pause)
(%vlc:define-and-provide-key-proc vlc-key-pause key-pause)
(%vlc:define-and-provide-key-proc vlc-key-play key-play)
(%vlc:define-and-provide-key-proc vlc-key-faster key-faster)
(%vlc:define-and-provide-key-proc vlc-key-slower key-slower)
(%vlc:define-and-provide-key-proc vlc-key-next key-next)
(%vlc:define-and-provide-key-proc vlc-key-prev key-prev)
(%vlc:define-and-provide-key-proc vlc-key-stop key-stop)
(%vlc:define-and-provide-key-proc vlc-key-position key-position)
(%vlc:define-and-provide-key-proc vlc-key-jump-extrashort key-jump-extrashort)
(%vlc:define-and-provide-key-proc vlc-key-jump+extrashort key-jump+extrashort)
(%vlc:define-and-provide-key-proc vlc-key-jump-short key-jump-short)
(%vlc:define-and-provide-key-proc vlc-key-jump+short key-jump+short)
(%vlc:define-and-provide-key-proc vlc-key-jump-medium key-jump-medium)
(%vlc:define-and-provide-key-proc vlc-key-jump+medium key-jump+medium)
(%vlc:define-and-provide-key-proc vlc-key-jump-long key-jump-long)
(%vlc:define-and-provide-key-proc vlc-key-jump+long key-jump+long)
(%vlc:define-and-provide-key-proc vlc-key-nav-activate key-nav-activate)
(%vlc:define-and-provide-key-proc vlc-key-nav-up key-nav-up)
(%vlc:define-and-provide-key-proc vlc-key-nav-down key-nav-down)
(%vlc:define-and-provide-key-proc vlc-key-nav-left key-nav-left)
(%vlc:define-and-provide-key-proc vlc-key-nav-right key-nav-right)
(%vlc:define-and-provide-key-proc vlc-key-disc-menu key-disc-menu)
(%vlc:define-and-provide-key-proc vlc-key-title-prev key-title-prev)
(%vlc:define-and-provide-key-proc vlc-key-title-next key-title-next)
(%vlc:define-and-provide-key-proc vlc-key-chapter-prev key-chapter-prev)
(%vlc:define-and-provide-key-proc vlc-key-chapter-next key-chapter-next)
(%vlc:define-and-provide-key-proc vlc-key-quit key-quit)
(%vlc:define-and-provide-key-proc vlc-key-vol-up key-vol-up)
(%vlc:define-and-provide-key-proc vlc-key-vol-down key-vol-down)
(%vlc:define-and-provide-key-proc vlc-key-vol-mute key-vol-mute)
(%vlc:define-and-provide-key-proc vlc-key-subdelay-up key-subdelay-up)
(%vlc:define-and-provide-key-proc vlc-key-subdelay-down key-subdelay-down)
(%vlc:define-and-provide-key-proc vlc-key-audiodelay-up key-audiodelay-up)
(%vlc:define-and-provide-key-proc vlc-key-audiodelay-down key-audiodelay-down)
(%vlc:define-and-provide-key-proc vlc-key-audio-track key-audio-track)
(%vlc:define-and-provide-key-proc vlc-key-subtitle-track key-subtitle-track)
(%vlc:define-and-provide-key-proc vlc-key-aspect-ratio key-aspect-ratio)
(%vlc:define-and-provide-key-proc vlc-key-crop key-crop)
(%vlc:define-and-provide-key-proc vlc-key-deinterlace key-deinterlace)
(%vlc:define-and-provide-key-proc vlc-key-intf-show key-intf-show)
(%vlc:define-and-provide-key-proc vlc-key-intf-hide key-intf-hide)
(%vlc:define-and-provide-key-proc vlc-key-snapshot key-snapshot)
(%vlc:define-and-provide-key-proc vlc-key-history-back key-history-back)
(%vlc:define-and-provide-key-proc vlc-key-history-forward key-history-forward)
(%vlc:define-and-provide-key-proc vlc-key-record key-record)
(%vlc:define-and-provide-key-proc vlc-key-dump key-dump)
(%vlc:define-and-provide-key-proc vlc-key-crop-top key-crop-top)
(%vlc:define-and-provide-key-proc vlc-key-uncrop-top key-uncrop-top)
(%vlc:define-and-provide-key-proc vlc-key-crop-left key-crop-left)
(%vlc:define-and-provide-key-proc vlc-key-uncrop-left key-uncrop-left)
(%vlc:define-and-provide-key-proc vlc-key-crop-bottom key-crop-bottom)
(%vlc:define-and-provide-key-proc vlc-key-uncrop-bottom key-uncrop-bottom)
(%vlc:define-and-provide-key-proc vlc-key-crop-right key-crop-right)
(%vlc:define-and-provide-key-proc vlc-key-uncrop-right key-uncrop-right)
(%vlc:define-and-provide-key-proc vlc-key-set-bookmark1 key-set-bookmark1)
(%vlc:define-and-provide-key-proc vlc-key-set-bookmark2 key-set-bookmark2)
(%vlc:define-and-provide-key-proc vlc-key-set-bookmark3 key-set-bookmark3)
(%vlc:define-and-provide-key-proc vlc-key-set-bookmark4 key-set-bookmark4)
(%vlc:define-and-provide-key-proc vlc-key-set-bookmark5 key-set-bookmark5)
(%vlc:define-and-provide-key-proc vlc-key-set-bookmark6 key-set-bookmark6)
(%vlc:define-and-provide-key-proc vlc-key-set-bookmark7 key-set-bookmark7)
(%vlc:define-and-provide-key-proc vlc-key-set-bookmark8 key-set-bookmark8)
(%vlc:define-and-provide-key-proc vlc-key-set-bookmark9 key-set-bookmark9)
(%vlc:define-and-provide-key-proc vlc-key-set-bookmark10 key-set-bookmark10)
(%vlc:define-and-provide-key-proc vlc-key-play-bookmark1 key-play-bookmark1)
(%vlc:define-and-provide-key-proc vlc-key-play-bookmark2 key-play-bookmark2)
(%vlc:define-and-provide-key-proc vlc-key-play-bookmark3 key-play-bookmark3)
(%vlc:define-and-provide-key-proc vlc-key-play-bookmark4 key-play-bookmark4)
(%vlc:define-and-provide-key-proc vlc-key-play-bookmark5 key-play-bookmark5)
(%vlc:define-and-provide-key-proc vlc-key-play-bookmark6 key-play-bookmark6)
(%vlc:define-and-provide-key-proc vlc-key-play-bookmark7 key-play-bookmark7)
(%vlc:define-and-provide-key-proc vlc-key-play-bookmark8 key-play-bookmark8)
(%vlc:define-and-provide-key-proc vlc-key-play-bookmark9 key-play-bookmark9)
(%vlc:define-and-provide-key-proc vlc-key-play-bookmark10 key-play-bookmark10)

(doc (section "Other Operations")
     
     (para "In addition to the procedures that correspond to VLC RC commands,
there are some additional procedures that are built atop RC commands."))

;;(doc (defproc (%vlc:wait-for-vlc-status-state
;;               (        state-bytes bytes?)
;;               (#:delay delay       (and/c real? (not/c negative?)) 0.1)
;;               (#:vlc   vlc         vlc?                            (current-vlc)))
;;       void?
;;       (para "")))
;; (provide %vlc:wait-for-vlc-status-state)
(define (%vlc:wait-for-vlc-status-state state-bytes
                                        #:delay (delay 0.1)
                                        #:vlc   (vlc   (current-vlc)))
  (let loop ()
    (cond ((assoc #"state" (vlc-status #:vlc vlc))
           => (lambda (pair)
                (if (equal? (cdr pair) state-bytes)
                    (void)
                    (begin (sleep delay)
                           (loop)))))
          (else (sleep delay)
                (loop)))))

(doc (defproc (wait-for-vlc-active-playing
               (#:delay delay       (and/c real? (not/c negative?)) 0.1)
               (#:vlc   vlc         vlc?                            (current-vlc)))
       void?
       (para "Wait for VLC to be actively playing, by which we mean that the
stream has actually started playing, not just the RC "
             (tt "status")
             " command indicating "
             (tt "state: playing")
             ", when, say, the DVD hasn't actually started playing.  This seems
to be important for some other operations to take effect, such as seeking in
some cases.")
       (para "Note that this procedure is currently protocol-intensive with the
RC interface.  "
             (racket delay)
             " is the number of seconds to pause in between repeatedly sending
some RC messages.  By default, it is "
             (racket 0.1)
             ", meaning one tenth of a second.")))
(provide wait-for-vlc-active-playing)
(define (wait-for-vlc-active-playing #:delay (delay 0.1)
                                     #:vlc   (vlc   (current-vlc)))
  ;; TODO: Deal with possible race conditions that might result in "status" or
  ;; "get_time" command giving an error.
  (%vlc:wait-for-vlc-status-state #"playing" #:delay delay)
  (let ((first-time (vlc-get-time #:vlc vlc)))
    (sleep delay)
    (let loop ()
      (%vlc:wait-for-vlc-status-state #"playing" #:delay delay)
      (if (equal? (vlc-get-time #:vlc vlc)
                  first-time)
          (begin (sleep delay)
                 (loop))
          (void)))))

(doc (section "Known Issues")
     
     (itemlist
      
      (item "Finish implementing RC commands.")
      
      (item "Need to verify that RC uses UTF-8, and consistently.")
      
      (item "Should try to verify existence of objects before being added to
the playlist, since otherwise VLC can keep trying them continuously and
flooding with repeated error messages.")
      
      (item "The protocol parsing is pretty good, but could still be improved.
In particular, for some messages, it would be better to make the message end
detection sensitive to the syntax of the message.  Before doing that, verify
that RC uses UTF-8 consistently.")
      
      (item "Add a "
            (racket exn:fail:vlc)
            " exception, for ease of handling errors from the protocol, such as
error-message output from RC commands.  Currently, these are raised as "
            (racket exn:fail)
            ".")
      
      (item "Make "
            (racket vlc-status)
            " return strings instead of byte strings, after making sure UTF-8 is consistent.")))

(doc history
     
     (#:planet 1:4 #:date "2012-10-03"
               (itemlist
                (item "Added RC "
                      (tt "key")
                      "-related procedures.")))
     
     (#:planet 1:3 #:date "2012-10-02"
               (itemlist
                (item "Added exception types.")))
     
     (#:planet 1:2 #:date "2012-09-27"
               (itemlist
                (item "Documented that VLC 2.0.3 RC does not work on Windows,
so this package does not support Windows.")))
     
     (#:planet 1:1 #:date "2012-09-27"
               (itemlist
                (item "When "
                      (racket start-vlc)
                      " can't find VLC in the executable search path, it will
then try a few ``known suspect'' paths, including the standard one for Mac OS
X. (Thanks to Greg Hendershott for reporting.)")
                (item "Documentation for "
                      (racket start-vlc)
                      " regarding custodians has been corrected. (Thanks to
Greg Hendershott for reporting.)")
                (item "Updated documentation to say that this package has been
reported to work on Mac OS X and Microsoft Windows XP.")))
     
     (#:planet 1:0 #:date "2012-09-22"
               (itemlist
                
                (item "Preliminary release for testing some of the functionality on
various host platforms and with various VLC versions in use.  Not all commands
are implemented, and little testing has been done."))))