%D \module
%D   [       file=syst-cat,
%D        version=2006.09.18,
%D          title=\CONTEXT\ System Macros,
%D       subtitle=Catcode Handling,
%D         author=Hans Hagen,
%D           date=\currentdate,
%D      copyright={PRAGMA / Hans Hagen \& Ton Otten}]
%C
%C This module is part of the \CONTEXT\ macro||package and is
%C therefore copyrighted by \PRAGMA. See mreadme.pdf for
%C details.

%D A long standing wish has been the availability of catcode
%D arrays. Because traditional \TEX\ does ot provide this we
%D implement a fake method in the Mark II file.

\ifx\zerocount\undefined \chardef           \zerocount= 0 \fi
\ifx\plusone  \undefined \chardef           \plusone  = 1 \fi
\ifx\minusone \undefined \newcount\minusone \minusone =-1 \fi

\newif \ifrecatcodeuppercharacters % only used in good old tex

\newcount\cctdefcounter \cctdefcounter\plusone % 0 = signal

\newcount\cctcountera
\newcount\cctcounterb
\newcount\cctcounterc

\loadmarkfile{syst-cat}

%D The next command can be defined in a cleaner way in the
%D Mk IV file but we want to have a fast one with a minimal
%D chance for interference.

\chardef\activehackcode=`\~

%D Once a catcode is assigned, the next assignments will happen faster.

% (expandable) let

\def\letcatcodecommand {\afterassignment\letcatcodecommanda\cctcountera}
\def\letcatcodecommanda{\afterassignment\letcatcodecommandb\cctcounterb}

\def\letcatcodecommandb % each time
  {\ifcsname CCL:\number\cctcountera:\number\cctcounterb\endcsname
     \csname CCL:\number\cctcountera:\number\cctcounterb\expandafter\endcsname
   \else
     \expandafter\letcatcodecommandc
   \fi}

\def\letcatcodecommandc % only first time
  {\expandafter\gdef\csname CCL:\number\cctcountera:\number\cctcounterb\expandafter\endcsname\expandafter
     {\expandafter\let\csname CCC:\number\cctcountera:\number\cctcounterb\endcsname}%
   \reinstatecatcodecommanda
   \csname CCL:\number\cctcountera:\number\cctcounterb\endcsname}

% expandable def

\def\defcatcodecommand {\afterassignment\defcatcodecommanda\cctcountera}
\def\defcatcodecommanda{\afterassignment\defcatcodecommandb\cctcounterb}

\def\defcatcodecommandb % each time
  {\ifcsname CCD:\number\cctcountera:\number\cctcounterb\endcsname
     \csname CCD:\number\cctcountera:\number\cctcounterb\expandafter\endcsname
   \else
     \expandafter\defcatcodecommandc
   \fi}

\def\defcatcodecommandc % only first time
  {\expandafter\gdef\csname CCD:\number\cctcountera:\number\cctcounterb\expandafter\endcsname
     \expandafter##\expandafter1\expandafter
       {\expandafter\def\csname CCC:\number\cctcountera:\number\cctcounterb\endcsname{##1}}%
   \reinstatecatcodecommanda
   \csname CCD:\number\cctcountera:\number\cctcounterb\endcsname}

% un expandable def (e.g. used for discretionaries)

\def\uedcatcodecommand {\afterassignment\uedcatcodecommanda\cctcountera}
\def\uedcatcodecommanda{\afterassignment\uedcatcodecommandb\cctcounterb}

\def\uedcatcodecommandb % each time
  {\ifcsname CCU:\number\cctcountera:\number\cctcounterb\endcsname
     \csname CCU:\number\cctcountera:\number\cctcounterb\expandafter\endcsname
   \else
     \expandafter\uedcatcodecommandc
   \fi}

\def\uedcatcodecommandc % only first time
  {\expandafter\gdef\csname CCU:\number\cctcountera:\number\cctcounterb\expandafter\endcsname
     \expandafter##\expandafter1\expandafter
       {\expandafter\unexpanded\expandafter\def\csname CCC:\number\cctcountera:\number\cctcounterb\endcsname{##1}}%
   \reinstatecatcodecommanda
   \csname CCU:\number\cctcountera:\number\cctcounterb\endcsname}

\def\reinstatecatcodecommand{\afterassignment\reinstatecatcodecommanda\cctcounterb}

\def\reinstatecatcodecommanda % can be used when a direct definition has been done
  {\bgroup                    % and the selector has been lost
   \uccode\activehackcode\cctcounterb
   \catcode\uccode\activehackcode13
   \uppercase{\xdef~{\noexpand\catcodecommand{\number\cctcounterb}}}%
   \egroup}

\chardef\defaultcatcodetable\zerocount

\def\catcodecommand#1%
  {\csname CCC:\number
     \ifcsname CCC:\number\currentcatcodetable:\number#1\endcsname
       \currentcatcodetable \else \defaultcatcodetable
     \fi
   :\number#1\endcsname}

%D Here we define some catcode regimes:

\ifx\nilcatcodes \undefined \newcatcodetable \nilcatcodes  \fi
\ifx\texcatcodes \undefined \newcatcodetable \texcatcodes  \fi
\ifx\ctxcatcodes \undefined \newcatcodetable \ctxcatcodes  \fi
\ifx\vrbcatcodes \undefined \newcatcodetable \vrbcatcodes  \fi
\ifx\prtcatcodes \undefined \newcatcodetable \prtcatcodes  \fi
\ifx\mthcatcodes \undefined \newcatcodetable \mthcatcodes  \fi % math
\ifx\xmlcatcodesn\undefined \newcatcodetable \xmlcatcodesn \fi % normal
\ifx\xmlcatcodese\undefined \newcatcodetable \xmlcatcodese \fi % entitle
\ifx\xmlcatcodesr\undefined \newcatcodetable \xmlcatcodesr \fi % reduce

% was redefined in core-job anyway: \catcode`\^^L = 13 % ascii form-feed

\startcatcodetable \nilcatcodes
    \catcode`\^^I = 10 % ascii tab is a blank space
    \catcode`\^^M =  5 % ascii return is end-line
    \catcode`\^^L =  5 % ascii form-feed
    \catcode`\    = 10 % ascii space is blank space
    \catcode`\^^Z =  9 % ascii eof is ignored
\stopcatcodetable

\startcatcodetable \vrbcatcodes % probably less needed
    \catcode`\^^I = 12
    \catcode`\^^M = 12
    \catcode`\^^L = 12
    \catcode`\    = 12
    \catcode`\^^Z = 12
\stopcatcodetable

\startcatcodetable \texcatcodes
    \catcode`\^^I = 10
    \catcode`\^^M =  5
    \catcode`\^^L =  5
    \catcode`\    = 10
    \catcode`\^^Z =  9
    \catcode`\\   =  0
    \catcode`\{   =  1
    \catcode`\}   =  2
    \catcode`\$   =  3
    \catcode`\&   =  4
    \catcode`\#   =  6
    \catcode`\^   =  7
    \catcode`\_   =  8
    \catcode`\%   = 14
\stopcatcodetable

\startcatcodetable \ctxcatcodes
    \catcode`\^^I = 10
    \catcode`\^^M =  5
%     \catcode`\^^J = 10 % new
    \catcode`\^^L =  5
    \catcode`\    = 10
    \catcode`\^^Z =  9
    \catcode`\\   =  0
    \catcode`\{   =  1
    \catcode`\}   =  2
    \catcode`\$   =  3
    \catcode`\&   =  4
    \catcode`\#   =  6
    \catcode`\^   =  7
    \catcode`\_   =  8
    \catcode`\%   = 14
    \catcode`\~   = 13
    \catcode`\|   = 13
\stopcatcodetable

\startcatcodetable \prtcatcodes
    \catcode`\^^I = 10
    \catcode`\^^M =  5
    \catcode`\^^L =  5
    \catcode`\    = 10
    \catcode`\^^Z =  9
    \catcode`\\   =  0
    \catcode`\{   =  1
    \catcode`\}   =  2
    \catcode`\$   =  3
    \catcode`\&   =  4
    \catcode`\#   =  6
    \catcode`\^   =  7
    \catcode`\_   =  8
    \catcode`\%   = 14
    \catcode`\@   = 11
    \catcode`\!   = 11
    \catcode`\?   = 11
    \catcode`\~   = 13
    \catcode`\|   = 13
\stopcatcodetable

\startcatcodetable \xmlcatcodesn
    \catcode`\^^I = 10 % ascii tab is a blank space
    \catcode`\^^M =  5 % ascii return is end-line
    \catcode`\^^L =  5 % ascii form-feed
    \catcode`\    = 10 % ascii space is blank space
    \catcode`\^^Z =  9 % ascii eof is ignored
    \catcode`\&   = 13 % entity
    \catcode`\<   = 13 % element
    \catcode`\>   = 12
    \catcode`\"   = 12 % probably not needed any more
    \catcode`\/   = 12 % probably not needed any more
    \catcode`\'   = 12 % probably not needed any more
    \catcode`\~   = 12 % probably not needed any more
    \catcode`\#   = 12 % probably not needed any more
    \catcode`\\   = 12 % probably not needed any more
\stopcatcodetable

\startcatcodetable \xmlcatcodese
    \catcode`\^^I = 10 % ascii tab is a blank space
    \catcode`\^^M =  5 % ascii return is end-line
    \catcode`\^^L =  5 % ascii form-feed
    \catcode`\    = 10 % ascii space is blank space
    \catcode`\^^Z =  9 % ascii eof is ignored
    \catcode`\&   = 13 % entity
    \catcode`\<   = 13 % element
    \catcode`\>   = 12
    \catcode`\#   = 13
    \catcode`\$   = 13
    \catcode`\%   = 13
    \catcode`\\   = 13
    \catcode`\^   = 13
    \catcode`\_   = 13
    \catcode`\{   = 13
    \catcode`\}   = 13
    \catcode`\|   = 13
    \catcode`\~   = 13
\stopcatcodetable

\startcatcodetable \xmlcatcodesr
    \catcode`\^^I = 10 % ascii tab is a blank space
    \catcode`\^^M =  5 % ascii return is end-line
    \catcode`\^^L =  5 % ascii form-feed
    \catcode`\    = 10 % ascii space is blank space
    \catcode`\^^Z =  9 % ascii eof is ignored
    \catcode`\&   = 13 % entity
    \catcode`\<   = 13 % element
    \catcode`\>   = 12
    \catcode`\#   = 13
    \catcode`\$   = 13
    \catcode`\%   = 13
    \catcode`\\   = 13
    \catcode`\^   = 13
    \catcode`\_   = 13
    \catcode`\{   = 13
    \catcode`\}   = 13
    \catcode`\|   = 13
    \catcode`\~   = 13
\stopcatcodetable

\letcatcodecommand \ctxcatcodes  `\|   \relax
\letcatcodecommand \ctxcatcodes  `\~   \relax

%letcatcodecommand \prtcatcodes  `\|   \relax % falls back on ctx
%letcatcodecommand \prtcatcodes  `\~   \relax % falls back on ctx

\letcatcodecommand \xmlcatcodesn `\&   \relax
\letcatcodecommand \xmlcatcodesn `\<   \relax

\letcatcodecommand \xmlcatcodese `\&   \relax
\letcatcodecommand \xmlcatcodese `\<   \relax

\letcatcodecommand \xmlcatcodesr `\&   \relax
\letcatcodecommand \xmlcatcodesr `\<   \relax

\letcatcodecommand \xmlcatcodese `\#   \relax
\letcatcodecommand \xmlcatcodese `\$   \relax
\letcatcodecommand \xmlcatcodese `\%   \relax
\letcatcodecommand \xmlcatcodese `\\   \relax
\letcatcodecommand \xmlcatcodese `\^   \relax
\letcatcodecommand \xmlcatcodese `\_   \relax
\letcatcodecommand \xmlcatcodese `\{   \relax
\letcatcodecommand \xmlcatcodese `\}   \relax
\letcatcodecommand \xmlcatcodese `\|   \relax
\letcatcodecommand \xmlcatcodese `\~   \relax

\letcatcodecommand \xmlcatcodesr `\#   \relax
\letcatcodecommand \xmlcatcodesr `\$   \relax
\letcatcodecommand \xmlcatcodesr `\%   \relax
\letcatcodecommand \xmlcatcodesr `\\   \relax
\letcatcodecommand \xmlcatcodesr `\^   \relax
\letcatcodecommand \xmlcatcodesr `\_   \relax
\letcatcodecommand \xmlcatcodesr `\{   \relax
\letcatcodecommand \xmlcatcodesr `\}   \relax
\letcatcodecommand \xmlcatcodesr `\|   \relax
\letcatcodecommand \xmlcatcodesr `\~   \relax

    \catcodetable       \ctxcatcodes
\let\defaultcatcodetable\ctxcatcodes
\let\xmlcatcodes        \xmlcatcodesn

%D \macros
%D   {restorecatcodes,
%D    beginrestorecatcodes,endrestorecatcodes}
%D
%D We're not finished dealing \CATCODES\ yet. In \CONTEXT\ we
%D use only one auxiliary file, which deals with tables of
%D contents, registers, two pass tracking, references etc. This
%D file, as well as files concerning graphics, is processed when
%D needed, which can be in the mid of typesetting verbatim.
%D However, when reading in data in verbatim mode, we should
%D temporary restore the normal \CATCODES, and that's exactly
%D what the next macros do. Saving the catcodes can be
%D disabled by saying \type{\localcatcodestrue}.

\let\savedcatcodetable\relax

\newcount\catcoderestorelevel

\def\pushcatcodetable
  {\advance\catcoderestorelevel\plusone
   \tracepushcatcodetable
   \expandafter\mathchardef\csname scct:\number\catcoderestorelevel\endcsname\currentcatcodetable}

% \def\popcatcodetable
%    {\expandafter\catcodetable\csname scct:\number\catcoderestorelevel\endcsname
%     \tracepopcatcodetable
%     \advance\catcoderestorelevel\minusone}

\def\popcatcodetable
  {\ifcase\catcoderestorelevel
     \immediate\write16{}%
     \immediate\write16{Fatal error: catcode push/pop mismatch. Fix this!}\wait\end
     \immediate\write16{}%
   \else
     \expandafter\catcodetable\csname scct:\number\catcoderestorelevel\endcsname
     \tracepopcatcodetable
     \advance\catcoderestorelevel\minusone
   \fi}

\def\restorecatcodes % takes previous level
  {\ifnum\catcoderestorelevel>\plusone
     \expandafter\catcodetable\csname scct:\number\numexpr\catcoderestorelevel-1\relax\endcsname
   \fi}

\newtoks\everycatcodetable

\def\setcatcodetable#1%
   {\catcodetable#1%
    \the\everycatcodetable
    \tracesetcatcodetable}

\def\dotracecatcodetable#1{\immediate\write16{[#1]}}

\def\tracecatcodetables
  {\def\tracesetcatcodetable {\dotracecatcodetable{set  \catcodetablename\space                              at \number\catcoderestorelevel}}%
   \def\tracepushcatcodetable{\dotracecatcodetable{push \catcodetablename\space from \catcodetableprev\space at \number\catcoderestorelevel}}%
   \def\tracepopcatcodetable {\dotracecatcodetable{pop  \catcodetablename\space to   \catcodetableprev\space at \number\catcoderestorelevel}}}

\def\catcodetableprev
  {\ifnum\numexpr\catcoderestorelevel-1\relax>\zerocount
     \csname @@ccn:\number\csname scct:\number\numexpr\catcoderestorelevel-1\relax\endcsname\endcsname
   \else
     -%
   \fi}

\def\catcodetablename
  {\ifnum\currentcatcodetable>\zerocount
     \csname @@ccn:\number\currentcatcodetable\endcsname
   \else
     -%
   \fi}

\ifx\empty\undefined \def\empty{} \fi

\let\tracesetcatcodetable \empty
\let\tracepushcatcodetable\empty
\let\tracepopcatcodetable \empty

% \def\beginrestorecatcodes{\pushcatcodetable\catcodetable\ctxcatcodes}
% \def\endrestorecatcodes  {\popcatcodetable}

\def\beginrestorecatcodes{\pushcatcodetable}
\def\endrestorecatcodes  {\popcatcodetable}

\def\unprotect {\pushcatcodetable\setcatcodetable\prtcatcodes}
\def\protect   {\popcatcodetable}

%D \macros
%D   {installactivecharacter}


\def\installactivecharacter#1 %
  {\edef\temp{\detokenize{#1}}%
   \cctcounterc\expandafter`\temp\relax % relax needed
   \expandafter\startextendcatcodetable
      \expandafter\ctxcatcodes\expandafter\catcode\the\cctcounterc=13
   \stopextendcatcodetable
   \letcatcodecommand \ctxcatcodes \cctcounterc \temp \relax
   \ifnum\currentcatcodetable=\ctxcatcodes \setcatcodetable\ctxcatcodes \fi}

%D \macros
%D   {defineactivecharacter}
%D
%D Use this one with care, esp in combination with catcode
%D vectors. There are better ways now.

\chardef\activehackcode=`~

\def\defineactivecharacter #1 #2%
  {\cctcounterc\uccode\activehackcode
   \uccode\activehackcode\expandafter\doifnumberelse\expandafter{\string#1}\empty`#1%
   \catcode\uccode\activehackcode13
   \uppercase{\def\next{~}}%
   \uccode\activehackcode\cctcounterc
   \expandafter\expandafter\expandafter\def\expandafter\next\expandafter
     {\expandafter\dohandleactivecharacter\next{#2}}}

\chardef\activecharactermode\plusone % overloading still backward compatible

\def\dodohandleactivecharacter#1#2{#2}
\def\donthandleactivecharacter#1#2{\noexpand#1}

\def\dohandleactivecharacter
  {\ifcase\activecharactermode
     \expandafter\donthandleactivecharacter
   \else
     \expandafter\dodohandleactivecharacter
   \fi}

\def\makecharacteractive #1 {\catcode`#1\active}

%D Handy for debugging:

% \tracecatcodetables

\endinput
