MODULE DevSelectors;
(**
project = "BlackBox"
organization = "www.oberon.ch"
contributors = "Oberon microsystems"
version = "System/Rsrc/About"
copyright = "System/Rsrc/About"
license = "Docu/BB-License"
changes = ""
issues = ""
**)
IMPORT
Ports, Stores, Models, Views, Controllers, Fonts, Properties, TextModels, TextViews, TextSetters;
CONST
left* = 1; middle* = 2; right* = 3;
minVersion = 0; currentVersion = 0;
changeSelectorsKey = "#Dev:Change Selectors";
TYPE
Selector* = POINTER TO RECORD (Views.View)
position-: INTEGER; (* left, middle, right *)
leftHidden: TextModels.Model; (* valid iff (position = left) *)
rightHidden: TextModels.Model (* valid iff (position = left) *)
END;
Directory* = POINTER TO ABSTRACT RECORD END;
StdDirectory = POINTER TO RECORD (Directory) END;
VAR
dir-, stdDir-: Directory;
PROCEDURE (d: Directory) New* (position: INTEGER): Selector, NEW, ABSTRACT;
PROCEDURE GetFirst (selector: Selector; OUT first: Selector; OUT pos: INTEGER);
VAR c: Models.Context; rd: TextModels.Reader; v: Views.View; nest: INTEGER;
BEGIN
c := selector.context; first := NIL; pos := 0;
WITH c: TextModels.Context DO
IF selector.position = left THEN
first := selector
ELSE
rd := c.ThisModel().NewReader(NIL); rd.SetPos(c.Pos());
nest := 1; pos := 1; rd.ReadPrevView(v);
WHILE (v # NIL) & (nest > 0) DO
WITH v: Selector DO
IF v.position = left THEN DEC(nest);
IF nest = 0 THEN first := v END
ELSIF v.position = right THEN INC(nest)
ELSIF nest = 1 THEN INC(pos)
END
ELSE
END;
rd.ReadPrevView(v)
END
END
ELSE (* selector not embedded in a text *)
END;
ASSERT((first = NIL) OR (first.position = left), 100)
END GetFirst;
PROCEDURE GetNext (rd: TextModels.Reader; OUT next: Selector);
VAR nest: INTEGER; v: Views.View;
BEGIN
nest := 1; next := NIL; rd.ReadView(v);
WHILE v # NIL DO
WITH v: Selector DO
IF v.position = left THEN INC(nest)
ELSIF nest = 1 THEN next := v; RETURN
ELSIF v.position = right THEN DEC(nest)
END
ELSE
END;
rd.ReadView(v)
END
END GetNext;
PROCEDURE CalcSize (f: Selector; OUT w, h: INTEGER);
VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; asc, dsc, fw: INTEGER;
BEGIN
c := f.context;
IF (c # NIL) & (c IS TextModels.Context) THEN
a := c(TextModels.Context).Attr();
font := a.font
ELSE font := Fonts.dir.Default();
END;
font.GetBounds(asc, dsc, fw);
h := asc + dsc; w := 3 * h DIV 4
END CalcSize;
PROCEDURE GetSection (first: Selector; rd: TextModels.Reader; n: INTEGER; OUT name: ARRAY OF CHAR);
VAR i, p0, p1: INTEGER; ch: CHAR; sel: Selector;
BEGIN
sel := first;
IF first.leftHidden.Length() > 0 THEN
rd := first.leftHidden.NewReader(rd); rd.SetPos(0);
REPEAT p0 := rd.Pos(); GetNext(rd, sel); DEC(n) UNTIL (n < 0) OR (sel = NIL);
IF sel = NIL THEN INC(n) END;
p1 := rd.Pos() - 1
END;
IF n >= 0 THEN
rd := first.context(TextModels.Context).ThisModel().NewReader(rd);
rd.SetPos(first.context(TextModels.Context).Pos() + 1);
REPEAT p0 := rd.Pos(); GetNext(rd, sel); DEC(n) UNTIL (n < 0) OR (sel = NIL) OR (sel.position = right);
p1 := rd.Pos() - 1
END;
IF (n >= 0) & (first.rightHidden.Length() > 0) THEN
rd := first.rightHidden.NewReader(rd); rd.SetPos(1);
REPEAT p0 := rd.Pos(); GetNext(rd, sel); DEC(n) UNTIL (n < 0) OR (sel = NIL);
p1 := rd.Pos() - 1;
IF sel = NIL THEN p1 := first.rightHidden.Length() END
END;
IF n < 0 THEN
rd.SetPos(p0); rd.ReadChar(ch); i := 0;
WHILE (ch <= " ") & (rd.Pos() <= p1) DO rd.ReadChar(ch) END;
WHILE (i < LEN(name) - 1) & (rd.Pos() <= p1) & (ch # 0X) DO
IF ch >= " " THEN name[i] := ch; INC(i) END;
rd.ReadChar(ch)
END;
WHILE (i > 0) & (name[i - 1] = " ") DO DEC(i) END;
name[i] := 0X
ELSE
name := 7FX + ""
END
END GetSection;
PROCEDURE ChangeSelector (first: Selector; rd: TextModels.Reader; selection: INTEGER);
VAR pos, p0, len, s: INTEGER; text: TextModels.Model; sel: Selector;
BEGIN
text := rd.Base();
pos := first.context(TextModels.Context).Pos() + 1;
(* expand *)
rd.SetPos(pos);
REPEAT GetNext(rd, sel) UNTIL (sel = NIL) OR (sel.position = right);
IF sel # NIL THEN
len := first.rightHidden.Length();
IF len > 0 THEN text.Insert(rd.Pos() - 1, first.rightHidden, 0, len) END;
len := first.leftHidden.Length();
IF len > 0 THEN text.Insert(pos, first.leftHidden, 0, len) END;
IF selection # 0 THEN (* collapse *)
rd.SetPos(pos); s := 0;
REPEAT GetNext(rd, sel); INC(s) UNTIL (s = selection) OR (sel = NIL) OR (sel.position = right);
IF (sel # NIL) & (sel.position = middle) THEN
first.leftHidden.Insert(0, text, pos, rd.Pos());
rd.SetPos(pos); GetNext(rd, sel);
p0 := rd.Pos() - 1;
WHILE (sel # NIL) & (sel.position # right) DO GetNext(rd, sel) END;
IF sel # NIL THEN
first.rightHidden.Insert(0, text, p0, rd.Pos() - 1)
END
END
END
END;
rd.SetPos(pos)
END ChangeSelector;
PROCEDURE ChangeThis (
text: TextModels.Model; rd, rd1: TextModels.Reader; title: ARRAY OF CHAR; selection: INTEGER
);
VAR v: Views.View; str: ARRAY 256 OF CHAR;
BEGIN
rd := text.NewReader(rd);
rd.SetPos(0); rd.ReadView(v);
WHILE v # NIL DO
WITH v: Selector DO
IF v.position = left THEN
GetSection(v, rd1, 0, str);
IF str = title THEN
ChangeSelector(v, rd, selection)
END;
IF v.leftHidden.Length() > 0 THEN ChangeThis(v.leftHidden, NIL, rd1, title, selection) END;
IF v.rightHidden.Length() > 0 THEN ChangeThis(v.rightHidden, NIL, rd1, title, selection) END
END
ELSE
END;
rd.ReadView(v)
END
END ChangeThis;
PROCEDURE Change* (text: TextModels.Model; title: ARRAY OF CHAR; selection: INTEGER);
VAR rd, rd1: TextModels.Reader; script: Stores.Operation;
BEGIN
rd := text.NewReader(NIL);
rd1 := text.NewReader(NIL);
Models.BeginModification(Models.clean, text);
Models.BeginScript(text, changeSelectorsKey, script);
ChangeThis(text, rd, rd1, title, selection);
Models.EndScript(text, script);
Models.EndModification(Models.clean, text);
END Change;
PROCEDURE ChangeTo* (text: TextModels.Model; title, entry: ARRAY OF CHAR);
VAR rd, rd1: TextModels.Reader; str: ARRAY 256 OF CHAR; v: Views.View; sel: INTEGER;
BEGIN
rd := text.NewReader(NIL);
rd1 := text.NewReader(NIL);
rd.SetPos(0); rd.ReadView(v);
WHILE v # NIL DO
WITH v: Selector DO
IF v.position = left THEN
GetSection(v, rd1, 0, str);
IF title = str THEN
sel := 0;
REPEAT
INC(sel); GetSection(v, rd1, sel, str)
UNTIL (str[0] = 7FX) OR (str = entry);
IF str[0] # 7FX THEN
Change(text, title, sel);
RETURN
END
END
END
ELSE
END;
rd.ReadView(v)
END
END ChangeTo;
PROCEDURE (selector: Selector) HandlePropMsg- (VAR msg: Properties.Message);
VAR c: Models.Context; a: TextModels.Attributes; asc, w: INTEGER;
BEGIN
WITH msg: Properties.SizePref DO CalcSize(selector, msg.w, msg.h)
| msg: Properties.ResizePref DO msg.fixed := TRUE;
| msg: Properties.FocusPref DO msg.hotFocus := TRUE;
| msg: TextSetters.Pref DO c := selector.context;
IF (c # NIL) & (c IS TextModels.Context) THEN
a := c(TextModels.Context).Attr();
a.font.GetBounds(asc, msg.dsc, w)
END
ELSE (*selector.HandlePropMsg^(msg);*)
END
END HandlePropMsg;
PROCEDURE Track (selector: Selector; f: Views.Frame; x, y: INTEGER; buttons: SET; VAR hit: BOOLEAN);
VAR a: TextModels.Attributes; font: Fonts.Font; c: Models.Context;
w, h, asc, dsc, fw: INTEGER; isDown, in, in0: BOOLEAN; modifiers: SET;
BEGIN
c := selector.context; hit := FALSE;
WITH c: TextModels.Context DO
a := c.Attr(); font := a.font;
c.GetSize(w, h); in0 := FALSE;
in := (0 <= x) & (x < w) & (0 <= y) & (y < h);
REPEAT
IF in # in0 THEN
f.MarkRect(0, 0, w, h, Ports.fill, Ports.hilite, FALSE); in0 := in
END;
f.Input(x, y, modifiers, isDown);
in := (0 <= x) & (x < w) & (0 <= y) & (y < h)
UNTIL ~isDown;
IF in0 THEN hit := TRUE;
font.GetBounds(asc, dsc, fw);
f.MarkRect(0, 0, w, asc + dsc, Ports.fill, Ports.hilite, FALSE);
END
ELSE
END
END Track;
PROCEDURE (selector: Selector) HandleCtrlMsg* (
f: Views.Frame; VAR msg: Views.CtrlMessage; VAR focus: Views.View
);
VAR hit: BOOLEAN; sel, pos: INTEGER; text: TextModels.Model; title: ARRAY 256 OF CHAR; first: Selector;
BEGIN
WITH msg: Controllers.TrackMsg DO
IF selector.context IS TextModels.Context THEN
Track(selector, f, msg.x, msg.y, msg.modifiers, hit);
IF hit THEN
text := selector.context(TextModels.Context).ThisModel();
GetFirst(selector, first, pos);
IF first # NIL THEN
GetSection(first, NIL, 0, title);
IF selector.position = middle THEN sel := pos ELSE sel := 0 END;
Change(text, title, sel);
text := selector.context(TextModels.Context).ThisModel();
IF TextViews.FocusText() = text THEN
pos := selector.context(TextModels.Context).Pos();
TextViews.ShowRange(text, pos, pos+1, TRUE)
END
END
END
END
| msg: Controllers.PollCursorMsg DO
msg.cursor := Ports.refCursor;
ELSE
END
END HandleCtrlMsg;
PROCEDURE (selector: Selector) Restore* (f: Views.Frame; l, t, r, b: INTEGER);
VAR w, h, d: INTEGER;
BEGIN
selector.context.GetSize(w, h);
(*
GetFirst(selector, first, pos);
*)
w := w - w MOD f.unit; d := 2 * f.dot;
f.DrawLine(d, d, w - d, d, d, Ports.grey25);
f.DrawLine(d, h - d, w - d, h - d, d, Ports.grey25);
IF selector.position # right THEN f.DrawLine(d, d, d, h - d, d, Ports.grey25) END;
IF selector.position # left THEN f.DrawLine(w - d, d, w - d, h - d, d, Ports.grey25) END
END Restore;
PROCEDURE (selector: Selector) CopyFromSimpleView- (source: Views.View);
BEGIN
(* selector.CopyFrom^(source); *)
WITH source: Selector DO
selector.position := source.position;
IF source.leftHidden # NIL THEN
selector.leftHidden := TextModels.CloneOf(source.leftHidden);
selector.leftHidden.InsertCopy(0, source.leftHidden, 0, source.leftHidden.Length())
END;
IF source.rightHidden # NIL THEN
selector.rightHidden := TextModels.CloneOf(source.rightHidden);
selector.rightHidden.InsertCopy(0, source.rightHidden, 0, source.rightHidden.Length())
END
END
END CopyFromSimpleView;
PROCEDURE (selector: Selector) InitContext* (context: Models.Context);
BEGIN
selector.InitContext^(context);
IF selector.position = left THEN
WITH context: TextModels.Context DO
IF selector.leftHidden = NIL THEN
selector.leftHidden := TextModels.CloneOf(context.ThisModel());
Stores.Join(selector, selector.leftHidden);
END;
IF selector.rightHidden = NIL THEN
selector.rightHidden := TextModels.CloneOf(context.ThisModel());
Stores.Join(selector, selector.rightHidden)
END
ELSE
END
END
END InitContext;
PROCEDURE (selector: Selector) Internalize- (VAR rd: Stores.Reader);
VAR version: INTEGER; store: Stores.Store;
BEGIN
selector.Internalize^(rd);
IF rd.cancelled THEN RETURN END;
rd.ReadVersion(minVersion, currentVersion, version);
IF rd.cancelled THEN RETURN END;
rd.ReadInt(selector.position);
rd.ReadStore(store);
IF store # NIL THEN selector.leftHidden := store(TextModels.Model)
ELSE selector.leftHidden := NIL
END;
rd.ReadStore(store);
IF store # NIL THEN selector.rightHidden := store(TextModels.Model)
ELSE selector.rightHidden := NIL
END
END Internalize;
PROCEDURE (selector: Selector) Externalize- (VAR wr: Stores.Writer);
BEGIN
selector.Externalize^(wr);
wr.WriteVersion(currentVersion);
wr.WriteInt(selector.position);
wr.WriteStore(selector.leftHidden);
wr.WriteStore(selector.rightHidden)
END Externalize;
PROCEDURE (d: StdDirectory) New (position: INTEGER): Selector;
VAR selector: Selector;
BEGIN
NEW(selector);
selector.position := position;
RETURN selector
ENDNew;
PROCEDURE SetDir* (d: Directory);
BEGIN
ASSERT(d # NIL, 20);
dir := d
END SetDir;
PROCEDURE DepositLeft*;
BEGIN
Views.Deposit(dir.New(left))
END DepositLeft;
PROCEDURE DepositMiddle*;
BEGIN
Views.Deposit(dir.New(middle))
END DepositMiddle;
PROCEDURE DepositRight*;
BEGIN
Views.Deposit(dir.New(right))
END DepositRight;
PROCEDURE InitMod;
VAR d: StdDirectory;
BEGIN
NEW(d); dir := d; stdDir := d;
END InitMod;
BEGIN
InitMod
END DevSelectors.
"Insert Left" "*F5" "DevSelectors.DepositLeft; StdCmds.PasteView" "StdCmds.PasteViewGuard"
"Insert Middle" "*F6" "DevSelectors.DepositMiddle; StdCmds.PasteView" "StdCmds.PasteViewGuard"
"Insert Right" "*F7" "DevSelectors.DepositRight; StdCmds.PasteView" "StdCmds.PasteViewGuard"