;; This script converts ".aux" files that were generated for
;; non-hyperref linking to provide labels that can be consumed for
;; hyperref linking. The labels will not actually be hyperlinked, but
;; they won't crash the hyperref package.

;; So, if new ".aux" files are pulled in a generated by a non-hyperref
;; run of TSPL, they can be further updated by running this script
;; within the directory that contains the ".aux" files.

(define (line-match line prefix . seps)
  (cond
    [(and (>= (string-length line)
              (string-length prefix))
          (string=? prefix (substring line 0 (string-length prefix))))
     (let loop ([seps seps] [start (string-length prefix)])
       (cond
         [(null? seps) '()]
         [else
          (let sloop ([i start])
            (cond
              [(> i (- (string-length line)
                       (string-length (car seps))))
               #f]
              [(string=? (car seps) (substring line i (+ i (string-length (car seps)))))
               (cons (substring line start i)
                     (loop (cdr seps) (+ i (string-length (car seps)))))]
              [else (sloop (+ i 1))]))]))]
    [else #f]))

(for-each
 (lambda (f)
   (when (equal? "aux" (path-extension f))
     (printf "Convert ~s\n" f)
     (call-with-input-file
      f
      (lambda (i)
        (with-output-to-file "tmp"
          (lambda ()
            (let loop ([sec #f])
              (let ([line (get-line i)])
                (unless (eof-object? line)
                  (cond
                    [(line-match line
                                 "\\@writefile{toc}{\\contentsline {chapter}{\\numberline {"
                                 "}"
                                 "}")
                     => (lambda (m)
                          (display line) (newline)
                          (loop (list (car m) (cadr m))))]
                    [(line-match line
                                 "\\@writefile{toc}{\\contentsline {chapter}{"
                                 "}")
                     => (lambda (m)
                          (display line) (newline)
                          (loop (list "" (car m))))]
                    [(line-match line "\\newlabel")
                     => (lambda (m)
                          (display (string-append
                                    (substring line 0 (sub1 (string-length line)))
                                    "{" (or (car sec) "") "}"
                                    "{" (cadr sec) "}"
                                    "{}"
                                    "}"))
                          (newline)
                          (loop sec))]
                    [else
                     (display line)
                     (newline)
                     (loop sec)])))))
          '(truncate))))
     (rename-file "tmp" f)))
 (directory-list (current-directory)))
