;;; Transform flat.sgm into hierarch.sgm.

;; 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))