<* PRAGMA LL *>

MODULE DocVBT;

IMPORT Env, Fmt, FormsVBT, Rsrc, MyBundle, WSObjectVBT, VBT, Web, WebVBT,
       Thread, DeckVBT, WorkspaceVBT, FVTypes, SourceVBT, Text, TextList,
       FreeDocVBT, AnyEvent, Point, Rect, Options;

<* FATAL ANY *>

TYPE
  MyWebVBT = WebVBT.T OBJECT
    doc: T;
    fork: BOOLEAN;
    mu: MUTEX;
    cond: Thread.Condition;
    done: BOOLEAN;
  OVERRIDES
    hotlink := HotLink;
    ready := Ready;
  END;

REVEAL T = FormsVBT.T BRANDED OBJECT
    owner: WSObjectVBT.T := NIL;
    webvbt: MyWebVBT;
  OVERRIDES
    realize := Realize;
  END;

TYPE
  Source = FVTypes.FVSource OBJECT
    doc: T;
  OVERRIDES
    hit := Hit;
  END;

PROCEDURE Realize (doc: T; type, name: TEXT) : VBT.T
  RAISES {FormsVBT.Error} =
  BEGIN
    IF Text.Equal (name, "source") THEN
      RETURN NEW (Source, doc := doc)
    ELSE
      RETURN FormsVBT.T.realize (doc, type, name)
    END;
  END Realize;

PROCEDURE NewDoc (): T =
  VAR
    doc      := NEW(T);
    path     := Rsrc.BuildPath("$DeckScapePATH", MyBundle.Get());
    delete   := NEW(FormsVBT.Closure, apply := Delete);
    hotlist  := NEW(FormsVBT.Closure, apply := Hotlist);
    reparent := NEW(FormsVBT.Closure, apply := Reparent);
  BEGIN
    EVAL FormsVBT.T.initFromRsrc(doc, "Doc.fv", path, TRUE);
    FormsVBT.Attach(doc, "killButton", delete);
    FormsVBT.Attach(doc, "hotlistButton", hotlist);
    FormsVBT.Attach(doc, "source", reparent);
    doc.webvbt := NEW(MyWebVBT, doc:=doc).init();
    FormsVBT.PutGeneric(doc, "gen", doc.webvbt);
    RETURN doc;
  END NewDoc;

PROCEDURE NewFromPage (page: Web.Page; base: TEXT): T =
  VAR
    doc    := NewDoc();
    webvbt := doc.webvbt;
  BEGIN
    FormsVBT.PutText(doc, "docName", base);
    webvbt.fork := TRUE;
    webvbt.fromText(
      style := GetCurrentStyle(), zippers := GetCurrentZippers(),
      contents := page.contents, contentType := page.header.contentType,
      contentSubType := page.header.contentSubType, url := base);
    RETURN doc;
  END NewFromPage;

PROCEDURE NewFromURL (url: TEXT := NIL; reload := FALSE; fork := TRUE): T =
  VAR
    doc    := NewDoc();
    webvbt := doc.webvbt;
  BEGIN
    IF url = NIL THEN url := DefaultHomeURL END;
    FormsVBT.PutText(doc, "docName", url);
    webvbt.fork := fork;
    IF fork THEN
      webvbt.fetch(url, reload := reload, style := GetCurrentStyle(),
                   zippers := GetCurrentZippers());
    ELSE
      webvbt.mu := NEW(MUTEX);
      webvbt.cond := NEW(Thread.Condition);
      webvbt.done := FALSE;
      LOCK webvbt.mu DO
        webvbt.fetch(url, reload := reload, style := GetCurrentStyle(),
                     zippers := GetCurrentZippers());
        WHILE NOT webvbt.done DO Thread.Wait(webvbt.mu, webvbt.cond) END
      END
    END;
    RETURN doc;
  END NewFromURL;

PROCEDURE GetCurrentZippers (): BOOLEAN =
  BEGIN
    RETURN Options.zippers
  END GetCurrentZippers;

PROCEDURE GetCurrentStyle (): WebVBT.Style =
  BEGIN
    IF Options.fgImages THEN
      RETURN WebVBT.Style.Normal
    ELSE
      RETURN WebVBT.Style.Background
    END
  END GetCurrentStyle;

PROCEDURE Ready (w: MyWebVBT; ct: CARDINAL) =
  BEGIN
    IF NOT w.fork AND ct = 0 THEN
      LOCK w.mu DO w.done := TRUE; Thread.Broadcast(w.cond); END
    END
  END Ready;

PROCEDURE Copy (doc: T): T =
  BEGIN
    RETURN NewFromPage(doc.webvbt.page, doc.webvbt.url);
  END Copy;

PROCEDURE SetOwner (doc: T; owner: VBT.T) =
  BEGIN
    doc.owner := owner;
  END SetOwner;

PROCEDURE GetOwner (doc: T): VBT.T =
  BEGIN
    RETURN doc.owner
  END GetOwner;

PROCEDURE GetPage (doc: T): Web.Page =
  BEGIN
    RETURN doc.webvbt.page;
  END GetPage;

PROCEDURE GetTitle (doc: T): TEXT =
  BEGIN
    TYPECASE doc.webvbt.page OF
    | NULL => RETURN "fetching..."
    | WebVBT.HTMLPage (p) => RETURN p.html.title
    | WebVBT.ImagePage => RETURN "<image>"
    ELSE
      RETURN "<????>"
    END;
  END GetTitle;

PROCEDURE Hit (                      s     : Source;
                                     target: VBT.T;
               <* UNUSED *> READONLY cd    : VBT.PositionRec):
  BOOLEAN =
  VAR owner := s.doc.owner;
  BEGIN
    IF ISTYPE(owner, DeckVBT.T) THEN
      (* a DocVBT inside a DeckVBT can go into the Workspace
         and into a DeckVBT other than its owner *)
      IF ISTYPE(target, WorkspaceVBT.Target) THEN
        RETURN TRUE
      ELSE
        RETURN target # DeckVBT.GetTarget (owner)
      END
    ELSE
      (* a DocVBT inside a FreeDocVBT can go into any DeckVBT,
         but not into the Workspace *)
      RETURN ISTYPE (target, DeckVBT.Target)
    END
  END Hit;

PROCEDURE Reparent (<*UNUSED*> cl  : FormsVBT.Closure;
                               fv  : FormsVBT.T;
                    <*UNUSED*> name: TEXT;
                    <*UNUSED*> time: VBT.TimeStamp     ) =
  VAR
    doc    := NARROW(fv, T);
    source := NARROW(FormsVBT.GetVBT(fv, "source"), Source);
    target := SourceVBT.GetTarget(source);
    owner  := source.doc.owner;
    newDeck   : DeckVBT.T;
    newFreeDoc: FreeDocVBT.T;
  BEGIN
    TYPECASE owner OF
    | DeckVBT.T (deck) =>
        (* a DocVBT in a DeckVBT; the target is either a
           Workspace or a DeckVBT *)
        IF ISTYPE(target, WorkspaceVBT.Target) THEN
          DeckVBT.RemDoc(deck, doc);
          newFreeDoc :=
            FreeDocVBT.New(DeckVBT.GetTitle(deck) & " [DOC]");
          VAR dom := VBT.Domain(deck);
              nw := LocateMouse(fv);
              hor := Rect.HorSize(dom);
              ver := Rect.VerSize(dom);
              r := Rect.FromEdges (nw.h, nw.h+hor, nw.v, nw.v+ver);
          BEGIN
            WorkspaceVBT.AddFreeDoc(deck.getWorkspace(), newFreeDoc, r);
          END;
          DeckVBT.AddFreeDoc(deck, newFreeDoc);
          FreeDocVBT.AddDoc(newFreeDoc, doc);
        ELSE
          DeckVBT.RemDoc(deck, doc);
          newDeck := NARROW(target, DeckVBT.Target).deck;
          DeckVBT.AddDoc(newDeck, doc);
        END
    | FreeDocVBT.T (freeDoc) =>
        (* a DocVBT in a FreeDocVBT; the target must be a
           DeckVBT *)
        FreeDocVBT.RemDoc(freeDoc, doc);
        newDeck := NARROW(target, DeckVBT.Target).deck;
        DeckVBT.AddDoc(newDeck, doc);
    ELSE                         <* ASSERT FALSE *>
    END;
  END Reparent;

PROCEDURE LocateMouse (fv: FormsVBT.T): Point.T =
  BEGIN
    TYPECASE FormsVBT.GetTheEvent(fv) OF
    | AnyEvent.Mouse (m) =>
        WITH cp = m.mouse.cp DO
          IF NOT cp.offScreen THEN RETURN cp.pt END
        END
    ELSE
    END;
    RETURN Point.Origin
  END LocateMouse;

PROCEDURE Delete (<*UNUSED*> cl  : FormsVBT.Closure;
                             fv  : FormsVBT.T;
                  <*UNUSED*> name: TEXT;
                  <*UNUSED*> time: VBT.TimeStamp     ) =
  VAR doc: T := fv;
  BEGIN
    doc.owner.remDoc(doc);
  END Delete;

PROCEDURE Hotlist (<*UNUSED*> cl  : FormsVBT.Closure;
                              fv  : FormsVBT.T;
                   <*UNUSED*> name: TEXT;
                   <*UNUSED*> time: VBT.TimeStamp     ) =
  VAR doc: T := fv;
       ws: WorkspaceVBT.T := doc.owner.getWorkspace();
  BEGIN
    DeckVBT.AddDoc(ws.hotlist, Copy(doc));
  END Hotlist;

PROCEDURE Search (doc: T; text: TEXT): BOOLEAN =
  BEGIN
    RETURN doc.webvbt.search(text)
  END Search;

PROCEDURE Reload (doc: T): T =
  BEGIN
    RETURN NewFromURL(doc.webvbt.url, reload := TRUE)
  END Reload;

TYPE
  Link = REF RECORD
    label, url: TEXT;
    next: Link;
  END;

TYPE
  ExpandClosure = Thread.Closure OBJECT
                    (* READONLY by threads: *)
                    doc     : T;
                    deck    : DeckVBT.T;
                    numLinks: INTEGER;
                    (* protected by mu: *)
                    mu   : MUTEX;
                    links: TextList.T;  (* NIL'd once processed *)
                  OVERRIDES
                    apply := DoExpand;
                  END;

PROCEDURE Expand (doc: T): VBT.T =
  VAR
    links := doc.webvbt.getLinks();
    l     := links;
    ct    := 0;
    mu    := NEW(MUTEX);
  BEGIN
    WHILE l # NIL DO INC(ct); l := l.tail END;
    WITH deck = DeckVBT.New("Expanding " & Fmt.Int(ct) & " links") DO
      LOCK mu DO
        FOR th := 1 TO NumberOfExpansionThreads DO
          EVAL Thread.Fork(NEW(ExpandClosure, doc := doc, deck := deck,
                               numLinks := ct, mu := mu, links := links));
        END
      END;
      RETURN deck
    END
  END Expand;

PROCEDURE DoExpand (cl: ExpandClosure): REFANY =
  VAR
    doc   := cl.doc;
    deck  := cl.deck;
    links := cl.links;
  VAR
    l     : TextList.T;
    url   : TEXT;
    newURL: TEXT;
    newDoc: T;
  BEGIN
    LOOP
      LOCK cl.mu DO
        l := links;
        WHILE l # NIL AND l.head = NIL DO l := l.tail END;
        IF l = NIL THEN EXIT END;
        url := l.head;
        l.head := NIL;
      END;
      newURL := Web.AbsoluteURL(url, doc.webvbt.url);
      newDoc := NewFromURL(newURL, fork := FALSE);
      LOCK VBT.mu DO DeckVBT.AddDoc(deck, newDoc, FALSE) END
    END;
    LOCK VBT.mu DO DeckVBT.SetTitle(deck, "Expanded"); END;
    RETURN NIL;
  END DoExpand;

PROCEDURE HotLink (w: MyWebVBT; url: TEXT; READONLY cd: VBT.MouseRec) =
  VAR
    expandedURL    := Web.AbsoluteURL(url, w.url);
    newDoc     : T;
  BEGIN
    IF VBT.Modifier.Control IN cd.modifiers THEN
      VAR
        deck    := WhichDeck(w.doc);
        docList := DeckVBT.DocList(deck, includeFreeDocs := FALSE);
      BEGIN
        WHILE docList # NIL DO
          VAR doc: T := docList.head;
          BEGIN
            IF Text.Equal(expandedURL, doc.webvbt.url) THEN
              DeckVBT.SetTopDoc(deck, DeckVBT.IndexOfDoc(deck, doc));
              RETURN
            END
          END;
          docList := docList.tail
        END
      END
    END;
    newDoc := NewFromURL(expandedURL);
    w.doc.owner.addDoc(newDoc);
  END HotLink;

PROCEDURE WhichDeck (doc: T): DeckVBT.T =
  VAR owner := doc.owner;
  BEGIN
    IF ISTYPE (owner, DeckVBT.T) THEN
      RETURN owner
    ELSIF ISTYPE (owner, FreeDocVBT.T) THEN
      RETURN FreeDocVBT.GetDeck (owner)
    ELSE <* ASSERT FALSE *>
    END
  END WhichDeck;

BEGIN
  DefaultHomeURL := Env.Get("WWW_HOME");
  IF DefaultHomeURL = NIL OR Text.Empty(DefaultHomeURL) THEN
      DefaultHomeURL := "https://www.research.digital.com/"
  END;
END DocVBT.