123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779 |
- MODULE StdFolds;
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Folds.odc *)
- (* DO NOT EDIT *)
- IMPORT
- Domains := Stores, Ports, Stores, Containers, Models, Views, Controllers, Fonts,
- Properties,Controls,
- TextModels, TextViews, TextControllers, TextSetters,
- Dialog, Services;
- CONST
- expanded* = FALSE; collapsed* = TRUE;
- minVersion = 0; currentVersion = 0;
- collapseFoldKey = "#Std:Collapse Fold";
- expandFoldKey = "#Std:Expand Fold";
- zoomInKey = "#Std:Zoom In";
- zoomOutKey = "#Std:Zoom Out";
- expandFoldsKey = "#Std:Expand Folds";
- collapseFoldsKey = "#Std:Collapse Folds";
- insertFoldKey = "#Std:Insert Fold";
- setLabelKey = "#Std:Set Label";
- TYPE
- Label* = ARRAY 32 OF CHAR;
-
- Fold* = POINTER TO RECORD (Views.View)
- leftSide-: BOOLEAN;
- collapsed-: BOOLEAN;
- label-: Label; (* valid iff leftSide *)
- hidden: TextModels.Model (* valid iff leftSide; NIL if no hidden text *)
- END;
- Directory* = POINTER TO ABSTRACT RECORD END;
- StdDirectory = POINTER TO RECORD (Directory) END;
- FlipOp = POINTER TO RECORD (Domains.Operation)
- text: TextModels.Model; (* containing text *)
- leftpos, rightpos: INTEGER (* position of left and right Fold *)
- END;
-
- SetLabelOp = POINTER TO RECORD (Domains.Operation)
- text: TextModels.Model; (* containing text *)
- pos: INTEGER; (* position of fold in text *)
- oldlabel: Label
- END;
-
- Action = POINTER TO RECORD (Services.Action) END;
-
- VAR
- dir-, stdDir-: Directory;
- foldData*: RECORD
- nested*: BOOLEAN;
- all*: BOOLEAN;
- findLabel*: Label;
- newLabel*: Label
- END;
- iconFont: Fonts.Typeface;
- leftExp, rightExp, leftColl, rightColl: ARRAY 8 OF SHORTCHAR;
- coloredBackg: BOOLEAN;
- action: Action;
- fingerprint: INTEGER; (* for the property inspector *)
- PROCEDURE (d: Directory) New* (collapsed: BOOLEAN; label: Label;
- hiddenText: TextModels.Model): Fold, NEW, ABSTRACT;
- PROCEDURE GetPair (fold: Fold; VAR l, r: Fold);
- VAR c: Models.Context; text: TextModels.Model; rd: TextModels.Reader; v: Views.View;
- nest: INTEGER;
- BEGIN
- c := fold.context; l := NIL; r := NIL;
- WITH c: TextModels.Context DO
- text := c.ThisModel(); rd := text.NewReader(NIL);
- IF fold.leftSide THEN l := fold;
- rd.SetPos(c.Pos()+1); nest := 1;
- REPEAT rd.ReadView(v);
- IF (v # NIL) & (v IS Fold) THEN
- IF v(Fold).leftSide THEN INC(nest) ELSE DEC(nest) END
- END
- UNTIL (v = NIL) OR (nest = 0);
- IF v # NIL THEN r := v(Fold) ELSE r := NIL END
- ELSE r := fold;
- rd.SetPos(c.Pos()); nest := 1;
- REPEAT rd.ReadPrevView(v);
- IF (v # NIL) & (v IS Fold) THEN
- IF ~v(Fold).leftSide THEN INC(nest) ELSE DEC(nest) END
- END
- UNTIL (v = NIL) OR (nest = 0);
- IF v # NIL THEN l := v(Fold) ELSE l := NIL END
- END
- ELSE (* fold not embedded in a text *)
- END;
- ASSERT((l = NIL) OR l.leftSide & (l.hidden # NIL), 100);
- ASSERT((r = NIL) OR ~r.leftSide & (r.hidden = NIL), 101)
- END GetPair;
- PROCEDURE (fold: Fold) HiddenText* (): TextModels.Model, NEW;
- VAR l, r: Fold;
- BEGIN
- IF fold.leftSide THEN RETURN fold.hidden
- ELSE GetPair(fold, l, r);
- IF l # NIL THEN RETURN l.hidden ELSE RETURN NIL END
- END
- END HiddenText;
- PROCEDURE (fold: Fold) MatchingFold* (): Fold, NEW;
- VAR l, r: Fold;
- BEGIN
- GetPair(fold, l, r);
- IF l # NIL THEN
- IF fold = l THEN RETURN r ELSE RETURN l END
- ELSE RETURN NIL
- END
- END MatchingFold;
- PROCEDURE GetIcon (fold: Fold; VAR icon: ARRAY OF SHORTCHAR);
- BEGIN
- IF fold.leftSide THEN
- IF fold.collapsed THEN icon := leftColl$ ELSE icon := leftExp$ END
- ELSE
- IF fold.collapsed THEN icon := rightColl$ ELSE icon := rightExp$ END
- END
- END GetIcon;
- PROCEDURE CalcSize (f: Fold; VAR w, h: INTEGER);
- VAR icon: ARRAY 8 OF SHORTCHAR; c: Models.Context; a: TextModels.Attributes; font: Fonts.Font;
- asc, dsc, fw: INTEGER;
- BEGIN
- GetIcon(f, icon);
- c := f.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;
- w := font.SStringWidth(icon);
- font.GetBounds(asc, dsc, fw);
- h := asc + dsc
- END CalcSize;
- PROCEDURE Update (f: Fold);
- VAR w, h: INTEGER;
- BEGIN
- CalcSize(f, w, h);
- f.context.SetSize(w, h);
- Views.Update(f, Views.keepFrames)
- END Update;
- PROCEDURE FlipPair (l, r: Fold);
- VAR text, hidden: TextModels.Model; cl, cr: Models.Context;
- lpos, rpos: INTEGER;
- BEGIN
- IF (l # NIL) & (r # NIL) THEN
- ASSERT(l.leftSide, 100);
- ASSERT(~r.leftSide, 101);
- ASSERT(l.hidden # NIL, 102);
- ASSERT(r.hidden = NIL, 103);
- cl := l.context; cr := r.context;
- text := cl(TextModels.Context).ThisModel();
- lpos := cl(TextModels.Context).Pos() + 1; rpos := cr(TextModels.Context).Pos();
- ASSERT(lpos <= rpos, 104);
- hidden := TextModels.CloneOf(text);
- hidden.Insert(0, text, lpos, rpos);
- text.Insert(lpos, l.hidden, 0, l.hidden.Length());
- l.hidden := hidden; Stores.Join(l, hidden);
- l.collapsed := ~l.collapsed;
- r.collapsed := l.collapsed;
- Update(l); Update(r);
- TextControllers.SetCaret(text, lpos)
- END
- END FlipPair;
- PROCEDURE (op: FlipOp) Do;
- VAR rd: TextModels.Reader; left, right: Views.View;
- BEGIN
- rd := op.text.NewReader(NIL);
- rd.SetPos(op.leftpos); rd.ReadView(left);
- rd.SetPos(op.rightpos); rd.ReadView(right);
- FlipPair(left(Fold), right(Fold));
- op.leftpos := left.context(TextModels.Context).Pos();
- op.rightpos := right.context(TextModels.Context).Pos()
- END Do;
- PROCEDURE (op: SetLabelOp) Do;
- VAR rd: TextModels.Reader; fold: Views.View; left, right: Fold; lab: Label;
- BEGIN
- rd := op.text.NewReader(NIL);
- rd.SetPos(op.pos); rd.ReadView(fold);
- WITH fold: Fold DO
- GetPair(fold, left, right);
- IF left # NIL THEN
- lab := fold.label; left.label := op.oldlabel; op.oldlabel := lab;
- right.label := left.label
- END
- END
- END Do;
- PROCEDURE SetProp (fold: Fold; p : Properties.Property);
- VAR op: SetLabelOp; left, right: Fold;
- BEGIN
- WHILE p # NIL DO
- WITH p: Controls.Prop DO
- IF (Controls.label IN p.valid) & (p.label # fold.label) THEN
- GetPair(fold, left, right);
- IF left # NIL THEN
- NEW(op); op.oldlabel := p.label$;
- op.text := fold.context(TextModels.Context).ThisModel();
- op.pos := fold.context(TextModels.Context).Pos();
- Views.Do(fold, setLabelKey, op)
- END
- END
- ELSE
- END;
- p := p.next
- END
- END SetProp;
- PROCEDURE (fold: Fold) Flip*, NEW;
- VAR op: FlipOp; left, right: Fold;
- BEGIN
- ASSERT(fold # NIL, 20);
- NEW(op);
- GetPair(fold, left, right);
- IF (left # NIL) & (right # NIL) THEN
- op.text := fold.context(TextModels.Context).ThisModel();
- op.leftpos := left.context(TextModels.Context).Pos();
- op.rightpos := right.context(TextModels.Context).Pos();
- Views.BeginModification(Views.clean, fold);
- IF ~left.collapsed THEN Views.Do(fold, collapseFoldKey, op)
- ELSE Views.Do(fold, expandFoldKey, op)
- END;
- Views.EndModification(Views.clean, fold)
- END
- END Flip;
- PROCEDURE ReadNext (rd: TextModels.Reader; VAR fold: Fold);
- VAR v: Views.View;
- BEGIN
- REPEAT rd.ReadView(v) UNTIL rd.eot OR (v IS Fold);
- IF ~rd.eot THEN fold := v(Fold) ELSE fold := NIL END
- END ReadNext;
- PROCEDURE (fold: Fold) FlipNested*, NEW;
- VAR text: TextModels.Model; rd: TextModels.Reader; l, r: Fold; level: INTEGER;
- op: Domains.Operation;
- BEGIN
- ASSERT(fold # NIL, 20);
- GetPair(fold, l, r);
- IF (l # NIL) & (l.context # NIL) & (l.context IS TextModels.Context) THEN
- text := l.context(TextModels.Context).ThisModel();
- Models.BeginModification(Models.clean, text);
- rd := text.NewReader(NIL);
- rd.SetPos(l.context(TextModels.Context).Pos());
- IF l.collapsed THEN
- Models.BeginScript(text, expandFoldsKey, op);
- ReadNext(rd, fold); level := 1;
- WHILE (fold # NIL) & (level > 0) DO
- IF fold.leftSide & fold.collapsed THEN fold.Flip END;
- ReadNext(rd, fold);
- IF fold.leftSide THEN INC(level) ELSE DEC(level) END
- END
- ELSE (* l.state = expanded *)
- Models.BeginScript(text, collapseFoldsKey, op);
- level := 0;
- REPEAT ReadNext(rd, fold);
- IF fold.leftSide THEN INC(level) ELSE DEC(level) END;
- IF (fold # NIL) & ~fold.leftSide & ~fold.collapsed THEN
- fold.Flip;
- rd.SetPos(fold.context(TextModels.Context).Pos()+1)
- END
- UNTIL (fold = NIL) OR (level = 0)
- END;
- Models.EndScript(text, op);
- Models.EndModification(Models.clean, text)
- END
- END FlipNested;
- PROCEDURE (fold: Fold) HandlePropMsg- (VAR msg: Properties.Message);
- VAR prop: Controls.Prop; c: Models.Context; a: TextModels.Attributes; asc, w: INTEGER;
- BEGIN
- WITH msg: Properties.SizePref DO
- CalcSize(fold, msg.w, msg.h)
- | msg: Properties.ResizePref DO
- msg.fixed := TRUE
- | msg: Properties.FocusPref DO msg.hotFocus := TRUE
- | msg: Properties.PollMsg DO NEW(prop);
- prop.known := {Controls.label}; prop.valid := {Controls.label}; prop.readOnly := {};
- prop.label := fold.label$;
- msg.prop := prop
- | msg: Properties.SetMsg DO SetProp(fold, msg.prop)
- | msg: TextSetters.Pref DO c := fold.context;
- IF (c # NIL) & (c IS TextModels.Context) THEN
- a := c(TextModels.Context).Attr();
- a.font.GetBounds(asc, msg.dsc, w)
- END
- ELSE
- END
- END HandlePropMsg;
- PROCEDURE Track (fold: Fold; 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 := fold.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 (fold: Fold) HandleCtrlMsg* (f: Views.Frame; VAR msg: Views.CtrlMessage;
- VAR focus: Views.View);
- VAR hit: BOOLEAN; pos: INTEGER; l, r: Fold;
- context: TextModels.Context; text: TextModels.Model;
- BEGIN
- WITH msg: Controllers.TrackMsg DO
- IF fold.context IS TextModels.Context THEN
- Track(fold, f, msg.x, msg.y, msg.modifiers, hit);
- IF hit THEN
- IF Controllers.modify IN msg.modifiers THEN
- fold.FlipNested
- ELSE
- fold.Flip;
- context := fold.context(TextModels.Context);
- text := context.ThisModel();
- IF TextViews.FocusText() = text THEN
- GetPair(fold, l, r);
- pos := context.Pos();
- IF fold = l THEN
- TextControllers.SetCaret(text, pos + 1)
- ELSE
- TextControllers.SetCaret(text, pos)
- END;
- TextViews.ShowRange(text, pos, pos + 1, TRUE)
- END
- END
- END
- END
- | msg: Controllers.PollCursorMsg DO
- msg.cursor := Ports.refCursor
- ELSE
- END
- END HandleCtrlMsg;
- PROCEDURE (fold: Fold) Restore* (f: Views.Frame; l, t, r, b: INTEGER);
- VAR a: TextModels.Attributes; color: Ports.Color; c: Models.Context; font: Fonts.Font;
- icon: ARRAY 8 OF SHORTCHAR; w, h: INTEGER; asc, dsc, fw: INTEGER;
- BEGIN
- GetIcon(fold, icon); c := fold.context;
- IF (c # NIL) & (c IS TextModels.Context) THEN
- a := fold.context(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
- fold.context.GetSize(w, h);
- f.DrawRect(f.l, f.dot, f.r, h-f.dot, Ports.fill, Ports.grey50);
- color := Ports.white
- END;
- font.GetBounds(asc, dsc, fw);
- f.DrawSString(0, asc, color, icon, font)
- END Restore;
- PROCEDURE (fold: Fold) CopyFromSimpleView- (source: Views.View);
- BEGIN
- (* fold.CopyFrom^(source); *)
- WITH source: Fold DO
- ASSERT(source.leftSide = (source.hidden # NIL), 100);
- fold.leftSide := source.leftSide;
- fold.collapsed := source.collapsed;
- fold.label := source.label;
- IF source.hidden # NIL THEN
- fold.hidden := TextModels.CloneOf(source.hidden); Stores.Join(fold.hidden, fold);
- fold.hidden.InsertCopy(0, source.hidden, 0, source.hidden.Length())
- END
- END
- END CopyFromSimpleView;
- PROCEDURE (fold: Fold) Internalize- (VAR rd: Stores.Reader);
- VAR version: INTEGER; store: Stores.Store; xint: INTEGER;
- BEGIN
- fold.Internalize^(rd);
- IF rd.cancelled THEN RETURN END;
- rd.ReadVersion(minVersion, currentVersion, version);
- IF rd.cancelled THEN RETURN END;
- rd.ReadXInt(xint);fold.leftSide := xint = 0;
- rd.ReadXInt(xint); fold.collapsed := xint = 0;
- rd.ReadXString(fold.label);
- rd.ReadStore(store);
- IF store # NIL THEN fold.hidden := store(TextModels.Model); Stores.Join(fold.hidden, fold)
- ELSE fold.hidden := NIL
- END;
- fold.leftSide := store # NIL
- END Internalize;
- PROCEDURE (fold: Fold) Externalize- (VAR wr: Stores.Writer);
- VAR xint: INTEGER;
- BEGIN
- fold.Externalize^(wr);
- wr.WriteVersion(currentVersion);
- IF fold.hidden # NIL THEN xint := 0 ELSE xint := 1 END;
- wr.WriteXInt(xint);
- IF fold.collapsed THEN xint := 0 ELSE xint := 1 END;
- wr.WriteXInt(xint);
- wr.WriteXString(fold.label);
- wr.WriteStore(fold.hidden)
- END Externalize;
- (* --------------------- expanding and collapsing in focus text ------------------------ *)
- PROCEDURE ExpandFolds* (text: TextModels.Model; nested: BOOLEAN; IN label: ARRAY OF CHAR);
- VAR op: Domains.Operation; fold, l, r: Fold; rd: TextModels.Reader;
- BEGIN
- ASSERT(text # NIL, 20);
- Models.BeginModification(Models.clean, text);
- IF nested THEN Models.BeginScript(text, expandFoldsKey, op)
- ELSE Models.BeginScript(text, zoomInKey, op)
- END;
- rd := text.NewReader(NIL); rd.SetPos(0);
- ReadNext(rd, fold);
- WHILE ~rd.eot DO
- IF fold.leftSide & fold.collapsed THEN
- IF (label = "") OR (label = fold.label) THEN
- fold.Flip;
- IF ~nested THEN
- GetPair(fold, l, r);
- rd.SetPos(r.context(TextModels.Context).Pos())
- END
- END
- END;
- ReadNext(rd, fold)
- END;
- Models.EndScript(text, op);
- Models.EndModification(Models.clean, text)
- END ExpandFolds;
- PROCEDURE CollapseFolds* (text: TextModels.Model; nested: BOOLEAN; IN label: ARRAY OF CHAR);
- VAR op: Domains.Operation; fold, r, l: Fold; rd: TextModels.Reader;
- BEGIN
- ASSERT(text # NIL, 20);
- Models.BeginModification(Models.clean, text);
- IF nested THEN Models.BeginScript(text, collapseFoldsKey, op)
- ELSE Models.BeginScript(text, zoomOutKey, op)
- END;
- rd := text.NewReader(NIL); rd.SetPos(0);
- ReadNext(rd, fold);
- WHILE ~rd.eot DO
- IF ~fold.leftSide & ~fold.collapsed THEN
- GetPair(fold, l, r);
- IF (label = "") OR (label = l.label) THEN
- fold.Flip;
- GetPair(l, l, r);
- rd.SetPos(r.context(TextModels.Context).Pos()+1);
- IF ~nested THEN REPEAT ReadNext(rd, fold) UNTIL rd.eot OR fold.leftSide
- ELSE ReadNext(rd, fold)
- END
- ELSE ReadNext(rd, fold)
- END
- ELSE ReadNext(rd, fold)
- END
- END;
- Models.EndScript(text, op);
- Models.EndModification(Models.clean, text)
- END CollapseFolds;
- PROCEDURE ZoomIn*;
- VAR text: TextModels.Model;
- BEGIN
- text := TextViews.FocusText();
- IF text # NIL THEN ExpandFolds(text, FALSE, "") END
- END ZoomIn;
- PROCEDURE ZoomOut*;
- VAR text: TextModels.Model;
- BEGIN
- text := TextViews.FocusText();
- IF text # NIL THEN CollapseFolds(text, FALSE, "") END
- END ZoomOut;
- PROCEDURE Expand*;
- VAR text: TextModels.Model;
- BEGIN
- text := TextViews.FocusText();
- IF text # NIL THEN ExpandFolds(text, TRUE, "") END
- END Expand;
- PROCEDURE Collapse*;
- VAR text: TextModels.Model;
- BEGIN
- text := TextViews.FocusText();
- IF text # NIL THEN CollapseFolds(text, TRUE, "") END
- END Collapse;
- (* ---------------------- foldData dialogbox --------------------------- *)
- PROCEDURE FindLabelGuard* (VAR par: Dialog.Par);
- BEGIN
- par.disabled := (TextViews.Focus() = NIL) OR foldData.all
- END FindLabelGuard;
-
- PROCEDURE SetLabelGuard* ( VAR p : Dialog.Par );
- VAR v: Views.View;
- BEGIN
- Controllers.SetCurrentPath(Controllers.targetPath);
- v := Containers.FocusSingleton();
- p.disabled := (v = NIL) OR ~(v IS Fold) OR ~v(Fold).leftSide;
- Controllers.ResetCurrentPath()
- END SetLabelGuard;
- PROCEDURE ExpandLabel*;
- VAR text: TextModels.Model;
- BEGIN
- IF foldData.all & (foldData.findLabel # "") THEN
- foldData.findLabel := ""; Dialog.Update(foldData)
- END;
- text := TextViews.FocusText();
- IF text # NIL THEN
- IF ~foldData.all THEN ExpandFolds(text, foldData.nested, foldData.findLabel)
- ELSE ExpandFolds(text, foldData.nested, "")
- END
- END
- END ExpandLabel;
- PROCEDURE CollapseLabel*;
- VAR text: TextModels.Model;
- BEGIN
- IF foldData.all & (foldData.findLabel # "") THEN
- foldData.findLabel := ""; Dialog.Update(foldData)
- END;
- text := TextViews.FocusText();
- IF text # NIL THEN
- IF ~foldData.all THEN CollapseFolds(text, foldData.nested, foldData.findLabel)
- ELSE CollapseFolds(text, foldData.nested, "")
- END
- END
- END CollapseLabel;
- PROCEDURE FindFold(first: BOOLEAN);
- VAR c : TextControllers.Controller; r: TextModels.Reader;
- v : Views.View; pos, i : INTEGER;
- BEGIN
- c := TextControllers.Focus();
- IF c # NIL THEN
- IF first THEN pos := 0
- ELSE
- pos := c.CaretPos();
- IF pos = TextControllers.none THEN
- c.GetSelection(i, pos);
- IF pos = i THEN pos := 0 ELSE INC(pos) END;
- pos := MIN(pos, c.text.Length()-1)
- END
- END;
- r := c.text.NewReader(NIL); r.SetPos(pos);
- REPEAT r.ReadView(v)
- UNTIL r.eot OR ((v IS Fold) & v(Fold).leftSide) & (foldData.all OR (v(Fold).label$ = foldData.findLabel$));
- IF r.eot THEN
- c.SetCaret(0); Dialog.Beep
- ELSE
- pos := r.Pos();
- c.view.ShowRange(pos-1, pos, FALSE);
- c.SetSelection(pos-1, pos);
- IF LEN(v(Fold).label) > 0 THEN
- foldData.newLabel := v(Fold).label
- END;
- Dialog.Update(foldData)
- END
- ELSE
- Dialog.Beep
- END
- END FindFold;
- PROCEDURE FindNextFold*;
- BEGIN
- FindFold(FALSE)
- END FindNextFold;
-
- PROCEDURE FindFirstFold*;
- BEGIN
- FindFold(TRUE)
- END FindFirstFold;
-
- PROCEDURE SetLabel*;
- VAR v: Views.View;
- BEGIN
- Controllers.SetCurrentPath(Controllers.targetPath);
- v := Containers.FocusSingleton();
- IF (v # NIL) & (v IS Fold) & (LEN(foldData.newLabel) > 0) THEN
- v(Fold).label := foldData.newLabel
- ELSE
- Dialog.Beep
- END;
- Controllers.ResetCurrentPath()
- END SetLabel;
- PROCEDURE (a: Action) Do;
- VAR v: Views.View; fp: INTEGER;
- BEGIN
- Controllers.SetCurrentPath(Controllers.targetPath);
- v := Containers.FocusSingleton();
- IF (v = NIL) OR ~(v IS Fold) THEN
- fingerprint := 0;
- foldData.newLabel := ""
- ELSE
- fp := Services.AdrOf(v);
- IF fp # fingerprint THEN
- foldData.newLabel := v(Fold).label;
- fingerprint := fp;
- Dialog.Update(foldData)
- END
- END;
- Controllers.ResetCurrentPath();
- Services.DoLater(action, Services.Ticks() + Services.resolution DIV 2)
- END Do;
- (* ------------------------ inserting folds ------------------------ *)
-
- PROCEDURE Overlaps* (text: TextModels.Model; beg, end: INTEGER): BOOLEAN;
- VAR n, level: INTEGER; rd: TextModels.Reader; v: Views.View;
- BEGIN
- ASSERT(text # NIL, 20);
- ASSERT((beg >= 0) & (end <= text.Length()) & (beg <= end), 21);
- rd := text.NewReader(NIL); rd.SetPos(beg);
- n := 0; level := 0;
- REPEAT rd.ReadView(v);
- IF ~rd.eot & (rd.Pos() <= end) THEN
- WITH v: Fold DO INC(n);
- IF v.leftSide THEN INC(level) ELSE DEC(level) END
- ELSE
- END
- END
- UNTIL rd.eot OR (level < 0) OR (rd.Pos() >= end);
- RETURN (level # 0) OR ODD(n)
- END Overlaps;
- PROCEDURE InsertionAttr (text: TextModels.Model; pos: INTEGER): TextModels.Attributes;
- VAR rd: TextModels.Reader; ch: CHAR;
- BEGIN
- rd := text.NewReader(NIL);
- rd.SetPos(pos); rd.ReadChar(ch);
- RETURN rd.attr
- END InsertionAttr;
- PROCEDURE Insert* (text: TextModels.Model; label: Label; beg, end: INTEGER; collapsed: BOOLEAN);
- VAR w: TextModels.Writer; fold: Fold; insop: Domains.Operation; a: TextModels.Attributes;
- BEGIN
- ASSERT(text # NIL, 20);
- ASSERT((beg >= 0) & (end <= text.Length()) & (beg <= end), 21);
- a := InsertionAttr(text, beg);
- w := text.NewWriter(NIL); w.SetPos(beg);
- IF a # NIL THEN w.SetAttr(a) END;
- NEW(fold);
- fold.leftSide := TRUE; fold.collapsed := collapsed;
- fold.hidden := TextModels.CloneOf(text); Stores.Join(fold, fold.hidden);
- fold.label := label$;
- Models.BeginScript(text, insertFoldKey, insop);
- w.WriteView(fold, 0, 0);
- w.SetPos(end+1);
- a := InsertionAttr(text, end+1);
- IF a # NIL THEN w.SetAttr(a) END;
- NEW(fold);
- fold.leftSide := FALSE; fold.collapsed := collapsed;
- fold.hidden := NIL; fold.label := "";
- w.WriteView(fold, 0, 0);
- Models.EndScript(text, insop)
- END Insert;
- PROCEDURE CreateGuard* (VAR par: Dialog.Par);
- VAR c: TextControllers.Controller; beg, end: INTEGER;
- BEGIN c := TextControllers.Focus();
- IF (c # NIL) & ~(Containers.noCaret IN c.opts) THEN
- IF c.HasSelection() THEN c.GetSelection(beg, end);
- IF Overlaps(c.text, beg, end) THEN par.disabled := TRUE END
- END
- ELSE par.disabled := TRUE
- END
- END CreateGuard;
- PROCEDURE Create* (state: INTEGER); (* menu cmd parameters don't accept Booleans *)
- VAR c: TextControllers.Controller; beg, end: INTEGER; collapsed: BOOLEAN;
- BEGIN
- collapsed := state = 0;
- c := TextControllers.Focus();
- IF (c # NIL) & ~(Containers.noCaret IN c.opts) THEN
- IF c.HasSelection() THEN c.GetSelection(beg, end);
- IF ~Overlaps(c.text, beg, end) THEN Insert(c.text, "", beg, end, collapsed) END
- ELSE beg := c.CaretPos(); Insert(c.text, "", beg, beg, collapsed)
- END
- END
- END Create;
- PROCEDURE InitIcons;
- VAR font: Fonts.Font;
- PROCEDURE DefaultAppearance;
- BEGIN
- font := Fonts.dir.Default(); iconFont := font.typeface$;
- leftExp := ">"; rightExp := "<";
- leftColl := "=>"; rightColl := "<=";
- coloredBackg := TRUE
- END DefaultAppearance;
- BEGIN
- IF Dialog.platform = Dialog.linux THEN (* Linux *)
- DefaultAppearance;
- coloredBackg := FALSE
- ELSIF 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
- leftExp[0] := SHORT(CHR(240)); leftExp[1] := 0X;
- rightExp[0] := SHORT(CHR(239)); rightExp[1] := 0X;
- leftColl[0] := SHORT(CHR(232)); leftColl[1] := 0X;
- rightColl[0] := SHORT(CHR(231)); rightColl[1] := 0X;
- coloredBackg := FALSE
- END
- ELSIF Dialog.platform DIV 10 = 2 THEN (* Mac *)
- iconFont := "Chicago";
- font := Fonts.dir.This(iconFont, 10*Fonts.point (*arbitrary*), {}, Fonts.normal);
- IF font.IsAlien() THEN DefaultAppearance
- ELSE
- leftExp := ">"; rightExp := "<";
- leftColl := "»"; rightColl := "«";
- coloredBackg := TRUE
- END
- ELSE
- DefaultAppearance
- END
- END InitIcons;
- PROCEDURE (d: StdDirectory) New (collapsed: BOOLEAN; label: Label;
- hiddenText: TextModels.Model): Fold;
- VAR fold: Fold;
- BEGIN
- NEW(fold); fold.leftSide := hiddenText # NIL; fold.collapsed := collapsed;
- fold.label := label; fold.hidden := hiddenText;
- IF hiddenText # NIL THEN Stores.Join(fold, fold.hidden) END;
- RETURN fold
- END New;
- PROCEDURE SetDir* (d: Directory);
- BEGIN
- ASSERT(d # NIL, 20);
- dir := d
- END SetDir;
- PROCEDURE InitMod;
- VAR d: StdDirectory;
- BEGIN
- foldData.all := TRUE; foldData.nested := FALSE; foldData.findLabel := ""; foldData.newLabel := "";
- NEW(d); dir := d; stdDir := d;
- InitIcons;
- NEW(action); Services.DoLater(action, Services.now);
- END InitMod;
- BEGIN
- InitMod
- END StdFolds.
|