%D \module
%D   [      file=t-nath,
%D        version=2003.04.11,
%D          title=\CONTEXT\ User Module, 
%D       subtitle=Natural mATH,
%D         author=Giuseppe Bilotta,
%D           date=\currentdate,
%D      copyright={PRAGMA / Giuseppe Bilotta}]

%D This ConTeXt module is intended to provide Nath-like
%D functionality to ConTeXt

\unprotect

%D The following is used when we want to scan for sub- or
%D superscripts to a command.

\newtoks\supertoks
\newtoks\subertoks

\newif\ifsuper
\newif\ifsuber

\def\subsup!parse{
  \superfalse\suberfalse
  \def\next!command{\afterassignment\subsup!!parse\let\next=}%
  \next!command
}

\def\subsup!!parse{%
  \ifx\next_
    \ifsuber
      % TODO report error for double subscript
    \else\subertrue
    \fi
    \def\next!command{\sb!!}
  \else
    \ifx\next^
      \ifsuper
        % TODO report error for double superscript
      \else\supertrue
      \fi
      \def\next!command{\sp!!}
    \else
      \def\next!command{\aftersubsupparse}
    \fi
  \fi
  \next!command
}

\def\sp!!#1{\supertoks{#1}\afterassignment\subsup!!parse\let\next=}
\def\sb!!#1{\subertoks{#1}\afterassignment\subsup!!parse\let\next=}

\let\aftersubsupparse\relax

%D We use it instantly for our first thing:
%D extensible arrows

\def\arrowfiller{%
 \cleaders\hbox{\mathematics{\mkern-3mu\mathord-\mkern-3mu}}%
}

\def\doublearrowfiller{%
 \cleaders\hbox{\mathematics{\mkern-3mu\mathord=\mkern-3mu}}%
}

\def\doarrowfill#1#2{%
  \setbox\!!boxa\hbox{\mathematics{\scriptscriptstyle#1}}%
  \setbox\!!boxb\hbox{\mathematics{\scriptscriptstyle#2}}%
  \ifdim\wd\!!boxa>\wd\!!boxb
    \scratchdimen\wd\!!boxa
  \else
    \scratchdimen\wd\!!boxb
  \fi
  \hbox to \scratchdimen{\arrowfiller\hfill}%
}

\def\dodoublearrowfill#1#2{%
  \setbox\!!boxa\hbox{\mathematics{\scriptscriptstyle#1}}%
  \setbox\!!boxb\hbox{\mathematics{\scriptscriptstyle#2}}%
  \ifdim\wd\!!boxa>\wd\!!boxb
    \scratchdimen\wd\!!boxa
  \else
    \scratchdimen\wd\!!boxb
  \fi
  \hbox to \scratchdimen{\doublearrowfiller\hfill}%
}

\def\xarrow#1#2#3#4#5{% sup sub left right default
  \doifelse{#1#2}\empty{#5}{%
    % \message{Doing something with: .#1#2.^^J}%
    \mathrel{%
      \mathop{%
        \mathopen{#3}\mkern-6mu
        \doarrowfill{#1}{#2}
        \mkern-6mu\mathclose{#4}
      }\limits^{\hss\scriptscriptstyle#1\hss}_{\hss\scriptscriptstyle#2\hss}%
    }
  }%
}

% \def\xrightarrow#1#2{%
%   \doifelse{#1#2}\empty\rightarrow{%
%     % \message{Doing something with: .#1#2.^^J}%
%     \mathrel{%
%       \mathop{%
%         \mathopen-\mkern-6mu
%         \doarrowfill{#1}{#2}
%         \mkern-6mu\mathclose\rightarrow
%       }\limits^{\hss\scriptscriptstyle#1\hss}_{\hss\scriptscriptstyle#2\hss}%
%     }
%   }%
% }

\def\xrightarrow#1#2{\xarrow{#1}{#2}-\rightarrow\rightarrow}
\def\xleftarrow#1#2{\xarrow{#1}{#2}\leftarrow-\leftarrow}
\def\xleftrightarrow#1#2{\xarrow{#1}{#2}\leftarrow\rightarrow\leftrightarrow}
\def\xmapsto#1#2{\xarrow{#1}{#2}\mapstochar\rightarrow{\mapstochar\rightarrow}}

\def\xdoublearrow#1#2#3#4#5{% sup sub left right default
  \doifelse{#1#2}\empty{#5}{%
    % \message{Doing something with: .#1#2.^^J}%
    \mathrel{%
      \mathop{%
        \mathopen{#3}\mkern-6mu
        \dodoublearrowfill{#1}{#2}
        \mkern-6mu\mathclose{#4}
      }\limits^{\hss\scriptscriptstyle#1\hss}_{\hss\scriptscriptstyle#2\hss}%
    }%
  }%
}

\def\xRightarrow#1#2{\xdoublearrow{#1}{#2}=\Rightarrow\Rightarrow}
\def\xLeftarrow#1#2{\xdoublearrow{#1}{#2}\Leftarrow=\Leftarrow}
\def\xLeftrightarrow#1#2{\xdoublearrow{#1}{#2}\Leftarrow\Rightarrow\Leftrightarrow}
\def\xLongleftrightarrow#1#2{\xdoublearrow{#1}{#2}\Leftarrow\Rightarrow\Longleftrightarrow}

\unexpanded\def\to{%
  \def\aftersubsupparse{%
    \xrightarrow{\ifsuper\the\supertoks\fi}{\ifsuber\the\subertoks\fi}%
    \next}%
%   \suberfalse\superfalse\def\next!command{\afterassignment\subsup!!parse\let\next=}%
%   \next!command
    \subsup!parse
}

\unexpanded\def\ot{%
  \def\aftersubsupparse{%
    \xleftarrow{\ifsuper\the\supertoks\fi}{\ifsuber\the\subertoks\fi}%
    \next}%
    \subsup!parse
}

\unexpanded\def\otto{%
  \def\aftersubsupparse{%
    \xleftrightarrow{\ifsuper\the\supertoks\fi}{\ifsuber\the\subertoks\fi}%
    \next}%
    \subsup!parse
}

\unexpanded\def\mapsto{%
  \def\aftersubsupparse{%
    \xmapsto{\ifsuper\the\supertoks\fi}{\ifsuber\the\subertoks\fi}%
    \next}%
    \subsup!parse
}

\unexpanded\def\implies{%
  \def\aftersubsupparse{%
    \xRightarrow{\ifsuper\the\supertoks\fi}{\ifsuber\the\subertoks\fi}%
    \next}%
%   \suberfalse\superfalse\def\next!command{\afterassignment\subsup!!parse\let\next=}%
%   \next!command
    \subsup!parse
}

\unexpanded\def\follows{%
  \def\aftersubsupparse{%
    \xLeftarrow{\ifsuper\the\supertoks\fi}{\ifsuber\the\subertoks\fi}%
    \next}%
    \subsup!parse
}

\unexpanded\def\iff{%
  \def\aftersubsupparse{%
    \xLongleftrightarrow{\ifsuper\the\supertoks\fi}{\ifsuber\the\subertoks\fi}%
    \next}%
    \subsup!parse
}

\protect
