MODULE StdLinks;
(**

   project   = "BlackBox"
   organization   = "www.oberon.ch"
   contributors   = "Oberon microsystems"
   version   = "System/Rsrc/About"
   copyright   = "System/Rsrc/About"
   license   = "Docu/BB-License"
   changes   = ""
   issues   = ""

**)

   IMPORT Kernel, Services,

      Stores, Ports, Fonts,Models, Views, Controllers, Properties, Dialog, Containers,
      TextModels, TextMappers, TextViews, TextControllers, TextSetters, TextRulers,
      Strings, StdCmds;
   CONST

      kind* = 0; cmd* = 1; close* = 2;   (* constants for Prop.valid *)
      always* = 0; ifShiftDown* = 1; never* = 2;   (* constants for close attrubute *)
      minLinkVersion = 0; maxLinkVersion = 1;
      minTargVersion = 0; maxTargVersion = 0;
   TYPE

      Directory* = POINTER TO ABSTRACT RECORD END;
      Link* = POINTER TO RECORD (Views.View)

         leftSide-: BOOLEAN;
         cmd: POINTER TO ARRAY OF CHAR;
         close: INTEGER
      END;
      Target* = POINTER TO RECORD (Views.View)

         leftSide-: BOOLEAN;
         ident: POINTER TO ARRAY OF CHAR
      END;
      Prop* = POINTER TO RECORD (Properties.Property)

         cmd*: POINTER TO ARRAY OF CHAR;
         link-: BOOLEAN;
         close*: INTEGER
      END;
      
      ChangeAttrOp = POINTER TO RECORD (Stores.Operation)
         v: Views.View;
         cmd: POINTER TO ARRAY OF CHAR;
         close: INTEGER;
         valid: SET
      END;
      
      StdDirectory = POINTER TO RECORD (Directory) END;
      TrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner) END;

   VAR

      dir-, stdDir-: Directory;
      par-: Link;
      iconFont: Fonts.Typeface;
      linkLeft, linkRight, targetLeft, targetRight: ARRAY 8 OF SHORTCHAR;
      coloredBackg: BOOLEAN;
      
      cleaner: TrapCleaner;
      dialog*: RECORD

         cmd*: ARRAY 512 OF CHAR;
         type-: ARRAY 32 OF CHAR;
         close*: Dialog.List;
         known, valid: SET;
      END;
      fingerprint: INTEGER;
   (** Cleaner **)

   PROCEDURE (c: TrapCleaner) Cleanup;

   BEGIN
      par := NIL
   END Cleanup;
   (** Properties **)

   PROCEDURE (p: Prop) IntersectWith* (q: Properties.Property; OUT equal: BOOLEAN);

      VAR valid: SET;
   BEGIN
      WITH q: Prop DO
         valid := p.valid * q.valid; equal := TRUE;
         IF (cmd IN valid) & (p.cmd^ # q.cmd^) THEN EXCL(valid, cmd) END;
         IF (kind IN valid) & (p.link # q.link) THEN EXCL(valid, kind) END;
         IF (close IN valid) & (p.close # q.close) THEN EXCL (valid, close) END;
         IF p.valid # valid THEN p.valid := valid; equal := FALSE END
      END
   END IntersectWith;
      
   PROCEDURE (op: ChangeAttrOp) Do;
      VAR v: Views.View; s: POINTER TO ARRAY OF CHAR; c: INTEGER;
   BEGIN
      v := op.v;
      WITH
      | v: Link DO
         IF cmd IN op.valid THEN s := op.cmd; op.cmd := v.cmd; v.cmd := s END;
         IF close IN op.valid THEN c := op.close; op.close := v.close; v.close := c END
      | v: Target DO
         IF cmd IN op.valid THEN s := op.cmd; op.cmd := v.ident; v.ident := s END
      END
   END Do;
   PROCEDURE DoChangeAttrOp (v: Views.View; s: POINTER TO ARRAY OF CHAR; c: INTEGER; valid: SET);

      VAR op: ChangeAttrOp;
   BEGIN
      NEW(op); op.v := v; op.valid := valid;
      IF close IN valid THEN
      op.close := c END;
      IF cmd IN valid THEN NEW(op.cmd, LEN(s)+1); op.cmd^ := s$ END;
      Views.Do(v,"#Std:LinkChange", op)
   END DoChangeAttrOp;
   
   PROCEDURE SetProp(v: Views.View; msg: Properties.SetMsg);
      VAR p: Properties.Property;
    BEGIN
      p := msg.prop;
      WHILE p # NIL DO
         WITH p: Prop DO
            IF (cmd IN p.valid) OR (close IN p.valid) THEN DoChangeAttrOp(v, p.cmd, p.close, p.valid) END
         ELSE
         END;
         p := p.next
      END
   END SetProp;
   
   PROCEDURE PollProp(v: Views.View; VAR msg: Properties.PollMsg);
      VAR p: Prop;
   BEGIN
      NEW(p);   
      WITH v: Link DO
         p.known := {kind, cmd, close};
         p.link := TRUE;
         p.cmd := v.cmd;
         p.close := v.close
      | v: Target DO
         p.known := {kind, cmd};
         p.link := FALSE;
         p.cmd := v.ident
      ELSE
      END;
      p.valid := p.known;
      Properties.Insert(msg.prop, p)
   END PollProp;
   
   PROCEDURE InitDialog*;
      VARp: Properties.Property;
   BEGIN
      dialog.cmd := ""; dialog.type := ""; dialog.close.index := -1;
      dialog.known := {}; dialog.valid := {};
      Properties.CollectProp(p);
      WHILE p # NIL DO
         WITH p: Prop DO
            dialog.valid := p.valid; dialog.known := p.known;
            IF cmd IN p.valid THEN
               dialog.cmd := p.cmd$
            END;
            IF kind IN p.valid THEN
               IF p.link THEN Dialog.MapString("#Std:Link", dialog.type)
               ELSE Dialog.MapString("#Std:Target", dialog.type)
               END
            END;
            IF close IN p.valid THEN
               dialog.close.index := p.close
            END
         ELSE
         END;
         p := p.next
      END;
      Dialog.Update(dialog)
   END InitDialog;
   
   PROCEDURE Set*;
      VAR p: Prop;
   BEGIN
      NEW(p);
      p.valid := dialog.valid;
      IF cmd IN p.valid THEN
         NEW(p.cmd, LEN(dialog.cmd) + 1);
         p.cmd^ := dialog.cmd$
      END;
      p.close := dialog.close.index;
      Properties.EmitProp(NIL, p);
      fingerprint := 0   (* force actualization of fields *)
   END Set;
   
   PROCEDURE CmdGuard* (VAR par: Dialog.Par);
      VAR c: Containers.Controller; v: Views.View; fp: INTEGER;
   BEGIN
      IF ~(cmd IN dialog.known) THEN par.disabled := TRUE
      ELSIF ~(cmd IN dialog.valid) THEN par.undef := TRUE
      END;
      Controllers.SetCurrentPath(Controllers.targetPath);
      fp := 0;
      c := Containers.Focus();
      IF c # NIL THEN
         c.GetFirstView(Containers.selection, v);
         WHILE v # NIL DO fp := fp + Services.AdrOf(v); c.GetNextView(TRUE, v) END
      END;
      IF fp # fingerprint THEN fingerprint := fp; InitDialog END;
      Controllers.ResetCurrentPath()
   END CmdGuard;
   
   PROCEDURE CloseGuard* (VAR par: Dialog.Par);
   BEGIN
      IF ~(close IN dialog.known) THEN par.disabled := TRUE
      ELSIF ~(close IN dialog.valid) THEN par.undef := TRUE
      END;
   END CloseGuard;
   
   PROCEDURE Notifier* (idx, op, from, to: INTEGER);
   BEGIN
      IF op = Dialog.changed THEN INCL(dialog.valid, idx) END
   END Notifier;
   PROCEDURE (d: Directory) NewLink* (IN cmd: ARRAY OF CHAR): Link, NEW, ABSTRACT;

   PROCEDURE (d: Directory) NewTarget* (IN ident: ARRAY OF CHAR): Target, NEW, ABSTRACT;
   PROCEDURE InFrame (f: Views.Frame; x, y: INTEGER): BOOLEAN;


   BEGIN
      RETURN (f.l <= x) & (x < f.r) & (f.t <= y) & (y < f.b)
   END InFrame;
   PROCEDURE Mark (f: Views.Frame; show: BOOLEAN);

   BEGIN
      f.MarkRect(f.l, f.t, f.r, f.b, Ports.fill, Ports.hilite, show)
   END Mark;
   PROCEDURE ThisPos (v: TextViews.View; f: Views.Frame; x, y: INTEGER): INTEGER;

      (* "corrected" v.ThisPos: does not adjust position when crossing 50% boundary of characters *)
      VAR loc: TextViews.Location; pos: INTEGER;
   BEGIN
      pos := v.ThisPos(f, x, y); v.GetThisLocation(f, pos, loc);
      IF (loc.y <= y) & (y < loc.y + loc.asc + loc.dsc) & (x < loc.x) THEN DEC(pos) END;
      RETURN pos
   END ThisPos;
   PROCEDURE GetLinkPair (this: Link; VAR l, r: Link);

      (* POST: BalancedPair(l, r) & (l # r) & (l = this OR r = this) OR(l = r = NIL) *)
      VAR t: TextModels.Model; rd: TextModels.Reader; v: Views.View; level: INTEGER;
   BEGIN
      l := NIL; r := NIL; level := 1;
      IF (this.context # NIL) & (this.context IS TextModels.Context) THEN
         t := this.context(TextModels.Context).ThisModel();
         rd := t.NewReader(NIL);
         IF this.leftSide THEN
            rd.SetPos(this.context(TextModels.Context).Pos() + 1);
            REPEAT
               rd.ReadView(v);
               IF (v # NIL) & (v IS Link) THEN
                  IF v(Link).leftSide THEN INC(level) ELSE DEC(level) END
               END
            UNTIL (v = NIL) OR (level = 0);
            IF v # NIL THEN l := this; r := v(Link) END
         ELSE
            rd.SetPos(this.context(TextModels.Context).Pos());
            REPEAT
               rd.ReadPrevView(v);
               IF (v # NIL) & (v IS Link) THEN
                  IF v(Link).leftSide THEN DEC(level) ELSE INC(level) END
               END
            UNTIL (v = NIL) OR (level = 0);
            IF v # NIL THEN l := v(Link); r := this END
         END
      END
   END GetLinkPair;
   PROCEDURE GetTargetPair (this: Target; VAR l, r: Target);

      (* POST: BalancedPair(l, r) & (l # r) & (l = this OR r = this) OR(l = r = NIL) *)
      VAR t: TextModels.Model; rd: TextModels.Reader; v: Views.View; level: INTEGER;
   BEGIN
      l := NIL; r := NIL; level := 1;
      IF (this.context # NIL) & (this.context IS TextModels.Context) THEN
         t := this.context(TextModels.Context).ThisModel();
         rd := t.NewReader(NIL);
         IF this.leftSide THEN
            rd.SetPos(this.context(TextModels.Context).Pos() + 1);
            REPEAT
               rd.ReadView(v);
               IF (v # NIL) & (v IS Target) THEN
                  IF v(Target).leftSide THEN INC(level) ELSE DEC(level) END
               END
            UNTIL (v = NIL) OR (level = 0);
            IF v # NIL THEN l := this; r := v(Target) END
         ELSE
            rd.SetPos(this.context(TextModels.Context).Pos());
            REPEAT
               rd.ReadPrevView(v);
               IF (v # NIL) & (v IS Target) THEN
                  IF v(Target).leftSide THEN DEC(level) ELSE INC(level) END
               END
            UNTIL (v = NIL) OR (level = 0);
            IF v # NIL THEN l := v(Target); r := this END
         END
      END
   END GetTargetPair;
   PROCEDURE GetRange (l, r: Link; VAR beg, end: INTEGER);

   BEGIN
      beg := l.context(TextModels.Context).Pos();
      end := r.context(TextModels.Context).Pos() + 1
   END GetRange;
   PROCEDURE MarkRange (v: TextViews.View; f: Views.Frame; beg, end: INTEGER; show: BOOLEAN);

      VAR b, e: TextViews.Location; r, t: INTEGER;
   BEGIN
      ASSERT(beg < end, 20);
      v.GetThisLocation(f, beg, b); v.GetThisLocation(f, end, e);
      IF (b.pos < e.pos) OR (b.pos = e.pos) & (b.x < e.x) THEN
         IF b.start # e.start THEN
            r := f.r; t := b.y + b.asc + b.dsc;
            f.MarkRect(b.x, b.y, r, t, Ports.fill, Ports.hilite, show);
            IF t < e.y THEN f.MarkRect(0, t, r, e.y, Ports.fill, Ports.hilite, show) END;
            b.x := f.l; b.y := e.y
         END;
      f.MarkRect(b.x, b.y, e.x, e.y + e.asc + e.dsc, Ports.fill, Ports.hilite, show)
      END
   END MarkRange;
   PROCEDURE Reveal (left, right: Views.View; str: ARRAY OF CHAR; opname: Stores.OpName);

      VAR con: TextModels.Context; t: TextModels.Model; pos: INTEGER;
         w: TextMappers.Formatter; op: Stores.Operation;
   BEGIN
      con := left.context(TextModels.Context);
      t := con.ThisModel(); pos := con.Pos();
      w.ConnectTo(t); w.SetPos(pos);
      IF con.Attr() # NIL THEN w.rider.SetAttr(con.Attr()) END;
      Models.BeginScript(t, opname, op);
      t.Delete(pos, pos + 1);
      w.WriteChar("<");
      IF str # "" THEN w.WriteString(str) END;
      w.WriteChar(">");
      con := right.context(TextModels.Context);
      pos := con.Pos();
      w.SetPos(pos);
      IF con.Attr() # NIL THEN w.rider.SetAttr(con.Attr()) END;
      t.Delete(pos, pos + 1);
      w.WriteString("<>");
      Models.EndScript(t, op)
   END Reveal;
   
   PROCEDURE RevealCmd (v: Link);
      VAR left, right: Link;
   BEGIN GetLinkPair(v, left, right);
      IF left # NIL THEN
         IF v.cmd # NIL THEN Reveal(left, right, v.cmd^, "#StdLinks:Reveal Link Command")
         ELSE Reveal(left, right, "", "#StdLinks:Reveal Link Command")
         END
      END
   END RevealCmd;
   PROCEDURE RevealTarget (targ: Target);

      VARleft, right: Target;
   BEGIN GetTargetPair(targ, left, right);
      IF left # NIL THEN
         IF left.ident # NIL THEN Reveal(left, right, left.ident^, "#SdtLinks:Reveal Target Ident")
         ELSE Reveal(left, right, "", "#SdtLinks:Reveal Target Ident")
         END
      END
   END RevealTarget;
   
   PROCEDURE CallCmd (v: Link; close: BOOLEAN);
      VAR res: INTEGER;
   BEGIN
      Kernel.PushTrapCleaner(cleaner);
      par := v;
      IF v.cmd^ # "" THEN
         IF close & (v.close = ifShiftDown) OR (v.close = always) THEN
            StdCmds.CloseDialog
         END;
         Dialog.Call(v.cmd^, "#StdLinks:Link Call Failed", res)
      END;
      par := NIL;
      Kernel.PopTrapCleaner(cleaner)
   END CallCmd;
   PROCEDURE TrackSingle (f: Views.Frame; VAR in: BOOLEAN);

      VAR x, y: INTEGER; modifiers: SET; in0, isDown: BOOLEAN;
   BEGIN
      in := FALSE;
      REPEAT
         f.Input(x, y, modifiers, isDown);
         in0 := in; in := InFrame(f, x, y);
         IF in # in0 THEN Mark(f, in) END
      UNTIL ~isDown;
      IF in THEN Mark(f, FALSE) END
   END TrackSingle;
   PROCEDURE TrackRange (v: TextViews.View; f: Views.Frame; l, r: Link; x, y: INTEGER;

                                    VAR in: BOOLEAN);
      VAR pos, beg, end: INTEGER; modifiers: SET; in0, isDown: BOOLEAN;
   BEGIN
      in := FALSE;
      GetRange(l, r, beg, end); pos := ThisPos(v, f, x, y);
      IF (beg <= pos) & (pos < end) THEN
         REPEAT
            f.Input(x, y, modifiers, isDown); pos := ThisPos(v, f, x, y);
            in0 := in; in := (beg <= pos) & (pos < end);
            IF in # in0 THEN MarkRange(v, f, beg, end, in) END
         UNTIL ~isDown;
         IF in THEN
            MarkRange(v, f, beg, end, FALSE)
         END
      END
   END TrackRange;
   PROCEDURE Track (v: Link; f: Views.Frame; c: TextControllers.Controller;

                           x, y: INTEGER; modifiers: SET);
   (* PRE: (c # NIL) & (f.view.ThisModel() = v.context.ThisModel())OR(c = NIL) & (f.view = v) *)
      VAR l, r: Link; in: BOOLEAN;
   BEGIN
      GetLinkPair(v, l, r);
      IF l # NIL THEN
         IF c # NIL THEN TrackRange(c.view, f, l, r, x, y, in)
         ELSE TrackSingle(f, in)
         END;
         IF in THEN
            IF (Controllers.modify IN modifiers) & ((c = NIL) OR ~(Containers.noCaret IN c.opts)) THEN
               RevealCmd(l)
            ELSE
               CallCmd(l, Controllers.extend IN modifiers)
            END
         END
      END
   END Track;
   PROCEDURE TrackTarget (targ: Target; f: Views.Frame; modifiers: SET);

      VAR in: BOOLEAN;
   BEGIN
      TrackSingle(f, in);
      IF in & (Controllers.modify IN modifiers) THEN RevealTarget(targ) END
   END TrackTarget;
   PROCEDURE (v: Link) CopyFromSimpleView- (source: Views.View);

   BEGIN
      WITH source: Link DO
         ASSERT(source.leftSide = (source.cmd # NIL), 100);
         v.leftSide := source.leftSide;
         v.close := source.close;
         IF source.cmd # NIL THEN
            NEW(v.cmd, LEN(source.cmd^));
            v.cmd^ := source.cmd^$
         ELSE v.cmd := NIL
         END
      END
   END CopyFromSimpleView;
   PROCEDURE (t: Target) CopyFromSimpleView- (source: Views.View);

   BEGIN
      WITH source: Target DO
         ASSERT(source.leftSide = (source.ident # NIL), 100);
         t.leftSide := source.leftSide;
         IF source.ident # NIL THEN
            NEW(t.ident, LEN(source.ident^));
            t.ident^ := source.ident^$
         ELSE t.ident := NIL
         END
      END
   END CopyFromSimpleView;
   PROCEDURE (v: Link) Internalize- (VAR rd: Stores.Reader);

      VAR len: INTEGER; version: INTEGER; pos: INTEGER;
   BEGIN
      v.Internalize^(rd);
      IF rd.cancelled THEN RETURN END;
      rd.ReadVersion(minLinkVersion, maxLinkVersion, version);
      IF rd.cancelled THEN RETURN END;
      rd.ReadBool(v.leftSide);
      rd.ReadInt(len);
      IF len = 0 THEN v.cmd := NIL
      ELSE NEW(v.cmd, len); rd.ReadXString(v.cmd^)
      END;
      v.leftSide := v.cmd # NIL;
      IF v.leftSide THEN
         IF version = 1 THEN
            rd.ReadInt(v.close)
         ELSE
            Strings.Find(v.cmd, "StdLinks.ShowTarget", 0, pos);
            IF (pos # 0) THEN v.close := ifShiftDown
            ELSE v.close := never
            END
         END
      END
   END Internalize;
   PROCEDURE (v: Link) Externalize- (VAR wr: Stores.Writer);

      VAR pos, version: INTEGER;
   BEGIN
      v.Externalize^(wr);
      IF v.leftSide THEN
         Strings.Find(v.cmd, "StdLinks.ShowTarget", 0, pos);
         IF (pos = 0) & (v.close = never) OR (v.close = ifShiftDown) THEN version := 0
         ELSE version := 1
         END
      ELSE
         version := 0
      END;
      wr.WriteVersion(version);
      wr.WriteBool(v.cmd # NIL);
      IF v.cmd = NIL THEN wr.WriteInt(0)
      ELSE wr.WriteInt(LEN(v.cmd^)); wr.WriteXString(v.cmd^)
      END;
      IF version = 1 THEN wr.WriteInt(v.close) END
   END Externalize;
   PROCEDURE (t: Target) Internalize- (VAR rd: Stores.Reader);

      VAR len: INTEGER; version: INTEGER;
   BEGIN
      t.Internalize^(rd);
      IF rd.cancelled THEN RETURN END;
      rd.ReadVersion(minTargVersion, maxTargVersion, version);
      IF rd.cancelled THEN RETURN END;
      rd.ReadBool(t.leftSide);
      rd.ReadInt(len);
      IF len = 0 THEN t.ident := NIL
      ELSE NEW(t.ident, len); rd.ReadXString(t.ident^)
      END;
      t.leftSide := t.ident # NIL
   END Internalize;
   PROCEDURE (t: Target) Externalize- (VAR wr: Stores.Writer);

   BEGIN
      t.Externalize^(wr);
      wr.WriteVersion(maxTargVersion);
      wr.WriteBool(t.ident # NIL);
      IF t.ident = NIL THEN wr.WriteInt(0)
      ELSE wr.WriteInt(LEN(t.ident^)); wr.WriteXString(t.ident^)
      END
   END Externalize;
   PROCEDURE RestoreView (v: Views.View; f: Views.Frame; icon: ARRAY OF SHORTCHAR);

      VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; color: Ports.Color;
         asc, dsc, w: INTEGER;
   BEGIN
      c := v.context;
      IF (c # NIL) & (c IS TextModels.Context) THEN
         a := c(TextModels.Context).Attr();
         font := Fonts.dir.This(iconFont, a.font.size, {}, Fonts.normal);
         color := a.color
      ELSE font := Fonts.dir.Default(); color := Ports.black
      END;
      IF coloredBackg THEN
      f.DrawRect(f.l, f.t, f.r, f.b, Ports.fill, Ports.grey25) END;
      font.GetBounds(asc, dsc, w);
      f.DrawSString(1*Ports.mm DIV 2, asc, color, icon, font)
   END RestoreView;
   PROCEDURE (v: Link) Restore* (f: Views.Frame; l, t, r, b: INTEGER);

   BEGIN
      IF v.leftSide THEN RestoreView(v, f, linkLeft)
      ELSE RestoreView(v, f, linkRight)
      END
   END Restore;
   PROCEDURE (targ: Target) Restore* (f: Views.Frame; l, t, r, b: INTEGER);

   BEGIN
      IF targ.leftSide THEN RestoreView(targ, f, targetLeft)
      ELSE RestoreView(targ, f, targetRight)
      END
   END Restore;
   PROCEDURE SizePref (v: Views.View; icon: ARRAY OF SHORTCHAR; VAR msg: Properties.SizePref);

      VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font;
         asc, dsc, w: INTEGER;
   BEGIN
      c := v.context;
      IF (c # NIL) & (c IS TextModels.Context) THEN
         a := c(TextModels.Context).Attr();
         font := Fonts.dir.This(iconFont, a.font.size, {}, Fonts.normal)
      ELSE
         font := Fonts.dir.Default()
      END;
      msg.w := font.SStringWidth(icon) + 1*Ports.mm;
      font.GetBounds(asc, dsc, w);
      msg.h := asc + dsc
   END SizePref;
   
   PROCEDURE (v: Link) HandlePropMsg- (VAR msg: Properties.Message);
      VAR a: TextModels.Attributes; c: Models.Context; asc, dsc, w: INTEGER; l, r: Link;
   BEGIN
      WITH msg: Properties.SizePref DO
         IF v.leftSide THEN SizePref(v, linkLeft, msg)
         ELSE SizePref(v, linkRight, msg)
         END
      | msg: Properties.FocusPref DO
         msg.hotFocus := TRUE
      | msg: Properties.ResizePref DO
         msg.fixed := TRUE
      | msg: TextModels.Pref DO
         msg.opts := {TextModels.hideable}
      | msg: TextControllers.FilterPref DO
         msg.filter := TRUE
      | msg: TextSetters.Pref DO c := v.context;
         IF (c # NIL) & (c IS TextModels.Context) THEN
            a := c(TextModels.Context).Attr();
            a.font.GetBounds(asc, dsc, w);
            msg.dsc := dsc
         END
      | msg: Properties.PollMsg DO
         IF v.leftSide THEN PollProp(v, msg)
         ELSE
            GetLinkPair(v, l, r);
            IF l # NIL THEN PollProp(l, msg) END
         END
      | msg: Properties.SetMsg DO
         IF v.leftSide THEN SetProp(v, msg)
         ELSE GetLinkPair(v, l, r); SetProp(l, msg)
         END
      ELSE
      END
   END HandlePropMsg;
   
   PROCEDURE (targ: Target) HandlePropMsg- (VAR msg: Properties.Message);
      VAR a: TextModels.Attributes; c: Models.Context; asc, dsc, w: INTEGER;l, r: Target;
   BEGIN
      WITH msg: Properties.SizePref DO
         IF targ.leftSide THEN SizePref(targ, targetLeft, msg)
         ELSE SizePref(targ, targetRight, msg)
         END
      | msg: Properties.FocusPref DO
         msg.hotFocus := TRUE
      | msg: Properties.ResizePref DO
         msg.fixed := TRUE
      | msg: TextModels.Pref DO
         msg.opts := {TextModels.hideable}
      | msg: TextSetters.Pref DO c := targ.context;
         IF (c # NIL) & (c IS TextModels.Context) THEN
            a := c(TextModels.Context).Attr();
            a.font.GetBounds(asc, dsc, w);
            msg.dsc := dsc
         END
      | msg: Properties.PollMsg DO
         IF targ.leftSide THEN PollProp(targ, msg)
         ELSE
            GetTargetPair(targ, l, r);
            IF l # NIL THEN PollProp(l, msg) END
         END
      | msg: Properties.SetMsg DO
         IF targ.leftSide THEN SetProp(targ, msg)
         ELSE GetTargetPair(targ, l, r); SetProp(l, msg)
         END
      ELSE
      END
   END HandlePropMsg;
   PROCEDURE (v: Link) HandleCtrlMsg* (f: Views.Frame;

      VAR msg: Controllers.Message; VAR focus: Views.View);
      PROCEDURE isHot(c: TextControllers.Controller; x, y: INTEGER; mod: SET): BOOLEAN;

         VAR pos, beg, end: INTEGER;
      BEGIN
         (* ignore alt, cmd, and middle clicks in edit mode *)
         IF ~(Containers.noCaret IN c.opts) & (mod * {17, 27, 28} # {}) THEN RETURN FALSE END;
         pos := ThisPos(c.view, f, x, y);
         (* ignore clicks in selection *)
         c.GetSelection(beg, end);
         IF (end > beg) & (pos >= beg) & (pos <= end) THEN RETURN FALSE END;
         IF v.leftSide THEN RETURN pos >= v.context(TextModels.Context).Pos()
         ELSE RETURN pos < v.context(TextModels.Context).Pos()
         END
      END isHot;
      
   BEGIN
      WITH msg: Controllers.PollCursorMsg DO
         msg.cursor := Ports.refCursor
      | msg: TextControllers.FilterPollCursorMsg DO
         IF isHot(msg.controller, msg.x, msg.y, {}) THEN
            msg.cursor := Ports.refCursor; msg.done := TRUE
         END
      | msg: Controllers.TrackMsg DO
         Track(v, f, NIL, msg.x, msg.y, msg.modifiers)
      | msg: TextControllers.FilterTrackMsg DO
         IF isHot(msg.controller, msg.x, msg.y, msg.modifiers) THEN
            Track(v, f,msg.controller, msg.x, msg.y, msg.modifiers);
            msg.done := TRUE
         END
      ELSE
      END
   END HandleCtrlMsg;
   PROCEDURE (targ: Target) HandleCtrlMsg* (f: Views.Frame; VAR msg: Controllers.Message;

                                                      VAR focus: Views.View);
   BEGIN
      WITH msg: Controllers.TrackMsg DO TrackTarget(targ, f, msg.modifiers)
      ELSE
      END
   END HandleCtrlMsg;
   PROCEDURE (v: Link) GetCmd* (OUT cmd: ARRAY OF CHAR), NEW;

   BEGIN
      ASSERT(v.leftSide, 20);
      ASSERT(v.cmd # NIL, 100);
      cmd := v.cmd$
   END GetCmd;
   PROCEDURE (t: Target) GetIdent* (OUT ident: ARRAY OF CHAR), NEW;

   BEGIN
      ASSERT(t.leftSide, 20);
      ASSERT(t.ident # NIL, 100);
      ident := t.ident$
   END GetIdent;
   (* --------------- create commands and menu guards ------------------------ *)

   PROCEDURE GetParam (c: TextControllers.Controller; VAR param: ARRAY OF CHAR;

                           VAR lbrBeg, lbrEnd, rbrBeg, rbrEnd: INTEGER);
      VAR rd: TextModels.Reader; i, beg, end: INTEGER;
         ch0, ch1, ch2: CHAR;
   BEGIN
      param[0] := 0X;
      IF (c # NIL) & c.HasSelection() THEN
         c.GetSelection(beg, end);
         IF end - beg > 4 THEN
            rd := c.text.NewReader(NIL);
            rd.SetPos(beg); rd.ReadChar(ch0);
            rd.SetPos(end-2); rd.ReadChar(ch1); rd.ReadChar(ch2);
            IF (ch0 = "<") & (ch1 = "<") & (ch2 = ">") THEN
               rd.SetPos(beg+1); rd.ReadChar(ch0); i := 0;
               WHILE ~rd.eot & (ch0 # ">") DO
                  IF i < LEN(param) - 1 THEN param[i] := ch0; INC(i) END;
                  rd.ReadChar(ch0)
               END;
               param[i] := 0X;
               lbrBeg := beg; lbrEnd := rd.Pos();
               rbrBeg := end -2; rbrEnd := end
            END
         END
      END
   END GetParam;
   
   PROCEDURE CreateGuard* (VAR par: Dialog.Par);
      VAR param: ARRAY 512 OF CHAR; lbrBeg, lbrEnd, rbrBeg, rbrEnd: INTEGER;
   BEGIN
      GetParam(TextControllers.Focus(), param, lbrBeg, lbrEnd, rbrBeg, rbrEnd);
      par.disabled := param = ""
   END CreateGuard;
   PROCEDURE InsertionAttr (c: TextControllers.Controller; pos: INTEGER): TextModels.Attributes;

      VAR rd: TextModels.Reader; r: TextRulers.Ruler; a: TextModels.Attributes; ch: CHAR;
   BEGIN
      rd := c.text.NewReader(NIL);a := NIL;
      rd.SetPos(pos); rd.ReadChar(ch); a := rd.attr;
      IF a = NIL THEN c.view.PollDefaults(r, a) END;
      RETURN a
   END InsertionAttr;
   PROCEDURE CreateLink*;

      VAR lbrBeg, lbrEnd, rbrBeg, rbrEnd: INTEGER;
         left, right: Link; c: TextControllers.Controller;
         cmd: ARRAY 512 OF CHAR;
         op: Stores.Operation;
         w: TextModels.Writer; a: TextModels.Attributes;
   BEGIN
      c := TextControllers.Focus();
      GetParam(TextControllers.Focus(), cmd, lbrBeg, lbrEnd, rbrBeg, rbrEnd);
      IF cmd # "" THEN
         w := c.text.NewWriter(NIL);
         Models.BeginScript(c.text, "#StdLinks:Create Link", op);
         a := InsertionAttr(c, rbrBeg);
         c.text.Delete(rbrBeg, rbrEnd);
         right := dir.NewLink("");
         w.SetPos(rbrBeg);
         IF a # NIL THEN w.SetAttr(a) END;
         w.WriteView(right, 0, 0);
         a := InsertionAttr(c, lbrBeg);
         c.text.Delete(lbrBeg, lbrEnd);
         left := dir.NewLink(cmd);
         w.SetPos(lbrBeg);
         IF a # NIL THEN w.SetAttr(a) END;
         w.WriteView(left, 0, 0);
         Models.EndScript(c.text, op)
      END
   END CreateLink;
   PROCEDURE CreateTarget*;

      VAR lbrBeg, lbrEnd, rbrBeg, rbrEnd: INTEGER;
         left, right: Target; c: TextControllers.Controller;
         ident: ARRAY 512 OF CHAR;
         op: Stores.Operation;
         w: TextModels.Writer; a: TextModels.Attributes;
   BEGIN
      c := TextControllers.Focus();
      GetParam(TextControllers.Focus(), ident, lbrBeg, lbrEnd, rbrBeg, rbrEnd);
      IF ident # "" THEN
         w := c.text.NewWriter(NIL);
         Models.BeginScript(c.text, "#StdLinks:Create Target", op);
         a := InsertionAttr(c, rbrBeg);
         c.text.Delete(rbrBeg, rbrEnd);
         right := dir.NewTarget("");
         w.SetPos(rbrBeg);
         IF a # NIL THEN w.SetAttr(a) END;
         w.WriteView(right, 0, 0);
         a := InsertionAttr(c, lbrBeg);
         c.text.Delete(lbrBeg, lbrEnd);
         left := dir.NewTarget(ident);
         w.SetPos(lbrBeg);
         IF a # NIL THEN w.SetAttr(a) END;
         w.WriteView(left, 0, 0);
         Models.EndScript(c.text, op)
      END
   END CreateTarget;
   PROCEDURE ShowTarget* (IN ident: ARRAY OF CHAR);

      VAR c: TextControllers.Controller; rd: TextModels.Reader;
         v: Views.View; left, right: Target; beg, end: INTEGER;
   BEGIN
      c := TextControllers.Focus();
      IF c # NIL THEN
         rd := c.text.NewReader(NIL);
         REPEAT rd.ReadView(v)
         UNTIL rd.eot OR (v # NIL) & (v IS Target) & v(Target).leftSide & (v(Target).ident^ = ident);
         IF ~rd.eot THEN
            GetTargetPair(v(Target), left, right);
            IF (left # NIL) & (right # NIL) THEN
               beg := left.context(TextModels.Context).Pos();
               end := right.context(TextModels.Context).Pos() + 1;
               c.SetSelection(beg, end);
               c.view.SetOrigin(beg, 0)
            ELSE
               Dialog.ShowParamMsg("target '^0' not found", ident, "", "")
            END
         ELSE
            Dialog.ShowParamMsg("target '^0' not found", ident, "", "")
         END
      END
   END ShowTarget;
   (* programming interface *)


   PROCEDURE (d: StdDirectory) NewLink (IN cmd: ARRAY OF CHAR): Link;

      VAR link: Link; i: INTEGER;
   BEGIN
      NEW(link); link.leftSide := cmd # "";
      IF link.leftSide THEN
         i := 0; WHILE cmd[i] # 0X DO INC(i) END;
         NEW(link.cmd, i + 1); link.cmd^ := cmd$
      ELSE
         link.cmd := NIL
      END;
      link.close := ifShiftDown;
      RETURN link
   END NewLink;
   PROCEDURE (d: StdDirectory) NewTarget (IN ident: ARRAY OF CHAR): Target;

      VAR t: Target; i: INTEGER;
   BEGIN
      NEW(t); t.leftSide := ident # "";
      IF t.leftSide THEN
         i := 0; WHILE ident[i] # 0X DO INC(i) END;
         NEW(t.ident, i + 1); t.ident^ := ident$
      ELSE
         t.ident := NIL
      END;
      RETURN t
   END NewTarget;
   PROCEDURE SetDir* (d: Directory);

   BEGIN
      ASSERT(d # NIL, 20);
      dir := d
   END SetDir;
   PROCEDURE Init;

      VAR font: Fonts.Font; d: StdDirectory;
      PROCEDURE DefaultAppearance;

      BEGIN font := Fonts.dir.Default(); iconFont := font.typeface;
         linkLeft := "Link"; linkRight := "~";
         targetLeft := "Targ"; targetRight :="~";
         coloredBackg := TRUE
      END DefaultAppearance;
   BEGIN

      NEW(d); dir := d; stdDir := d;
      IF Dialog.platform DIV 10 = 1 THEN (* Windows *)
         iconFont := "Wingdings";
         font := Fonts.dir.This(iconFont, 10*Fonts.point (*arbitrary*), {}, Fonts.normal);
         IF font.IsAlien() THEN DefaultAppearance
         ELSE
            linkLeft[0] := SHORT(CHR(246)); linkLeft[1] := 0X;
            linkRight[0] := SHORT(CHR(245)); linkRight[1] := 0X;
            targetLeft[0] := SHORT(CHR(164)); targetLeft[1] := 0X;
            targetRight[0] := SHORT(CHR(161)); targetRight[1] := 0X;
            coloredBackg := FALSE
         END
      ELSIF Dialog.platform DIV 10 = 2 THEN (* Mac *)
         DefaultAppearance
      ELSE
         DefaultAppearance
      END;
      NEW(cleaner);
      dialog.close.SetResources("#Std:links")
   END Init;
BEGIN

   Init
END StdLinks.