Module : scanner
<module title="Scanner for XML">
<table name="scan" use="Table containing the information of the latest tag">
<fields name="order" type="sort"
name="key" use="Key inside the tag"
name="value" use="Value given to the key">
<index fields="order">
<index name="scankey" fields="key order">
</table>
<variable name="ch" type="string" local/>
<variable name="nextch" type="string" local/>
<variable name="keyword" type="string" use="Found keyword"/>
<variable name="keywstr" type="string" use="Found string in the code"/>
<variable name="addcd" type="string" local/>
<variable name="addcdpos" type="number" local/>
<variable name="chin" type="stream" local/>
<variable name="chout" type="stream" local/>
<variable name="chmess" type="string" local/>
<variable name="chline" type="string" local/>
<variable name="chold" type="string" local/>
<variable name="chbetween" type="string" local/>
<variable name="chnew" type="string" local/>
<variable name="chwhat" type="[nothing start next]" local/>
<variable name="chwhere" type="[tonew tobetween]" local/>
<variable name="chstate" type="[Text Tag String]" local/>
<variable name="scantag" type="string" use="Latest tag found"/>
<variable name="scantype" type="[EOF StartTag EndTag SingleTag]"/>
<variable name="scanstring" type="string" use="String found"/>
<variable name="scanmessnr" type="number" local/>
<routine name="scanmessage"
parameter="messid" type="string"
parameter="type" type="string"
parameter="message" type="string" local>
if type=null then
chmess+=tag("A name="""+messid+"""")+message+tag("/A")
else
chmess+=tag("A name="""+messid+"""")+tag("FONT color=""#F00000""")+
type+": "+tag("/FONT")+message+tag("/A")+tag("br")
endif
</routine>
<routine name="putmessage"
parameter="message" type="string" local>
scanmessnr+=1
scanmessage "scan"+scanmessnr, "Error", message
</routine>
<routine name="getsingle" local>
var pos as number
if chwhat="next" then
chwhere="tobetween"
chwhat="nothing"
chline=chline+chold+chbetween
loop
pos=findstring(chline, char(10), 1)
if pos<1 then break endif
output left(chline, pos-1)+chmess to chout
flush(chout) /* cancel this statement for better performance */
if pos=length(chline) then
chline=null
else
chline=mid(chline, pos+1, 999999)
endif
chmess=null
do
chold=chnew
chbetween=null
chnew=null
endif
if chwhat="start" then
chwhere="tonew"
chwhat="nothing"
endif
if addcdpos=0 then
if chwhere="tonew" then
chnew+=notag(ch)
else
chbetween+=notag(ch)
endif
endif
ch=nextch
if addcdpos>0 then
if addcdpos>length(addcd) then
addcdpos=0
nextch=get(chin)
else
nextch=mid(addcd, addcdpos, 1)
addcdpos+=1
endif
else
nextch=get(chin)
if nextch=char(13) then
nextch=get(chin)
endif
endif
</routine>
<routine name="getchar" local>
getsingle()
if chstate="Text" or chstate="Tag" then
if ch="/" and nextch="*" then
getsingle()
getsingle()
loop
if nextch=null or (ch="*" and nextch="/") then break endif
getsingle()
do
getsingle()
getsingle()
endif
endif
if ch=null then
chwhat="next"
getsingle()
chwhat="next"
getsingle()
endif
</routine>
<routine name="separator" local>
loop
if ch=null then break endif
if ch<>" " and ch<>char(10) and ch<>char(9) and ch<>char(13) then break endif
getchar()
do
</routine>
<routine name="scankeyword" use="Scan keywords form the source file">
if keyword<>null then chwhat="next" endif
keyword=null
keywstr=null
separator()
if ch<>null then
if isalpha(ch) or isnumber(ch) then
chwhat="start"
loop
if not (isnumber(ch) or isalpha(ch) or ch="_") then break endif
keyword+=ch
getchar()
do
elsif ch="""" then
getchar()
loop
if (ch="""" and nextch<>"""") or ch=null or ch=char(10) then break endif
if ch="""" and nextch="""" then getchar() endif
keywstr+=ch
getchar()
do
if ch<>"""" then
putmessage "No end of String found within a line"
else
getchar()
endif
elsif ch="<" and (nextch="/" or isalpha(nextch)) then
keyword=null
else
keyword=ch
getchar()
endif
endif
</routine>
<routine name="addscancode"
parameter="code" type="string" local>
addcd=mid(code+keyword+ch+nextch, 3, 999)
ch=left(code, 1)
nextch=mid(code, 2, 1)
addcdpos=1
chmess+=tag("FONT color=""#666666""")+notag(code)+tag("/FONT")
scankeyword
</routine>
<routine name="scantoken"
type="string" local>
var w as string
w=ch
getchar()
if isalpha(w) then
loop
if isalpha(ch) or ch="_" or isnumber(ch) then
w+=ch
getchar()
else
break
endif
do
endif
return w
</routine>
<routine name="do_scan" use="Scan the source for the next tag"
parameter="expect" type="string" use="List of valid scan tags separated by spaces">
var str as string
var last as string
var token as string
scantype="EOF"
if scantag<>null then chwhat="next" endif
scantag=null
scanstring=null
chstate="Text"
last=scantoken()
loop
token=scantoken()
if last=null then break endif
if last="<" and token="/" then
last+="/"
token=scantoken()
endif
if (last="<" or last="<"+"/") and findstring(" "+expect+" ", " "+token+" ", 1)>0 then
break
endif
scanstring+=last
last=token
do
if last="<" or last="<"+"/" then
chwhat="start"
clear scan
chstate="Tag"
if last="<"+"/" then
scantype="EndTag"
else
scantype="StartTag"
endif
scantag=token
separator()
chwhat="next"
loop
if ch=null or ch="/" or ch=">" then break endif
if isalpha(ch) then
add scan
scan.key=null
loop
if ch=null or not isalpha(ch) then break endif
scan.key+=ch
getchar()
do
separator()
if ch="=" then
getchar()
separator()
if ch="-" or isnumber(ch) then
scan.value=ch
getchar()
loop
if ch=null or not isnumber(ch) then break endif
scan.value+=ch
getchar()
do
elsif ch="""" then
chstate="String"
getchar()
str=null
loop
if ch=null or (ch="""" and nextch<>"""") or ch=char(10) then break endif
if ch="""" and nextch="""" then getchar() endif
str+=ch
getchar()
do
scan.value=str
if ch=char(10) or ch=null then
putmessage "No end of string found within a line"
else
getchar()
separator()
endif
chstate="Tag"
endif
endif
update
else
putmessage "Unexpected symbol '"+ch+"' ("+ascii(ch)+") found in tag"
getchar()
endif
do
if ch="/" then
scantype="SingleTag"
getchar()
endif
if ch=">" then
getchar()
else
putmessage "No end of a tag found ("+ch+"/"+nextch+")"
endif
endif
</routine>
<routine name="initscan" use="Initialise the use of the scanner"
parameter="file" type="string" use="The filename to use as the source file">
chout=create(file+".html")
if chout=null then output "Cannot write to '"+file+".html'" endif
output tag("HTML")+tag("BODY LINK=""0"" VLINK=""0""")+tag("h1")+
"Module : "+left(file, length(file)-2)+tag("/h1")+tag("font size=2") to chout
chin=open(file)
chwhat="nothing"
chwhere="tobetween"
if chin<>null then
nextch=get(chin)
getchar()
endif
</routine>
<variable name="scanstackpointer" type="number" local/>
<table name="scanstack" local>
<fields name="pos" type="sort"
name="file" type="number"
name="outfile" type="number"
name="ch" type="string"
name="nextch" type="string"
name="chwhat" type="string"
name="chwhere" type="string"
name="chmess" type="string"
name="chline" type="string"
name="chold" type="string"
name="chbetween" type="string"
name="chnew" type="string">
<index fields="pos">
</table>
<routine name="getstream" type="number"
parameter="file" type="stream" system local>
return (long int)v_file;
</routine>
<routine name="setstream"
type="stream"
parameter="numb" type="number" system local>
return (FILE*)v_numb;
</routine>
<routine name="scanpush" use="Change the source file but remember the old one"
parameter="file" type="string" use="Filename to continue scanning">
add scanstack
scanstack.file=getstream(chin)
scanstack.outfile=getstream(chout)
scanstack.ch=ch
scanstack.nextch=nextch
scanstack.chwhat=chwhat
scanstack.chwhere=chwhere
scanstack.chmess=chmess
scanstack.chline=chline
scanstack.chold=chold
scanstack.chbetween=chbetween
scanstack.chnew=chnew
update
chout=create(file+".html")
if chout=null then output "Cannot write to '"+file+".html'" endif
output tag("HTML")+tag("BODY LINK=""0"" VLINK=""0""")+tag("h1")+
"Module : "+left(file, length(file)-2)+tag("/h1")+tag("font size=2") to chout
chin=open(file)
chmess=null
chline=null
chold=null
chbetween=null
chnew=null
ch=null
nextch=null
chwhat="nothing"
chwhere="tobetween"
scanstackpointer=scanstack.pos
if chin<>null then
nextch=get(chin)
getchar()
endif
</routine>
<routine name="scanpop" use="Return to the previous file to scan">
output tag("/BODY")+tag("/HTML") to chout
close(chout)
close(chin)
get scanstack where scanstack.pos=scanstackpointer
scanstack=tbl_search_scanstack(scanstackpointer) loop
if scanstack=null or (scanstack.pos > scanstackpointer) then scanstack=null break endif
if tbl_get_scanstack_pos(scanstack) = scanstackpointer then break endif
scanstack=ptrplus1(scanstack, 4)
do
ifnot scanstack.found then
putmessage "Already at top level module"
endif
chin=setstream(scanstack.file)
chout=setstream(scanstack.outfile)
ch=scanstack.ch
nextch=scanstack.nextch
chwhat=scanstack.chwhat
chwhere=scanstack.chwhere
chmess=scanstack.chmess
chline=scanstack.chline
chold=scanstack.chold
chbetween=scanstack.chbetween
chnew=scanstack.chnew
delete scanstack
scanstackpointer-=1
</routine>
<routine name="addtag"
parameter="left" type="string"
parameter="right" type="string" local>
chnew=tag(left)+chnew+tag(right)
</routine>