%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\notcatcodes \undefined \newcatcodetable \notcatcodes  \fi
\ifx\vrbcatcodes \undefined \newcatcodetable \vrbcatcodes  \fi
\ifx\prtcatcodes \undefined \newcatcodetable \prtcatcodes  \fi
\ifx\mthcatcodes \undefined \newcatcodetable \mthcatcodes  \fi % math, not used, too tricky
\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 \notcatcodes
    \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`\~   = 12
    \catcode`\#   = 12 % probably too much, in principle
    \catcode`\$   = 12 % nilcatcodes would be ok too
    \catcode`\%   = 12
    \catcode`\^   = 12
    \catcode`\&   = 12
    \catcode`\_   = 12
    \catcode`\<   = 12
    \catcode`\>   = 12
    \catcode`\{   = 12
    \catcode`\}   = 12
    \catcode`\"   = 12
    \catcode`\'   = 12
    \catcode`\/   = 12
    \catcode`\\   = 12
    \catcode`\|   = 12
\stopcatcodetable

\startcatcodetable \mthcatcodes
    \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}}}
%
% \defineactivecharacter "0EFFF {oeps} \utfchar{0xEFFF}

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

\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
