(* ---------------------------------------------------------------
Title         Q&D MOD to HTML
Author        PhG
Overview      try and convert a Modula-2 source to HTML
Usage         see help
Notes         very, very, very quick & dirty... :-(
              minimal error messages and checking, etc.
              using data from HTMSTRIP.INI
              from what I've seen, HTML markups
              are limited and poorly designed even with "CSS" :
              I won't bother losing time trying to do a better job
              for this Q&D conversion tool : user beware !
              flagBR was not so good an idea after all : remed out

              created for TopSpeed J.P.I. Modula-2 source code
              but possibly useful for newer Modula-2 compilers
              (alternate INI specified with -i:$ option should do)

              alternate INI files (-i:$ option) are :
              M2_ISO, M2_PIM and M2_OBJM2
              they merely contain keywords
              ripped from Pygments202 Pascal lexer
              unlikely user will have to complete them
              for libraries and functions

Bugs          we don't flag this FLOAT pattern : "[+-]#E[+-]#"
              (we know why and we don't care fixing it anyway)

Wish List     support for XDS and ADW ? not for me !

--------------------------------------------------------------- *)

MODULE MOD2HTM;

IMPORT Lib;
IMPORT FIO;
IMPORT Str;
IMPORT IO;

FROM IO IMPORT WrStr, WrLn;

FROM Storage IMPORT ALLOCATE,DEALLOCATE,Available;

FROM QD_ASCII IMPORT dash, slash, nullchar, tabchar, cr, lf, nl, bs,
space, dot, deg, doublequote, quote, colon, percent, vbar,
blank, equal, dquote, charnull, singlequote, antislash, dollar,
star, backslash, coma, question, underscore, tabul, hbar,
comma, semicolon, diese, pound, openbracket, closebracket, tilde, exclam,
stardotstar, dotdot, escCh, escSet, letters, digits,
lettersUpp, lettersLow, openbrace, closebrace;

FROM QD_Box IMPORT str80, str2, cmdInit, cmdShow, cmdStop, delim,
Work, video, Ltrim, Rtrim, UpperCase, LowerCase, ReplaceChar,
ChkEscape, Waitkey, WaitkeyDelay, Flushkey, IsRedirected, chkJoker,
isOption, GetOptIndex, GetLongCard, GetLongInt, GetString, CharCount,
same, aR, aH, aS, aD, aA, everything, isDirectory, fixDirectory,
str128, str256, Animation, allfiles, Belongs, FixAE, CodePhonetic,
CodeSoundex, CodeSoundexOrg, isReadOnly, LtrimBlanks, RtrimBlanks,
getStrIndex, cmdSHOW,BiosWaitkey,BiosWaitkeyShifted,BiosFlushkey,
str1024, isoleItemS, dmpTTX, str2048, Elapsed, TerminalReadString,
getDosVersion, DosVersion, warning95, runningWindows,
aV, reallyeverything, chkClassicTextMode, setClassicTextMode,
AltAnimation, str16, getCurrentDirectory, setReadWrite, setReadOnly,
getFileSize, verifyString, str4096, unfixDirectory,
animShow, animSHOW, animAdvance, animEnd, animClear,
animInit, animGetSdone, anim, cleantabs, UpperCaseAlt, LowerCaseAlt,
completedInit, completedShow, completedSHOW, completedEnd, completed,
removeDups, isValidHDunit, removePhantoms, removeFloppies,
getCDROMunits, getCDROMletters, removeCDROMs, getAllHDunits,
getAllLegalUnits, metaproc, getCli, argc, argv,
metaproc, UpperCaseFR, LowerCaseFR, ASCIIonly;

FROM QD_File IMPORT pathtype, w9XnothingRequired,
fileOpenRead, fileOpen, fileExists, fileExistsAlt,
fileIsRO, fileSetRW, fileSetRO,
fileErase, fileCreate, fileRename, fileGetFileSize, fileGetFileStamp,
fileIsDirectorySpec, fileClose, fileFlush, fileSupportLFN;

FROM QD_LFN IMPORT path9X, huge9X, findDataRecordType,
unicodeConversionFlagType, w9XchangeDir,
w9XgetDOSversion, w9XgetTrueDOSversion, w9XisWindowsEnh, w9XisMSDOS7,
w9XfindFirst, w9XfindNext, w9XfindClose, w9XgetCurrentDirectory,
w9XlongToShort, w9XshortToLong, w9XtrueName, w9XchangeDir,
w9XmakeDir, w9XrmDir, w9Xrename, w9XopenFile, w9XcloseFile,
w9XsupportLFN;

(* ------------------------------------------------------------ *)

CONST
    extHTML       = ".htm"; (* was "html" *)
    extHTM        = ".HTM";
    extHT         = ".HT_";
    extH          = ".HT!";
    extMOD        = ".MOD";
    extDEF        = ".DEF";
    dotstar       = dot+star;
CONST
    extINI        = ".INI";
    extBAK        = ".BK!";
    extCOM        = ".COM";
    extEXE        = ".EXE";
    extDLL        = ".DLL";
    extZIP        = ".ZIP";
    extARJ        = ".ARJ";
    skippedextensions = extINI+delim+extBAK+delim+extCOM+delim+extEXE+delim+
                        extDLL+delim+extZIP+delim+extARJ+delim+
                        extHTML+delim+extHTM+delim+extHT+delim+extH;
CONST
    sBRcode           = "<BR>";
    sUnbreakableSpace = "&nbsp;";
    lenunbreakable    = 6; (* avoid recomputing it at each line *)
CONST
    ProgEXEname   = "MOD2HTM";
    ProgTitle     = "Q&D Modula-2 source to HTML format";
    ProgVersion   = "v1.0";
    ProgCopyright = "by PhG";
    Banner        = ProgTitle+" "+ProgVersion+" "+ProgCopyright;


CONST
    errNone                 = 0;
    errHelp                 = 1;
    errOption               = 2;
    errTooManyParms         = 3;
    errMissingSpec          = 4;
    errTooManyFiles         = 5;
    errNoMatch              = 6;
    errMissingIni           = 7;
    errBadExt               = 8;
    errMissingSection       = 9;
    errTooManyLinesHeader   = 10;
    errTooManyLinesTrailer  = 11;
    errTooManyLinesEntity   = 12;
    errBadEntity            = 13;
    errMissingSafety        = 14;
    errTooManyTokens        = 15;
    errBadToken             = 16;
    errBadVal               = 17;
    errEmptyLine            = 18;

(* ------------------------------------------------------------ *)

PROCEDURE abort (e : CARDINAL; einfo : ARRAY OF CHAR);
(*
 00000000011111111112222222222333333333344444444445555555555666666666677777777778
 1...'....0....'....0....'....0....'....0....'....0....'....0....'....0....'....0
*)
CONST
    msghelp=
Banner+nl+
nl+
"Syntax : "+ProgEXEname+" <file(s)> [option]..."+nl+
nl+
"This program converts Modula-2 source code to HTML format."+nl+
nl+
"  -i:$  specify alternate "+extINI+" file (default is "+ProgEXEname+extINI+")"+nl+
"  -t:#  specify tab stop ([1..32], default is 4)"+nl+
"  -t    do not expand tabulation character ($09) to space(s)"+nl+
'  -f    force each space to "'+sUnbreakableSpace+'" non-breakable space'+nl+
(* '  -n    force each $0d0a to "'+sBRcode+'"'+nl+ *)
"  -k    ignore keywords case (default is case-sensitive)"+nl+
"  -y    casify keywords using "+ProgEXEname+extINI+" lists (-k forced)"+nl+
'  -l[l] show line numbers (-ll = pad with "0"s instead of spaces)'+nl+
"  -a    alternate set of HTML formatting tags"+nl+
"  -c    assume source is a mere text file and thus do not try to parse it"+nl+
"  -dos  assume source is DOS ASCII (default)"+nl+
"  -oem  assume source is Windows OEM"+nl+
"  -o[o] overwrite existing target (oo = overwrite read-only target)"+nl+
"  -p    create target in source directory (default is in current directory)"+nl+
"  -r    create target without header nor trailer"+nl+
"  -q    no eyecandy"+nl+
"  -i    show active parameters"+nl+
'  -z    change default extension to "'+dotstar+'" (default is "'+extMOD+'")'+nl+
"  -x    disable LFN support even if available"+nl+
nl+
"a) "+skippedextensions+" files are ignored."+nl+
"b) Without -i:$ option, "+ProgEXEname+extINI+" must exist :"+nl+
"   it is first searched for in current then in executable directory."+nl+
"   Note various program limits are specified in original "+ProgEXEname+extINI+" remarks."+nl+
"   Any file specified with -i:$ option must exist."+nl+
"c) Source code syntax is assumed to be correct"+nl+
"   (its compilation should be a success)."+nl+
"d) Source file cannot contain any $00 character ;"+nl+
"   each line should be smaller than 1024 characters."+nl+
'e) With LFN support, "'+extHTML+'" is appended to source filename.'+nl+
'   Without LFN support, extension becomes either "'+extHTM+'" or "'+extHT+'"'+nl+
'   depending upon source has "'+extMOD+'" or "'+extDEF+'" extension ;'+nl+
'   any other source extension will be changed to "'+extH+'" extension.'+nl+
"f) -f option overrides any space redefinition in "+ProgEXEname+extINI+" file."+nl+
"g) -l[l] option inherits whatever current format is : this is by design."+nl+
"h) This program was written for TopSpeed J.P.I. Modula-2 source code,"+nl+
"   but it should be useful for newer Modula-2 compilers."+nl+
nl+
"Examples : "+ProgEXEname+" src\mod2htm.MOD /a /o"+nl+
"           "+ProgEXEname+" *.def /o /t:8 /y /i:xds.ini"+nl;


VAR
    S : str1024;
BEGIN
    CASE e OF
    ¦ errHelp :         WrStr(msghelp);
    ¦ errOption :       S := 'Illegal "¦" option !';
    ¦ errTooManyParms : S := '"¦" is just one parameter too far !';
    ¦ errMissingSpec  : S := "Missing <file(s)> specification !";
    ¦ errTooManyFiles : S := 'Too many files match "¦" specification !';
    ¦ errNoMatch :      S := 'No file matches "¦" specification !';
    ¦ errMissingIni :   S := 'Required "¦" file could not be found !';
    ¦ errBadExt :       S := "File extension would prevent file(s) from being processed !";
    ¦ errMissingSection:S := "A required section is missing !";
    ¦ errTooManyLinesHeader: S:="Too many lines in header section (¦) !";
    ¦ errTooManyLinesTrailer:S:="Too many lines in trailer section (¦) !";
    ¦ errTooManyLinesEntity: S:="Too many lines in entities section (¦) !";
    ¦ errBadEntity:     S := "Illegal entity (¦) !";
    ¦ errMissingSafety: S := "Missing safety section at end of "+extINI+" file !";
    ¦ errTooManyTokens: S := "Too many tokens (¦) !";
    ¦ errBadToken:      S := "Illegal token (¦) !";
    ¦ errBadVal:        S := 'Illegal or out of range "¦" value !';
    ¦ errEmptyLine:     S := 'Empty single-line section (¦) !';
    ELSE
        S := "This is illogical, Captain !";
    END;
    CASE e OF
    ¦ errNone,errHelp:
        ;
    ELSE
        Str.Subst(S,"¦",einfo);
        WrStr(ProgEXEname+" : "); WrStr(S); WrLn;
    END;
    Lib.SetReturnCode(SHORTCARD(e));
    HALT;
END abort;

(* ------------------------------------------------------------ *)
(* ------------------------------------------------------------ *)

CONST
    ioBufferSize    = (8 * 512) + FIO.BufferOverhead;
    firstBufferByte = 1;
    lastBufferByte  = ioBufferSize;
TYPE
    ioBufferType  = ARRAY [firstBufferByte..lastBufferByte] OF BYTE;
VAR
    ioBufferIn,ioBufferOut : ioBufferType;

(* ------------------------------------------------------------ *)
(* ------------------------------------------------------------ *)

PROCEDURE legalextension (S,skipthem:ARRAY OF CHAR):BOOLEAN;
VAR
    e3 : str16;
    n:CARDINAL;
    rc:BOOLEAN;
BEGIN
    Str.Caps(S); (* ah, lowercase LFNs... *)
    rc:=TRUE;
    n:=0;
    LOOP
        isoleItemS(e3, skipthem,delim,n);
        IF same(e3,"") THEN EXIT; END;

        Str.Caps(e3); (* safety because of lowercase ".html" *)

        IF Str.Pos(S,e3) # MAX(CARDINAL) THEN rc:=FALSE;EXIT; END;
        INC(n);
    END;
    RETURN rc;
END legalextension;

(* ------------------------------------------------------------ *)

TYPE
    pFname = POINTER TO fnameType;
    fnameType = RECORD
        next      : pFname;
        slen      : SHORTCARD;
        str       : CHAR;
    END;

PROCEDURE initList (VAR anchor : pFname );
BEGIN
    anchor := NIL;
END initList;

PROCEDURE freeList (anchor : pFname);
VAR
    needed : CARDINAL;
    p      : pFname;
BEGIN
    (* p:=anchor; *)
    WHILE anchor # NIL DO
        needed := SIZE(fnameType) - SIZE(anchorˆ.str) + CARDINAL(anchorˆ.slen);
        p := anchorˆ.next;
        DEALLOCATE(anchor,needed);
        anchor:=p;
    END
END freeList;

PROCEDURE buildNewPtr (VAR anchor,p:pFname; len:CARDINAL):BOOLEAN;
VAR
    needed : CARDINAL;
BEGIN
    needed := SIZE(fnameType) - SIZE(pˆ.str) + len;
    IF Available(needed)=FALSE THEN RETURN FALSE; END;
    IF anchor = NIL THEN
        ALLOCATE(anchor,needed);
        p:=anchor;
    ELSE
        p:=anchor;
        WHILE pˆ.next # NIL DO
            p:=pˆ.next;
        END;
        ALLOCATE(pˆ.next,needed);
        p:=pˆ.next;
    END;
    pˆ.next := NIL;
    RETURN TRUE;
END buildNewPtr;

(* assume p is valid *)

PROCEDURE getStr (VAR S : pathtype; p:pFname);
VAR
    len:CARDINAL;
BEGIN
    len := CARDINAL(pˆ.slen);
    Lib.FastMove( ADR(pˆ.str),ADR(S),len);
    S[len] := nullchar; (* REQUIRED safety ! *)
END getStr;

(* ------------------------------------------------------------ *)

PROCEDURE isReservedEntry (S:ARRAY OF CHAR) : BOOLEAN;
BEGIN
    IF same(S,dot) THEN RETURN TRUE; END;
    RETURN same(S,dotdot);
END isReservedEntry;

PROCEDURE buildFileList (VAR anchor:pFname;
                        useLFN:BOOLEAN;spec:pathtype;skipext:ARRAY OF CHAR):CARDINAL;
VAR
    count:CARDINAL; (* should do ! *)
    ok,found:BOOLEAN;
    unicodeconversion:unicodeConversionFlagType;
    w9Xentry : findDataRecordType;
    w9Xhandle,errcode:CARDINAL;
    entry : FIO.DirEntry;
    dosattr:FIO.FileAttr;
    entryname:pathtype;
    len : CARDINAL;
    pp:pFname;
    includeme:BOOLEAN;
BEGIN
    count:=0;
    IF useLFN THEN
        found := w9XfindFirst (spec,SHORTCARD(everything),SHORTCARD(w9XnothingRequired),
                              unicodeconversion,w9Xentry,w9Xhandle,errcode);
    ELSE
        found := FIO.ReadFirstEntry(spec,everything,entry);
    END;
    WHILE found DO
        IF useLFN THEN
            Str.Copy(entryname,w9Xentry.fullfilename);
        ELSE
            Str.Copy(entryname,entry.Name);
        END;
        includeme := NOT( isReservedEntry(entryname) ); (* skip "." and ".." *)
        includeme := includeme AND legalextension(entryname,skipext);
        IF includeme THEN
            IF useLFN THEN
                dosattr:=FIO.FileAttr(w9Xentry.attr AND 0FFH);
            ELSE
                dosattr:=entry.attr;
            END;
            IF NOT (aD IN dosattr) THEN
                (* if file has no extension, add it as a marker *)
                IF Str.RCharPos(entryname,".")=MAX(CARDINAL) THEN
                    Str.Append(entryname,".");
                END;
                len:=Str.Length(entryname);
                IF buildNewPtr(anchor,pp,len)=FALSE THEN
                    IF useLFN THEN ok:=w9XfindClose(w9Xhandle,errcode); END;
                    RETURN MAX(CARDINAL); (* errStorage *)
                END;
                INC(count);
                ppˆ.slen      := SHORTCARD(len);
                Lib.FastMove ( ADR(entryname),ADR(ppˆ.str),len );
            END;
        END;
        IF useLFN THEN
            found :=w9XfindNext(w9Xhandle, unicodeconversion,w9Xentry,errcode);
        ELSE
            found :=FIO.ReadNextEntry(entry);
        END;
    END;
    IF useLFN THEN ok:=w9XfindClose(w9Xhandle,errcode); END;
    RETURN count;
END buildFileList;

(* ------------------------------------------------------------ *)
(* ------------------------------------------------------------ *)

PROCEDURE buildPath (VAR path:pathtype; spec:pathtype);
VAR
    u,d,n,e:pathtype;
BEGIN
    Lib.SplitAllPath(spec, u,d,n,e);
    Str.Concat(path, u,d);
    fixDirectory(path); (* safety *)
END buildPath;

PROCEDURE fixspec (VAR spec:pathtype; flagForceMOD:BOOLEAN );
VAR
    i:CARDINAL;
    ext,fullext:str16; (* oversized *)
BEGIN
    IF flagForceMOD THEN
        ext:=extMOD;
    ELSE
        ext:=dotstar;
    END;
    Str.Concat(fullext,star,ext);

    IF same(spec,".") THEN Str.Copy(spec,fullext); END;
    IF Str.Match(spec,"*\") THEN Str.Append(spec,fullext); END;
    IF Str.Match(spec,"*\.") THEN
        i:=Str.Length(spec);
        spec[i-1]:=nullchar;
        Str.Append(spec,fullext);
    END;
    IF Str.RCharPos(spec,dot)=MAX(CARDINAL) THEN Str.Append(spec,ext);END;
END fixspec;

PROCEDURE wrQ (useLFN:BOOLEAN;S:ARRAY OF CHAR   );
BEGIN
    IF useLFN THEN WrStr(dquote);END;
    WrStr(S);
    IF useLFN THEN WrStr(dquote);END;
END wrQ;

PROCEDURE parserange (mini,maxi:CARDINAL;S:ARRAY OF CHAR   ):CARDINAL;
VAR
    lc:LONGCARD;
    v:CARDINAL;
BEGIN
    v := MAX(LONGCARD);
    IF GetLongCard(S,lc) THEN
        IF lc <= MAX(CARDINAL) THEN
            v:=CARDINAL(lc);
            IF ( (v < mini) OR (v > maxi) ) THEN v:=MAX(CARDINAL); END;
        END;
    END;
    RETURN v;
END parserange;

PROCEDURE detabme (VAR R : ARRAY OF CHAR;
                  tabwidth:CARDINAL;S:ARRAY OF CHAR);
VAR
    i,j,add: CARDINAL;
    c : CHAR;
BEGIN
    Str.Copy(R,"");
    j:=0; (* yes, 0 and not 1 ! *)
    FOR i:=1 TO Str.Length(S) DO
        c := S[i-1];
        IF c = tabchar THEN
            add := tabwidth - (j MOD tabwidth);
            WHILE add > 0 DO
                Str.Append(R,space); INC(j);
                DEC(add);
            END;
        ELSE
            Str.Append(R,c); INC(j);
        END;
    END;
END detabme;

PROCEDURE newExt(VAR S:pathtype;ext:str16);
VAR
    R:pathtype;
    p:CARDINAL;
BEGIN
    Str.Copy(R,S);
    p:=Str.RCharPos(R,dot);
    IF p # MAX(CARDINAL) THEN R[p]:=nullchar;END;
    Str.Concat(S,R,ext);
END newExt;

PROCEDURE findIni (VAR ini:pathtype;useLFN,flagUserINI:BOOLEAN  ):BOOLEAN;
VAR
    u,d,n,e,F:pathtype;
BEGIN
    IF flagUserINI THEN
        IF Str.CharPos(ini,dot) = MAX(CARDINAL) THEN Str.Append(ini,extINI);END;
    ELSE
        Lib.ParamStr(ini,0); (* always uppercase *)
        newExt(ini,extINI);
        Lib.SplitAllPath(ini,u,d,n,e);
        Lib.MakeAllPath(F,"","",n,extINI);
        IF fileExists(useLFN,F) THEN
            Str.Copy(ini,F);
            RETURN TRUE;
        END;
    END;
    RETURN fileExists(useLFN,ini);
END findIni;

PROCEDURE padme ( S:ARRAY OF CHAR  );
CONST
    winfo = 30;
VAR
    i:CARDINAL;
BEGIN
    WrStr(S);
    FOR i:=Str.Length(S)+1 TO winfo DO WrStr(" ");END;
    WrStr(": ");
END padme;

PROCEDURE dmpboolZ (tf:BOOLEAN;sY,sN,S:ARRAY OF CHAR   );
BEGIN
    padme(S);
    IF tf THEN
        WrStr(sY);
    ELSE
        WrStr(sN);
    END;
    WrLn;
END dmpboolZ;

PROCEDURE dmpbool (tf:BOOLEAN;S:ARRAY OF CHAR);
BEGIN
    dmpboolZ(tf,"YES","no",S);
END dmpbool;

PROCEDURE dmpval (v:CARDINAL;S:ARRAY OF CHAR   );
BEGIN
    padme(S);
    IO.WrCard(v,1);WrLn;
END dmpval;

PROCEDURE dmpstr (S1,S:ARRAY OF CHAR);
BEGIN
    padme(S);
    WrStr(doublequote);
    WrStr(S1);
    WrStr(doublequote);WrLn;
END dmpstr;

PROCEDURE num2str (n,base,wi:CARDINAL;padchar:CHAR):str16;
VAR
    R:str16;
    ok:BOOLEAN;
BEGIN
    Str.CardToStr( LONGCARD(n),R,base,ok );
    WHILE Str.Length(R) < wi DO
        Str.Prepend(R,padchar);
    END;
    IF base=16 THEN Str.Lows(R);Str.Prepend(R,dollar);END;
    RETURN R;
END num2str;

(* ------------------------------------------------------------ *)

PROCEDURE isDigit (c:CHAR):BOOLEAN;
BEGIN
    RETURN Belongs(digits,c);
END isDigit;

(*
    ripped from QD_SKY (thus NOT universal)

    specialized for date, time, latitude, longitude check
    check if source s$ and pattern fmt$ match together
    #=any number, ?=any char, [..]=one char from this charset, else exact
    if # or ? needed, use [#] or [?]
*)

PROCEDURE MatchFormat (fmt,S:ARRAY OF CHAR  ) : BOOLEAN;
CONST
    setBegin = "[";
    setEnd   = "]";
    Number   = "#";
    anyChar  = "?";
VAR
    wasdigit : BOOLEAN;
    p        : CARDINAL;
    maxp     : CARDINAL;
    currchar : CHAR;
    i        : CARDINAL;
    maxi     : CARDINAL;
    currfmt  : CHAR;
    pclose   : CARDINAL;
    charset  : str128;
BEGIN
    IF same(S,"") THEN RETURN FALSE; END;
    IF same(fmt,"") THEN RETURN FALSE; END;
    IF CharCount(fmt,setBegin) # CharCount(fmt,setEnd) THEN RETURN FALSE; END;
    (* Q&D checks are done now... *)
    p        := 0;                (* index in source S *)
    maxp     := Str.Length(S)-1;
    wasdigit := FALSE;            (* flag for # pattern *)
    i        := 0;                (* index in pattern fmt *)
    maxi     := Str.Length(fmt)-1;
    LOOP
        currchar := S[p];
        currfmt  := fmt[i];
        CASE currfmt OF
        ¦ anyChar :               (* any char so advance both pointers *)
            INC(i);
            INC(p);
        ¦ Number :                (* any number *)
            CASE isDigit(currchar) OF
            ¦ TRUE :
                wasdigit := TRUE;
                INC(p); (* advance only in source S *)
                IF p > maxp THEN (* if a digit was last char of source S... *)
                    INC(i);      (* ... then advance in fmt, just in case *)
                END;
            ¦ FALSE :
                IF wasdigit=FALSE THEN RETURN FALSE; END; (* no digit at all *)
                wasdigit:=FALSE; (* reset flag *)
                INC (i); (* advance only in pattern fmt and keep new nondigit *)
            END;
        ¦ setBegin : (* any char in charset [..] *)
            pclose:=Str.NextPos(fmt,setEnd,i+1);
            Str.Slice(charset,fmt,i+1,pclose-(i+1) );
            IF Str.CharPos(charset,currchar)=MAX(CARDINAL) THEN RETURN FALSE; END;
            i:=pclose+1;
            INC(p);
        ELSE (* exact *)
            IF currchar # currfmt THEN RETURN FALSE; END;
            INC (i); (* advance both pointers *)
            INC (p);
        END;
        IF (i > maxi) AND (p > maxp) THEN EXIT; END; (* all is ok, S and fmt match *)
        IF (i > maxi) OR (p > maxp) THEN RETURN FALSE; END; (* chars left in either S or fmt *)
    END;
    RETURN TRUE;
END MatchFormat;

(* ------------------------------------------------------------ *)
(* ------------------------------------------------------------ *)

TYPE
    ndxtype = (ndxfmtheader,ndxfmttrailer,

               ndxfmtnormal,ndxfmtremark,
               ndxfmtstringdouble,ndxfmtstringsingle,
               ndxfmtinteger,ndxfmtfloat,
               ndxfmthex,ndxfmtbin,

               ndxfmtkeyword,ndxfmtlibrary,ndxfmtfunction,
               ndxfmtuserlibraryA,ndxfmtuserfunctionA,
               ndxfmtuserlibraryB,ndxfmtuserfunctionB,

               ndxdelimiters,

               ndxkeywords,
               ndxlibraries,ndxfunctions,
               ndxuserlibraries_A,ndxuserfunctions_A,
               ndxuserlibraries_B,ndxuserfunctions_B,

               ndxentities);
CONST
    sections = "header,trailer,"+

               "normal,remark,"+
               "stringdouble,stringsingle,"+
               "integer,float,"+
               "hex,binary,"+

               "fmtkeyword,fmtlibrary,fmtfunction,"+
               "fmtuserlibrary_A,fmtuserfunction_A,"+
               "fmtuserlibrary_B,fmtuserfunction_B,"+

               "delimiters,"+

               "keywords,"+
               "libraries,functions,"+
               "userlibraries_A,userfunctions_A,"+
               "userlibraries_B,userfunctions_B,"+

               "entities"; (* prefixed with "DOS_" or "WIN_" *)

CONST
    MAXHASH= MAX(CARDINAL); (* 65535 is really enough ! *)
TYPE
    str8 = ARRAY [0..8-1] OF CHAR;
    str32= ARRAY [0..32-1] OF CHAR;
TYPE
    entitytype = RECORD
        string         : str8;         (* seems enough for those "entities" *)
        replacement    : CHAR;
    END;
    tokentype = RECORD
        hash   : CARDINAL;
        category:SHORTCARD;
        string : str32;
    END;
CONST
    lenmaxstring   = 8;
    lenmaxnew      = 1; (* we force ONE character DOS or OEM *)
    lenmaxtoken    = 32;
    lenmaxsfmt     = 128;
CONST
    firstToken     = 1;   lastToken      = 1856; (* str32 *)
    firstEntity    = 1;   lastEntity     = 500;  (* entitytype *)
    firstHeader    = 1;   lastHeader     = 32;   (* str128 *)
    firstTrailer   = 1;   lastTrailer    = 32;   (* str128 *)
    firstSfmt      = 1;   lastSfmt       = 32;   (* str128 *)
    ndxtotal       = ORD(ndxentities)+1;
VAR
    tokencount: ARRAY[ORD(ndxfmtheader)..ORD(ndxentities)+1] OF CARDINAL; (* add one hidden globerk *)
    token     : ARRAY[firstToken..lastToken]     OF tokentype;

    entity    : ARRAY[firstEntity..lastEntity]   OF entitytype;
    header    : ARRAY[firstHeader..lastHeader]   OF str128;
    trailer   : ARRAY[firstTrailer..lastTrailer] OF str128;

    sfmt      : ARRAY[firstSfmt..lastSfmt]       OF str128;

(* ------------------------------------------------------------ *)
(* ------------------------------------------------------------ *)

PROCEDURE makesection (VAR wantedsection:ARRAY OF CHAR;
                      n:CARDINAL;flagAlt:BOOLEAN);
CONST
    strAlt = "_ALT";
VAR
    i:CARDINAL;
BEGIN
    IF flagAlt THEN Str.Append(wantedsection,strAlt);END;
    FOR i:=1 TO n DO
        Str.Prepend(wantedsection,openbracket);
        Str.Append(wantedsection,closebracket);
    END;
END makesection;

PROCEDURE locatesection (VAR errline:CARDINAL;
                        hin:FIO.File;wantedsection:ARRAY OF CHAR ):BOOLEAN;
VAR
    S:str256;
    found:BOOLEAN;
BEGIN
    errline:=0;
    found:=FALSE;
    Str.Caps(wantedsection);
    FIO.Seek(hin,0); (* rewind *)
    FIO.EOF := FALSE;
    LOOP
        IF FIO.EOF THEN EXIT; END;
        FIO.RdStr(hin,S);  INC(errline);
        LtrimBlanks(S);
        RtrimBlanks(S);
        Str.Caps(S);
        found:=same(S,wantedsection);
        IF found THEN EXIT; END;
    END;
    RETURN found;
END locatesection;

PROCEDURE loadMultiline (VAR errline:CARDINAL;
                        DEBUG,flagAlt:BOOLEAN;hin:FIO.File;ndx:ndxtype):CARDINAL ;
VAR
    wantedsection:str80;
    S:str128;
    last:CARDINAL;
BEGIN
    errline:=0;
    isoleItemS(wantedsection, sections, "," , ORD(ndx) );
    makesection(wantedsection,1,flagAlt);
    IF locatesection(errline,hin,wantedsection)=FALSE THEN RETURN errMissingSection;END;
    last:=1-1;
    LOOP
        IF FIO.EOF THEN EXIT;END;
        FIO.RdStr(hin,S); INC(errline);
        LtrimBlanks(S);
        RtrimBlanks(S);
        CASE S[0] OF
        ¦ nullchar,semicolon,pound: ;
        ¦ openbracket: EXIT;
        ELSE
            INC(last);
            CASE ndx OF
            ¦ ndxfmtheader:
                IF last > lastHeader THEN RETURN errTooManyLinesHeader;END;
                header[last]:=S;
            ¦ ndxfmttrailer:
                IF last > lastTrailer THEN RETURN errTooManyLinesTrailer;END;
                trailer[last]:=S;
            END;
IF DEBUG THEN
    IO.WrCard(last,-8);WrStr(S);WrLn;
END;
        END;
    END;
    tokencount[ORD(ndx)]:=last;
    RETURN errNone;
END loadMultiline;

PROCEDURE loadSingleline (VAR errline:CARDINAL;
                         DEBUG,flagAlt:BOOLEAN;hin:FIO.File;ndx,n:CARDINAL):CARDINAL ;
VAR
    wantedsection:str80;
    S:str128;
BEGIN
    errline:=0;
    isoleItemS(wantedsection, sections, "," , ORD(ndx) );
    makesection(wantedsection,n,flagAlt);
    IF locatesection(errline,hin,wantedsection)=FALSE THEN RETURN errMissingSection;END;
    LOOP
        IF FIO.EOF THEN EXIT;END;
        FIO.RdStr(hin,S); INC(errline);
        LtrimBlanks(S);
        RtrimBlanks(S);
        CASE S[0] OF
        ¦ nullchar,semicolon,pound: ;
        ¦ openbracket: EXIT;
        ELSE
            tokencount[ndx]:=1;
            sfmt[ndx]:=S;
            EXIT;
        END;
    END;
IF DEBUG THEN
    IO.WrCard(ndx,-8);WrStr(sfmt[ndx]);WrLn;
END;
    IF same(sfmt[ndx],"") THEN
        RETURN errEmptyLine;
    ELSE
        RETURN errNone;
    END;
END loadSingleline;

PROCEDURE loadTokens (VAR lasttok,errline:CARDINAL;
                      DEBUG,flagIgnoreCase:BOOLEAN;hin:FIO.File;ndx,ndxfmt,n:CARDINAL):CARDINAL ;
VAR
    wantedsection:str80;
    S:str128;
    sav:CARDINAL;
BEGIN
    sav:=lasttok;
    errline:=0;
    isoleItemS(wantedsection, sections, "," , ndx );
    makesection(wantedsection,n,FALSE );
    IF locatesection(errline,hin,wantedsection)=FALSE THEN RETURN errMissingSection;END;

    LOOP
        IF FIO.EOF THEN EXIT;END;
        FIO.RdStr(hin,S); INC(errline);
        LtrimBlanks(S);
        RtrimBlanks(S);
        CASE S[0] OF
        ¦ nullchar,semicolon,pound: ;
        ¦ openbracket: EXIT;
        ELSE
            IF Str.Length(S) > lenmaxtoken THEN RETURN errBadToken;END;
            INC(lasttok);
            IF lasttok > lastToken THEN RETURN errTooManyTokens;END;
            IF flagIgnoreCase THEN Str.Caps(S);END;
            token[lasttok].hash:=Lib.HashString(S,MAXHASH);
            token[lasttok].category:=SHORTCARD(ndxfmt);
            token[lasttok].string:=str32(S);
IF DEBUG THEN
    IO.WrCard(lasttok,4);                WrStr(tabul);
    IO.WrCard(token[lasttok].hash,6);    WrStr(tabul);
    IO.WrCard(CARDINAL(token[lasttok].category),2);WrStr(tabul);
    WrStr(token[lasttok].string);        WrStr(tabul); WrLn;
END;
        END;
    END;
    tokencount[ndx]:=lasttok-sav;
IF DEBUG THEN
    WrStr("count = ");IO.WrCard(tokencount[ndx],4);WrLn;
END;
    RETURN errNone;
END loadTokens;

(* ------------------------------------------------------------ *)

CONST
    bindigits ="01";
    decidigits="0123456789"; (* same as digits from QD_Box *)
    hexadigits=decidigits+"ABCDEF";

PROCEDURE gotentitystr (S : ARRAY OF CHAR; VAR R : ARRAY OF CHAR) : BOOLEAN;
CONST
    markdec  = "\";
    markhex1 = "&";
    markhex2 = "H";
VAR
    new    : str128;
    i      : CARDINAL;
    len    : CARDINAL;
    p      : CARDINAL;
    ch     : CHAR;
    status : (waiting,indec,inhex1,inhex2);
    number : str16;
    n      : LONGCARD;
    ok     : BOOLEAN;
BEGIN
    len    := Str.Length(S);
    i      := 0;
    p      := 0;
    status := waiting;
    LOOP
        IF i = len THEN EXIT; END;
        ch := S[i];
        CASE status OF
        ¦ waiting :
            CASE ch OF
            ¦ markdec :
                status:=indec;
                number:="";
            ¦ markhex1:
                status:=inhex1;
                number:="";
            ELSE
                new[p]:=ch;
                INC(p);
            END;
            INC(i);
        ¦ indec :
            IF Belongs(decidigits,ch) THEN
                Str.Append(number,ch);
                INC(i);
            ELSE
                IF same(number,"") THEN
                    new[p]:=markdec;
                ELSE
                    n:=Str.StrToCard(number,10,ok);
                    IF ok=FALSE THEN RETURN FALSE; END;
                    n := n MOD 256;
                    new[p]:=CHR( CARDINAL(n));
                END;
                INC(p);
                status:=waiting;
            END;
        ¦ inhex1 :
            IF ch=markhex2 THEN
                status:=inhex2;
                INC(i);
            ELSE
                new[p]:=markhex1;
                INC(p);
                status:=waiting;
            END;
        ¦ inhex2 :
            IF Belongs(hexadigits,ch) THEN
                Str.Append(number,ch);
                INC(i);
            ELSE
                IF same(number,"") THEN
                    new[p]:=markhex1;
                    INC(p);
                    new[p]:=markhex2;
                ELSE
                    n:= Str.StrToCard(number,16,ok);
                    IF ok=FALSE THEN RETURN FALSE; END;
                    n := n MOD 256;
                    new[p]:=CHR( CARDINAL(n));
                END;
                INC(p);
                status:=waiting;
            END;
        END;
    END;
    CASE status OF
    ¦ indec :
        IF same(number,"") THEN
            new[p]:=markdec;
        ELSE
            n:=Str.StrToCard(number,10,ok);
            IF ok=FALSE THEN RETURN FALSE; END;
            n := n MOD 256;
            new[p]:=CHR( CARDINAL(n));
        END;
        INC(p);
    ¦ inhex1 :
        new[p]:=markhex1;
        INC(p);
    ¦ inhex2 :
        IF same(number,"") THEN
            new[p]:=markhex1;
            INC(p);
            new[p]:=markhex2;
        ELSE
            n:=Str.StrToCard(number,16,ok);
            IF ok=FALSE THEN RETURN FALSE; END;
            n := n MOD 256;
            new[p]:=CHR( CARDINAL(n));
        END;
        INC(p);
    END;
    IF p > lenmaxnew THEN RETURN FALSE; END;
    new[p]:=CHR(0);
    Str.Copy(R,new);
    RETURN TRUE;
END gotentitystr;

PROCEDURE parseAndStoreEntity (S : ARRAY OF CHAR;index:CARDINAL) : BOOLEAN;
CONST
    sep = "_";
VAR
    R : str128;
    i : CARDINAL;
    newch : CHAR;
    tmp : str128;
BEGIN
    Str.ItemS(R,S,space+tabul,0);
    IF Str.Length(R) > lenmaxstring THEN RETURN FALSE; END;
    entity[index].string:=str8(R);

    Str.ItemS(R,S,space+tabul,2);     (* skip the = sign ! *)
    (* char or \### *)
    IF gotentitystr(R,newch)=FALSE THEN RETURN FALSE; END;
    entity[index].replacement:=newch;
    RETURN TRUE;
END parseAndStoreEntity;

PROCEDURE loadEntities (VAR errline:CARDINAL;
                        flagOEM,DEBUG:BOOLEAN;hin:FIO.File):CARDINAL ;
CONST
    strOEM = "_OEM";
    strDOS = "_DOS";
VAR
    S:str128;
    last:CARDINAL;
    wantedsection:str80;
BEGIN
    errline:=0;

    isoleItemS(wantedsection, sections, "," , ORD(ndxentities) );
    IF flagOEM THEN
        Str.Append(wantedsection,strOEM);
    ELSE
        Str.Append(wantedsection,strDOS);
    END;
    makesection(wantedsection,2,FALSE );
    IF locatesection(errline,hin,wantedsection)=FALSE THEN RETURN errMissingSection;END;
    last:=1-1;

    LOOP
        IF FIO.EOF THEN EXIT;END;
        FIO.RdStr(hin,S); INC(errline);
        LtrimBlanks(S);
        RtrimBlanks(S);
        CASE S[0] OF
        ¦ nullchar,semicolon,pound: ;
        ¦ openbracket: EXIT;
        ELSE
            INC(last);
            IF last > lastEntity THEN RETURN errTooManyLinesEntity;END;
            IF parseAndStoreEntity(S,last)=FALSE THEN RETURN errBadEntity;END;
IF DEBUG THEN
    IO.WrCard(last,4);                     WrStr(tabul);
    WrStr(entity[last].string);            WrStr(tabul);
    WrStr(entity[last].replacement);       WrLn;
END;
        END;
    END;
    tokencount[ORD(ndxentities)]:=last;
    RETURN errNone;
END loadEntities;

PROCEDURE loadIni (VAR errline:CARDINAL;
                  DEBUG,useLFN,flagIgnoreCase,flagOEM,flagAlt:BOOLEAN;
                  inifile:pathtype  ):CARDINAL;
CONST
    sSafety = "safety";
VAR
    ndxfmt,rc,i,lasttok,n:CARDINAL;
    hin:FIO.File;
    ztoken:tokentype;
    zentity:entitytype;
    S:str128;
    tf:BOOLEAN;
BEGIN
    (* yes, we cold zero everything using address and size ! *)

    FOR i:=firstHeader TO lastHeader DO header[i]:="";END;
    FOR i:=firstTrailer TO lastTrailer DO trailer[i]:="";END;
    FOR i:=firstSfmt TO lastSfmt DO sfmt[i]:="";END;

    ztoken.hash:=0;
    ztoken.string:="";
    FOR i:=firstToken TO lastToken DO token[i]:=ztoken;END;

    zentity.string:="";
    zentity.replacement:=""; (* DOS or OEM *)
    FOR i:=firstEntity TO lastEntity DO entity[i]:=zentity;END;

    FOR i:=ORD(ndxfmtheader) TO ORD(ndxentities) DO tokencount[i]:=0;END;

    rc      := errNone;
    hin:=fileOpenRead(useLFN,inifile);
    FIO.AssignBuffer(hin,ioBufferIn);

    S:=sSafety;
    makesection(S,3,FALSE );
    IF locatesection(errline,hin,S)=FALSE THEN RETURN errMissingSafety;END;

    IF rc = errNone THEN rc:=loadMultiline(errline,DEBUG,flagAlt,hin,ndxfmtheader);END;
    IF rc = errNone THEN rc:=loadMultiline(errline,DEBUG,flagAlt,hin,ndxfmttrailer);END;
    IF rc = errNone THEN rc:=loadEntities(errline,flagOEM,DEBUG,hin);END;

    FOR i:=ORD(ndxfmtnormal) TO ORD(ndxfmtuserfunctionB) DO
        IF rc = errNone THEN rc:=loadSingleline(errline,DEBUG,flagAlt,hin,i,1);END;
    END;

    IF rc = errNone THEN rc:=loadSingleline(errline,DEBUG,FALSE,hin,ORD(ndxdelimiters),2);END;
    Str.Copy(S,sfmt[ORD(ndxdelimiters)]);
    IF Str.Match(S,dquote+"*"+dquote) THEN
        Str.Delete(S,0,1);
        S[Str.Length(S)-1]:=nullchar;
        Str.Copy(sfmt[ORD(ndxdelimiters)],S);
    END;

    (* now load tokens keeping track of their count *)

    lasttok:=1-1;
    ndxfmt:=ORD(ndxfmtkeyword);
    FOR i:=ORD(ndxkeywords) TO ORD(ndxuserfunctions_B) DO
        IF rc = errNone THEN
            rc:=loadTokens(lasttok,errline, DEBUG,flagIgnoreCase,hin,i,ndxfmt,2);
        END;
        INC(ndxfmt);
    END;

    tokencount[ndxtotal]:=0;
    FOR i:=ORD(ndxkeywords) TO ORD(ndxuserfunctions_B) DO
        INC(tokencount[ndxtotal],tokencount[i]);
    END;

    fileClose(useLFN,hin);

IF DEBUG THEN
    FOR i:=ORD(ndxfmtheader) TO ORD(ndxentities) DO
        CASE i OF
        ¦ ORD(ndxfmtheader)..ORD(ndxfmtuserfunctionB) :
            n:=1; tf:=flagAlt;
        ELSE
            n:=2; tf:=FALSE;
        END;
        isoleItemS(S, sections, "," , i );
        makesection(S,n,tf);

        IO.WrCard(i,8);WrStr(tabul);
        IO.WrCard(tokencount[i],4);WrStr(tabul);
        WrStr(S);WrLn;
    END;
END;

    RETURN rc;
END loadIni;

(* ------------------------------------------------------------ *)
(* ------------------------------------------------------------ *)

(* some day, we'll rewrite the thing in a more clever way -- yes, we're lying here ;-) *)

PROCEDURE procentities (VAR R : ARRAY OF CHAR;
                       flagUnbreakable:BOOLEAN;S:ARRAY OF CHAR);
VAR
    i,p:CARDINAL;
    ch:CHAR;
    needconversion : str1024; (* oversized *)
BEGIN
    needconversion := "";
    FOR i:=firstEntity TO tokencount[ORD(ndxentities)] DO
        ch:=entity[i].replacement;
        Str.Append(needconversion,ch);
    END;

    (* this slow way, we'll avoid reprocessing processed chars such as "&" *)

    Str.Copy(R,"");
    FOR i:=1 TO Str.Length(S) DO
        ch := S[i-1];
        IF ( (ch = space) AND flagUnbreakable ) THEN
            Str.Append(R,sUnbreakableSpace);
        ELSE
            p  := Str.CharPos(needconversion,ch);
            IF p = MAX (CARDINAL) THEN
                Str.Append(R,ch);
            ELSE
                Str.Append(R,entity[p+firstEntity].string);
            END;
        END;
    END;
END procentities;

(* ------------------------------------------------------------ *)
(* ------------------------------------------------------------ *)

(*
PROCEDURE dbg (S1,S2:ARRAY OF CHAR   );
BEGIN
    WrStr("/// ");WrStr(S1);WrStr(S2);WrLn;
END dbg;
*)

PROCEDURE chkInteger (S:ARRAY OF CHAR   ):BOOLEAN ;
VAR
    i,len,n:CARDINAL;
BEGIN
    len:=Str.Length(S);
    IF len=0 THEN RETURN FALSE;END; (* should never happen *)
    n:=0;
    FOR i:=1 TO len DO
        IF Belongs(digits,S[i-1]) THEN INC(n);END;
    END;
    RETURN (n=len);
    (* or merely RETURN MatchFormat("#",S); ! *)
END chkInteger;

(*
(*
    yes, yes, we could replace this ugly code with matchFormat() from QD_SKY
    but this would be overkill for such trivial a task here
*)

PROCEDURE chkFloat (S:ARRAY OF CHAR   ):BOOLEAN;
VAR
    i,len,n:CARDINAL;
BEGIN
    (*
    len:=Str.Length(S);
    IF len=0 THEN RETURN FALSE;END; (* should never happen *)
    IF CharCount(S,dot) # 1 THEN RETURN FALSE;END;
    i:=Str.CharPos(S,dot);
    IF i= 0  THEN RETURN FALSE;END; (* ".#" *)
    IF i=len THEN RETURN FALSE;END; (* "#." *)
    Str.Subst(S,dot,"");
    RETURN chkInteger(S);
    *)
END chkFloat;
*)

PROCEDURE PatSuffix (suffix:CHAR;allowed,S:ARRAY OF CHAR ):BOOLEAN;
VAR
    n,i,len:CARDINAL;
BEGIN
    len:=Str.Length(S);
    IF len=0 THEN RETURN FALSE;END;
    IF S[len-1] # suffix THEN RETURN FALSE;END;
    Str.Delete(S,len-1,1);
    DEC(len);
    IF len=0 THEN RETURN FALSE;END;
    n:=0;
    FOR i:=1 TO len DO
        IF Belongs(allowed,S[i-1]) THEN INC(n);END;
    END;
    RETURN (n=len);
END PatSuffix;

CONST
    isValUnknown = 0;
    isValInt     = 1;
    isValHex     = 2;
    isValBin     = 3;
    isValFloat   = 4;

PROCEDURE findvaluetype (S:ARRAY OF CHAR   ):CARDINAL;
BEGIN
    IF MatchFormat("#"            ,S) THEN RETURN isValInt;END;
    IF MatchFormat("[+-]#"        ,S) THEN RETURN isValInt;END;

    IF PatSuffix  ("H",hexadigits ,S) THEN RETURN isValHex; END;
    IF PatSuffix  ("B",bindigits  ,S) THEN RETURN isValBin; END;

    IF MatchFormat("#.#"          ,S) THEN RETURN isValFloat;END;
    IF MatchFormat("#.#E#"        ,S) THEN RETURN isValFloat;END;
    IF MatchFormat("#.#E[+-]#"    ,S) THEN RETURN isValFloat;END; (* missed *)

    IF MatchFormat("[+-]#.#"      ,S) THEN RETURN isValFloat;END;
    IF MatchFormat("[+-]#.#E#"    ,S) THEN RETURN isValFloat;END;
    IF MatchFormat("[+-]#.#E[+-]#",S) THEN RETURN isValFloat;END; (* missed *)

    RETURN isValUnknown;
END findvaluetype;

PROCEDURE findid (VAR ndx,i:CARDINAL;flagIgnoreCase:BOOLEAN;S:ARRAY OF CHAR):BOOLEAN;
VAR
    hash:CARDINAL;
BEGIN
    IF flagIgnoreCase THEN Str.Caps(S);END;
    hash:=Lib.HashString(S,MAXHASH);
(* dbg("token = ",S); *)
    i:=firstToken-1;
    LOOP
        INC(i);
        IF i > tokencount[ndxtotal] THEN EXIT;END;
        IF token[i].hash = hash THEN
            IF same(token[i].string,S) THEN
                ndx:=CARDINAL( token[i].category );
(*IO.WrCard(ndx,12);WrLn;*)
(* dbg("found = ",S); *)
                RETURN TRUE;
            END;
        END;
    END;

    i:=MAX(CARDINAL); (* unknown token *)

    (* unknown token : possibly integer or float *)

    (*
    IF chkInteger(S) THEN
        ndx:=ORD(ndxfmtinteger);
(* dbg("found integer = ",S); *)
        RETURN TRUE;
    END;

    IF chkFloat(S) THEN
        ndx:=ORD(ndxfmtfloat);
(* dbg("found float = ",S); *)
        RETURN TRUE;
    END;
    *)

    CASE findvaluetype(S) OF
    ¦ isValInt:   ndx:=ORD(ndxfmtinteger);
    ¦ isValHex:   ndx:=ORD(ndxfmthex);
    ¦ isValBin:   ndx:=ORD(ndxfmtbin);
    ¦ isValFloat: ndx:=ORD(ndxfmtfloat);
    ELSE
        RETURN FALSE;
    END;
    RETURN TRUE;

    (*
(* dbg("NOT found !",""); *)
    RETURN FALSE;
    *)
END findid;

(* ------------------------------------------------------------ *)

CONST
    zeplaceholder = "¦";
CONST
    both    = 0; (* <>$<> *)
    opening = 1; (* <>$ *)
    closing = 2; (* $<> *)
    nada    = 3; (* $ *)

PROCEDURE makehtml (VAR R : ARRAY OF CHAR ;
                   flagUnbreakable:BOOLEAN;fmtmode,ndx:CARDINAL;
                   tok:ARRAY OF CHAR );
VAR
    newtok : str1024; (* really oversized for safety, should match tok *)
    p:CARDINAL;
BEGIN
    procentities (newtok, flagUnbreakable,tok);

    Str.Copy(R,sfmt[ndx]);
(* dbg("makehtml fmt = ",R); *)
    CASE fmtmode OF
    ¦ both:
        Str.Subst(R,zeplaceholder,newtok);
    ¦ opening:
        p:=Str.CharPos(R,zeplaceholder);
        IF p # MAX(CARDINAL) THEN R[p]:=nullchar;END;
        Str.Append(R,newtok);
    ¦ closing:
        p:=Str.CharPos(R,zeplaceholder);
        IF p # MAX(CARDINAL) THEN Str.Delete(R,0,p+1);END;
        Str.Prepend(R,newtok);
    ¦ nada:
        Str.Copy(R,tok);
    END;
(* dbg("makehtml result = ",R); *)
END makehtml;

PROCEDURE cook (VAR newtok : ARRAY OF CHAR;
               flagUnbreakable:BOOLEAN; tok:ARRAY OF CHAR   );
BEGIN
    procentities(newtok, flagUnbreakable,tok);
END cook;

TYPE
    parsingstatetype = (waitingdata,instring,grabbing,inremark);

(*
//FIXME cleanup parsing code
do not optimize yet !
*)

PROCEDURE procline (VAR parsingstate:parsingstatetype;
                    VAR remdepth:CARDINAL;
                    VAR R:ARRAY OF CHAR;
                    flagIgnoreCase,flagCasify,flagUnbreakable:BOOLEAN;
                    S:ARRAY OF CHAR   );
CONST
    hardCodedDelimiters   = " (),=+-*<>/\[]ˆ:;."; (* removed "_" *)
    openrem               = "(*";
    closerem              = "*)";
    lenrem                = 2;
    anydelimiter          = space;
VAR
    ndxtoken,cpos,i,len,ndx:CARDINAL;
    delimiters : str80; (* oversized *)
    orgch,ch,stringdelimiter:CHAR;
    newtok,tok,Z:str1024; (* really oversized for safety *)
    group:str2;
BEGIN
    Str.Copy(delimiters,hardCodedDelimiters);
    Str.Copy(delimiters,sfmt[ORD(ndxdelimiters)]); (* //8-ung! let user beware ! *)

    (*
    out of laziness, we'll append a fake blank delimiter to S
    so we don't need to handle parsingstate at EXIT
    *)
    Str.Append(S,blank);

(* dbg("parsing : ",S); *)

    Str.Copy(R,"");
    Str.Copy(tok,"");
    len:=Str.Length(S);
    cpos:=1-1;
    LOOP
        IF cpos >= len THEN EXIT; END;
        orgch:=S[cpos];
        ch:=orgch;
        IF Belongs(delimiters,orgch) THEN ch:=anydelimiter;END;

        CASE parsingstate OF
        ¦ waitingdata:
(* dbg("waitingdata : ",orgch); *)
            CASE ch OF
            ¦ anydelimiter:
                CASE orgch OF
                ¦ "(":
                    Str.Slice(group,S,cpos,lenrem);
                    IF same(group,openrem) THEN
                        INC(remdepth);
                        INC(cpos); (* pass "*" *)
                        makehtml(newtok, flagUnbreakable,opening,ORD(ndxfmtremark),group);
                        Str.Append(R,newtok);
                        parsingstate:=inremark;
                    ELSE
                        cook(newtok, flagUnbreakable,orgch);
                        Str.Append(R,newtok);
                    END;
                ELSE
                    cook(newtok, flagUnbreakable,orgch);
                    Str.Append(R,newtok);
                END;
            ¦ singlequote,doublequote:
                Str.Copy(tok,orgch);
                stringdelimiter:=orgch;
                parsingstate:=instring;
            ELSE
                Str.Copy(tok,orgch);
                parsingstate:=grabbing;
            END;

        ¦ instring:
(* dbg("instring : ",orgch); *)
            Str.Append(tok,orgch);
            IF ch=stringdelimiter THEN
                CASE stringdelimiter OF
                ¦ doublequote:ndx:=ORD(ndxfmtstringdouble);
                ¦ singlequote:ndx:=ORD(ndxfmtstringsingle);
                END;
                makehtml(newtok, flagUnbreakable,both,ndx,tok);
                Str.Append(R,newtok);
                parsingstate:=waitingdata;
            END;

        ¦ grabbing:
(* dbg("grabbing : ",orgch); *)
            CASE ch OF
            ¦ anydelimiter:
                CASE orgch OF
                ¦ dot :
                    IF chkInteger(tok) THEN (* possibly a float *)
                        Str.Append(tok,orgch);
                    ELSE
                        IF findid(ndx,ndxtoken, flagIgnoreCase,tok) THEN
                            IF flagCasify THEN
                                IF ndxtoken # MAX(CARDINAL) THEN
                                    Str.Copy(tok,token[ndxtoken].string);
                                END;
                            END;
                            makehtml(newtok, flagUnbreakable,both,ndx,tok);
                            Str.Append(R,newtok);
                            cook(newtok, flagUnbreakable,orgch);
                            Str.Append(R,newtok);
                            parsingstate:=waitingdata;
                        ELSE
                            cook(newtok, flagUnbreakable,tok);
                            Str.Append(R,newtok);
                            cook(newtok, flagUnbreakable,orgch);
                            Str.Append(R,newtok);
                            parsingstate:=waitingdata;
                        END;
                    END;
                ELSE
                        IF findid(ndx,ndxtoken, flagIgnoreCase,tok) THEN
                            IF flagCasify THEN
                                IF ndxtoken # MAX(CARDINAL) THEN
                                    Str.Copy(tok,token[ndxtoken].string);
                                END;
                            END;
                            makehtml(newtok, flagUnbreakable,both,ndx,tok);
                            Str.Append(R,newtok);
                            cook(newtok, flagUnbreakable,orgch);
                            Str.Append(R,newtok);
                            parsingstate:=waitingdata;
                        ELSE
                            cook(newtok, flagUnbreakable,tok);
                            Str.Append(R,newtok);
                            cook(newtok, flagUnbreakable,orgch);
                            Str.Append(R,newtok);
                            parsingstate:=waitingdata;
                        END;

                END;
            ELSE
                 Str.Append(tok,orgch);
            END;

        ¦ inremark:
(* dbg("inremark : ",orgch); *)
            CASE orgch OF
            ¦ "(" :
                Str.Slice(group,S,cpos,lenrem);
                IF same(group,openrem) THEN
                    INC(remdepth);
                    INC(cpos);
                    cook(newtok, flagUnbreakable,group);
                    Str.Append(R,newtok);
                ELSE
                    cook(newtok, flagUnbreakable,orgch);
                    Str.Append(R,newtok);
                END;
            ¦ "*" :
                Str.Slice(group,S,cpos,lenrem);
                IF same(group,closerem) THEN
                    INC(cpos); (* pass ")" *)
                    IF remdepth # 0 THEN (* should always be here *)
                        DEC(remdepth);
                        IF remdepth = 0 THEN
                            makehtml(newtok, flagUnbreakable,closing,ORD(ndxfmtremark),group);
                            Str.Append(R,newtok);
                            parsingstate:=waitingdata;
                        ELSE
                            cook(newtok, flagUnbreakable,group);
                            Str.Append(R,newtok);
                        END;
                    END;
                ELSE
                    cook(newtok, flagUnbreakable,orgch);
                    Str.Append(R,newtok);
                END;
            ELSE
                cook(newtok, flagUnbreakable,orgch);
                Str.Append(R,newtok);
            END;
        END;
        INC(cpos);
    END;
    (* no need to handle parsingstate at exit thanks to appended delimiter *)

    (* remove fake trailing space whatever its form *)

    IF flagUnbreakable THEN
        IF Str.Match(R,"*"+sUnbreakableSpace) THEN
            i:=Str.Length(R)-lenunbreakable;
            R[i]:=nullchar; (* brutal *)
        END;
    ELSE
        Rtrim(R,space);
    END;

END procline;

(* ------------------------------------------------------------ *)

(* yes, we could process by byte instead of by line *)

PROCEDURE doFormat (useLFN,flagIgnoreCase,flagCasify,flagRaw,
                   flagUnbreakable,flagBR,flagExpand,flagYesWeCode,
                   flagShowLine:BOOLEAN;padcharShowLine:CHAR;
                   tabstop:CARDINAL;source,target:pathtype);
VAR
    hin,hout:FIO.File;
    S:str1024;   (* already oversized for any reasonable programmer *)
    R,Z:str4096; (* allow for expansion *)
    N,NN:str80;
    i,remdepth,currline:CARDINAL;
    parsingstate:parsingstatetype;
BEGIN
    hin:=fileOpenRead(useLFN,source);
    FIO.AssignBuffer(hin,ioBufferIn);
    hout:=fileCreate(useLFN,target);
    FIO.AssignBuffer(hout,ioBufferOut);

    IF NOT(flagRaw) THEN
        FOR i:=firstHeader TO tokencount[ORD(ndxfmtheader)] DO
            Str.Copy(S,header[i]);
            LOOP
                IF Str.CharPos(S,zeplaceholder)=MAX(CARDINAL) THEN EXIT;END;
                Str.Subst(S,zeplaceholder,source);
            END;
            FIO.WrStr(hout,S);
            IF flagBR THEN FIO.WrStr(hout,sBRcode);END;
            FIO.WrLn(hout);
        END;
    END;

    parsingstate:=waitingdata;
    remdepth:=0;
    currline:=0;
    LOOP
        IF FIO.EOF THEN EXIT;END;
        FIO.RdStr(hin,S);
        IF flagExpand THEN
            detabme(R,tabstop,S);
        ELSE
            Str.Copy(R,S);
        END;

        IF flagYesWeCode THEN (* "Flak to the moon" -- almost Iron Sky, eh eh *)
            procline (parsingstate,remdepth,Z,
                     flagIgnoreCase,flagCasify,flagUnbreakable,R);
        ELSE
            procentities(Z, flagUnbreakable,R);
        END;
        IF flagShowLine THEN
            INC(currline); (* take empty lines into account, of course *)
            Str.Concat(N, num2str (currline,10,5,padcharShowLine), " : " );
            cook(NN, flagUnbreakable,N);
            (* we'll keep current display format so we're reminded of remarks *)
            FIO.WrStr(hout,NN);
        END;

        FIO.WrStr(hout,Z);
        IF flagBR THEN FIO.WrStr(hout,sBRcode);END;
        FIO.WrLn(hout);
    END;

    IF NOT(flagRaw) THEN
        FOR i:=firstTrailer TO tokencount[ORD(ndxfmttrailer)] DO
            FIO.WrStr(hout,trailer[i]);
            IF flagBR THEN FIO.WrStr(hout,sBRcode);END;
            FIO.WrLn(hout);
        END;
    END;

    fileClose(useLFN,hout);
    fileClose(useLFN,hin);
END doFormat;

(* ------------------------------------------------------------ *)
(* ------------------------------------------------------------ *)

CONST
    defaultTabStop = 4;
    minTabStop     = 1;
    maxTabStop     = 32;
CONST
    msgProcessing  = "::: Source      : ";
    msgCreated     = "+++ Target      : ";
    msgSkipping    = "--- Existing    : ";
    msgSkippingRO  = "--- Existing RO : ";
    msgWorking     = "Processing file, please wait... ";
VAR
    flagHere,flagOEM,flagOverwrite,flagOverwriteRO,flagYesWeCode:BOOLEAN;
    flagUnbreakable,flagRaw,flagExpand,flagIgnoreCase,flagCasify:BOOLEAN;
    flagShowLine,flagAlt,flagUserINI,flagBR:BOOLEAN;
    flagShowParms,flagEyeCandy,flagForceMOD:BOOLEAN;
    padcharShowLine:CHAR;
    tabstop:CARDINAL;
VAR
    parmcount,i,opt : CARDINAL;
    S,R,spec,path,inifile,source,target : pathtype;
    state     : (waiting,gotspec);
    ok,isRO,DEBUG,useLFN    : BOOLEAN;
    countFile,total : CARDINAL;
    anchor,ptr:pFname;
BEGIN
    Lib.DisableBreakCheck();
    FIO.IOcheck := FALSE;
    WrLn;

    useLFN          := TRUE;
    flagHere        := TRUE;
    flagOEM         := FALSE;
    flagOverwrite   := FALSE;
    flagOverwriteRO := FALSE;
    flagIgnoreCase  := FALSE;
    flagCasify      := FALSE;
    flagRaw         := FALSE;
    flagUnbreakable := FALSE;
    flagYesWeCode   := TRUE;
    flagExpand      := TRUE;
    tabstop         := defaultTabStop;
    flagEyeCandy    := TRUE;
    flagAlt         := FALSE;
    flagShowParms   := FALSE;
    flagShowLine    := FALSE;
    padcharShowLine := space;
    flagUserINI     := FALSE;
    flagBR          := FALSE; (* will never become true *)
    flagForceMOD    := TRUE;
    DEBUG           := FALSE;

    state:=waiting;

    parmcount := Lib.ParamCount();
    IF parmcount=0 THEN abort(errHelp,"");END;
    FOR i := 1 TO parmcount DO
        Lib.ParamStr(S,i); cleantabs(S);
        Str.Copy(R,S);
        UpperCase(R);
        IF isOption(R) THEN
            opt := GetOptIndex(R,"?"+delim+"H"+delim+"HELP"+delim+
                                 "DOS"+delim+"ASCII"+delim+
                                 "OEM"+delim+"WIN"+delim+
                                 "O"+delim+"OVERWRITE"+delim+
                                 "OO"+delim+"READONLY"+delim+
                                 "X"+delim+"LFN"+delim+
                                 "DEBUG"+delim+
                                 "P"+delim+"PATH"+delim+
                                 "K"+delim+"IGNORECASE"+delim+
                                 "T"+delim+"KEEPTAB"+delim+
                                 "T:"+delim+"TAB:"+delim+
                                 "R"+delim+"RAW"+delim+
                                 "F"+delim+"FORCE"+delim+"NBSP"+delim+"UNBREAKABLE"+delim+
                                 "C"+delim+"TEXT"+delim+"NOTCODE"+delim+
                                 "Q"+delim+"QUIET"+delim+
                                 "A"+delim+"ALT"+delim+"ALTCOLORS"+delim+
                                 "I"+delim+"SHOWINFOS"+delim+"SHOWPARMS"+delim+
                                 "Y"+delim+"CASIFY"+delim+
                                 "L"+delim+
                                 "LL"+delim+
                                 "I:"+delim+"INI:"+delim+
                                 "Z"+delim+"ALLFILES"+delim+
                                 "N"+delim+"NL"+delim+"BR"
                              );
            CASE opt OF
            ¦ 1,2,3 :   abort(errHelp,"");
            ¦ 4,5   :   flagOEM         := FALSE;
            ¦ 6,7   :   flagOEM         := TRUE;
            ¦ 8,9   :   flagOverwrite   := TRUE;
            ¦ 10,11 :   flagOverwrite   := TRUE; flagOverwriteRO:=TRUE;
            ¦ 12,13 :   useLFN          := FALSE;
            ¦ 14    :   DEBUG           := TRUE;
            ¦ 15,16 :   flagHere        := FALSE;
            ¦ 17,18 :   flagIgnoreCase  := TRUE;
            ¦ 19,20 :   flagExpand      := FALSE;
            ¦ 21,22 :   tabstop := parserange(minTabStop,maxTabStop,R);
                        IF tabstop = MAX(CARDINAL) THEN abort(errBadVal,S);END;
            ¦ 23,24 :   flagRaw         := TRUE;
            ¦ 25,26,27,28: flagUnbreakable := TRUE;
            ¦ 29,30,31: flagYesWeCode   := FALSE;
            ¦ 32,33 :   flagEyeCandy    := FALSE;
            ¦ 34,35,36: flagAlt         := TRUE;
            ¦ 37,38,39: flagShowParms   := TRUE;
            ¦ 40,41   : flagIgnoreCase  := TRUE;
                        flagCasify      := TRUE;
            ¦ 42 :      flagShowLine    := TRUE;
            ¦ 43 :      flagShowLine    := TRUE; padcharShowLine:="0";
            ¦ 44,45 :   GetString(S,inifile);
                        flagUserINI     := TRUE;
            ¦ 46,47:    flagForceMOD    := FALSE;
            (* ¦ 48,49,50: flagBR          := TRUE; *)
            ELSE
                abort(errOption,S); (* could be errHelp, eh eh ! *)
            END;
        ELSE
            CASE state OF
            ¦ waiting : Str.Copy(spec,S);
            ¦ gotspec : abort(errTooManyParms,S);
            END;
            INC(state);
        END;
    END;

    useLFN := ( useLFN AND w9XsupportLFN() );

    (* check nonsense *)

    IF state=waiting THEN abort(errMissingSpec,""); END;

    IF findIni(inifile,useLFN,flagUserINI)=FALSE THEN abort(errMissingIni,inifile);END;

    IF legalextension (spec,skippedextensions)=FALSE THEN abort(errBadExt,"");END;

    fixspec(spec,flagForceMOD);

    initList(anchor);
    countFile:=buildFileList(anchor,useLFN,spec,skippedextensions);
    CASE countFile OF
    ¦ 0             : abort(errNoMatch,spec);
    ¦ MAX(CARDINAL) : abort(errTooManyFiles,spec); (* errStorage *)
    ELSE
        ; (* useless *)
    END;

    buildPath(path,  spec);

    (* let's load ini -- note flagOEM forces specific charset entities *)

    i:=loadIni(opt,DEBUG,useLFN,flagIgnoreCase,flagOEM,flagAlt,inifile);
    IF i # errNone THEN
        Str.CardToStr( LONGCARD(opt),R,10,ok);
        abort(i,R);
    END;

    IF flagShowParms THEN
        dmpstr  (spec            ,"Source pattern");
        dmpboolZ(flagHere        ,"in current directory","in source directory","Target creation");
        dmpbool (flagOverwrite   ,"Overwrite existing target");
        dmpbool (flagOverwriteRO ,"Overwrite read-only target");
        dmpboolZ(flagForceMOD    ,dquote+extMOD+dquote,dquote+dotstar+dquote,
                                  "Default extension");
        WrLn;
        dmpbool (flagAlt         ,"Use alternate formatting tags");
        dmpboolZ(flagOEM         ,"WIN OEM","DOS ASCII","Source character set");
        dmpbool (flagIgnoreCase  ,"Ignore keywords case");
        dmpbool (flagCasify      ,"Casify keywords using lists");
        dmpbool (flagShowLine    ,"Show line number");
        dmpboolZ( (padcharShowLine=space),'" "','"0"',"Padding character");
        dmpbool (flagRaw         ,"No header nor trailer");
        dmpbool (flagExpand      ,"Expand tabulation to spaces");
        dmpval  (tabstop         ,"Tabulation width");
        dmpbool (flagUnbreakable ,'Force space to "'+sUnbreakableSpace+'"');
        (* dmpbool (flagBR          ,'Force $0d0a to "'+sBRcode+'"'); *)
        dmpbool (flagYesWeCode   ,"Parse source as Modula-2 code");
        WrLn;
        dmpbool (flagEyeCandy    ,"Show message while processing");
        dmpbool (useLFN          ,"Use LFNs");
        WrLn;

        total:=0;
        FOR i:=ORD(ndxfmtheader) TO ORD(ndxentities) DO
            isoleItemS(S, sections, "," , i );
            CASE i OF
            ¦ ORD(ndxfmtnormal)..ORD(ndxfmtuserfunctionB):
                IF tokencount[i] # 1 THEN
                    makesection(S,1,flagAlt);
                    dmpstr(S,"Exactly ONE entry required");
                END;
            ¦ ORD(ndxdelimiters):
                IF tokencount[i] # 1 THEN
                    makesection(S,2,flagAlt);
                    dmpstr(S,"Exactly ONE entry required");
                END;
            ¦ ORD(ndxfmtheader)..ORD(ndxfmttrailer):
                makesection(S,1,flagAlt);
                dmpval(tokencount[i],S);
                IF i = ORD(ndxfmttrailer) THEN WrLn;END;
            ELSE
                makesection(S,2,flagAlt);
                dmpval(tokencount[i],S);
                INC(total, tokencount[i]);
            END;
        END;
        WrLn;
        dmpval  (total           ,"Total");
        WrLn;
    END;

    (* let's work *)

    ptr:=anchor;
    WHILE ptr # NIL DO
        getStr(source,ptr);
        Str.Prepend(source,path);

        IF flagHere THEN
            getStr(target,ptr);
        ELSE
            Str.Copy(target,source);
        END;

        IF useLFN THEN
            Str.Append(target,extHTML);            (* just append ".html" *)
        ELSE
            IF Str.Match(target,"*"+extMOD) THEN
                R:=extHTM;                         (* .MOD to .HTM *)
            ELSIF Str.Match(target,"*"+extDEF) THEN
                R:=extHT;                          (* .DEF to .HT *)
            ELSE
                R:=extH;                           (* .??? to .H *)
            END;
            i:=Str.RCharPos(target,dot);
            IF i # MAX(CARDINAL) THEN
                target[i]:=nullchar;
            END;
            Str.Append(target,R);
        END;

        WrStr(msgProcessing);wrQ(useLFN,source);WrLn;
        i := 0;
        IF fileExists(useLFN,target) THEN
            isRO:= fileIsRO(useLFN,target);
            IF isRO THEN
                IF flagOverwriteRO THEN
                    fileSetRW(useLFN,target);
                ELSE
                    INC(i);
                END;
            ELSE
                IF NOT(flagOverwrite) THEN INC(i); END;
            END;
        END;
        IF same(source,target) THEN INC(i); END; (* should never happen *)

        IF i=0 THEN
            IF flagEyeCandy THEN video(msgWorking,TRUE);END;
            doFormat (useLFN,flagIgnoreCase,flagCasify,flagRaw,
                     flagUnbreakable,flagBR,flagExpand,flagYesWeCode,
                     flagShowLine,padcharShowLine,
                     tabstop,source,target);
            IF flagEyeCandy THEN video(msgWorking,FALSE);END;
            WrStr(msgCreated);
        ELSE
            IF isRO THEN
                WrStr(msgSkippingRO);
            ELSE
                WrStr(msgSkipping);
            END;
        END;
        wrQ(useLFN,target);WrLn;

        ptr:=ptrˆ.next;
    END;

    freeList(anchor);

    abort(errNone,"");
END MOD2HTM.