<%
'==============================================================
' THIS FILE CONTAINS ONLY TWO PROCEDURES compile_schema and
' parse_s_ml_header
'--------------------------------------------------------------
sub compile_schema(sml_schema_f)
dim short3 'need to mark end of parcuts poor programming:
'no need for so many pieces of schema text
dim wwwtemp1,wwwtemp2,wwwtempi '=== ugly programming, get rid
dim j,k, s, ws, wss, wi, wii
dim EndPos 'to parse long-shortcuts denoting multiline
'texts
'------------------------------------------
this_version ="2" 'SET VERSION
'------------------------------------------
'-------------------------------------------------
'define accessible variables:
path_info = request.ServerVariables("PATH_INFO")
wi = instrrev(path_info, "/")
if wi <> 0 then
this_page = mid(path_info,wi+1)
else
this_page = path_info
end if
'-------------------------------------------------
'------------------------------------------
for j = 0 to elim
for k = 0 to tlim
sub_el_cut(j,k) = "" 'parameter shortcut = parcut = ""
next
for k = 0 to 127
tar(k,j)=0 'prepare target elements
'called by control k in scope j
next
next
'------------------------------------------
'variable "short" is a schema itself:
'"what an ugly programming..."
short = read_file ( sml_schema_f )
short = short & ve & ve
'--------------------------------------------------
've & ve is required
'comments may be put before this line
'comments can be empty;
i = instr(short, ve & ve )
short = mid(short, i)
'--------------------------------------------------
'--------------------------------------------------
'VITAL STATMENT: UGLY PROGRAMMING:
NextB 'skips this line and
'will and must be pointed precisely
'to \\short-ml
'or to next block.
'set_debug 'very good statement. recommended.
'--------------------------------------------------
'--------------------------------------------------
'HEADER:
'this ugly parse ... returns beginnig of schema:
short = mid(short,parse_s_ml_header(1,short,true))
'--------------------------------------------------
element(0) = 0
'================================================================
for i = 1 to elim ' LOOP VIA S T A T E S L I S T
'----------------------------------------------------------------
NextL 'the first line is always skipped
'so can have a comment.
s = ThisT
'empty line terminates first block:
if s = "" then exit for
do while left(s,1) = "'"
NextL
s=ThisT
if s = "" then exit for
loop
'parse CONSTRUCT_
if right(s,1) = "_" then
extended(i) = true
s = left(s,len(s)-1)
else
extended(i) = false
end if
'Upper case means tagable=true:
if lcase(s) <> s then
tagable(i) = true
else
tagable(i) = false
end if
s = lcase(s)
'fill out list of elements:
element(i) = s
'ws = "some"
foreign(i) = false
halftag(i) = false
abbr(i) = false
'true means that in result text
'will be a comment <!nest_level> for
'nest level in subelements tree.
mark(i) = false
'------------------------------------------------------------
if left(s,1) = SML_E_key then 'SML_E_key=="^"==
'long_shotrcut_control
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
element(i) = SML_E_key 'desing drawback;
SML_E_long(i) = true
SML_E_i = SML_E_i + 1
if SML_E_i > SML_E_m then stope "no space for long shortcuts"
'stack long_shortcut:
SML_E_scut(SML_E_i) = s
ws = NextT
if left(ws,1) = """" then
'this is not a second token.
'This is a multiline text.
SML_E_value(SML_E_i) = CutQuotedString( _
1, _
short, _
"""", true, true, true, EndPos)
'explanations:
' StartSearchPos, SourceS, Mark, _
' RecognizeDoubleQuouters, _
' ReduceDoubleQuoters, StripQMarks, EndPos)
short = mid(short,EndPos)
else 'take saved_the_rest_of_line
SML_E_value(SML_E_i) = saved_the_rest_of_line
wi = instr(short, vl)
if wi = 0 then wi = len(short) + 1
short = mid(short,wi) 'to simulate end-of-line parsing;
end if
'----------------------------------
'------------------------------------------------------------
else '==case not long_shotrcut_control
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
SML_E_long(i) = false
ws = NextT 'take second token from line
'===============================================
do while ws <> "" and left(ws,1) <> "'"
'parse rest of line
'starting from second token;
'comment terminates parsing;
'-----------------------------------------------
if ws = "m" then mark(i) = true
' tells translator to mark nesting level in comment
if ws = "a" then abbr(i) = true
if ws = "foreign" then foreign(i) = true
if ws = "halftag" then halftag(i) = true
ws = NextT
loop
if deb then printl "state " & i & " is " & _
element(i) & vt & " extended=" & extended(i) & vt _
& "tagable=" & tagable(i) & vt & " mark=`" & _
mark(i) & "`" & vt & _
" foreign=" & foreign(i) & vt & " halftag=" & _
halftag(i) & vt & " abbrev=" & abbr(i)
end if 'long_shotrcut_control
'----------------------------------------------
'ef line parsing
'===============================================
next
'copy (why?) number of long shortcuts:
SML_E_L = SML_E_i
'adding real tags=brothers-elements ''''''''''''''''''
'copy tagable elements with
'changing from low-case-element-name to
'upper-caase-element-name
j = i
for k=1 to i-1
if tagable(k) then
'raise the case of element:
element(j) = Ucase(element(k)) ' add brothers-elements with upper case (tags)
extended(j) = extended(k) ' keep property of parent element
if deb then printl " state " & j & " is " & element(j)
if j >= elim then stope "elements quantity exceeds limit =" & elim
j = j + 1
end if
next
enumb = j - 1 '-minus one.
' end adding real tags ''''''''''''''''''
' make the rest element empty ''''''''''''''''''
for k=j to enumb
element(k) = ""
next
'-------------------------------------------------------------------------------------
' ef S T A T E S L I S T
'=====================================================================================
'find state indices:
icommon = get_i("#common")
iistart = get_i("#start")
ibody = get_i("body")
'''''''' ELEMENT NOT LONG SHORTCUTS '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' shortcuts for elements/states
' NextB stands for Next Block
NextB : if deb then printl vbcrlf & ThisL
do
NextL
if ThisT = "" then exit do ' seems empty string terminates this block;
ws = ThisT ' this is a control char; no, now all shortcut;
wii = get_i(lcase(NextT)) ' scope
wi = get_i(lcase(NextT)) ' index of shortcut(ted) element
if wi = 0 or wii = 0 then
stope "script needs work: element or " & _
"scope in string (" & i & ") `" & _
ThisL & "` is not found"
end if
k = asc(left(ws,1)) ' SML_E: now, it can be longer than one ...
if k > 127 then stope "shortcut control char code > 127 ... "
tar(k,wii) = wi ' tar(control, scope) = target
'wis:?
any_scut(wi) = ws
if deb then printl "Element `" & element(wi) & "` " & vt & " has a shortcut `" & chr(k) & "`" & vt & " in scope `" & element(wii) & "` "
loop
'''''''' END ELEMENT SHORTCUTS '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'======================================================================================================
' PARCUTE PARSING
' format of line: parcut value type child;
' comma separates skipped token.
'======================================================================================================
do '=1 taggroups loop
NextB : if deb then printl vbcrlf & vbcrlf & _
"next block (taggroup-tagcuts) is starting ... "
NextL ' this line must be a header start
'hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh
do while ThisT <> "" '=2 elements in header loop
'header can have many elements
'for each element the same parcuts must be set.
'===================================================================================================
s = ThisT ' must be current element in the header list
j=get_i(s) ' j is element (actually index)
if j=0 then _
stope "index of element `" & s & _
"` shortcut is not found; this " & _
"shortcut may not listed above in schema ... "
short2 = short ' memorize source from the current element
' in the header list.
i = instr(short, "\\tagcuts") ''''''''''''''''''''''''''''
'find parcuts (= shortcuts for parameters of the element);
short = mid(short,i) 'get closer to parcuts;
NextL 'next line gives the first parcut;
if deb then printl ve & _
"element(" & j & ")=" & _
element(j) & "; about to add partcuts to it ... "
'assign tagcuts;
'find a position to fill out ...
if deb then printl "looking for the first free position k in array for parcuts ... "
for k = 1 to tlim
if deb then printl "" & k & " occupied by `" & sub_el_cut(j,k) & "`"
if sub_el_cut(j,k) = "" then exit for
next
'LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
' LOOP VIA LINES IN TAGCUTS(PARCUTS) BLOCK
'======================================================================================
if deb then printl k & " - is a first free position; adding ... "
do while ThisT <> "" '=4 ' collect parcuts
wwwtemp1 = ThisT
sub_el_cut(j,k) = wwwtemp1 ' must be optimized or indexed ...
' this is a shortcut like for `size= ..`
wi = len(wwwtemp1)
short = mid(short,wi+1)
wwwtemp1 = short
wwwtemp2 = NextT
short = wwwtemp1 ' end of use wwwtemp1
if left(wwwtemp2,1) = "`" then
' second token is a string ` .... `
' this is an entire string in "`" marks; take it
wwwtempi = instr(short,"`")
wi = instr(wwwtempi+1,short,"`")
if wi = 0 then stope "no termination char ` for tag element ... stopping ... "
subelement(j,k) = mid(short,wwwtempi+1,wi-wwwtempi-1)
short=mid(short,wi)
else
subelement(j,k) = NextT
if ThisT = "," then subelement(j,k) = ""
end if
subeltype(j,k)= NextT ' 0 - numbers, 1,2,3, 9 - string length
if ThisT = "," then subeltype(j,k) = ""
ws = NextT
if ThisT = "," then ws = ""
'for child-elements:
enext(j,k) = get_i(lcase(ws)) ' transform state to the next if
' this shortcut is inside the tag
NextL
if deb then printl sub_el_cut(j,k) & vt & subelement(j,k) & vt & _
subeltype(j,k) & vt & enext(j,k)
k = k + 1
if k > tlim then exit do
'======================================================================================
loop '=4 ef IN PARCUTS BLOCK
'LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
short3 = short 'poorily done
short = short2
NextL 'header list must be tailored by empty line;
'otherwise, elements and parcuts will stick together ...
'===================================================================================================
loop ' =2 loop vial elements in taggroup (header)
'hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh
short = short3 ' poorily done;
'=====================================================================================================
' LOOP VIA ALL TAGGROUPS IN SCHEMA:
loop while instr(short, "\\taggroup") > 0
' no need for special termination token
'mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm
end sub
'=============================================
' quits if beh missed
' if not missed eoh is required
' INPUT:
' hso - header source
' start - whe beo must be
' take_defaults - accept defaults
' before anything found
'
'---------------------------------------------
function parse_s_ml_header( _
start,hso,take_defaults)
dim i,j,k,wi,s
const beh = "\\short-ml"
const eoh = "\\end of header"
if take_defaults then
xescape = "\"
xself = "."
xtend = "." 'marks end of parcuts
tag_div = "," 'substitutor for space in tag
if IndentFlag = "" then
'default value:
IndentFlag = ve & " "
end if
end if
i = instr(start,hso,beh)
if i <> start then
'no header is found:
'this sets start of
'schema and retursn it
parse_s_ml_header = start
exit function
end if
k = instr(start,hso, vl & eoh)
if k=0 then stope "Missed " & eoh & "."
k = instr(k,hso,ve)
if k=0 then stope "Header must end with CRLF."
'return next position after the header:
parse_s_ml_header = k+2
'find escaper:
k = instr(start,hso, vl & "escaper=")
if k > 0 then
xescape=mid(hso,k+9,1)
if deb then printl "escaper=`" & xescape & "`"
end if
'find xself
k = instr(start,hso,vl & "escapee=")
if k > 0 then
xself =mid(hso,k+9,1)
if deb then printl "escapee=`" & xself & "`"
end if
'find "parsend"
k = instr(start,hso,vl & "tag end=")
if k > 0 then
xtend =mid(hso,k+8,1)
if deb then printl "parcuts end = `" & xself & "`"
end if
k = instr(start,hso,vl & "indent=")
if k > 0 then
wi = instr(k+1,hso,vl)
IndentFlag = replace(mid(hso,k+8,wi-k-8), vr, "")
if IndentFlag <> "" then
IndentFlag = ve & IndentFlag
end if
end if
if deb then printl "Indent=`" & IndentFlag & "`"
'---------------------------------------------
end function 'parse_s_ml_header
'=============================================
%>