;assumes multipage.mistie

(define h-string-trim-blanks
  (lambda (s)
    (let ((orig-n (string-length s)))
      (let ((i 0) (n orig-n))
        (let loop ((k i))
          (unless (>= k n)
            (cond ((char-whitespace? (string-ref s k))
                   (loop (+ k 1)))
                  (else (set! i k)))))
        (let loop ((k (- n 1)))
          (unless (<= k i)
            (cond ((char-whitespace? (string-ref s k))
                   (loop (- k 1)))
                  (else (set! n (+ k 1))))))
        (if (and (= i 0) (= n orig-n)) s
            (substring s i n))))))

(define h-labels '())

(mistie-def-ctl-seq 'label
  (lambda ()
    (let ((lbl (h-string-trim-blanks (h-read-group))))
      (write `(set! h-labels
                (cons (list ,lbl ,h-page-count
                        ,h-recent-label ,h-recent-label-value )
                  h-labels)) h-aux-port)
      (newline h-aux-port))))

(define h-resolve-xref
  (lambda (lbl)
    (let ((val (assoc lbl h-labels)))
      (if val
          (begin (display "<a href=\"")
            (display (h-page-numbered (list-ref val 1)))
            (display #\#)
            (display (list-ref val 2))
            (display "\">")
            (display (list-ref val 3))
            (display "</a>"))
          (begin
            (display "***")
            (display lbl)
            (display "***"))))))

(mistie-def-ctl-seq 'ref
  (lambda ()
    (let ((lbl (h-string-trim-blanks (h-read-group))))
      (h-resolve-xref lbl))))

(define h-bibitem-number 0)

(mistie-def-ctl-seq 'bibitem
  (lambda ()
    (set! h-bibitem-number (+ h-bibitem-number 1))
    (set! h-recent-label (string-append "BIBITEM_"
                           (number->string h-bibitem-number)))
    (set! h-recent-label-value h-bibitem-number)
    (display "<a name=\"")
    (display h-recent-label)
    (display "\">[")
    (display h-bibitem-number)
    (display "]&nbsp;")
    ((mistie-lookup-ctl-seq 'label))))

(mistie-def-ctl-seq 'cite
  (lambda ()
    (h-ignore-spaces)
    (let ((ch (read-char)))
      (unless (eqv? ch #\{)
        (error "cite: expected #\\{ but got" ch)))
    (write-char #\[)
    (let loop ()
      (h-resolve-xref
        (h-string-trim-blanks
          (h-read-until
            (lambda (c)
              (or (eqv? c #\,) (eqv? c #\}))))))
      (unless (char=? (read-char) #\}) (write-char #\,) (loop)))
    (write-char #\])))