(* ---------------------------------------------------------------
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 = " ";
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.