(module spod-roos mzscheme
        (require "spod.scm")
        (provide (all-from-except "spod.scm" spod)
                 (rename spod-roos spod))

        (define (_synopsis . args)
          (spod-merge
           (spod (s== "Synopsis"))
           (spod-apply verbatim args)))

        (define (_class-name name)
          (spod (s= 'class (format "~a" name))))

        (define (_class-constructor funcdef . doc)
          (if (spod-null? doc)
              (spod)
              (spod-nlnl
               (spod-merge
                (spod (s== "Constructor:" (s% (format "~a" funcdef))))
                doc))))

        (define (_class-supers . supers)
          (if (spod-null? supers)
              (spod)
              (if (and (list? (car supers)) (null? (cdr supers)))
                  (apply _class-supers (car supers))
                  (spod-nlnl
                   (spod-merge
                    (spod (s== "Super classes"))
                    (spod-comma (map (lambda (super)
                                       (spod (slink super)))
                                     supers)))))))

        (define (_class-derived . derived)
          (if (spod-null? derived)
              (spod)
              (if (and (list? (car derived)) (null? (cdr derived)))
                  (apply _class-derived (car derived))
                  (spod-nlnl
                   (spod-merge
                    (spod (s== "Derived classes"))
                    (spod-comma (map (lambda (deriv)
                                       (spod (slink deriv)))
                                     derived)))))))

        (define (_class-doc . doc)
          (if (spod-null? doc)
              (spod)
              (spod-nlnl
               (spod-merge
                (spod (s== "Overview"))
                doc))))

        (define (_class-cleanup . doc)
          (if (spod-null? doc)
              (spod)
              (spod-nlnl
               (spod-merge
                (spod (s== "Explicit Cleanup"))
                doc))))

        (define (_private-members pd . members)
          (if (spod-null? members)
              (spod)
              (spod-nlnl
               (spod-merge
                (spod (s== "Private members") pd)
                members))))

        (define (_public-members pd . members)
          (if (spod-null? members)
              (spod)
              (spod-nlnl
               (spod-merge
                (spod (s== "Public members") pd)
                members))))

        (define (_member-function funcdef . doc)
          (spod-nlnl
           (spod-merge
            (spod (s==== (s% (format "~a" funcdef))))
            doc)))

        (define (_member-variable var . doc)
          (spod-nlnl
           (spod-merge
            (spod (s==== (s% (format "~a" var))))
            doc)))

        (define (_see-also . references)
          (spod-merge
           (spod-nlnl (spod (s== "See also")))
           (spod-nlnl (spod-comma (map (lambda (ref) (spod (slink ref))) references)))))

        (define (_named-pars . args)
          (spod-merge
           (spod (sover (spod-nlnl (spod (s* (s/ "Named parameters"))))
                        (stable '(30 70) 'np "" 'no-border 'no-frame 'center ""
                                (map (lambda (np)
                                       (spod (sr (sc (car np)) (sc (cadr np)))))
                                     args))))))

        (define (_par . args)
          (list
           (spod (s% (car args)))
           (spod-merge (cdr args))))


        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

        (define (spod-roos-work op . args)
          ;(display (format "roos-spod: op=~a, args=~a~%" op args))
          (cond
           ((eq? op 'synopsis)        (apply _synopsis args))
           ((eq? op 'class-name)      (apply _class-name args))
           ((eq? op 'class-supers)    (apply _class-supers args))
           ((eq? op 'class-derived)   (apply _class-derived args))
           ((eq? op 'class-doc)       (apply _class-doc args))
           ((eq? op 'class-def)       (apply _class-constructor args))
           ((eq? op 'private-members) (apply _private-members args))
           ((eq? op 'public-members)  (apply _public-members args))
           ((eq? op 'member-function) (apply _member-function args))
           ((eq? op 'member-variable) (apply _member-variable args))
           ((eq? op 'class-cleanup)   (apply _class-cleanup args))
           ((eq? op 'see-also)        (apply _see-also args))
           ((eq? op 'named-pars)      (apply _named-pars args))
           ((eq? op 'named-items)     (apply _named-pars args))
           ((eq? op 'item)            (apply _par args))
           ((eq? op 'par)             (apply _par args))
           (else
            (display (format "not part of spod-roos~%"))
            #f)))


        (define-syntax spod-internal
          (syntax-rules ()
            ((_ op)
             (spod-roos-work 'op))
            ((_ op a1)
             (spod-roos-work 'op a1))
            ((_ op a1 ...)
             (spod-roos-work 'op a1 ...))
            ))

        (define-syntax spod1
          (lambda (x)
            (syntax-case x (class-synopsis
                            class-name class-def class-doc class-supers class-derived class-cleanup
                            class-private class-public
                            member-function member-var
                            named-pars par
                            named-items item
                            see-also)
                         ((_ (class-synopsis a1 ...))
                          (syntax (spod-internal synopsis (spod-roos a1) ...)))
                         ((_ (see-also a1 ...))
                          (syntax (spod-internal see-also (spod-roos a1) ...)))
                         ((_ (class-name a1 ...))
                          (syntax (spod-internal class-name (spod-roos a1) ...)))
                         ((_ (class-def a1 ...))
                          (syntax (spod-internal class-def (spod-roos a1) ...)))
                         ((_ (class-cleanup a1 ...))
                          (syntax (spod-internal class-cleanup (spod-roos a1) ...)))
                         ((_ (class-doc a1 ...))
                          (syntax (spod-internal class-doc (spod-roos a1) ...)))
                         ((_ (class-supers a1 ...))
                          (syntax (spod-internal class-supers (spod-roos a1) ...)))
                         ((_ (class-derived a1 ...))
                          (syntax (spod-internal class-derived (spod-roos a1) ...)))
                         ((_ (class-private pd a1 ...))
                          (syntax (spod-internal private-members pd (spod-roos a1) ...)))
                         ((_ (class-public pd a1 ...))
                          (syntax (spod-internal public-members pd (spod-roos a1) ...)))
                         ((_ (member-function a1 ...))
                          (syntax (spod-internal member-function (spod-roos a1) ...)))
                         ((_ (member-var a1 ...))
                          (syntax (spod-internal member-variable (spod-roos a1) ...)))
                         ((_ (named-pars p1 ...))
                          (syntax (spod-internal named-pars (spod-roos p1) ...)))
                         ((_ (par p ...))
                          (syntax (spod-internal par (spod-roos p) ...)))
                         ((_ (named-items p1 ...))
                          (syntax (spod-internal named-items (spod-roos p1) ...)))
                         ((_ (item p ...))
                          (syntax (spod-internal item (spod-roos p) ...)))
                         ((_ (any ...))
                          (syntax (spod (any ...))))
                         ((_ a)
                          (syntax (spod a))))))


        (define-syntax spod-roos
          (lambda (x)
            (syntax-case x (quote)
                         ((_ (quote a))
                          (syntax 'a))
                         ((_)
                          (syntax 'spod-empty))
                         ((_ a1 ...)
                          (syntax (spod-merge (spod1 a1) ...)))
                         )))


        )