Transform flat document to hierarchical document

;; Contents of continued para is transformed relative to
;; previous para of same level

(=> (children (q-element '(p (cont cont))))
    (create-sub
      (node-list-last
       (select-elements
        (preced (current-node))
        `(p (level ,(attribute-string
                     (current-node)
                     "level")
            cont nocont))))
      (copy-current))
    1)

;; Leave out continued P elements

(=> (q-element '(p (cont cont)))
    '()
    1)

(=> (q-element '(p (cont nocont)))
    (if (node-list-empty? (ipreced (current-node)))
        (identity-transform-by-origin)
        (let* ((last-nocont   ; last non-continued P
                (node-list-last
                 (select-elements (preced (current-node))
                                  '(p (cont nocont)))))
               (inc           ; change in list level
                (- (string->number
                    (attribute-string (current-node)
                                      "level"))
                   (string->number
                    (attribute-string last-nocont
                                      "level")))))
          (cond ((> inc 0)
                 (create-sub last-nocont
                             (l-i-p-subgrove inc))
                ((match-element? (current-node) '(p (mark mark)))
                 (create-follow (last-nocont-same-level-p)
                                (subgrove-spec
                                 class: 'element
                                 add: '((gi "I"))
                                 label: 'ignore
                                 children: (list (copy-current)))
                                result-path: parent))
                (else
                 (create-follow (last-nocont-same-level-p)
                                (copy-current))))))
    1)

(define (last-nocont-same-level-p)
  (node-list-last
   (select-elements
    (preced (current-node))
    `(p (level ,(attribute-string (current-node)
                                  "level")
         cont nocont)))))

(define (l-i-p-subgrove rep)
  (subgrove-spec
   class: 'element
   add: '((gi "L"))
   label: 'ignore
   children:
   (list
    (subgrove-spec
     class: 'element
     add: '((gi "I"))
     label: 'ignore
     children: (if (= rep 1)
                   (subgrove-spec
                    class: 'element
                    add: '((gi "P")))
                   (subgrove-spec
                    class: 'element
                    add: '((gi "P"))
                    label: 'ignore
                    children:
                    (list
                     (l-i-p-subgrove (- rep 1)))))))))

;; Leave out attributes of P element

(=> (attributes (q-element 'p))
    '()
    1)

(=> (current-root)
    (create-root
     #f
     (subgrove-spec
      subgrove: (sgml-parse-prolog "hierarch.sgm"))))

(=> (document-instance)
    (default-transform))