<* PRAGMA LL *> MODULE; IMPORT CIText, Filter, Fmt, Font, HTML, HTMLVBT, HTMLVBTText, HTMLVBTG, Images, MultiClass, MultiSplit, Pixmap, PixmapVBT, Point, RefList, SimpleWeb, Split, TextExtras, TextList, TextEditVBT, TextPort, TextureVBT, TextVBT, Thread, URLCache, VBT, Web, Image, Rd, TextRd, PaintOp; REVEAL Private = Filter.T BRANDED OBJECT END; REVEAL T = Public BRANDED OBJECT <* LL=VBT.mu *> t: Thread.T := NIL; OVERRIDES init := Init; fetch := Fetch; fromText := FromText; stop := Stop; getLinks := GetLinks; search := Search; ready := Ready; hotlink := Hotlink; isindex := Isindex; ismap := Ismap; form := Form; END; PROCEDURE WebVBT Init (v: T): T = BEGIN RETURN Filter.T.init(v, TextureVBT.New(txt:=Pixmap.Gray)) END Init; PROCEDUREFromText (v : T; contents : TEXT; contentType : Web.MIMEType := Web.MIMEType.Text; contentSubType: TEXT := "html"; url : TEXT := "text:"; style : Style := Style.Normal; zippers : BOOLEAN := FALSE; reload : BOOLEAN := FALSE; server : Web.T := NIL; scrollBar : BOOLEAN := TRUE) = VAR webpage := NEW(Web.Page); BEGIN v.stop(); webpage.header.contentType := contentType; webpage.header.contentSubType := contentSubType; webpage.header.location := url; webpage.contents := contents; v.t := Thread.Fork(NEW(FromTextClosure, v := v, webpage := webpage, url := url, style := style, zippers := zippers, reload := reload, server := server, scrollBar := scrollBar)) END FromText; TYPE Closure = Thread.Closure OBJECT v : T; style : Style; zippers : BOOLEAN; reload : BOOLEAN; server : Web.T; scrollBar: BOOLEAN; END; TYPE FromTextClosure = Closure OBJECT webpage : Web.Page; url : TEXT; OVERRIDES apply := FromTextWrapper; END; PROCEDUREFromTextWrapper (cl: FromTextClosure): REFANY = BEGIN Display(cl.webpage, cl.v, cl.url, cl.style, cl.zippers, cl.reload, cl.server, cl.scrollBar); RETURN NIL END FromTextWrapper; PROCEDUREFetch (v : T; url : TEXT; style : Style := Style.Normal; zippers : BOOLEAN := FALSE; reload : BOOLEAN := FALSE; server : Web.T := NIL; scrollBar: BOOLEAN := TRUE) = BEGIN v.stop(); v.t := Thread.Fork( NEW(FetchClosure, v := v, url := url, style := style, zippers := zippers, reload := reload, server := server, scrollBar := scrollBar)) END Fetch; TYPE FetchClosure = Closure OBJECT url : TEXT; OVERRIDES apply := FetchWrapper; END; PROCEDUREFetchWrapper (cl: FetchClosure): REFANY = VAR webpage: Web.Page; base: TEXT; BEGIN TRY webpage := SimpleWeb.Fetch(cl.url, reload := cl.reload, server := cl.server); base := webpage.header.location; (* SimpleWeb.Fetch always fills in header.location *) Display(webpage, cl.v, base, cl.style, cl.zippers, cl.reload, cl.server, cl.scrollBar); EXCEPT Thread.Alerted => END; RETURN NIL END FetchWrapper; CONST FontName = "-*-fixed-medium-r-semicondensed-*-*-120-*-*-*-*-iso8859-1"; PROCEDUREDisplay (webpage : Web.Page; v : T; base : TEXT; style : Style; zippers : BOOLEAN; reload : BOOLEAN; server : Web.T; scrollBar: BOOLEAN) = PROCEDURE NewTextPage (t: TEXT) RAISES {Thread.Alerted} = VAR page := NEW(TextPage); BEGIN page.vbt := NEW(TextEditVBT.T).init(); WITH tp = page.vbt.tp DO TextPort.SetText(tp, t); tp.setReadOnly(TRUE); tp.setFont(Font.FromName(ARRAY OF TEXT{FontName})); END; NewPage(page, page.vbt) END NewTextPage; PROCEDURE NewHTMLPage (h: HTML.T) RAISES {Thread.Alerted} = VAR page := NEW(HTMLPage); toLoad: RefList.T; BEGIN IF h.base = NIL THEN h.base := base END; page.html := h; URLCache.PutHTML (base, h); CASE style OF | Style.Ugly => page.vbt := NEW(TextHTMLVBT, parent := v).init(page.html); NewPage(page, page.vbt); | Style.NoImages => page.vbt := NEW(GraphicsHTMLVBT, parent := v).init( page.html, TRUE, zippers, toLoad, scrollBar); NewPage(page, page.vbt); | Style.Normal => page.vbt := NEW(GraphicsHTMLVBT, parent := v).init( page.html, FALSE, zippers, toLoad, scrollBar); LoadResources(v, reload, server, toLoad, FALSE); NewPage(page, page.vbt); | Style.Background => page.vbt := NEW(GraphicsHTMLVBT, parent := v).init( page.html, FALSE, zippers, toLoad, scrollBar); NewPage(page, page.vbt, RefList.Length(toLoad)); LoadResources(v, reload, server, toLoad, TRUE); END; END NewHTMLPage; PROCEDURE NewImagePage (pm: Pixmap.T) RAISES {Thread.Alerted} = VAR page := NEW(ImagePage); (* op := PaintOp.BgFg; *) op := PaintOp.Copy; BEGIN page.vbt := NEW(PixmapVBT.T).init(pm, op := op); NewPage(page, page.vbt); END NewImagePage; PROCEDURE NewPage (page: Page; vbt: VBT.T; imageCt := 0) RAISES {Thread.Alerted} = BEGIN LOCK VBT.mu DO IF Thread.TestAlert() THEN RAISE Thread.Alerted END; IF v.t # Thread.Self() THEN RETURN END; EVAL Filter.Replace(v, vbt); page.header := webpage.header; page.contents := webpage.contents; v.url := base; v.page := page; v.ready(imageCt); END END NewPage; BEGIN TRY WITH hdr = webpage.header, stuff = webpage.contents DO IF hdr.contentType = Web.MIMEType.Text THEN IF CIText.Equal(hdr.contentSubType, "html") THEN NewHTMLPage(HTML.FromRd(TextRd.New(stuff))) ELSE NewTextPage(stuff); END; ELSIF hdr.contentType = Web.MIMEType.Image THEN TRY IF CIText.Equal(hdr.contentSubType, "jpeg") THEN NewImagePage(Images.FromJPEG(stuff)); ELSIF CIText.Equal(hdr.contentSubType, "gif") THEN NewImagePage(Images.FromGIF(stuff)) ELSIF CIText.Equal(hdr.contentSubType, "ppm") OR CIText.Equal(hdr.contentSubType, "pnm") OR CIText.Equal(hdr.contentSubType, "pbm") OR CIText.Equal(hdr.contentSubType, "pgm") THEN WITH rd = TextRd.New(stuff) DO NewImagePage(Image.Unscaled(Image.FromRd(rd))); END; ELSE NewTextPage("cannot handle '" & hdr.contentSubType & "'"); END EXCEPT Rd.Failure, Image.Error, Images.Error => NewTextPage("cannot display image"); END END END EXCEPT Thread.Alerted => END END Display; PROCEDURELoadResources (v : T; reload : BOOLEAN; server : Web.T; list : RefList.T; callReadyMethod: BOOLEAN ) RAISES {Thread.Alerted} = VAR ct : INTEGER; info: HTMLVBTG.Info; page: Web.Page; BEGIN ct := RefList.Length(list); WHILE list # NIL DO info := list.head; page := SimpleWeb.Fetch(info.url, reload := reload, server := server); info.load(page); DEC(ct); IF callReadyMethod THEN InvokeReadyMethod(v, ct) END; list := list.tail; END; IF callReadyMethod THEN InvokeReadyMethod(v, 0) END; END LoadResources; PROCEDUREInvokeReadyMethod (v: T; arg: INTEGER) RAISES {Thread.Alerted} = BEGIN LOCK VBT.mu DO IF Thread.TestAlert() THEN RAISE Thread.Alerted END; IF v.t # Thread.Self() THEN RETURN END; v.ready(arg) END; END InvokeReadyMethod; TYPE GraphicsHTMLVBT = HTMLVBTG.T OBJECT parent: T; OVERRIDES hotlink := HTMLVBTHotlink; ismap := HTMLVBTIsmap; isindex := HTMLVBTIsindex; END; TYPE TextHTMLVBT = HTMLVBTText.T OBJECT parent: T; OVERRIDES hotlink := HTMLVBTHotlink; ismap := HTMLVBTIsmap; isindex := HTMLVBTIsindex; END; PROCEDUREHTMLVBTHotlink ( ch : HTMLVBT.T; url: TEXT; READONLY cd : VBT.MouseRec) = BEGIN TYPECASE ch OF | GraphicsHTMLVBT (v) => v.parent.hotlink(url, cd) ELSE END END HTMLVBTHotlink; PROCEDUREHTMLVBTIsmap ( ch : HTMLVBT.T; url: TEXT; READONLY pt : Point.T; READONLY cd : VBT.MouseRec) = BEGIN TYPECASE ch OF | GraphicsHTMLVBT (v) => v.parent.ismap(url & "?" & Fmt.Int(pt.h) & "," & Fmt.Int(pt.v), cd) ELSE END END HTMLVBTIsmap; PROCEDUREHTMLVBTIsindex (ch: HTMLVBT.T; typein: TEXT) = VAR p: T; BEGIN TYPECASE ch OF | GraphicsHTMLVBT (v) => p := v.parent; | TextHTMLVBT (v) => p := v.parent; ELSE <* ASSERT FALSE *> END; p.isindex(p.url & "?" & typein); END HTMLVBTIsindex; PROCEDUREStop (self: T) = BEGIN IF self.t # NIL THEN Thread.Alert(self.t) END END Stop; PROCEDUREHotlink (<* UNUSED *> self: T; <* UNUSED *> link: TEXT; <* UNUSED *> READONLY cd: VBT.MouseRec) = BEGIN END Hotlink; PROCEDUREIsindex (<* UNUSED *> self: T; <* UNUSED *> typein: TEXT) = BEGIN END Isindex; PROCEDUREIsmap (<* UNUSED *> self : T; <* UNUSED *> absURL: TEXT; <* UNUSED *> READONLY cd : VBT.MouseRec) = BEGIN END Ismap; PROCEDUREForm (<* UNUSED *> self: T) = BEGIN END Form; PROCEDUREReady (<* UNUSED *> self: T; <* UNUSED *> remImages: CARDINAL) = BEGIN END Ready; PROCEDUREGetLinks (self: T): TextList.T = BEGIN TYPECASE self.page OF | NULL => | HTMLPage (h) => RETURN HTML.GetLinks(h.html) ELSE END; RETURN NIL END GetLinks; PROCEDURESearch (self: T; pattern: TEXT): BOOLEAN = BEGIN TYPECASE self.page OF | NULL => | TextPage (t) => RETURN SearchVBTTree(t.vbt, pattern) | HTMLPage (h) => RETURN SearchVBTTree(h.vbt, pattern) ELSE END; RETURN FALSE END Search; PROCEDURESearchVBTTree (v: VBT.T; pattern: TEXT): BOOLEAN = <* FATAL MultiSplit.NotAChild *> BEGIN TYPECASE v OF | TextVBT.T (textvbt) => WITH text = TextVBT.Get(textvbt) DO RETURN TextSearch(text, pattern) END; | TextPort.T (textport) => WITH text = TextPort.GetText(textport) DO RETURN TextSearch(text, pattern) END ELSE IF MultiClass.Resolve(v) # NIL OR ISTYPE(v, Split.T) THEN VAR ch := MultiSplit.Succ(v, NIL); BEGIN WHILE ch # NIL DO IF SearchVBTTree(ch, pattern) THEN RETURN TRUE ELSE ch := MultiSplit.Succ(v, ch) END END; RETURN FALSE END ELSE RETURN FALSE END END; END SearchVBTTree; PROCEDURETextSearch (text, pattern: TEXT): BOOLEAN = VAR index: CARDINAL := 0; BEGIN RETURN TextExtras.FindSub(text, pattern, index) END TextSearch; BEGIN END WebVBT.