;; Transform hierarch.sgm into flat.sgm.

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

(=> (q-element 'doc)
    (default-transform))

(=> (union (union-for-each x
			   (q-element 'p)
			   (node-list-first (select-by-class (children x)
							     'data-char)))
	   (union-for-each x
			   (q-element 'l)
			   (node-list-first (select-by-class (follow x)
							     'data-char))))
    (create-sub (ancestor "doc" (current-node))
		(subgrove-spec class: 'element
			       add: '((gi "P"))
			       children: (list (copy-current))
			       sub: (list (cons 'attributes
						(generate-para-attributes)))
			       label: 'ignore))
    1)					; higher priority

(=> (select-by-class (subgrove (current-root)) 'data-char)
    (identity-transform-by-ipreced))
    
(define (generate-para-attributes)
  (let ((cur (current-node)))
    (list (subgrove-spec
	   class: 'attribute-assignment
	   add: '((name "MARK"))
	   children: (subgrove-spec
		      class: 'attribute-value-token
		      add: `((token ,(if (p-marked? cur)
					 "MARK"
					 "NOMARK")))))
	  (subgrove-spec
	   class: 'attribute-assignment
	   add: '((name "LEVEL"))
	   children: (subgrove-spec
		      class: 'attribute-value-token
		      add: `((token ,(number->string (p-level cur))))))
	  (subgrove-spec
	   class: 'attribute-assignment
	   add: '((name "CONT"))
	   children: (subgrove-spec
		      class: 'attribute-value-token
		      add: `((token ,(if (p-continued? cur)
					 "CONT"
					 "NOCONT"))))))))

(define (p-level nd)
  (node-list-count (select-element (ancestors nd) 'L)))

(define (p-continued? nd)
  (not (node-list-empty? (select-by-class (preced nd) 'element))))

(define (p-marked? nd)
  (and (not (p-continued? nd))
       (let ((p (parent nd)))
	 (and (match-element? (parent p) 'I)
	      (node-list-empty? (select-element (preced p)
						'P))))))