ref: c116550e6a41572796e4db65e4f6acbcb3d9d6f8
dir: /appl/lib/html.b/
implement HTML; include "sys.m"; include "html.m"; include "strinttab.m"; sys: Sys; T: StringIntTab; Stringtab: adt { name: string; val: int; }; chartab:= array[] of { T->StringInt ("AElig", 'Æ'), ("Aacute", 'Á'), ("Acirc", 'Â'), ("Agrave", 'À'), ("Aring", 'Å'), ("Atilde", 'Ã'), ("Auml", 'Ä'), ("Ccedil", 'Ç'), ("ETH", 'Ð'), ("Eacute", 'É'), ("Ecirc", 'Ê'), ("Egrave", 'È'), ("Euml", 'Ë'), ("Iacute", 'Í'), ("Icirc", 'Î'), ("Igrave", 'Ì'), ("Iuml", 'Ï'), ("Ntilde", 'Ñ'), ("Oacute", 'Ó'), ("Ocirc", 'Ô'), ("Ograve", 'Ò'), ("Oslash", 'Ø'), ("Otilde", 'Õ'), ("Ouml", 'Ö'), ("THORN", 'Þ'), ("Uacute", 'Ú'), ("Ucirc", 'Û'), ("Ugrave", 'Ù'), ("Uuml", 'Ü'), ("Yacute", 'Ý'), ("aacute", 'á'), ("acirc", 'â'), ("acute", '´'), ("aelig", 'æ'), ("agrave", 'à'), ("alpha", 'α'), ("amp", '&'), ("aring", 'å'), ("atilde", 'ã'), ("auml", 'ä'), ("beta", 'β'), ("brvbar", '¦'), ("ccedil", 'ç'), ("cdots", '⋯'), ("cedil", '¸'), ("cent", '¢'), ("chi", 'χ'), ("copy", '©'), ("curren", '¤'), ("ddots", '⋱'), ("deg", '°'), ("delta", 'δ'), ("divide", '÷'), ("eacute", 'é'), ("ecirc", 'ê'), ("egrave", 'è'), ("emdash", '—'), ("emsp", ' '), ("endash", '–'), ("ensp", ' '), ("epsilon", 'ε'), ("eta", 'η'), ("eth", 'ð'), ("euml", 'ë'), ("frac12", '½'), ("frac14", '¼'), ("frac34", '¾'), ("gamma", 'γ'), ("gt", '>'), ("iacute", 'í'), ("icirc", 'î'), ("iexcl", '¡'), ("igrave", 'ì'), ("iota", 'ι'), ("iquest", '¿'), ("iuml", 'ï'), ("kappa", 'κ'), ("lambda", 'λ'), ("laquo", '«'), ("ldots", '…'), ("lt", '<'), ("macr", '¯'), ("micro", 'µ'), ("middot", '·'), ("mu", 'μ'), ("nbsp", ' '), ("not", '¬'), ("ntilde", 'ñ'), ("nu", 'ν'), ("oacute", 'ó'), ("ocirc", 'ô'), ("ograve", 'ò'), ("omega", 'ω'), ("omicron", 'ο'), ("ordf", 'ª'), ("ordm", 'º'), ("oslash", 'ø'), ("otilde", 'õ'), ("ouml", 'ö'), ("para", '¶'), ("phi", 'φ'), ("pi", 'π'), ("plusmn", '±'), ("pound", '£'), ("psi", 'ψ'), ("quad", ' '), ("quot", '"'), ("raquo", '»'), ("reg", '®'), ("rho", 'ρ'), ("sect", '§'), ("shy", ''), ("sigma", 'σ'), ("sp", ' '), ("sup1", '¹'), ("sup2", '²'), ("sup3", '³'), ("szlig", 'ß'), ("tau", 'τ'), ("theta", 'θ'), ("thinsp", ' '), ("thorn", 'þ'), ("times", '×'), ("trade", '™'), ("uacute", 'ú'), ("ucirc", 'û'), ("ugrave", 'ù'), ("uml", '¨'), ("upsilon", 'υ'), ("uuml", 'ü'), ("varepsilon", '∈'), ("varphi", 'ϕ'), ("varpi", 'ϖ'), ("varrho", 'ϱ'), ("vdots", '⋮'), ("vsigma", 'ς'), ("vtheta", 'ϑ'), ("xi", 'ξ'), ("yacute", 'ý'), ("yen", '¥'), ("yuml", 'ÿ'), ("zeta", 'ζ'), }; htmlstringtab := array[] of { T->StringInt ("a", Ta), ("address", Taddress), ("applet", Tapplet), ("area", Tarea), ("att_footer", Tatt_footer), ("b", Tb), ("base", Tbase), ("basefont", Tbasefont), ("big", Tbig), ("blink", Tblink), ("blockquote", Tblockquote), ("body", Tbody), ("bq", Tbq), ("br", Tbr), ("caption", Tcaption), ("center", Tcenter), ("cite", Tcite), ("code", Tcode), ("col", Tcol), ("colgroup", Tcolgroup), ("dd", Tdd), ("dfn", Tdfn), ("dir", Tdir), ("div", Tdiv), ("dl", Tdl), ("dt", Tdt), ("em", Tem), ("font", Tfont), ("form", Tform), ("frame", Tframe), ("frameset", Tframeset), ("h1", Th1), ("h2", Th2), ("h3", Th3), ("h4", Th4), ("h5", Th5), ("h6", Th6), ("head", Thead), ("hr", Thr), ("html", Thtml), ("i", Ti), ("img", Timg), ("input", Tinput), ("isindex", Tisindex), ("item", Titem), ("kbd", Tkbd), ("li", Tli), ("link", Tlink), ("map", Tmap), ("menu", Tmenu), ("meta", Tmeta), ("nobr", Tnobr), ("noframes", Tnoframes), ("ol", Tol), ("option", Toption), ("p", Tp), ("param", Tparam), ("pre", Tpre), ("q", Tq), ("samp", Tsamp), ("script", Tscript), ("select", Tselect), ("small", Tsmall), ("strike", Tstrike), ("strong", Tstrong), ("style", Tstyle), ("sub", Tsub), ("sup", Tsup), ("t", Tt), ("table", Ttable), ("tbody", Ttbody), ("td", Ttd), ("textarea", Ttextarea), ("textflow", Ttextflow), ("tfoot", Ttfoot), ("th", Tth), ("thead", Tthead), ("title", Ttitle), ("tr", Ttr), ("tt", Ttt), ("u", Tu), ("ul", Tul), ("var", Tvar) }; W, D, L, U, N: con byte (1<<iota); NCTYPE: con 256; ctype := array[NCTYPE] of { '0'=>D, '1'=>D, '2'=>D, '3'=>D, '4'=>D, '5'=>D, '6'=>D, '7'=>D, '8'=>D, '9'=>D, 'A'=>U, 'B'=>U, 'C'=>U, 'D'=>U, 'E'=>U, 'F'=>U, 'G'=>U, 'H'=>U, 'I'=>U, 'J'=>U, 'K'=>U, 'L'=>U, 'M'=>U, 'N'=>U, 'O'=>U, 'P'=>U, 'Q'=>U, 'R'=>U, 'S'=>U, 'T'=>U, 'U'=>U, 'V'=>U, 'W'=>U, 'X'=>U, 'Y'=>U, 'Z'=>U, 'a'=>L, 'b'=>L, 'c'=>L, 'd'=>L, 'e'=>L, 'f'=>L, 'g'=>L, 'h'=>L, 'i'=>L, 'j'=>L, 'k'=>L, 'l'=>L, 'm'=>L, 'n'=>L, 'o'=>L, 'p'=>L, 'q'=>L, 'r'=>L, 's'=>L, 't'=>L, 'u'=>L, 'v'=>L, 'w'=>L, 'x'=>L, 'y'=>L, 'z'=>L, '.'=>N, '-'=>N, ' '=>W, '\n'=>W, '\t'=>W, '\r'=>W, * => byte 0 }; lex(b: array of byte, charset: int, keepwh: int): array of ref Lex { if(sys == nil) sys = load Sys Sys->PATH; if(T == nil) T = load StringIntTab StringIntTab->PATH; if(T == nil) { sys->print("HTML->lex: couldn't %s\n", StringIntTab->PATH); return nil; } a: array of ref Lex; ai := 0; i := 0; nb := len b; for(;;){ Whitespace: for(;;){ # ignore nulls while(i<nb && (int b[i] == 0)) i++; # skip white space if(!keepwh) { while(i<nb) { c := int b[i]; if(!(int (ctype[c]&W)) && c != ' ') break; i++; } } # skip comments if(i<nb-4 && int b[i]=='<' && int b[i+1]=='!' && int b[i+2]=='-' && int b[i+3]=='-') { i += 4; while(i<nb-3){ if(int b[i]=='-' && int b[i+1]=='-' && int b[i+2]=='>'){ i += 3; continue Whitespace; } i++; } continue Whitespace; } break; } if(i == nb) break; if(ai == len a){ na := array[len a + 500] of ref Lex; if(a != nil) na[0:] = a; a = na; } if(int b[i] == '<'){ lx : ref Lex; (lx, i) = gettag(b, i, charset); a[ai++] = lx; } else { s: string; (s, i) = getdata(b, i, keepwh, charset); a[ai++] = ref Lex (Data, s, nil); } } return a[0:ai]; } getdata(b: array of byte, i: int, keepnls, charset: int): (string, int) { s:= ""; j:= 0; c: int; nb := len b; loop: while(i < nb){ oldi := i; case charset{ Latin1 => c = int b[i++]; UTF8 => j: int; (c, j, nil) = sys->byte2char(b, i); i += j; } case c { 0 or 16r1a => continue loop; '<' => i = oldi; break loop; '&' => (c, i) = ampersand(b, i); '\n' => if(!keepnls) c = ' '; '\r' => if(oldi > 0 && int b[oldi-1] == '\n') continue loop; if(keepnls) c = '\n'; else c = ' '; } s[j++] = c; } return (s, i); } gettag(b: array of byte, i, charset: int): (ref Lex, int) { rbra := 0; nb := len b; ans := ref Lex(Notfound, "", nil); al: list of Attr; if(++i == nb) return (ans, i); istart := i; c := int b[i]; if(c == '/') { rbra = RBRA; if(++i == nb) return (ans, i); c = int b[i]; } if(c>=NCTYPE || !int (ctype[c]&(L|U))) { while(i < nb) { c = int b[i++]; if(c == '>') break; } ans.text = string b[istart:i]; return (ans, i); } namstart := i; while(c<NCTYPE && int (ctype[c]&(L|U|D|N))) { if(++i == nb) { ans.text = string b[istart:i]; return (ans, i); } c = int b[i]; } name := lowercase(b, namstart, i); (fnd, tag) := T->lookup(htmlstringtab, name); if(fnd) ans.tag = tag+rbra; else ans.text = name; attrloop: while(i < nb){ # look for "ws name" or "ws name ws = ws val" (ws=whitespace) # skip whitespace while(c<NCTYPE && int (ctype[c]&W)) { if(++i == nb) break attrloop; c = int b[i]; } if(c == '>') { i++; break; } if(c == '<') break; # error: unclosed tag if(c>=NCTYPE || !int (ctype[c]&(L|U))) { # error, not the start of a name # skip to end of tag while(i < nb) { c = int b[i++]; if(c == '>') break; } break attrloop; } # gather name namstart = i; while(c<NCTYPE && int (ctype[c]&(L|U|D|N))) { if(++i == nb) break attrloop; c = int b[i]; } name = lowercase(b, namstart, i); # skip whitespace while(c<NCTYPE && int (ctype[c]&W)) { if(++i == nb) break attrloop; c = int b[i]; } if(c != '=') { # no value for this attr al = (name, "") :: al; continue attrloop; } # skip whitespace if(++i == nb) break attrloop; c = int b[i]; while(c<NCTYPE && int (ctype[c]&W)) { if(++i == nb) break attrloop; c = int b[i]; } # gather value quote := 0; if(c == '\'' || c == '"') { quote = c; i++; } val := ""; nv := 0; valloop: while(i < nb) { case charset{ Latin1 => c = int b[i++]; UTF8 => j: int; (c, j, nil) = sys->byte2char(b, i); i += j; } if(c == '>') { if(quote) { # c might be part of string (though not good style) # but if line ends before close quote, assume # there was an unmatched quote for(k := i; k < nb; k++) { c = int b[k]; if(c == quote) { val[nv++] = '>'; continue valloop; } if(c == '\n') { i--; break valloop; } } } i--; break valloop; } if(quote) { if(c == quote) break valloop; if(c == '\n') continue valloop; if(c == '\t' || c == '\r') c = ' '; } else { if(c<NCTYPE && int (ctype[c]&W)) break valloop; } if(c == '&') (c, i) = ampersand(b, i); val[nv++] = c; } al = (name, val) :: al; if(i < nb) c = int b[i]; } ans.attr = al; return (ans, i); } ampersand(b: array of byte, i: int): (int, int) { starti := i; c := 0; nb := len b; if(i >= nb) return ('?', i); fnd := 0; ans := 0; if(int b[i] == '#'){ i++; while(i<nb){ d := int b[i]; if(!(int (ctype[d]&D))) break; c = c*10 + d-'0'; i++; } if(0<c && c<256) { if(c==160) c = ' '; # non-breaking space ans = c; fnd = 1; } } else { s := ""; k := 0; c = int b[i]; if(int (ctype[c]&(L|U))) { while(i<nb) { c = int b[i]; if(!(int (ctype[c]&(L|U|D|N)))) break; s[k++] = c; i++; } } (fnd, ans) = T->lookup(chartab, s); } if(!fnd) return ('&', starti); if(i<nb && (int b[i]==';' || int b[i]=='\n')) i++; return (ans, i); } lowercase(b: array of byte, istart, iend: int): string { l := ""; j := 0; for(i:=istart; i<iend; i++) { c := int b[i]; if(c < NCTYPE && int (ctype[c]&U)) l[j] = c-'A'+'a'; else l[j] = c; j++; } return l; } uppercase(s: string): string { l := ""; for(i:=0; i<len s; i++) { c := s[i]; if(c < NCTYPE && int (ctype[c]&L)) l[i] = c+'A'-'a'; else l[i] = c; } return l; } attrvalue(attr: list of Attr, name: string): (int, string) { while(attr != nil){ a := hd attr; if(a.name == name) return (1, a.value); attr = tl attr; } return (0, ""); } globalattr(html: array of ref Lex, tag: int, attr: string): (int, string) { for(i:=0; i<len html; i++) if(html[i].tag == tag) return attrvalue(html[i].attr, attr); return (0, ""); } isbreak(h: array of ref Lex, i: int): int { for(; i<len h; i++){ case h[i].tag{ Th1 or Th2 or Th3 or Th4 or Th5 or Th6 or Tbr or Tp or Tbody or Taddress or Tblockquote or Tul or Tdl or Tdir or Tmenu or Tol or Tpre or Thr or Tform => return 1; Data => return 0; } } return 0; } # for debugging lex2string(l: ref Lex): string { ans := ""; tag := l.tag; if(tag == HTML->Data) ans = "'" + l.text + "'"; else { ans = "<"; if(tag >= RBRA) { tag -= RBRA; ans = ans + "/"; } tname := T->revlookup(htmlstringtab, tag); if(tname != nil) ans = ans + uppercase(tname); for(al := l.attr; al != nil; al = tl al) { a := hd al; ans = ans + " " + a.name + "='" + a.value + "'"; } ans = ans + ">"; } return ans; }