(module rml-snips mzscheme
  (require (lib "class.ss")
           (lib "mred.ss" "mred")
           (lib "framework.ss" "framework"))
  (provide hrule-snip%
           collapse-box-snip%)
  
  ;; hrule-snip%
  ;; A snip for drawing horizontal separating lines.
  (define hrule-snip%
    (class* snip% ()
      (override get-extent
                draw)

      (define cached-xheight #f)
      (define (get-xheight dc)
        (or cached-xheight
            (let-values [((w h descent extra) (send dc get-text-extent "x"))]
              (set! cached-xheight h)
              h)))
      (define (get-extent dc x y bw bh bdescent bspace blspace brspace)
        (let-values [((h) (get-xheight dc))
                     ((fw fh) (send dc get-size))]
          (define (set-box?! b v)
            (when (box? b) (set-box! b v)))
          (set-box?! bw fw)
          (set-box?! bh h)))
      (define (draw dc x y left top right bottom dx dy draw-caret)
        ;(printf "drawing: ~s~n" (list x y left top right bottom dx dy))
        (let* [(xh (get-xheight dc))
               (ny (+ y (/ xh 2)))]
          (send dc draw-line x ny right ny)))
      (super-instantiate ())
      ))

  (define expand-img 
    (make-object bitmap% (build-path (collection-path "icons") "turn-up.gif")))
  (define collapse-img 
    (make-object bitmap% (build-path (collection-path "icons") "turn-down.gif")))

  ;; collapse-box-snip%
  ;; A snip which shows different content depending on whether it is
  ;; "collapsed" or "expanded". Like the built-in syntax snips.
  (define collapse-box-snip%
    (class* editor-snip% ()
      (init-field renderer)
      (init-field collapsed-rml
                  expanded-rml)
      (inherit show-border
               set-tight-text-fit)
      (public expand
              collapse)
      (define expanded? #t)
      
      (define cmd-expand-snip (make-object image-snip% expand-img))
      (define cmd-collapse-snip (make-object image-snip% collapse-img))

      (define outer-t (instantiate (text:hide-caret/selection-mixin scheme:text%) ()))
      (define collapsed (instantiate rml-display/snip% () (renderer renderer)))
      (define expanded (instantiate rml-display/snip% () (renderer renderer)))
      (send collapsed display/tail
            `(span () 
                   (link ,(lambda _ (expand)) () ,cmd-expand-snip)
                   ,collapsed-rml))
      (send expanded display/tail
            `(div ()
                  (div ()
                       (link ,(lambda _ (collapse)) () ,cmd-collapse-snip)
                       ,collapsed-rml)
                  ,expanded-rml))
      (send (send collapsed get-snip) show-border #f)
      (send* (send collapsed get-editor)
        (hide-caret #t)
        (lock #t))
      (send (send expanded get-snip) show-border #f)
      (send* (send expanded get-editor)
        (hide-caret #t)
        (lock #t))

      (define (expand)
        (unless expanded?
          (send outer-t lock #f)
          (show-border #t)
          (set-tight-text-fit #f)
          (send outer-t release-snip cmd-expand-snip)
          (send outer-t release-snip (send collapsed get-snip))
          (send outer-t erase)
          (send outer-t insert cmd-collapse-snip)
          (send outer-t insert (send expanded get-snip))
          (send outer-t lock #t)
          (set! expanded? #t)))
      (define (collapse)
        (when expanded?
          (send outer-t lock #f)
          (show-border #f)
          (set-tight-text-fit #t)
          (send outer-t release-snip cmd-collapse-snip)
          (send outer-t release-snip (send expanded get-snip))
          (send outer-t erase)
          ;(send outer-t insert cmd-expand-snip)
          (send outer-t insert (send collapsed get-snip))
          (send outer-t lock #t)
          (set! expanded? #f)))
      
      (super-instantiate () 
        (editor outer-t) (with-border? #f)
        (left-margin 3) (right-margin 0) (top-margin 0) (bottom-margin 0)
        (left-inset 1) (top-inset 0) (right-inset 0) (bottom-inset 0))
      (collapse)
      ))
  )