implement Xml; ## Portions copyright © 2002 Vita Nuova Holdings Limited### Derived from saxparser.b Copyright © 2001-2002 by John Powers or his employer# # TO DO:# - provide a way of getting attributes out of <?...?> (process) requests,# so that we can process stylesheet requests given in that way. include "sys.m";	sys: Sys;include "bufio.m";	bufio: Bufio;	Iobuf: import bufio;include "string.m";	str: String;include "hash.m";	hash: Hash;	HashTable: import hash;include "xml.m"; Parcel: adt {	pick {	Start or	Empty =>		name: string;		attrs: Attributes;	End =>		name: string;	Text =>		ch: string;		ws1, ws2: int;	Process =>		target: string;		data: string;	Error =>		loc:	Locator;		msg:	string;	Doctype =>		name:	string;		public:	int;		params:	list of string;	Stylesheet =>		attrs: Attributes;	EOF =>	}}; entinit := array[] of {	("AElig", "Æ"),	("OElig", "Œ"),	("aelig", "æ"),	("amp", "&"),	("apos", "\'"),	("copy", "©"),	("gt", ">"),	("ldquo", "``"),	("lt", "<"),	("mdash", "-"),		# XXX ??	("oelig", "œ"),	("quot", "\""),	("rdquo", "''"),	("rsquo", "'"),	("trade", "™"),	("nbsp", "\u00a0"),};entdict: ref HashTable; init(): string{	sys = load Sys Sys->PATH;	bufio = load Bufio Bufio->PATH;	if (bufio == nil)		return sys->sprint("cannot load %s: %r", Bufio->PATH);	str = load String String->PATH;	if (str == nil)		return sys->sprint("cannot load %s: %r", String->PATH);	hash = load Hash Hash->PATH;	if (hash == nil)		return sys->sprint("cannot load %s: %r", Hash->PATH);	entdict = hash->new(23);	for (i := 0; i < len entinit; i += 1) {		(key, value) := entinit[i];		entdict.insert(key, (0, 0.0, value));	}	return nil;} blankparser: Parser; open(srcfile: string, warning: chan of (Locator, string), preelem: string): (ref Parser, string){	fd := bufio->open(srcfile, Bufio->OREAD);	if(fd == nil)		return (nil, sys->sprint("cannot open %s: %r", srcfile));	return fopen(fd, srcfile, warning, preelem);} fopen(fd: ref Bufio->Iobuf, name: string, warning: chan of (Locator, string), preelem: string): (ref Parser, string){	x := ref blankparser;	x.in = fd;	# ignore utf16 initialisation character (yuck)	c := x.in.getc();	if (c != 16rfffe && c != 16rfeff)		x.in.ungetc();	x.estack = nil;	x.loc = Locator(1, name, "");	x.warning = warning;	x.preelem = preelem;	return (x, "");} Parser.next(x: self ref Parser): ref Item{	curroffset := x.fileoffset;	currloc := x.loc;	# read up until end of current item	while (x.actdepth > x.readdepth) {		pick p := getparcel(x) {		Start =>			x.actdepth++;		End =>			x.actdepth--;		EOF =>			x.actdepth = 0;			# premature EOF closes all tags		Error =>			return ref Item.Error(curroffset, x.loc, x.errormsg);		}	}	if (x.actdepth < x.readdepth) {		x.fileoffset = int x.in.offset();		return nil;	}	gp := getparcel(x);	item: ref Item;	pick p := gp {	Start =>		x.actdepth++;		item = ref Item.Tag(curroffset, p.name, p.attrs);	End =>		x.actdepth--;		item = nil;	EOF =>		x.actdepth = 0;		item = nil;	Error =>		x.actdepth = 0;			# XXX is this the right thing to do?		item = ref Item.Error(curroffset, currloc, x.errormsg);	Text =>		item = ref Item.Text(curroffset, p.ch, p.ws1, p.ws2);	Process =>		item = ref Item.Process(curroffset, p.target, p.data);	Empty =>		item = ref Item.Tag(curroffset, p.name, p.attrs);	Doctype =>		item = ref Item.Doctype(curroffset, p.name, p.public, p.params);	Stylesheet =>		item = ref Item.Stylesheet(curroffset, p.attrs);	}	x.fileoffset = int x.in.offset();	return item;} Parser.atmark(x: self ref Parser, m: ref Mark): int{	return  int x.in.offset() == m.offset;} Parser.down(x: self ref Parser){	x.readdepth++;} Parser.up(x: self ref Parser){	x.readdepth--;} # mark is only defined after a next(), not after up() or down().# this means that we don't have to record lots of state when going up or down levels.Parser.mark(x: self ref Parser): ref Mark{	return ref Mark(x.estack, x.loc.line, int x.in.offset(), x.readdepth);} Parser.goto(x: self ref Parser, m: ref Mark){	x.in.seek(big m.offset, Sys->SEEKSTART);	x.fileoffset = m.offset;	x.eof = 0;	x.estack = m.estack;	x.loc.line = m.line;	x.readdepth = m.readdepth;	x.actdepth = len x.estack;} Mark.str(m: self ref Mark): string{	# assume that neither the filename nor any of the tags contain spaces.	# format:	# offset readdepth linenum [tag...]	# XXX would be nice if the produced string did not contain	# any spaces so it could be treated as a word in other contexts.	s := sys->sprint("%d %d %d", m.offset, m.readdepth, m.line);	for (t := m.estack; t != nil; t = tl t)		s += " " + hd t;	return s;} Parser.str2mark(p: self ref Parser, s: string): ref Mark{	(n, toks) := sys->tokenize(s, " ");	if (n < 3)		return nil;	m := ref Mark(nil, p.loc.line, 0, 0);	(m.offset, toks) = (int hd toks, tl toks);	(m.readdepth, toks) = (int hd toks, tl toks);	(m.line, toks) = (int hd toks, tl toks);	m.estack = toks;	return m;} getparcel(x: ref Parser): ref Parcel{	{		p: ref Parcel;		while (!x.eof && p == nil) {			c := getc(x);			if (c == '<')				p = element(x);			else {				ungetc(x);				p = characters(x);			}		}		if (p == nil)			p = ref Parcel.EOF;		return p;	}exception e{	"sax:*" =>			return ref Parcel.Error(x.loc, x.errormsg);	}} parcelstr(gi: ref Parcel): string{	if (gi == nil)		return "nil";	pick i := gi {	Start =>		return sys->sprint("Start: %s", i.name);	Empty =>		return sys->sprint("Empty: %s", i.name);	End =>		return "End";	Text =>		return "Text";	Doctype =>		return sys->sprint("Doctype: %s", i.name);	Stylesheet =>		return "Stylesheet";	Error =>		return "Error: " + i.msg;	EOF =>		return "EOF";	* =>		return "Unknown";	}} element(x: ref Parser): ref Parcel{	# <tag ...>	elemname := xmlname(x);	c: int;	if (elemname != "") {		attrs := buildattrs(x);		skipwhite(x);		c = getc(x);		isend := 0;		if (c == '/')			isend = 1;		else			ungetc(x);		expect(x, '>'); 		if (isend)			return ref Parcel.Empty(elemname, attrs);		else {			startelement(x, elemname);			return ref Parcel.Start(elemname, attrs);		}	# </tag>	} else if ((c = getc(x)) == '/') {		elemname = xmlname(x);		if (elemname != "") {			expect(x, '>');			endelement(x, elemname);			return ref Parcel.End(elemname);		}		else			error(x, sys->sprint("illegal beginning of tag: '%c'", c));	# <?tag ... ?>	} else if (c == '?') {		elemname = xmlname(x);		if (elemname != "") {			# this special case could be generalised if there were many			# processing instructions that took attributes like this.			if (elemname == "xml-stylesheet") {				attrs := buildattrs(x);				balancedstring(x, "?>");				return ref Parcel.Stylesheet(attrs);			} else {				data := balancedstring(x, "?>");				return ref Parcel.Process(elemname, data);			}		}	} else if (c == '!') {		c = getc(x);		case c {		'-' =>			# <!-- comment -->			if(getc(x) == '-'){				balancedstring(x, "-->");				return nil;			}		'[' =>			# <![CDATA[...]]			s := xmlname(x);			if(s == "CDATA" && getc(x) == '['){				data := balancedstring(x, "]]>");				return ref Parcel.Text(data, 0, 0);			}		* =>			# <!declaration			ungetc(x);			s := xmlname(x);			case s {			"DOCTYPE" =>				# <!DOCTYPE name (SYSTEM "filename" | PUBLIC "pubid" "uri"?)? ("[" decls "]")?>				skipwhite(x);				name := xmlname(x);				if(name == nil)					break;				id := "";				uri := "";				public := 0;				skipwhite(x);				case sort := xmlname(x) {				"SYSTEM" =>					id = xmlstring(x, 1);				"PUBLIC" =>					public = 1;					id = xmlstring(x, 1);					skipwhite(x);					c = getc(x);					ungetc(x);					if(c == '"' || c == '\'')						uri = xmlstring(x, 1);				* =>					error(x, sys->sprint("unknown DOCTYPE: %s", sort));					return nil;				}				skipwhite(x);				if(getc(x) == '['){					error(x, "cannot handle DOCTYPE with declarations");					return nil;				}				ungetc(x);				skipwhite(x);				if(getc(x) == '>')					return ref Parcel.Doctype(name, public, id :: uri :: nil);			"ELEMENT" or "ATTRLIST" or "NOTATION" or "ENTITY" =>				# don't interpret internal DTDs				# <!ENTITY name ("value" | SYSTEM "filename")>				s = gets(x, '>');				if(s == nil || s[len s-1] != '>')					error(x, "end of file in declaration");				return nil;			* =>				error(x, sys->sprint("unknown declaration: %s", s));			}		}		error(x, "invalid XML declaration");	} else		error(x, sys->sprint("illegal beginning of tag: %c", c));	return nil;} characters(x: ref Parser): ref Parcel{	p: ref Parcel;	content := gets(x, '<');	if (len content > 0) {		if (content[len content - 1] == '<') {			ungetc(x);			content = content[0:len content - 1];		}		ws1, ws2: int;		if (x.ispre) {			content = substituteentities(x, content);			ws1 = ws2 = 0;		} else			(content, ws1, ws2) = substituteentities_sp(x, content);		if (content != nil || ws1)			p = ref Parcel.Text(content, ws1, ws2);	}	return p;} startelement(x: ref Parser, name: string){	x.estack = name :: x.estack;	if (name == x.preelem)		x.ispre++;} endelement(x: ref Parser, name: string){	if (x.estack != nil && name == hd x.estack) {		x.estack = tl x.estack;		if (name == x.preelem)			x.ispre--;	} else {		starttag := "";		if (x.estack != nil)			starttag = hd x.estack;		warning(x, sys->sprint("<%s></%s> mismatch", starttag, name)); 		# invalid XML but try to recover anyway to reduce turnaround time on fixing errors.		# loop back up through the tag stack to see if there's a matching tag, in which case		# jump up in the stack to that, making some rude assumptions about the		# way Parcels are handled at the top level.		n := 0;		for (t := x.estack; t != nil; (t, n) = (tl t, n + 1))			if (hd t == name)				break;		if (t != nil) {			x.estack = tl t;			x.actdepth -= n;		}	}} buildattrs(x: ref Parser): Attributes{	attrs: list of Attribute; 	attr: Attribute;	for (;;) {		skipwhite(x);		attr.name = xmlname(x);		if (attr.name == nil)			break;		skipwhite(x);		c := getc(x);		if(c != '='){			ungetc(x);			attr.value = nil;		}else			attr.value = xmlstring(x, 1);		attrs = attr :: attrs;	}	return Attributes(attrs);} xmlstring(x: ref Parser, dosub: int): string{	skipwhite(x);	s := "";	delim := getc(x);	if (delim == '\"' || delim == '\'') {		s = gets(x, delim);		n := len s;		if (n == 0 || s[n-1] != delim)			error(x, "unclosed string at end of file");		s = s[0:n-1];	# TO DO: avoid copy		if(dosub)			s = substituteentities(x, s);	} else		error(x, sys->sprint("illegal string delimiter: %c", delim));	return s;} xmlname(x: ref Parser): string{	name := "";	ch := getc(x);	case ch {	'_' or ':' or	'a' to 'z' or	'A' to 'Z' or	16r100 to 16rd7ff or	16re000 or 16rfffd =>		name[0] = ch;

Lines 1–500 of 717. Load more