MODULE DevSelectors; (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Dev/Mod/Selectors.odc *) (* DO NOT EDIT *) 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 END New; 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"