#!/usr/bin/sbcl --script
;;; -*- mode: lisp -*-

(defparameter *table*
  '(("a" "@")
    ("A" "a")
    ("I" "\\={\\i}")
    ("U" "\\=u")
    ("ai" "E")
    ("au" "O")
    ("M" "\\.*m")
    ("á" "\\~@")
    ("Á" "\\~a")
    ("í" "\\~{\\i}")
    ("Í" "\\~{\\=\\i}")
    ("ú" "\\~u")
    ("Ú" "\\~{\\=u}")
    ("é" "\\~e")
    ("aí" "\\~E")
    ("ó" "\\~o")
    ("aú" "\\~O")
    ("kh" "k\\super{h}")
    ("gh" "g\\super{h}")
    ("~N" "{\\ng}")
    ("ch" "c\\super{h}")
    ("jh" "j\\super{h}")
    ("~n" "{\\textltailn}")
    ("T" "\\:t")
    ("Th" "\\:t\\super{h}")
    ("D" "\\:d")
    ("Dh" "\\:d\\super{h}")
    ("N" "\\:n")
    ("th" "t\\super{h}")
    ("dh" "d\\super{h}")
    ("ph" "p\\super{h}")
    ("bh" "b\\super{h}")
    ("sh" "S")
    ("Sh" "\\:s")
    ("R" "\\:r")
    ("Rh" "\\:r\\super{h}")))

(defun ipafy (str)
  "Converts according to *TABLE*."
  (let ((n (length str)))
    (with-output-to-string (s)
      (loop for i from 0 below n do
           (let ((x (and (< i (1- n))
                         (cadar (member (subseq str i (+ i 2)) *table*
                                        :test #'equal :key #'first)))))
             (if x
                 (progn
                   (princ x s)
                   (incf i))
                 (let ((y (cadar (member (subseq str i (1+ i)) *table*
                                         :test #'equal :key #'first))))
                   (if y
                       (princ y s)
                       (princ (char str i) s)))))))))

(defun search-matching-brace (str i &optional (open 0))
  (cond ((< open 0) (1- i))
        ((char= (char str i) #\{)
         (search-matching-brace str (1+ i) (1+ open)))
        ((char= (char str i) #\})
         (search-matching-brace str (1+ i) (1- open)))
        (t (search-matching-brace str (1+ i) open))))

(defun hindify (str)
  "Finds tagged substrings:
- HINDIPA{...} [inline]
- HINDIPA>...<HINDIPA [environment]
and substitutes these with their expansions:
inline: \\textipa{...(ipafied text)...}
environment:
\\begin{IPA}
...(ipafied text)...
\\end{IPA}"
  (let ((next (search "HINDIPA" str)))
    (cond ((null next) str)
          ((char= (char str (+ next 7)) #\{)
           (let ((end (search-matching-brace str (+ next 8))))
             (concatenate 'string
                          (subseq str 0 next)
                          "\\textipa{"
                          (ipafy (subseq str (+ next 8) end))
                          "}"
                          (hindify (subseq str (1+ end))))))
          ((char= (char str (+ next 7)) #\>)
           (let ((end (search "HINDIPA" str :start2 (1+ next))))
             (concatenate 'string
                          (subseq str 0 next)
                          "\\begin{IPA}
"
                          (ipafy (subseq str (+ next 9) (1- end)))
                          "\\end{IPA}
"
                          (hindify (subseq str (+ end 8))))))
          (t (append (subseq str 0 (1+ next))
                     (hindify (subseq str (1+ next))))))))

;;; from ALEXANDRIA
(defun read-file-into-string (pathname &key (buffer-size 4096))
  (with-open-file (file-stream pathname)
    (let ((*print-pretty* nil))
      (with-output-to-string (datum)
        (let ((buffer (make-array buffer-size :element-type 'character)))
          (loop for bytes-read = (read-sequence buffer file-stream) do
               (write-sequence buffer datum :start 0 :end bytes-read)
             while (= bytes-read buffer-size)))))))

(unless (= (length sb-ext:*posix-argv*) 2)
  (format t "Usage: hindipa <filename.tex>~%")
  (quit))

(let ((str (read-file-into-string (second sb-ext:*posix-argv*))))
  (with-open-file (s "hindipa-out.tex" :direction :output :if-exists :supersede)
    (format s "% Generated by Hindipa~%~
               % Do not edit by hand!~%~
               ~a" (hindify str))))
(quit)