  string cr,tab,kd,ke,kk,qu,prbuf,prbufj,filelist
  int kl
  sys prof, profj

  cr=chr(13)+chr(10)
  tab=chr(9)
  kd=cr+"key:"
  kl=6 'len kd
  ke=cr+"."
  kk=cr
  qu=chr 34
  prbuf=""    'print buffer
  prof=0      'endpoint index
  prbufj=""    'json buffer
  profj=0      'json endpoint index
  filelist="" 'list of all files

  def varget %1=getfield record, "%1"
  '

  function replace(string t,w,r) as string
  ========================================
  '
  sys    a,b,lw,lr
  string s=t
  '
  lw=len w
  lr=len r
  a=1
  '  
  do
    a=instr a,s,w
    if a=0 then exit do
    s=left(s,a-1)+r+mid(s,a+lw)
    a+=lr
  end do
  return s
  end function




  procedure getblock(string s,kw,ke, sys *a,*b)
  =============================================
  a=instr(a,s,kw)
  if not a then a=1 : b=1 : exit procedure
  b=instr(a,s,ke)
  if not b then b=a
  end procedure

  procedure skiplspaceQu(sys p, int*i)
  ====================================
  byte*b : @b=p+i-1
  do
    select b
    case 0,13,10 : exit procedure
    case 1 to 32 : @b++
    case 34      : @b++
    case else    : exit procedure
    end select
    i++
  loop
  end procedure


  procedure skiplwordQu(sys p, int*i)
  ===================================
  byte*b : @b=p+i-1
  do
    select b
    case 0 to 32 : exit procedure
    case 34      : exit procedure
    case else    : @b++
    end select
    i++
  loop
  end procedure


  procedure getsdata(string s, int *a,*b,*e)
  ==========================================
  'returns data "word" with quotes removed
  int c,d
  e=0 'end of word
  c=instr a,s,kd 'data
  if c
    a=c 'start of data
    b=c+kl+1
    skiplspaceQu strptr(s),b
    e=b
    skiplwordQu(strptr(s),e) 'locate end of word
    exit procedure
  end if
  b=a
  end procedure


  procedure getrec(string s, sys *a,*b)
  =====================================
  b=a
  getblock(s,kd,ke,a,b)
  end procedure


  function getword(string s, sys *i) as string
  ============================================
  sys le,p,q,j=1
  byte*b
  le=len s
  if le=0 then exit function
  if i>le then exit function
  @b=i-1+strptr s
  'skip space or comma
  do
    select b
    case 0 : exit do
    case 1 to 32   : 'skip white space 
    case 44        : 'skip commas
    case 33 to 255 : exit do 'all other ascii
    end select
    @b++
    i++
  end do
  if b=0 then return ""
  j=i
  'exit when space or comma
  do
    select b
    case 0 : exit do
    case 1 to 32 : exit do 
    case 44      : exit do
    end select
    @b++
    i++
  end do
  return mid(s,j,i-j)
  end function



  function nqtword(string s, sys *a,*le) as string
  ================================================
  sys b,c
  a+=1
  '
  string q=chr(34)
  b=instr a,s,q
  if b=a then
    b+=1
    c=instr(b,s,q)
    a=c+1
    le=c-b
    return mid(s,b,le)
  end if
  '
  b=instr a,s," "
  a+=1 : c=b-1
  le=c-a
  if le>0 then function=mid s,a,le
  'itr skipspaces?
  a=b
  end function


  function getname(string s, sys a) as string
  ===========================================
  sys b,c,e
  b=a
  getsdata(s,b,c,e)
  if e then
    function=mid s, c,e-c
  end if
  end function


  function getnames(string s, sys a) as string
  ============================================
  sys b,c,d,e,le
  b=a : c=a
  do
    getsdata(s,b,c,e)
    if e=0 then exit do 'no more data
    le=e-c
    function+=mid(s,c,le) cr
    b=instr e,s,cr
    d=instr e,s,kd
    if b<>d then
      exit function 'not contiguous data statements
    end if
  end do
  end function


  function getfieldword(string s,n) as string
  ===========================================
  'single line of data only
  sys a,b,c
  a=instr(s,kk+n+":")
  if not a then exit function
  a+=len(n)+3
  b=instr a,s,cr
  if not b then b=1+len s
  function=ltrim(mid(s,a,b-a))
  end function


  function getfield(string s,n) as string
  =======================================
  sys a,b,c,le,k
  string w
  if n="" then exit function
  w=kk+n+":"
  '
  a=1 : le=len s
  '
  another:
  '-------
  '
  if a>le then exit function
  a=instr a,s,w
  if not a then exit function
  '
  a+=len(w) 'skip over fieldname
  '
  b=instr a,s,cr
  if not b then b=1+le
  function+=ltrim mid(s,a,b-a+2)
  '
  'additional lines
  do
    b+=2
    k=asc(s,b)
    'check for more field lines
    if k>32 then exit do 'next field or term
    if k=32
      b+=2 'skip indent spaces
    endif
    c=instr b,s,cr
    if c then
      function+=mid(s,b,c-b+2) 'cr is included
      b=c
      a=c
    end if
  end do
  '
  goto another 'include further fields of same name
  '
  end function


  type recordlist
  ===============
    s as string 'name of record
    i as sys    'position in file
    m as sys    'meta typecode
    c as sys    'unused
  end type


  procedure makegrlist(string s, recordlist*d, sys *i)
  ====================================================
  scope
  sys a,b,c,e,le
  a=1 : b=1 : le=0
  do
    getsdata(s,a,b,e)
    if e=0 then exit do
    c=e
    i+=1
    le=e-b
    d[i].s=mid(s,b,le)
    if not le then i-=1 : exit do
    d[i].i=a
    '
    'SKIP OVER OTHER DATA STATEMENTS IN THE BLOCK
    '
    do
      a=instr(c,s,cr)
      b=instr(c,s,kd)
      if a<>b then
        exit do
      end if
      c+=3
    end do
    a=c 'next group
  end do
  end scope
  end procedure


  function getmetatype(string s, sys *i) as string
  ================================================
  ++i
  return getword(s,i)
  end function


  procedure makelist(string s, recordlist*d, sys *i)
  ==================================================
  scope
  sys a,b,c,e,le
  string w
  a=1 : b=1 : le=0
  do
    getsdata(s,a,b,e)
    if e=0 then exit do
    c=e
    i+=1
    le=e-b
    d[i].s=mid(s,b,le)
    if not le then i-=1 : exit do
    w=getmetatype(s,c)
    d[i].m=val w
    d[i].i=a
    a=c
  end do
  end scope
  end procedure



  procedure pr(string s) 'ADD TO PRINT BUFFER
  ===========================================
    sys le,ls
    le=len prbuf : ls=len s
    if prof+ls>le then prbuf+=space(8000+ls)
    mid prbuf,prof+1,s
    prof+=ls
  end procedure


  procedure prjn(string t)
  ========================
  sys le,lt
  le=len prbufj : lt=len t
  if profj+lt>le then prbufj+=space(0x10000+lt) 'append 64k
  mid prbufj,profj+1,t
  profj+=lt
  end procedure


  procedure prijn(string k,s)
  ===========================
  'k name of field
  's content
  if not s then exit procedure
  /*
    JSON CHARACTER ENCODING
    'escaping embedded quotes in json data
    \" - Escapes a double quote
    \\ - Escapes a backslash
    \/ - Escapes a forward slash (optional)
    \b - Backspace
    \f - Form feed
    \n - Newline
    \r - Carriage return
    \t - Tab
    \uXXXX - Unicode character (where XXXX is a 4-digit hexadecimal code)
  */
  int j=len(s)
  int c
  c=asc(s,j) : if c=10 then j-=1
  c=asc(s,j) : if c=13 then j-=1
  string t=left(s,j) 'omit final cr
  string u=nuls j*2
  int i=1,m=1,a=0
  '
  'bytify
  indexbase 1
  byte bt at strptr t
  byte bu at strptr u
  '
  scope
  while i<=j
   'a=asc(t,i)
   '
   'bytify
   def ins bu=%1 : @bu++ : m+=1
   def insb bu=92 : @bu++ : bu=%1 : @bu++ : m+=2
   '
    a=bt
    select a
   'case 34,92,47 :   mid(u,m)="\"+chr(a) : m+=2
    case 34,92,47 :  insb  a
   'case 32 to 255 :  mid(u,m)=chr(a) : m+=1
    case 32 to 255 :  ins a
   'case  8 : mid(u,m)="\b" : m+=2
    case  8 : insb 0x62
   'case  9 : mid(u,m)="\t" : m+=2
    case  9 : insb 0x74
   'case 10 : mid(u,m)="\n" : m+=2
    case 10 : insb 0x6e
   'case 12 : mid(u,m)="\f" : m+=2
    case 12 : insb 0x66
   'case 13 : mid(u,m)="\n" : m+=2 : if asc(t,i+1)=10 then i++
    case 13 : insb 0x6e : if bt[2]=10 then @bt++ : i++
    case 0 to 31 : 'no action
    end select
    i++
    @bt++
  wend
  end scope
  t=left(u,m-1)
  
  'itr unicode
  '
  t= qu+k+qu+":"+qu+t+qu+"," cr
  prjn t
  end procedure


  '
  'def printfield pr "<b><i>" k "</i></b><br><br>" cr cr s "<br><br><br>" cr
  '
  def printfield
  ==============
    pr "<tr>" cr +
    "<td valign=top >" cr +
    "<font color=#3333ff><b><i>" k "</i></b></font>" +
    "</td>" cr +
    "<td valign=top>" cr +
    s +
    "<br>" cr +
    "</td>" cr +
    "</tr>" cr
  end def
  '
  def printHeading
    pr "<tr>" cr +
    "<td valign=top >" cr +
    "<font color=#3333ff><b>" k "</b></font>" +
    "</td>" cr +
    "</tr>" cr
  end def



  procedure prih(string k,s)
  ==========================
  printHeading
  end procedure



  procedure prif(string k,s)
  ==========================
  'k name of field
  's content
  sys le
  le=len s
  if not le then exit procedure
  printfield
  end procedure


  procedure prifc(string k,*s)
  ============================
  sys le
  le=len s
  if not le then exit procedure
  s="<pre>" s "</pre>"
  printfield
  end procedure


  procedure prifbr(string k,*s)
  =============================
  sys le
  le=len s
  if not le then exit procedure
  s=replace(s,cr,"<br>")
  printfield
  end procedure


  function filenameHTM(string *n) as string
  =========================================
  sys a,i
  string s
  n=lcase n
  for i=1 to len(n)
    a=asc(n,i)
    if a<97 or a>122 then
      s+="a"+str(a-31) 'supports ascii encoding (space=a1)
    else
      s+=chr(a)
    end if
  next
  return s+".htm"
  end function


  procedure splitword(string*w)
  =============================
  sys a
  a=instr(w,"__")
  if a then mid(w,a)="  "
  end procedure

  procedure splitword(string*w,*l,*r)
  ===================================
  sys a
  a=instr(w,"__")
  if a then
    mid(w,a)="  "
    l=left w,a-1
    r="("+mid(w,a+2)+") "
  else
    l=w
    r=""
  end if
  end procedure



  procedure reftag(string *s)
  ===========================
  sys i
  string w,r,n
  if len(s)<4 then exit procedure 'itr necessary
  i=1
  do
    w=getword(s,i)
    if len(w) then
      'itr enquote symbols
      n=filenameHTM w
      splitword w
      r+=`<a href="`+n+`">` w `</a> ` cr
    else
      exit do
    end if
  end do
  s=r
  end procedure


  procedure seelinks(string *s)
  =============================
  sys a=1,b
  string n,r,w
  do
    a=instr a,s,"see:"
    if not a then exit do
    a+=5
    b=a
    w=getword(s,a)
    if not w then exit do
    '
    n=filenameHTM w
    r=`<a href="`+n+`">` w `</a> `
    s=left(s,b-1)+r+mid(s,a)
    a=b+len r
  end do
  end procedure


  function htmlencode(string t) as string
  =======================================
  sys a,b
  string s=t
  do
    a=instr(s,"<")
    if a=0 then exit do
    s=left(s,a-1)+"&#60;"+mid(s,a+1)
  end do
  do
    a=instr(s,">")
    if a=0 then exit do
    s=left(s,a-1)+"&#62;"+mid(s,a+1)
  end do
  function=s
  end function


  procedure htmlencodew(string *w)
  ================================
  sys c
  '
  c=asc w
  if c=60 then
    if asc(w,2)=60 then
      w="&#60;&#60;" : exit procedure
    end if
    w="&#60;"+mid(w,2)
  elseif c=62 then
    w="&#62;"+mid(w,2)
  end if
  end procedure


/*
  function getmembers(string s, int p) as string
  ==============================================
  'capture list of 'key'
  int a,b,c,e,le
  string n,w
  a=p : b=1 : le=0 : w=""
  do
    getsdata(s,a,b,e)
    if e=0 then jmp fwd nget
    c=e
    le=e-b
    if not le then exit do
    w+=mid(s,b,le)+", "
    '
    'SKIP OVER OTHER DATA STATEMENTS IN THE BLOCK
    '
    do
      a=instr(c,s,cr)
      b=instr(c,s,kd)
      if a<>b then
        jmp fwd nget
      else 'a=b
        c=b+3
        exit do
      end if
    end do
  end do
  '
  nget:
  if w
    return left(w,len(w)-2) 'omit ', '
  endif
  '
  end function
*/


/*
  procedure grprintnames(string s, sys p, flinks)
  ===============================================
  'capture list of 'key'
  sys a,b,c,e,le
  string n,w
  a=p : b=1 : le=0
  do
    getsdata(s,a,b,e)
    if e=0 then exit procedure
    c=e
    '
    le=e-b
    if not le then pr cr : exit do
    w=mid(s,b,le)
    htmlencodew w
    '
    'CREATE FILE LINK FOR EACH KEYWORD IN THE GROUP
    '
    if flinks then
      n=filenameHTM w
      w=`<a href="`+n+`">` w `</a> ` cr
    end if
    pr w " , "
    '
    'SKIP OVER OTHER DATA STATEMENTS IN THE BLOCK
    '
    do
      a=instr(c,s,cr)
      b=instr(c,s,kd)
      if a<>b then
        if asc(s,b+2)=45
          pr "<br><br>" cr 'line break for line
        else
          jmp fwd ngrprint
        end if
        c=b+3
        continue do
      else
        exit do
      end if
    end do
  end do
  '
  ngrprint:
  '
  end procedure
*/


  function inclfile(string s,f) as string
  =======================================
  string ent
  filelist+=s ".hha" cr
  ent=f
  ent=replace ent,"%1",s
  ent=replace ent,"%2",s ".hha"
  function=ent
  end function



  function Embed(string f) as string
  ==================================
  string s,t,u
  s=rtrim f
  u=getfile s
  u=replace u,"<","&#60;"
  'u=replace u,">","&#62;" 'itr string corruption?
  function=u t
  end function


 
  function EmbedHTM(string *f) as string
  ======================================
  string s,t,u
  f=rtrim f
  s=quote
  !!!
  <tr>
  <td></td>
  <td>
  <pre>
  !!!
  t=quote
  !!!
  </pre>
  </td>
  </tr>
  !!!
  u=getfile f
  '
  u=replace u,"<","&#60;"
  'u=replace u,">","&#62;" 'itr string corruption?
  function=s u t
  end function

/*
  procedure htmbold(string *s) 'BOLD MARKUP
  =========================================
  sys a,b
  static string bb=chr(172) ' '
  do
    a=instr(a+1,s,bb)
    if not a then exit do
    b=instr(a+1,s,bb)
    if not b then exit do
    s=left(s,a-1)+"<b>"+mid(s,a+1,b-a-1)+"</b>"+mid(s,b+1)
    a=b+5 
  end do
  end procedure
*/