<% '====================================================================== 'NextL and NextT use horrible method to parse text: 'insted to move cursor they cut text each time. '====================================================================== sub stoper(s) stope t & vh & "... short-ml error message ... " & vh & s end sub '====================================================================== ' fuctions for language file compilation '====================================================================== '====================================================================== ' Parsing subroutines ' Method is ugly: parsed text variable (called "short" here) ' cut each time. No sliding pointer. '====================================================================== '====================================================================== ' takes word limited by < .33 chars ' result may be empty ' does not move along parsing file `short` '---------------------------------------------------------------------- function ThisT ' just take current tocken, maybe empty dim i l = len(short) for i=1 to l if asc(mid(short,i,1)) < 33 then exit for next ThisT = left(short, i-1) end function '====================================================================== '====================================================================== ' skips current tocken (=ThisT, which may be empty ) ' goes to next tocken (>32) or lf ' takes next tocken or "" if nothing met before lf ' stops at this taken tocken ' never goes beyond lf '---------------------------------------------------------------------- function NextT dim ll, w, i, wi NextT = ThisT ll = len(NextT) short = mid(short, ll+1 ) for ll = 1 to l w = asc(mid(short, ll, 1)) if w > 32 or w = 10 then exit for next 'Clean_div ttt...nnn ' lf ' ll ' lf ' short = mid(short, ll ) ''''''''''''''''''''''''' wi = instr(short, vblf) if wi = 0 then wi = len(short) + 1 saved_the_rest_of_line = left(short,wi-1) saved_the_rest_of_line = replace(saved_the_rest_of_line, vbcr,"") ''''''''''''''''''''''''' NextT = ThisT end function '====================================================================== '====================================================================== ' lines function ThisL dim i, ii i = instr(short, vblf) if i > 1 and instr(short, i-1) = vbcr then i = i - 1 ThisL = left(short, i) end function '====================================================================== '====================================================================== ' skipping current line, taking following line function NextL short = mid( short, instr(short, vblf)+1 ) NextL = ThisL end function '====================================================================== '======================================================== ' goes to next block which can be ' rigth on the next line; ' NOTE: CURRENT LINE IS ALWAYS SKIPPED; '-------------------------------------------------------- function NextB NextL do until ThisT <> "" NextL loop NextB = ThisL end function '======================================================== '======================================================== ' fuctions for source file compilation ' ' find and return index of element or belonging (scope): ' with name s: ' returns 0 if not found. '-------------------------------------------------------- function get_i(s) dim i i = 0 for i=1 to enumb if s = element(i) then get_i = i next end function '==================================================== '==================================================== 'find index of element based on 'shortcut-character=c and currrent-scope=pcurrent: '---------------------------------------------------- sub get_i_el(c) dim i c_control = lcase(c) i = asc(c_control) if i > 127 then stoper _ "control `" & c & "` asc > 127 ... " i_next_el = tar(i,pcurrent) if i_next_el = 0 then i_next_el = tar(i,icommon) if i_next_el > 0 then if deb then printl _ "found in common state ..." end if end if e_next_el = element(i_next_el) if i_next_el > 0 then if deb then printl " `" & e_next_el & _ "' found in common state ..." end if end sub '==================================================== '==================================================== 'DESC find element parameter index. ' 'programmed ugly: variable i is global and 'is source text cursor '---------------------------------------------------- function get_i_sub_el(ll,c) dim k,j,s get_i_sub_el = 0 if ll < 1 or ll > enumb then _ exit function 'search index k by cycling 'via all element parameters: 'may be slow: for k = 1 to tlim s = sub_el_cut(ll,k) 'first empty paramenter name 'terminates search: if s = "" then exit for 'Why not to make this simple: 'instr(i,source, s) = i if c = left(s,1) then if len(s) = 1 then get_i_sub_el = k exit function else if instr(i,source, s) = i then ' great, long element found get_i_sub_el = k i=i+len(s)-1 exit function end if end if end if next end function '==================================================== '==================================================== ' make indenting string according nesting level sub makei(d) dim i if IndentFlag = "" then exit sub indents = IndentFlag if d > 7 then indents = indents & chr(9) & space(d-7) ' make more tabs here ... else indents = indents & space(d+1) end if end sub '==================================================== ' make indenting string and insert it sub indent(d) if IndentFlag = "" then exit sub makei(d) if indented then exit sub 'if deb then printl "now indenting with = " & d t = t & indents indented = true end sub '==================================================== '==================================================== sub add(s) t = t & s indented = false end sub '==================================================== '====================================================== sub addi(s) 'to indent text which starts from new line '====================================================== if IndentFlag <> "" then s = replace (s, vbcr, "") s = replace (s, vblf, indents) end if t = t & s indented = false end sub '==================================================== '====================================================== sub open_e 'opening element or tag of element; 'considering abbr. as element and 'putting it; 'opening '------------------------------------------------------ if not tagable(i_next_el) then '----------------------- 'NOT TAGABLE '- - - - - - - - - - - - if abbr(i_next_el) then add e_next_el else if foreign(i_next_el) or extended(i_next_el) then indent d add "<" & e_next_el if not halftag(i_next_el) then add ">" end if if extended(i_next_el) then ' extended d = d + 1 p(d) = i_next_el 'pscut - perhaps "past shortcut": pscut(d) = c_control if mark(p(d)) then add "<!+" & d & "+>" end if '----------------------- else ' TAGABLE: '- - - - - - - - - - - - 'if deb then printl " now must indent title ..." if extended(i_next_el) then indent d 'ultimate indent may creates extra empty lines; add "<" & e_next_el 'setup sub-state:------------- d = d + 1 p(d) = get_i(ucase(e_next_el)) '----------------------------- 'perhaps memorize char, which 'triggered to this element: pscut(d) = c_control tag_state = true 'always allow to accept tagelements 'shortcuts from the beginning of tag: no_more_scuts = false end if set_state_attr end sub '====================================================================== ' tags which not need string input ' to extend a tag this is enough to decrease its case ' if it is not extendable, it will simply be closed ... '---------------------------------------------------------------------- sub extend_e ' extend tag dim wi add ">" tag_state = false if extended(ilowcurr) then p(d) = ilowcurr ' just decrease the case to change the state ... if mark(p(d)) then add "<!+" & d & "+>" ' indent d ' not extended elements do not imply indenting ... if ilowcurr = ibody then _ html_header_sent = true ' to make debug nice ' but may not optimal else test_d_low_limit d = d - 1 ' not extendable must just disappear ' from levels ... makei d end if set_state_attr end sub '====================================================================== '====================================================================== ' closing state and decreasing level '---------------------------------------------------------------------- sub close_e ' terminating tag 'set_debug 'if deb then printl " indenting with less on 1 than d=" & d & " indented= " & indented 'KK.07.17.01: ' SelfNamedFlag is a variable with tree possible values: ' "", SelfNamed, and SelfClosed: if SelfNamedFlag <> SelfNamed and SelfNamedFlag <> SelfClosed _ then indent (d-1) test_d_low_limit() 'if deb then printl " now adding after indenting closing element = " & elemcur 'graphics part ------------------- 'KK.07.17.01: if SelfNamedFlag <> SelfNamed then 'for self-named this is already done: if not_halfcurr then add "</" add elemcur & ">" end if 'graphics part end --------------- if mark(p(d)) then add "<!-" & d & "->" d = d - 1 makei d set_state_attr end sub '====================================================================== '====================================================================== sub test_d_low_limit() if element(p(d)) = "#start" then stoper _ "shortml error: cannot close element when `html` is closed ... " end sub '====================================================================== '====================================================================== ' functions for getting extra chars from the front ... function get_next() i= i + 1 if i>TLen then stoper "getting next char ... i=" & i & " length of text=" _ & Tlen & ve & _ "error: end of file in the middle of compilation: <br> " & _ "possibly unclosed text string or missing read " & _ "termination condition ... " else get_next = mid(source,i,1) end if end function '====================================================================== function fill_numbers do while i <= Tlen i= i + 1 if i>TLen then stoper "error: end of file in the middle of compilation: <br> " _ & "tableState=" & tableState & " rowState=" & _ rowState & " text=" & right(source,TLen) else c = mid(source,i,1) select case c case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9" t = t & c case else i = i - 1 exit function end select end if loop end function '====================================================================== '====================================================================== function isNeutral(c) if c = vbcr or c = vblf or c = " " or c=chr(9) then _ isNeutral = true else isNeutral = false end function '====================================================================== %>