(* Last edited on 1999-06-07 03:20:58 by stolfi *)

MODULE TeXMode;

IMPORT Text;

CONST 
  Vowels = SET OF CHAR { 'a', 'e', 'i', 'o', 'u',  'A', 'E', 'I', 'O', 'U' };
  ASCIILetters = SET OF CHAR { 'a'..'z',  'A'..'Z' };
  Spaces = SET OF CHAR { ' ', '\t', '\r', '\f', '\n', '\240' };

PROCEDURE ToISOLatin1(VAR (*IO*) buf: REF CHARS; VAR (*IO*) len: CARDINAL) =
      
  PROCEDURE GetBase(k: CARDINAL; VAR b: CHAR; VAR f: CARDINAL) =
    (*
      Tries to parse "buf[k..]" into a base letter for a preceding
      accent macro.  If it succeeds, returns the letter in "b"
      and the next unparsed index in "f".  Otherwise returns
      blank in "v" and sets "f := k". *)
    BEGIN
      f := k; b := ' '; 
      WHILE k < len AND (buf[k] = ' ' OR buf[k] = '{') DO INC(k) END;
      IF k >= len THEN 
        RETURN
      ELSIF buf[k] IN ASCIILetters THEN 
        b := buf[k]; f := k+1; RETURN
      ELSIF buf[k] = '\\'
      AND (k+1 < len AND buf[k+1] = 'i') 
      AND (k+2 >= len OR NOT buf[k+2] IN ASCIILetters) THEN
        b := 'i'; f := k+3
        WHILE f < len AND buf[f] IN Spaces DO INC(f) END;
        RETURN 
      ELSE
        RETURN
      END
    END GetBase;
    
  PROCEDURE Translate(v: CHAR; a, b: TEXT): CHAR =
    BEGIN
      FOR i := 0 TO Text.Length(a) DO
        IF v = Text.GetChar(a, i) THEN RETURN Text.GetChar(b,i) END
      END;
      <* ASSERT FALSE *>
    END Translate;
  
  VAR i, j: CARDINAL := 0;
      y: CHAR;
      lim: CARDINAL;
       
  BEGIN
    (* First pass: convert accents, remove braces, leave other macros unchanged *)
    WHILE i < len DO
      IF buf[i] = '{' OR buf[i] = '}' THEN
        INC(i)
      ELSIF buf[i] = '\\' THEN
        IF i+1 >= len THEN 
          buf[j] := buf[i]; INC(j); INC(i) 
        ELSE
          WITH x = buf[i+1] DO
            IF x = '\\' THEN
              buf[j] := '\\'; INC(j); INC(i,2)
            ELSIF x = '\'' THEN
              GetBase(i+2,y,lim);
              IF y IN Vowels OR y = 'y' OR y = 'Y' THEN 
                buf[j] := Translate(y, "aeiouyAEIOUY", "áéíóúýÁÉÍÓÚÝ");
                INC(j); i := lim
              ELSE
                buf[j] := buf[i]; INC(j); INC(i) 
              END
            ELSIF x = '`' THEN
              GetBase(i+2,y,lim);
              IF y IN Vowels THEN 
                buf[j] := Translate(y, "aeiouAEIOU", "àèìòùÀÈÌÒÙ");
                INC(j); i := lim
              ELSE
                buf[j] := buf[i]; INC(j); INC(i) 
              END
            ELSIF x = '"' THEN
              GetBase(i+2,y,lim);
              IF y IN Vowels OR y = 'y' THEN 
                buf[j] := Translate(y, "aeiouyAEIOU", "äëïöüÿÄËÏÖÜ");
                INC(j); i := lim
              ELSE
                buf[j] := buf[i]; INC(j); INC(i) 
              END
            ELSIF x = '^' THEN
              GetBase(i+2,y,lim);
              IF y IN Vowels THEN 
                buf[j] := Translate(y, "aeiouAEIOU", "âêîôûÂÊÎÔÛ");
                INC(j); i := lim
              ELSE
                buf[j] := buf[i]; INC(j); INC(i) 
              END
            ELSIF x = '~' THEN
              GetBase(i+2,y,lim);
              IF y = 'a' OR y = 'A'
              OR y = 'o' OR y = 'O'
              OR y = 'n' OR y = 'N' THEN 
                buf[j] := Translate(y, "aonAON", "ãõñÃÕÑ");
                INC(j); i := lim
              ELSE
                buf[j] := buf[i]; INC(j); INC(i) 
              END
            ELSIF x = 'c' THEN
              IF i+2 >= len OR buf[i+2] IN ASCIILetters THEN
                buf[j] := buf[i]; INC(j); INC(i)
              ELSE
                GetBase(i+2,y,lim);
                IF y = 'c' OR y = 'C' THEN 
                  buf[j] := Translate(y, "cC", "çÇ");
                  INC(j); i := lim
                ELSE
                  buf[j] := buf[i]; INC(j); INC(i) 
                END
              END
            ELSIF x = 'o' THEN
              IF i+2 >= len OR NOT buf[i+2] IN ASCIILetters THEN
                buf[j] := 'ø'; INC(j); INC(i,2);
                WHILE i < len AND buf[i] = ' ' DO INC(i) END;
              ELSE
                buf[j] := buf[i]; INC(j); INC(i)
              END;
            ELSIF x = 'O' THEN
              IF i+2 >= len OR NOT buf[i+2] IN ASCIILetters THEN
                buf[j] := 'Ø'; INC(j); INC(i,2);
                WHILE i < len AND buf[i] = ' ' DO INC(i) END;
              ELSE
                buf[j] := buf[i]; INC(j); INC(i)
              END;
            ELSIF x = 'a' THEN
              IF i+2 >= len THEN
                buf[j] := buf[i]; INC(j); INC(i)
              ELSIF buf[i+2] = 'e' AND (i+3 >= len OR NOT buf[i+3] IN ASCIILetters) THEN
                buf[j] := 'æ'; INC(j); INC(i,3);
                WHILE i < len AND buf[i] = ' ' DO INC(i) END;
              ELSIF buf[i+2] = 'a' AND (i+3 >= len OR NOT buf[i+3] IN ASCIILetters) THEN
                buf[j] := 'å'; INC(j); INC(i,3);
                WHILE i < len AND buf[i] = ' ' DO INC(i) END;
              ELSE
                buf[j] := buf[i]; INC(j); INC(i)
              END;
            ELSIF x = 'A' THEN
              IF i+2 >= len THEN
                buf[j] := buf[i]; INC(j); INC(i)
              ELSIF buf[i+2] = 'E' AND (i+3 >= len OR NOT buf[i+3] IN ASCIILetters) THEN
                buf[j] := 'Æ'; INC(j); INC(i,3);
                WHILE i < len AND buf[i] = ' ' DO INC(i) END;
              ELSIF buf[i+2] = 'A' AND (i+3 >= len OR NOT buf[i+3] IN ASCIILetters) THEN
                buf[j] := 'Å'; INC(j); INC(i,3);
                WHILE i < len AND buf[i] = ' ' DO INC(i) END;
              ELSE
                buf[j] := buf[i]; INC(j); INC(i)
              END;
            ELSIF x = 's' THEN
              IF i+2 >= len THEN
                buf[j] := buf[i]; INC(j); INC(i)
              ELSIF buf[i+2] = 's' AND (i+3 >= len OR NOT buf[i+3] IN ASCIILetters) THEN
                buf[j] := 'ß'; INC(j); INC(i,3);
                WHILE i < len AND buf[i] = ' ' DO INC(i) END;
              ELSE
                buf[j] := buf[i]; INC(j); INC(i)
              END;
            ELSE
              buf[j] := buf[i]; INC(j); INC(i)
            END
          END
        END
      ELSE
        buf[j] := buf[i]; INC(j); INC(i)
      END
    END;
    len := j;
    (* Second pass: replace all macros (but not macro arguments) by spaces. *)
    i := 0; j := 0;
    WHILE i < len DO
      IF buf[i] = '\\' THEN
        buf[j] := ' '; INC(j); INC(i);
        IF i < len THEN 
          WITH x = buf[i] DO
            IF x IN ASCIILetters THEN
              REPEAT INC(i) UNTIL i >= len OR NOT buf[i] IN ASCIILetters;
            ELSE
              INC(i)
            END;
            WHILE i < len AND buf[i] IN Spaces DO INC(i) END;
          END
        END
      ELSE
        buf[j] := buf[i]; INC(j); INC(i) 
      END
    END;
    len := j
  END ToISOLatin1;

BEGIN
  
END TeXMode.