
(module interactive-value-port mzscheme
  (require mzlib/pretty
           mred
           mzlib/class
           "syntax-browser.ss")
  (provide set-interactive-display-handler
           set-interactive-write-handler
           set-interactive-print-handler)

  (define op (current-output-port))
  (define (oprintf . x) (apply fprintf op x))
  
  (define (set-interactive-display-handler port)
    (let ([original-port-display-handler (port-display-handler port)])
      (port-display-handler
       port
       (λ (val port)
         (cond
           [(string? val) (original-port-display-handler val port)]
           [else
            (do-printing pretty-display val port)])))))
  
  (define (set-interactive-write-handler port)
    (port-write-handler
     port
     (λ (val port)
       (do-printing pretty-print val port))))
  
  (define (set-interactive-print-handler port)
    (port-print-handler
      port
      (λ (val port)
        (do-printing pretty-print val port))))
            
  (define (use-number-snip? x)
    (and #f
         (number? x)
         (exact? x)
         (real? x)
         (not (integer? x))))

  (define default-pretty-print-current-style-table (pretty-print-current-style-table))

  (define (do-printing pretty value port)
    (parameterize (;; these handlers aren't used, but are set to override the user's settings
                   [pretty-print-print-line (λ (line-number op old-line dest-columns) 
                                                (when (and (not (equal? line-number 0))
                                                           (not (equal? dest-columns 'infinity)))
                                                  (newline op))
                                                0)]
                   [pretty-print-pre-print-hook (λ (val port) (void))]
                   [pretty-print-post-print-hook (λ (val port) (void))]
                   [pretty-print-columns 'infinity]
                   [pretty-print-exact-as-decimal #f]
                   [pretty-print-depth #f]
                   [pretty-print-.-symbol-without-bars #f]
                   [pretty-print-show-inexactness #f]
                   [pretty-print-abbreviate-read-macros #t]
                   [pretty-print-current-style-table default-pretty-print-current-style-table]
                   [pretty-print-remap-stylable (λ (x) #f)]
                   [pretty-print-print-line
                    (lambda (line port offset width)
                      (when (and (number? width)
                                 (not (eq? 0 line)))
                        (newline port))
                      0)]
                   
                   [pretty-print-size-hook
                    (λ (value display? port)
                      (cond
                        [(not (port-writes-special? port)) #f]
                        [(is-a? value snip%) 1]
                        ;[(use-number-snip? value) 1]
                        [(syntax? value) 1]
                        [else #f]))]
                   [pretty-print-print-hook
                    (λ (value display? port)
                      (cond
                        [(is-a? value snip%)
                         (write-special value port)
                         1]
                        #;
                        [(use-number-snip? value)
                         (write-special
                          (number-snip:make-repeating-decimal-snip value #f)
                          port)
                         1]
                        [(syntax? value)
                         (write-special (render-syntax/snip value))]
                        [else (void)]))])
      (pretty value port))))
