summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 7c7fa4a)
raw | patch | inline | side by side (parent: 7c7fa4a)
| author | Alexander Shiryaev <aixp@mail.ru> | |
| Fri, 16 Nov 2012 19:54:32 +0000 (23:54 +0400) | ||
| committer | Alexander Shiryaev <aixp@mail.ru> | |
| Fri, 16 Nov 2012 19:54:32 +0000 (23:54 +0400) |
19 files changed:
diff --git a/new/Std/Mod/Api.txt b/new/Std/Mod/Api.txt
--- a/new/Std/Mod/Api.txt
+++ /dev/null
@@ -1,229 +0,0 @@
-MODULE StdApi;
-
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Api.odc *)
- (* DO NOT EDIT *)
-
- IMPORT
- Kernel, Views, Files, Dialog, Converters, Windows, Sequencers, Stores, Meta,
- Containers, StdDialog, Documents;
-
- (* Auxiliary procedures *)
-
- PROCEDURE CheckQualident (VAR str, mod, name: ARRAY OF CHAR);
- VAR i, j: INTEGER; ch: CHAR;
- BEGIN
- i := 0;
- REPEAT
- ch := str[i]; mod[i] := ch; INC(i)
- UNTIL (i = LEN(str)) OR (i = LEN(mod)) OR (ch < "0") OR (ch > "9") & (CAP(ch) < "A") OR (CAP(ch) > "Z");
- IF ch = "." THEN
- mod[i - 1] := 0X; j := 0;
- REPEAT
- ch := str[i]; name[j] := ch; INC(i); INC(j)
- UNTIL (i = LEN(str)) OR (j = LEN(name)) OR (ch < "0") OR (ch > "9") & (CAP(ch) < "A") OR (CAP(ch) > "Z");
- IF ch # 0X THEN mod[0] := 0X; name[0] := 0X END
- ELSE mod[0] := 0X; name[0] := 0X
- END
- END CheckQualident;
-
- PROCEDURE PathToSpec (VAR path: ARRAY OF CHAR; VAR loc: Files.Locator; VAR name: Files.Name);
- VAR i, j: INTEGER; ch: CHAR;
- BEGIN
- i := 0; j := 0; loc := Files.dir.This("");
- WHILE (loc.res = 0) & (i < LEN(path) - 1) & (j < LEN(name) - 1) & (path[i] # 0X) DO
- ch := path[i]; INC(i);
- IF (j > 0) & ((ch = "/") OR (ch = "\")) THEN
- name[j] := 0X; j := 0;
- IF name = "*" THEN
- IF Dialog.language # "" THEN loc := loc.This(Dialog.language) END
- ELSE loc := loc.This(name)
- END
- ELSE
- name[j] := ch; INC(j)
- END
- END;
- IF path[i] = 0X THEN name[j] := 0X
- ELSE loc.res := 1; name := ""
- END
- END PathToSpec;
-
- PROCEDURE ThisDialog (dialog: ARRAY OF CHAR): Views.View;
- VAR fname, submod, sub, mod: Files.Name; canCreate: BOOLEAN; conv: Converters.Converter;
- loc: Files.Locator; file: Files.File; v: Views.View; s: Stores.Store; var: Meta.Item;
- BEGIN
- ASSERT(dialog # "", 20);
- v := NIL; file := NIL; canCreate := FALSE;
- CheckQualident(dialog, submod, fname);
- IF submod # "" THEN (* is qualident *)
- Meta.LookupPath(dialog, var);
- IF var.obj = Meta.varObj THEN (* variable exists *)
- canCreate := TRUE;
- Kernel.SplitName(submod, sub, mod);
- loc := Files.dir.This(sub);
- IF loc # NIL THEN
- Kernel.MakeFileName(fname, "");
- loc := loc.This("Rsrc");
- IF loc # NIL THEN file := Files.dir.Old(loc, fname, Files.shared) END;
- IF (file = NIL) & (sub = "") THEN
- loc := Files.dir.This("System"); ASSERT(loc # NIL, 100);
- IF loc # NIL THEN
- loc := loc.This("Rsrc");
- IF loc # NIL THEN file := Files.dir.Old(loc, fname, Files.shared) END
- END
- END
- END
- END
- END;
- IF (file = NIL) & ~canCreate THEN (* try file name *)
- PathToSpec(dialog, loc, fname);
- IF loc.res = 0 THEN
- Kernel.MakeFileName(fname, "");
- file := Files.dir.Old(loc, fname, Files.shared)
- END
- END;
- IF file # NIL THEN
- Kernel.MakeFileName(fname, "");
- conv := NIL; Converters.Import(loc, fname, conv, s);
- IF s # NIL THEN
- v := s(Views.View)
- END
- ELSE Dialog.ShowParamMsg("#System:FileNotFound", dialog, "", "")
- END;
- RETURN v
- END ThisDialog;
-
- PROCEDURE ThisMask (param: ARRAY OF CHAR): Views.View;
- VAR v: Views.View; c: Containers.Controller;
- BEGIN
- v := ThisDialog(param);
- IF v # NIL THEN
- WITH v: Containers.View DO
- c := v.ThisController();
- IF c # NIL THEN
- c.SetOpts(c.opts - {Containers.noFocus} + {Containers.noCaret, Containers.noSelection})
- ELSE Dialog.ShowMsg("#System:NotEditable")
- END
- ELSE Dialog.ShowMsg("#System:ContainerExpected")
- END
- END;
- RETURN v
- END ThisMask;
-
- (* Interface procedures *)
-
- PROCEDURE CloseDialog* (OUT closedView: Views.View);
- CONST canClose = {Windows.neverDirty, Windows.isTool, Windows.isAux};
- VAR w: Windows.Window; msg: Sequencers.CloseMsg;
- BEGIN
- closedView := NIL;
- w := Windows.dir.First();
- IF w # NIL THEN
- IF w.sub THEN
- closedView := w.frame.view;
- Windows.dir.Close(w);
- ELSIF (w.flags * canClose = {}) & w.seq.Dirty() THEN
- Dialog.ShowMsg("#System:CannotCloseDirtyWindow")
- ELSE
- msg.sticky := FALSE; w.seq.Notify(msg);
- IF ~msg.sticky THEN closedView := w.frame.view; Windows.dir.Close(w) END
- END
- END
- END CloseDialog;
-
- PROCEDURE OpenAux* (file, title: ARRAY OF CHAR; OUT v: Views.View);
- VAR loc: Files.Locator; name: Files.Name; t: Views.Title;
- BEGIN
- PathToSpec(file, loc, name);
- IF loc.res = 0 THEN
- loc.res := 77; v := Views.OldView(loc, name); loc.res := 0;
- IF v # NIL THEN t := title$; Views.OpenAux(v, t)
- ELSE Dialog.ShowParamMsg("#System:FileNotFound", file, "", "")
- END
- ELSE Dialog.ShowParamMsg("#System:FileNotFound", file, "", "")
- END
- END OpenAux;
-
- PROCEDURE OpenAuxDialog* (file, title: ARRAY OF CHAR; OUT v: Views.View);
- VAR t0: Views.Title; done: BOOLEAN;
- BEGIN
- Dialog.MapString(title, t0);
- Windows.SelectByTitle(NIL, {Windows.isAux}, t0, done);
- IF ~done THEN
- v := ThisMask(file);
- IF v # NIL THEN
- StdDialog.Open(v, title, NIL, "", NIL, FALSE, TRUE, TRUE, FALSE, TRUE)
- END
- END
- END OpenAuxDialog;
-
- PROCEDURE OpenBrowser* (file, title: ARRAY OF CHAR; OUT v: Views.View);
- VAR loc: Files.Locator; name: Files.Name; t: Views.Title;
- c: Containers.Controller;
- BEGIN
- PathToSpec(file, loc, name);
- IF loc.res = 0 THEN
- loc.res := 77; v := Views.OldView(loc, name); loc.res := 0;
- IF v # NIL THEN
- WITH v: Containers.View DO
- c := v.ThisController();
- IF c # NIL THEN
- c.SetOpts(c.opts - {Containers.noFocus, Containers.noSelection} + {Containers.noCaret})
- END
- ELSE
- END;
- t := title$;
- StdDialog.Open(v, t, NIL, "", NIL, FALSE, TRUE, FALSE, TRUE, FALSE)
- ELSE Dialog.ShowParamMsg("#System:FileNotFound", file, "", "")
- END
- ELSE Dialog.ShowParamMsg("#System:FileNotFound", file, "", "")
- END
- END OpenBrowser;
-
- PROCEDURE OpenDoc* (file: ARRAY OF CHAR; OUT v: Views.View);
- VAR loc: Files.Locator; name: Files.Name; conv: Converters.Converter;
- BEGIN
- PathToSpec(file, loc, name);
- IF loc.res = 0 THEN
- conv := NIL; v := Views.Old(Views.dontAsk, loc, name, conv);
- IF loc.res = 78 THEN loc := NIL; name := "" END; (* stationery *)
- IF v # NIL THEN Views.Open(v, loc, name, conv)
- ELSE Dialog.ShowParamMsg("#System:FileNotFound", file, "", "")
- END
- ELSE Dialog.ShowParamMsg("#System:FileNotFound", file, "", "")
- END
- END OpenDoc;
-
- PROCEDURE OpenCopyOf* (file: ARRAY OF CHAR; OUT v: Views.View);
- VAR loc: Files.Locator; name: Files.Name; conv: Converters.Converter;
- BEGIN
- PathToSpec(file, loc, name);
- IF loc.res = 0 THEN
- conv := NIL; v := Views.Old(Views.dontAsk, loc, name, conv);
- IF loc.res = 78 THEN loc := NIL; name := "" END; (* stationary *)
- IF v # NIL THEN
- IF v.context # NIL THEN
- v := Views.CopyOf(v.context(Documents.Context).ThisDoc(), Views.deep);
- Stores.InitDomain(v)
- ELSE v := Views.CopyOf(v, Views.deep)
- END;
- Views.Open(v, NIL, "", conv)
- ELSE Dialog.ShowParamMsg("#System:FileNotFound", file, "", "")
- END
- ELSE Dialog.ShowParamMsg("#System:FileNotFound", file, "", "")
- END
- END OpenCopyOf;
-
- PROCEDURE OpenToolDialog* (file, title: ARRAY OF CHAR; OUT v: Views.View);
- VAR t0: Views.Title; done: BOOLEAN;
- BEGIN
- Dialog.MapString(title, t0);
- Windows.SelectByTitle(NIL, {Windows.isTool}, t0, done);
- IF ~done THEN
- v := ThisMask(file);
- IF v # NIL THEN
- StdDialog.Open(v, title, NIL, "", NIL, TRUE, FALSE, TRUE, FALSE, TRUE)
- END
- END
- END OpenToolDialog;
-
-END StdApi.
diff --git a/new/Std/Mod/CFrames.txt b/new/Std/Mod/CFrames.txt
--- a/new/Std/Mod/CFrames.txt
+++ /dev/null
@@ -1,243 +0,0 @@
-MODULE StdCFrames;
-
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/CFrames.odc *)
- (* DO NOT EDIT *)
-
- IMPORT Fonts, Ports, Views, Dates, Dialog;
-
- CONST lineUp* = 0; lineDown* = 1; pageUp* = 2; pageDown* = 3;
-
- TYPE
- Frame* = POINTER TO ABSTRACT RECORD (Views.Frame)
- disabled*, undef*, readOnly*, noRedraw*: BOOLEAN;
- font*: Fonts.Font
- END;
-
- PushButton* = POINTER TO ABSTRACT RECORD (Frame)
- label*: ARRAY 256 OF CHAR;
- default*, cancel*: BOOLEAN;
- Do*: PROCEDURE (f: PushButton)
- END;
-
- CheckBox* = POINTER TO ABSTRACT RECORD (Frame)
- label*: ARRAY 256 OF CHAR;
- Get*: PROCEDURE (f: CheckBox; OUT on: BOOLEAN);
- Set*: PROCEDURE (f: CheckBox; on: BOOLEAN)
- END;
-
- RadioButton* = POINTER TO ABSTRACT RECORD (Frame)
- label*: ARRAY 256 OF CHAR;
- Get*: PROCEDURE (f: RadioButton; OUT on: BOOLEAN);
- Set*: PROCEDURE (f: RadioButton; on: BOOLEAN)
- END;
-
- ScrollBar* = POINTER TO ABSTRACT RECORD (Frame)
- Track*: PROCEDURE (f: ScrollBar; dir: INTEGER; VAR pos: INTEGER);
- Get*: PROCEDURE (f: ScrollBar; OUT size, sect, pos: INTEGER);
- Set*: PROCEDURE (f: ScrollBar; pos: INTEGER)
- END;
-
- Field* = POINTER TO ABSTRACT RECORD (Frame)
- maxLen*: INTEGER; (* max num of characters in field (w/o 0X) *)
- left*, right*, multiLine*, password*: BOOLEAN;
- Get*: PROCEDURE (f: Field; OUT string: ARRAY OF CHAR);
- Set*: PROCEDURE (f: Field; IN string: ARRAY OF CHAR);
- Equal*: PROCEDURE (f: Field; IN s1, s2: ARRAY OF CHAR): BOOLEAN
- END;
-
- UpDownField* = POINTER TO ABSTRACT RECORD (Frame)
- min*, max*, inc*: INTEGER;
- Get*: PROCEDURE (f: UpDownField; OUT val: INTEGER);
- Set*: PROCEDURE (f: UpDownField; val: INTEGER)
- END;
-
- DateField* = POINTER TO ABSTRACT RECORD (Frame)
- Get*: PROCEDURE (f: DateField; OUT date: Dates.Date);
- Set*: PROCEDURE (f: DateField; IN date: Dates.Date);
- GetSel*: PROCEDURE (f: DateField; OUT sel: INTEGER);
- SetSel*: PROCEDURE (f: DateField; sel: INTEGER)
- END;
-
- TimeField* = POINTER TO ABSTRACT RECORD (Frame)
- Get*: PROCEDURE (f: TimeField; OUT date: Dates.Time);
- Set*: PROCEDURE (f: TimeField; IN date: Dates.Time);
- GetSel*: PROCEDURE (f: TimeField; OUT sel: INTEGER);
- SetSel*: PROCEDURE (f: TimeField; sel: INTEGER)
- END;
-
- ColorField* = POINTER TO ABSTRACT RECORD (Frame)
- Get*: PROCEDURE (f: ColorField; OUT col: INTEGER);
- Set*: PROCEDURE (f: ColorField; col: INTEGER)
- END;
-
- ListBox* = POINTER TO ABSTRACT RECORD (Frame)
- sorted*: BOOLEAN;
- Get*: PROCEDURE (f: ListBox; OUT i: INTEGER);
- Set*: PROCEDURE (f: ListBox; i: INTEGER);
- GetName*: PROCEDURE (f: ListBox; i: INTEGER; VAR name: ARRAY OF CHAR)
- END;
-
- SelectionBox* = POINTER TO ABSTRACT RECORD (Frame)
- sorted*: BOOLEAN;
- Get*: PROCEDURE (f: SelectionBox; i: INTEGER; OUT in: BOOLEAN);
- Incl*: PROCEDURE (f: SelectionBox; from, to: INTEGER);
- Excl*: PROCEDURE (f: SelectionBox; from, to: INTEGER);
- Set*: PROCEDURE (f: SelectionBox; from, to: INTEGER);
- GetName*: PROCEDURE (f: SelectionBox; i: INTEGER; VAR name: ARRAY OF CHAR)
- END;
-
- ComboBox* = POINTER TO ABSTRACT RECORD (Frame)
- sorted*: BOOLEAN;
- Get*: PROCEDURE (f: ComboBox; OUT string: ARRAY OF CHAR);
- Set*: PROCEDURE (f: ComboBox; IN string: ARRAY OF CHAR);
- GetName*: PROCEDURE (f: ComboBox; i: INTEGER; VAR name: ARRAY OF CHAR)
- END;
-
- Caption* = POINTER TO ABSTRACT RECORD (Frame)
- label*: ARRAY 256 OF CHAR;
- left*, right*: BOOLEAN;
- END;
-
- Group* = POINTER TO ABSTRACT RECORD (Frame)
- label*: ARRAY 256 OF CHAR
- END;
-
- TreeFrame* = POINTER TO ABSTRACT RECORD (Frame)
- sorted*, haslines*, hasbuttons*, atroot*, foldericons*: BOOLEAN;
- NofNodes*: PROCEDURE (f: TreeFrame): INTEGER;
- Child*: PROCEDURE (f: TreeFrame; node: Dialog.TreeNode): Dialog.TreeNode;
- Parent*: PROCEDURE (f: TreeFrame; node: Dialog.TreeNode): Dialog.TreeNode;
- Next*: PROCEDURE (f: TreeFrame; node: Dialog.TreeNode): Dialog.TreeNode;
- Select*: PROCEDURE (f: TreeFrame; node: Dialog.TreeNode);
- Selected*: PROCEDURE (f: TreeFrame): Dialog.TreeNode;
- SetExpansion*: PROCEDURE (f: TreeFrame; tn: Dialog.TreeNode; expanded: BOOLEAN)
- END;
-
- Directory* = POINTER TO ABSTRACT RECORD END;
-
-
- VAR
- setFocus*: BOOLEAN;
- defaultFont*, defaultLightFont*: Fonts.Font;
- dir-, stdDir-: Directory;
-
-
- (** Frame **)
-
-
- PROCEDURE (f: Frame) MouseDown* (x, y: INTEGER; buttons: SET), NEW, EMPTY;
- PROCEDURE (f: Frame) WheelMove* (x, y: INTEGER; op, nofLines: INTEGER;
- VAR done: BOOLEAN), NEW, EMPTY;
- PROCEDURE (f: Frame) KeyDown* (ch: CHAR), NEW, EMPTY;
- PROCEDURE (f: Frame) Restore* (l, t, r, b: INTEGER), NEW, ABSTRACT;
- PROCEDURE (f: Frame) UpdateList*, NEW, EMPTY;
- PROCEDURE (f: Frame) Mark* (on, focus: BOOLEAN), NEW, EMPTY;
- PROCEDURE (f: Frame) Edit* (op: INTEGER; VAR v: Views.View; VAR w, h: INTEGER;
- VAR singleton, clipboard: BOOLEAN), NEW, EMPTY;
- PROCEDURE (f: Frame) GetCursor* (x, y: INTEGER; modifiers: SET; VAR cursor: INTEGER), NEW, EMPTY;
-
- PROCEDURE (f: Frame) Update*, NEW, EXTENSIBLE;
- VAR l, t, r, b: INTEGER; root: Views.RootFrame;
- BEGIN
- l := f.l + f.gx; t := f.t + f.gy; r := f.r + f.gx; b := f.b + f.gy;
- root := Views.RootOf(f);
- Views.UpdateRoot(root, l, t, r, b, Views.keepFrames);
- Views.ValidateRoot(root)
- END Update;
-
- PROCEDURE (f: Frame) DblClickOk* (x, y: INTEGER): BOOLEAN, NEW, EXTENSIBLE;
- BEGIN
- RETURN TRUE
- END DblClickOk;
-
-
- (** Field **)
-
- PROCEDURE (f: Field) Idle* (), NEW, ABSTRACT;
- PROCEDURE (f: Field) Select* (from, to: INTEGER), NEW, ABSTRACT;
- PROCEDURE (f: Field) GetSelection* (OUT from, to: INTEGER), NEW, ABSTRACT;
- PROCEDURE (f: Field) Length* (): INTEGER, NEW, ABSTRACT;
-
- PROCEDURE (f: Field) GetCursor* (x, y: INTEGER; modifiers: SET; VAR cursor: INTEGER), EXTENSIBLE;
- BEGIN
- cursor := Ports.textCursor
- END GetCursor;
-
-
- (** UpDownField **)
-
- PROCEDURE (f: UpDownField) Idle*, NEW, ABSTRACT;
- PROCEDURE (f: UpDownField) Select* (from, to: INTEGER), NEW, ABSTRACT;
- PROCEDURE (f: UpDownField) GetSelection* (OUT from, to: INTEGER), NEW, ABSTRACT;
-
- PROCEDURE (f: UpDownField) GetCursor* (x, y: INTEGER; modifiers: SET;
- VAR cursor: INTEGER), EXTENSIBLE;
- BEGIN
- cursor := Ports.textCursor
- END GetCursor;
-
-
- (** SelectionBox **)
-
- PROCEDURE (f: SelectionBox) Select* (from, to: INTEGER), NEW, ABSTRACT;
- PROCEDURE (f: SelectionBox) GetSelection* (OUT from, to: INTEGER), NEW, ABSTRACT;
-
- PROCEDURE (f: SelectionBox) UpdateRange* (op, from, to: INTEGER), NEW, EXTENSIBLE;
- BEGIN
- f.Update
- END UpdateRange;
-
-
- (** ComboBox **)
-
- PROCEDURE (f: ComboBox) Idle* (), NEW, ABSTRACT;
- PROCEDURE (f: ComboBox) Select* (from, to: INTEGER), NEW, ABSTRACT;
- PROCEDURE (f: ComboBox) GetSelection* (OUT from, to: INTEGER), NEW, ABSTRACT;
- PROCEDURE (f: ComboBox) Length* (): INTEGER, NEW, ABSTRACT;
-
- (* TreeFrame **)
- PROCEDURE (f: TreeFrame) GetSize* (OUT w, h: INTEGER), NEW, ABSTRACT;
-
- (** Directory **)
-
- PROCEDURE (d: Directory) GetPushButtonSize* (VAR w, h: INTEGER), NEW, ABSTRACT;
- PROCEDURE (d: Directory) GetCheckBoxSize* (VAR w, h: INTEGER), NEW, ABSTRACT;
- PROCEDURE (d: Directory) GetRadioButtonSize* (VAR w, h: INTEGER), NEW, ABSTRACT;
- PROCEDURE (d: Directory) GetScrollBarSize* (VAR w, h: INTEGER), NEW, ABSTRACT;
- PROCEDURE (d: Directory) GetFieldSize* (max: INTEGER; VAR w, h: INTEGER), NEW, ABSTRACT;
- PROCEDURE (d: Directory) GetUpDownFieldSize* (max: INTEGER; VAR w, h: INTEGER), NEW, ABSTRACT;
- PROCEDURE (d: Directory) GetDateFieldSize* (VAR w, h: INTEGER), NEW, ABSTRACT;
- PROCEDURE (d: Directory) GetTimeFieldSize* (VAR w, h: INTEGER), NEW, ABSTRACT;
- PROCEDURE (d: Directory) GetColorFieldSize* (VAR w, h: INTEGER), NEW, ABSTRACT;
- PROCEDURE (d: Directory) GetListBoxSize* (VAR w, h: INTEGER), NEW, ABSTRACT;
- PROCEDURE (d: Directory) GetSelectionBoxSize* (VAR w, h: INTEGER), NEW, ABSTRACT;
- PROCEDURE (d: Directory) GetComboBoxSize* (VAR w, h: INTEGER), NEW, ABSTRACT;
- PROCEDURE (d: Directory) GetCaptionSize* (VAR w, h: INTEGER), NEW, ABSTRACT;
- PROCEDURE (d: Directory) GetGroupSize* (VAR w, h: INTEGER), NEW, ABSTRACT;
- PROCEDURE (d: Directory) GetTreeFrameSize* (VAR w, h: INTEGER), NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewPushButton* (): PushButton, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewCheckBox* (): CheckBox, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewRadioButton* (): RadioButton, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewScrollBar* (): ScrollBar, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewField* (): Field, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewUpDownField* (): UpDownField, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewDateField* (): DateField, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewTimeField* (): TimeField, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewColorField* (): ColorField, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewListBox* (): ListBox, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewSelectionBox* (): SelectionBox, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewComboBox* (): ComboBox, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewCaption* (): Caption, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewGroup* (): Group, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewTreeFrame* (): TreeFrame, NEW, ABSTRACT;
-
-
- PROCEDURE SetDir* (d: Directory);
- BEGIN
- ASSERT(d # NIL, 20); dir := d;
- IF stdDir = NIL THEN stdDir := d END
- END SetDir;
-
-BEGIN
- setFocus := FALSE
-END StdCFrames.
diff --git a/new/Std/Mod/Clocks.txt b/new/Std/Mod/Clocks.txt
--- a/new/Std/Mod/Clocks.txt
+++ /dev/null
@@ -1,183 +0,0 @@
-MODULE StdClocks;
-
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Clocks.odc *)
- (* DO NOT EDIT *)
-
- IMPORT
- Dates, Math, Domains := Stores, Ports, Stores, Models, Views, Services, Properties,
- TextModels;
-
- CONST
- minSize = 25 * Ports.point; niceSize = 42 * Ports.point;
- minVersion = 0; maxVersion = 0;
-
- TYPE
- StdView = POINTER TO RECORD (Views.View)
- time: Dates.Time
- END;
-
- TickAction = POINTER TO RECORD (Services.Action) END;
-
- Msg = RECORD (Models.Message)
- consumed: BOOLEAN;
- time: Dates.Time
- END;
-
- VAR
- clockTime: Dates.Time;
- action: TickAction;
- actionIsAlive: BOOLEAN;
-
-
- PROCEDURE Cos (r, g: INTEGER): INTEGER;
- BEGIN
- RETURN SHORT(ENTIER(r * Math.Cos(2 * Math.Pi() * g / 60) + 0.5))
- END Cos;
-
- PROCEDURE Sin (r, g: INTEGER): INTEGER;
- BEGIN
- RETURN SHORT(ENTIER(r * Math.Sin(2 * Math.Pi() * g / 60) + 0.5))
- END Sin;
-
- PROCEDURE (a: TickAction) Do;
- VAR msg: Msg; time: Dates.Time;
- BEGIN
- Dates.GetTime(time);
- IF clockTime.second = time.second THEN
- Services.DoLater(action, Services.Ticks() + Services.resolution DIV 2)
- ELSE
- clockTime := time;
- msg.consumed := FALSE;
- msg.time := time;
- Views.Omnicast(msg);
- IF msg.consumed THEN
- Services.DoLater(action, Services.Ticks() + Services.resolution DIV 2)
- ELSE
- actionIsAlive := FALSE
- END
- END
- END Do;
-
-
- (* View *)
-
- PROCEDURE DrawTick (f: Views.Frame; m, d0, d1, s, g: INTEGER; c: Ports.Color);
- BEGIN
- f.DrawLine(m + Sin(d0, g), m - Cos(d0, g), m + Sin(d1, g), m - Cos(d1, g), s, c)
- END DrawTick;
-
-
- PROCEDURE (v: StdView) Externalize (VAR wr: Stores.Writer);
- BEGIN
- v.Externalize^(wr);
- wr.WriteVersion(maxVersion);
- wr.WriteByte(9)
- END Externalize;
-
- PROCEDURE (v: StdView) Internalize (VAR rd: Stores.Reader);
- VAR thisVersion: INTEGER; format: BYTE;
- BEGIN
- v.Internalize^(rd);
- IF ~rd.cancelled THEN
- rd.ReadVersion(minVersion, maxVersion, thisVersion);
- IF ~rd.cancelled THEN
- rd.ReadByte(format);
- v.time.second := -1
- END
- END
- END Internalize;
-
- PROCEDURE (v: StdView) CopyFromSimpleView (source: Views.View);
- BEGIN
- WITH source: StdView DO
- v.time.second := -1
- END
- END CopyFromSimpleView;
-
- PROCEDURE (v: StdView) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- VAR c: Models.Context; a: TextModels.Attributes; color: Ports.Color;
- time: Dates.Time;
- i, m, d, u, hs, hd1, ms, md1, ss, sd0, sd1, w, h: INTEGER;
- BEGIN
- IF ~actionIsAlive THEN
- actionIsAlive := TRUE; Services.DoLater(action, Services.now)
- END;
- IF v.time.second = -1 THEN Dates.GetTime(v.time) END;
- c := v.context; c.GetSize(w, h);
- WITH c: TextModels.Context DO a := c.Attr(); color := a.color
- ELSE color := Ports.defaultColor
- END;
- u := f.unit;
- d := h DIV u * u;
- IF ~ODD(d DIV u) THEN DEC(d, u) END;
- m := (h - u) DIV 2;
- IF d >= niceSize - 2 * Ports.point THEN
- hs := 3 * u; ms := 3 * u; ss := u;
- hd1 := m * 4 DIV 6; md1 := m * 5 DIV 6; sd0 := -(m DIV 6); sd1 := m - 4 * u;
- i := 0; WHILE i < 12 DO DrawTick(f, m, m * 11 DIV 12, m, u, i * 5, color); INC(i) END
- ELSE
- hd1 := m * 2 DIV 4; hs := u; ms := u; ss := u;
- md1 := m * 3 DIV 4; sd0 := 0; sd1 := 3 * u
- END;
- time := v.time;
- f.DrawOval(0, 0, d, d, u, color);
- DrawTick(f, m, 0, m * 4 DIV 6, hs, time.hour MOD 12 * 5 + time.minute DIV 12, color);
- DrawTick(f, m, 0, md1, ms, time.minute, color);
- DrawTick(f, m, sd0, sd1, ss, time.second, color)
- END Restore;
-
- PROCEDURE (v: StdView) HandleModelMsg (VAR msg: Models.Message);
- VAR w, h: INTEGER;
- BEGIN
- WITH msg: Msg DO
- msg.consumed := TRUE;
- IF v.time.second # msg.time.second THEN (* execute only once per view *)
- Views.Update(v, Views.keepFrames);
- v.time := msg.time
- END
- ELSE
- END
- END HandleModelMsg;
-
- PROCEDURE SizePref (v: StdView; VAR p: Properties.SizePref);
- BEGIN
- IF (p.w > Views.undefined) & (p.h > Views.undefined) THEN
- Properties.ProportionalConstraint(1, 1, p.fixedW, p.fixedH, p.w, p.h);
- IF p.w < minSize THEN p.w := minSize; p.h := minSize END
- ELSE
- p.w := niceSize; p.h := niceSize
- END
- END SizePref;
-
- PROCEDURE (v: StdView) HandlePropMsg (VAR msg: Properties.Message);
- BEGIN
- WITH msg: Properties.Preference DO
- WITH msg: Properties.SizePref DO
- SizePref(v, msg)
- ELSE
- END
- ELSE
- END
- END HandlePropMsg;
-
-
- (** allocation **)
-
- PROCEDURE New* (): Views.View;
- VAR v: StdView;
- BEGIN
- NEW(v); v.time.second := -1; RETURN v
- END New;
-
- PROCEDURE Deposit*;
- BEGIN
- Views.Deposit(New())
- END Deposit;
-
-
-BEGIN
- clockTime.second := -1;
- NEW(action); actionIsAlive := FALSE
-CLOSE
- IF actionIsAlive THEN Services.RemoveAction(action) END
-END StdClocks.
diff --git a/new/Std/Mod/Cmds.txt b/new/Std/Mod/Cmds.txt
--- a/new/Std/Mod/Cmds.txt
+++ /dev/null
@@ -1,1016 +0,0 @@
-MODULE StdCmds;
-
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Cmds.odc *)
- (* DO NOT EDIT *)
-
- IMPORT
- Fonts, Ports, Services, Stores, Sequencers, Models, Views,
- Controllers, Containers, Properties, Dialog, Documents, Windows, Strings,
- StdDialog, StdApi;
-
- CONST
- illegalSizeKey = "#System:IllegalFontSize";
- defaultAllocator = "TextViews.Deposit; StdCmds.Open";
-
- (* wType, hType *)
- fix = 0; page = 1; window = 2;
-
- VAR
- size*: RECORD
- size*: INTEGER
- END;
- layout*: RECORD
- wType*, hType*: INTEGER;
- width*, height*: REAL;
- doc: Documents.Document;
- u: INTEGER
- END;
- allocator*: Dialog.String;
-
- propEra: INTEGER; (* (propEra, props) form cache for StdProps() *)
- props: Properties.StdProp; (* valid iff propEra = Props.era *)
-
- prop: Properties.Property; (* usef for copy/paste properties *)
-
- (* auxiliary procedures *)
-
- PROCEDURE StdProp (): Properties.StdProp;
- BEGIN
- IF propEra # Properties.era THEN
- Properties.CollectStdProp(props);
- propEra := Properties.era
- END;
- RETURN props
- END StdProp;
-
- PROCEDURE Append (VAR s: ARRAY OF CHAR; t: ARRAY OF CHAR);
- VAR len, i, j: INTEGER; ch: CHAR;
- BEGIN
- len := LEN(s);
- i := 0; WHILE s[i] # 0X DO INC(i) END;
- j := 0; REPEAT ch := t[j]; s[i] := ch; INC(j); INC(i) UNTIL (ch = 0X) OR (i = len);
- s[len - 1] := 0X
- END Append;
-
- (* standard commands *)
-
- PROCEDURE OpenAuxDialog* (file, title: ARRAY OF CHAR);
- VAR v: Views.View;
- BEGIN
- StdApi.OpenAuxDialog(file, title, v)
- END OpenAuxDialog;
-
- PROCEDURE OpenToolDialog* (file, title: ARRAY OF CHAR);
- VAR v: Views.View;
- BEGIN
- StdApi.OpenToolDialog(file, title, v)
- END OpenToolDialog;
-
- PROCEDURE OpenDoc* (file: ARRAY OF CHAR);
- VAR v: Views.View;
- BEGIN
- StdApi.OpenDoc(file, v)
- END OpenDoc;
-
- PROCEDURE OpenCopyOf* (file: ARRAY OF CHAR);
- VAR v: Views.View;
- BEGIN
- StdApi.OpenCopyOf(file, v)
- END OpenCopyOf;
-
- PROCEDURE OpenAux* (file, title: ARRAY OF CHAR);
- VAR v: Views.View;
- BEGIN
- StdApi.OpenAux(file, title, v)
- END OpenAux;
-
- PROCEDURE OpenBrowser* (file, title: ARRAY OF CHAR);
- VAR v: Views.View;
- BEGIN
- StdApi.OpenBrowser(file, title, v)
- END OpenBrowser;
-
- PROCEDURE CloseDialog*;
- VAR v: Views.View;
- BEGIN
- StdApi.CloseDialog(v)
- END CloseDialog;
-
-
- PROCEDURE Open*;
- VAR i: INTEGER; v: Views.View;
- BEGIN
- i := Views.Available();
- IF i > 0 THEN Views.Fetch(v); Views.OpenView(v)
- ELSE Dialog.ShowMsg("#System:DepositExpected")
- END
- END Open;
-
- PROCEDURE PasteView*;
- VAR i: INTEGER; v: Views.View;
- BEGIN
- i := Views.Available();
- IF i > 0 THEN
- Views.Fetch(v);
- Controllers.PasteView(v, Views.undefined, Views.undefined, FALSE)
- ELSE Dialog.ShowMsg("#System:DepositExpected")
- END
- END PasteView;
-
- (* file menu commands *)
-
- PROCEDURE New*;
- VAR res: INTEGER;
- BEGIN
- Dialog.Call(allocator, " ", res)
- END New;
-
-
- (* edit menu commands *)
-
- PROCEDURE Undo*;
- VAR w: Windows.Window;
- BEGIN
- w := Windows.dir.Focus(Controllers.frontPath);
- IF w # NIL THEN w.seq.Undo END
- END Undo;
-
- PROCEDURE Redo*;
- VAR w: Windows.Window;
- BEGIN
- w := Windows.dir.Focus(Controllers.frontPath);
- IF w # NIL THEN w.seq.Redo END
- END Redo;
-
- PROCEDURE CopyProp*;
- BEGIN
- Properties.CollectProp(prop)
- END CopyProp;
-
- PROCEDURE PasteProp*;
- BEGIN
- Properties.EmitProp(NIL, prop)
- END PasteProp;
-
- PROCEDURE Clear*;
- (** remove the selection of the current focus **)
- VAR msg: Controllers.EditMsg;
- BEGIN
- msg.op := Controllers.cut; msg.view := NIL;
- msg.clipboard := FALSE;
- Controllers.Forward(msg)
- END Clear;
-
- PROCEDURE SelectAll*;
- (** select whole content of current focus **)
- VAR msg: Controllers.SelectMsg;
- BEGIN
- msg.set := TRUE; Controllers.Forward(msg)
- END SelectAll;
-
- PROCEDURE DeselectAll*;
- (** select whole content of current focus **)
- VAR msg: Controllers.SelectMsg;
- BEGIN
- msg.set := FALSE; Controllers.Forward(msg)
- END DeselectAll;
-
- PROCEDURE SelectDocument*;
- (** select whole document **)
- VAR w: Windows.Window; c: Containers.Controller;
- BEGIN
- w := Windows.dir.Focus(Controllers.path);
- IF w # NIL THEN
- c := w.doc.ThisController();
- IF (c # NIL) & ~(Containers.noSelection IN c.opts) & (c.Singleton() = NIL) THEN
- c.SetSingleton(w.doc.ThisView())
- END
- END
- END SelectDocument;
-
- PROCEDURE SelectNextView*;
- VAR c: Containers.Controller; v: Views.View;
- BEGIN
- c := Containers.Focus();
- IF (c # NIL) & ~(Containers.noSelection IN c.opts) THEN
- IF c.HasSelection() THEN v := c.Singleton() ELSE v := NIL END;
- IF v = NIL THEN
- c.GetFirstView(Containers.any, v)
- ELSE
- c.GetNextView(Containers.any, v);
- IF v = NIL THEN c.GetFirstView(Containers.any, v) END
- END;
- c.SelectAll(FALSE);
- IF v # NIL THEN c.SetSingleton(v) END
- ELSE Dialog.ShowMsg("#Dev:NoTargetFocusFound")
- END
- END SelectNextView;
-
-
- (** font menu commands **)
-
- PROCEDURE Font* (typeface: Fonts.Typeface);
- (** set the selection to the given font family **)
- VAR p: Properties.StdProp;
- BEGIN
- NEW(p); p.valid := {Properties.typeface}; p.typeface := typeface;
- Properties.EmitProp(NIL, p)
- END Font;
-
- PROCEDURE DefaultFont*;
- (** set the selection to the default font family **)
- VAR p: Properties.StdProp;
- BEGIN
- NEW(p); p.valid := {Properties.typeface}; p.typeface := Fonts.default;
- Properties.EmitProp(NIL, p)
- END DefaultFont;
-
-
- (** attributes menu commands **)
-
- PROCEDURE Plain*;
- (** reset the font attribute "weight" and all font style attributes of the selection **)
- VAR p: Properties.StdProp;
- BEGIN
- NEW(p); p.valid := {Properties.style, Properties.weight};
- p.style.val := {}; p.style.mask := {Fonts.italic, Fonts.underline, Fonts.strikeout};
- p.weight := Fonts.normal;
- Properties.EmitProp(NIL, p)
- END Plain;
-
- PROCEDURE Bold*;
- (** change the font attribute "weight" in the selection;
- if the selection has a homogeneously bold weight: toggle to normal, else force to bold **)
- VAR p, p0: Properties.StdProp;
- BEGIN
- Properties.CollectStdProp(p0);
- NEW(p); p.valid := {Properties.weight};
- IF (Properties.weight IN p0.valid) & (p0.weight # Fonts.normal) THEN
- p.weight := Fonts.normal
- ELSE p.weight := Fonts.bold
- END;
- Properties.EmitProp(NIL, p)
- END Bold;
-
- PROCEDURE Italic*;
- (** change the font style attribute "italic" in the selection;
- if the selection is homogeneous wrt this attribute: toggle, else force to italic **)
- VAR p, p0: Properties.StdProp;
- BEGIN
- Properties.CollectStdProp(p0);
- NEW(p); p.valid := {Properties.style}; p.style.mask := {Fonts.italic};
- IF (Properties.style IN p0.valid) & (Fonts.italic IN p0.style.val) THEN
- p.style.val := {}
- ELSE p.style.val := {Fonts.italic}
- END;
- Properties.EmitProp(NIL, p)
- END Italic;
-
- PROCEDURE Underline*;
- (** change the font style attribute "underline" in the selection;
- if the selection is homogeneous wrt this attribute: toggle, else force to underline **)
- VAR p, p0: Properties.StdProp;
- BEGIN
- Properties.CollectStdProp(p0);
- NEW(p); p.valid := {Properties.style}; p.style.mask := {Fonts.underline};
- IF (Properties.style IN p0.valid) & (Fonts.underline IN p0.style.val) THEN
- p.style.val := {}
- ELSE p.style.val := {Fonts.underline}
- END;
- Properties.EmitProp(NIL, p)
- END Underline;
-
- PROCEDURE Strikeout*;
- (** change the font style attribute "strikeout" in the selection,
- without changing other attributes;
- if the selection is homogeneous wrt this attribute: toggle,
- else force to strikeout **)
- VAR p, p0: Properties.StdProp;
- BEGIN
- Properties.CollectStdProp(p0);
- NEW(p); p.valid := {Properties.style}; p.style.mask := {Fonts.strikeout};
- IF (Properties.style IN p0.valid) & (Fonts.strikeout IN p0.style.val) THEN
- p.style.val := {}
- ELSE p.style.val := {Fonts.strikeout}
- END;
- Properties.EmitProp(NIL, p)
- END Strikeout;
-
- PROCEDURE Size* (size: INTEGER);
- (** set the selection to the given font size **)
- VAR p: Properties.StdProp;
- BEGIN
- NEW(p); p.valid := {Properties.size};
- p.size := size * Ports.point;
- Properties.EmitProp(NIL, p)
- END Size;
-
- PROCEDURE SetSize*;
- VAR p: Properties.StdProp;
- BEGIN
- IF (0 <= size.size) & (size.size < 32768) THEN
- NEW(p); p.valid := {Properties.size};
- p.size := size.size * Fonts.point;
- Properties.EmitProp(NIL, p)
- ELSE
- Dialog.ShowMsg(illegalSizeKey)
- END
- END SetSize;
-
- PROCEDURE InitSizeDialog*;
- VAR p: Properties.StdProp;
- BEGIN
- Properties.CollectStdProp(p);
- IF Properties.size IN p.valid THEN size.size := p.size DIV Fonts.point END
- END InitSizeDialog;
-
- PROCEDURE Color* (color: Ports.Color);
- (** set the color attributes of the selection **)
- VAR p: Properties.StdProp;
- BEGIN
- NEW(p); p.valid := {Properties.color};
- p.color.val := color;
- Properties.EmitProp(NIL, p)
- END Color;
-
- PROCEDURE UpdateAll*; (* for HostCmds.Toggle *)
- VAR w: Windows.Window; pw, ph: INTEGER; dirty: BOOLEAN; msg: Models.UpdateMsg;
- BEGIN
- w := Windows.dir.First();
- WHILE w # NIL DO
- IF ~w.sub THEN
- dirty := w.seq.Dirty();
- Models.Domaincast(w.doc.Domain(), msg);
- IF ~dirty THEN w.seq.SetDirty(FALSE) END (* not perfect: "undoable dirt" ... *)
- END;
- w.port.GetSize(pw, ph);
- w.Restore(0, 0, pw, ph);
- w := Windows.dir.Next(w)
- END
- END UpdateAll;
-
- PROCEDURE RestoreAll*;
- VAR w: Windows.Window; pw, ph: INTEGER;
- BEGIN
- w := Windows.dir.First();
- WHILE w # NIL DO
- w.port.GetSize(pw, ph);
- w.Restore(0, 0, pw, ph);
- w := Windows.dir.Next(w)
- END
- END RestoreAll;
-
-
- (** document layout dialog **)
-
- PROCEDURE SetLayout*;
- VAR opts: SET; l, t, r, b, r0, b0: INTEGER; c: Containers.Controller; script: Stores.Operation;
- BEGIN
- c := layout.doc.ThisController();
- opts := c.opts - {Documents.pageWidth..Documents.winHeight};
- IF layout.wType = page THEN INCL(opts, Documents.pageWidth)
- ELSIF layout.wType = window THEN INCL(opts, Documents.winWidth)
- END;
- IF layout.hType = page THEN INCL(opts, Documents.pageHeight)
- ELSIF layout.hType = window THEN INCL(opts, Documents.winHeight)
- END;
- layout.doc.PollRect(l, t, r, b); r0 := r; b0 := b;
- IF layout.wType = fix THEN r := l + SHORT(ENTIER(layout.width * layout.u)) END;
- IF layout.hType = fix THEN b := t + SHORT(ENTIER(layout.height * layout.u)) END;
- IF (opts # c.opts) OR (r # r0) OR (b # b0) THEN
- Views.BeginScript(layout.doc, "#System:ChangeLayout", script);
- c.SetOpts(opts);
- layout.doc.SetRect(l, t, r, b);
- Views.EndScript(layout.doc, script)
- END
- END SetLayout;
-
- PROCEDURE InitLayoutDialog*;
- (* guard: WindowGuard *)
- VAR w: Windows.Window; c: Containers.Controller; l, t, r, b: INTEGER;
- BEGIN
- w := Windows.dir.First();
- IF w # NIL THEN
- layout.doc := w.doc;
- c := w.doc.ThisController();
- IF Documents.pageWidth IN c.opts THEN layout.wType := page
- ELSIF Documents.winWidth IN c.opts THEN layout.wType := window
- ELSE layout.wType := fix
- END;
- IF Documents.pageHeight IN c.opts THEN layout.hType := page
- ELSIF Documents.winHeight IN c.opts THEN layout.hType := window
- ELSE layout.hType := fix
- END;
- IF Dialog.metricSystem THEN layout.u := Ports.mm * 10 ELSE layout.u := Ports.inch END;
- w.doc.PollRect(l, t, r, b);
- layout.width := (r - l) DIV (layout.u DIV 100) / 100;
- layout.height := (b - t) DIV (layout.u DIV 100) / 100
- END
- END InitLayoutDialog;
-
- PROCEDURE WidthGuard* (VAR par: Dialog.Par);
- BEGIN
- IF layout.wType # fix THEN par.readOnly := TRUE END
- END WidthGuard;
-
- PROCEDURE HeightGuard* (VAR par: Dialog.Par);
- BEGIN
- IF layout.hType # fix THEN par.readOnly := TRUE END
- END HeightGuard;
-
- PROCEDURE TypeNotifier* (op, from, to: INTEGER);
- VAR w, h, l, t, r, b: INTEGER; d: BOOLEAN;
- BEGIN
- layout.doc.PollRect(l, t, r, b);
- IF layout.wType = page THEN
- layout.doc.PollPage(w, h, l, t, r, b, d)
- ELSIF layout.wType = window THEN
- layout.doc.context.GetSize(w, h); r := w - l
- END;
- layout.width := (r - l) DIV (layout.u DIV 100) / 100;
- layout.doc.PollRect(l, t, r, b);
- IF layout.hType = page THEN
- layout.doc.PollPage(w, h, l, t, r, b, d)
- ELSIF layout.hType = window THEN
- layout.doc.context.GetSize(w, h); b := h - t
- END;
- layout.height := (b - t) DIV (layout.u DIV 100) / 100;
- Dialog.Update(layout)
- END TypeNotifier;
-
-
- (** window menu command **)
-
- PROCEDURE NewWindow*;
- (** guard ModelViewGuard **)
- VAR win: Windows.Window; doc: Documents.Document; v: Views.View; title: Views.Title;
- seq: ANYPTR; clean: BOOLEAN;
- BEGIN
- win := Windows.dir.Focus(Controllers.frontPath);
- IF win # NIL THEN
- v := win.doc.ThisView();
- IF v.Domain() # NIL THEN seq := v.Domain().GetSequencer() ELSE seq := NIL END;
- clean := (seq # NIL) & ~seq(Sequencers.Sequencer).Dirty();
- doc := win.doc.DocCopyOf(v);
- (* Stores.InitDomain(doc, v.Domain()); *)
- ASSERT(doc.Domain() = v.Domain(), 100);
- win.GetTitle(title);
- Windows.dir.OpenSubWindow(Windows.dir.New(), doc, win.flags, title);
- IF clean THEN seq(Sequencers.Sequencer).SetDirty(FALSE) END
- END
- END NewWindow;
-
- (* properties *)
-
- PROCEDURE GetCmd (name: ARRAY OF CHAR; OUT cmd: ARRAY OF CHAR);
- VAR i, j: INTEGER; ch, lch: CHAR; key: ARRAY 256 OF CHAR;
- BEGIN
- i := 0; ch := name[0]; key[0] := "#"; j := 1;
- REPEAT
- key[j] := ch; INC(j); lch := ch; INC(i); ch := name[i]
- UNTIL (ch = 0X) OR (ch = ".")
- OR ((ch >= "A") & (ch <= "Z") OR (ch >= "À") & (ch # "×") & (ch <= "Þ"))
- & ((lch < "A") OR (lch > "Z") & (lch < "À") OR (lch = "×") OR (lch > "Þ"));
- IF ch = "." THEN
- key := "#System:" + name
- ELSE
- key[j] := ":"; INC(j); key[j] := 0X; j := 0;
- WHILE ch # 0X DO name[j] := ch; INC(i); INC(j); ch := name[i] END;
- name[j] := 0X; key := key + name
- END;
- Dialog.MapString(key, cmd);
- IF cmd = name THEN cmd := "" END
- END GetCmd;
-
- PROCEDURE SearchCmd (call: BOOLEAN; OUT found: BOOLEAN);
- VAR p: Properties.Property; std: BOOLEAN; v: Views.View; cmd: ARRAY 256 OF CHAR; pos, res: INTEGER;
- BEGIN
- Controllers.SetCurrentPath(Controllers.targetPath);
- v := Containers.FocusSingleton(); found := FALSE;
- IF v # NIL THEN
- Services.GetTypeName(v, cmd);
- GetCmd(cmd, cmd);
- IF cmd # "" THEN found := TRUE;
- IF call THEN Dialog.Call(cmd, "", res) END
- END
- END;
- std := FALSE;
- Properties.CollectProp(p);
- WHILE p # NIL DO
- IF p IS Properties.StdProp THEN std := TRUE
- ELSE
- Services.GetTypeName(p, cmd);
- GetCmd(cmd, cmd);
- IF cmd # "" THEN found := TRUE;
- IF call THEN Dialog.Call(cmd, "", res) END
- ELSE
- Services.GetTypeName(p, cmd);
- Strings.Find(cmd, "Desc", LEN(cmd$)-4, pos);
- IF LEN(cmd$)-4 = pos THEN
- cmd[pos] := 0X; GetCmd(cmd, cmd);
- IF cmd # "" THEN found := TRUE;
- IF call THEN Dialog.Call(cmd, "", res) END
- END
- END
- END
- END;
- p := p.next
- END;
- IF std & ~found THEN
- Dialog.MapString("#Host:Properties.StdProp", cmd);
- IF cmd # "Properties.StdProp" THEN found := TRUE;
- IF call THEN Dialog.Call(cmd, "", res) END
- END
- END;
- IF ~found THEN
- Dialog.MapString("#System:ShowProp", cmd);
- IF cmd # "ShowProp" THEN found := TRUE;
- IF call THEN Dialog.Call(cmd, "", res) END
- END
- END;
- Controllers.ResetCurrentPath
- END SearchCmd;
-
- PROCEDURE ShowProp*;
- VAR found: BOOLEAN;
- BEGIN
- SearchCmd(TRUE, found)
- END ShowProp;
-
- PROCEDURE ShowPropGuard* (VAR par: Dialog.Par);
- VAR found: BOOLEAN;
- BEGIN
- SearchCmd(FALSE, found);
- IF ~found THEN par.disabled := TRUE END
- END ShowPropGuard;
-
-
- (* container commands *)
-
- PROCEDURE ActFocus (): Containers.Controller;
- VAR c: Containers.Controller; v: Views.View;
- BEGIN
- c := Containers.Focus();
- IF c # NIL THEN
- v := c.ThisView();
- IF v IS Documents.Document THEN
- v := v(Documents.Document).ThisView();
- IF v IS Containers.View THEN
- c := v(Containers.View).ThisController()
- ELSE c := NIL
- END
- END
- END;
- RETURN c
- END ActFocus;
-
- PROCEDURE ToggleNoFocus*;
- VAR c: Containers.Controller; v: Views.View;
- BEGIN
- c := ActFocus();
- IF c # NIL THEN
- v := c.ThisView();
- IF ~((v IS Documents.Document) OR (Containers.noSelection IN c.opts)) THEN
- IF Containers.noFocus IN c.opts THEN
- c.SetOpts(c.opts - {Containers.noFocus})
- ELSE
- c.SetOpts(c.opts + {Containers.noFocus})
- END
- END
- END
- END ToggleNoFocus;
-
- PROCEDURE OpenAsAuxDialog*;
- (** create a new sub-window onto the focus view shown in the top window, mask mode **)
- VAR win: Windows.Window; doc: Documents.Document; v, u: Views.View; title: Views.Title;
- c: Containers.Controller;
- BEGIN
- v := Controllers.FocusView();
- IF (v # NIL) & (v IS Containers.View) & ~(v IS Documents.Document) THEN
- win := Windows.dir.Focus(Controllers.frontPath); ASSERT(win # NIL, 100);
- doc := win.doc.DocCopyOf(v);
- u := doc.ThisView();
- c := u(Containers.View).ThisController();
- c.SetOpts(c.opts - {Containers.noFocus} + {Containers.noCaret, Containers.noSelection});
- IF v # win.doc.ThisView() THEN
- c := doc.ThisController();
- c.SetOpts(c.opts - {Documents.pageWidth, Documents.pageHeight}
- + {Documents.winWidth, Documents.winHeight})
- END;
- (* Stores.InitDomain(doc, v.Domain()); already done in DocCopyOf *)
- win.GetTitle(title);
- Windows.dir.OpenSubWindow(Windows.dir.New(), doc,
- {Windows.isAux, Windows.neverDirty, Windows.noResize, Windows.noHScroll, Windows.noVScroll},
- title)
- ELSE Dialog.Beep
- END
- END OpenAsAuxDialog;
-
- PROCEDURE OpenAsToolDialog*;
- (** create a new sub-window onto the focus view shown in the top window, mask mode **)
- VAR win: Windows.Window; doc: Documents.Document; v, u: Views.View; title: Views.Title;
- c: Containers.Controller;
- BEGIN
- v := Controllers.FocusView();
- IF (v # NIL) & (v IS Containers.View) & ~(v IS Documents.Document) THEN
- win := Windows.dir.Focus(Controllers.frontPath); ASSERT(win # NIL, 100);
- doc := win.doc.DocCopyOf(v);
- u := doc.ThisView();
- c := u(Containers.View).ThisController();
- c.SetOpts(c.opts - {Containers.noFocus} + {Containers.noCaret, Containers.noSelection});
- IF v # win.doc.ThisView() THEN
- c := doc.ThisController();
- c.SetOpts(c.opts - {Documents.pageWidth, Documents.pageHeight}
- + {Documents.winWidth, Documents.winHeight})
- END;
- (* Stores.InitDomain(doc, v.Domain()); already done in DocCopyOf *)
- win.GetTitle(title);
- Windows.dir.OpenSubWindow(Windows.dir.New(), doc,
- {Windows.isTool, Windows.neverDirty, Windows.noResize, Windows.noHScroll, Windows.noVScroll},
- title)
- ELSE Dialog.Beep
- END
- END OpenAsToolDialog;
-
- PROCEDURE RecalcFocusSize*;
- VAR c: Containers.Controller; v: Views.View; bounds: Properties.BoundsPref;
- BEGIN
- c := Containers.Focus();
- IF c # NIL THEN
- v := c.ThisView();
- bounds.w := Views.undefined; bounds.h := Views.undefined;
- Views.HandlePropMsg(v, bounds);
- v.context.SetSize(bounds.w, bounds.h)
- END
- END RecalcFocusSize;
-
- PROCEDURE RecalcAllSizes*;
- VAR w: Windows.Window;
- BEGIN
- w := Windows.dir.First();
- WHILE w # NIL DO
- StdDialog.RecalcView(w.doc.ThisView());
- w := Windows.dir.Next(w)
- END
- END RecalcAllSizes;
-
- PROCEDURE SetMode(opts: SET);
- VAR
- c: Containers.Controller; v: Views.View;
- gm: Containers.GetOpts; sm: Containers.SetOpts;
- w: Windows.Window;
- BEGIN
- c := Containers.Focus();
- gm.valid := {};
- IF (c # NIL) & (c.Singleton() # NIL) THEN
- v := c.Singleton();
- Views.HandlePropMsg(v, gm);
- END;
- IF gm.valid = {} THEN
- w := Windows.dir.Focus(Controllers.path);
- IF (w # NIL) & (w.doc.ThisView() IS Containers.View) THEN v := w.doc.ThisView() ELSE v := NIL END
- END;
- IF v # NIL THEN
- sm.valid := {Containers.noSelection, Containers.noFocus, Containers.noCaret};
- sm.opts := opts;
- Views.HandlePropMsg(v, sm);
- END;
- END SetMode;
-
- PROCEDURE GetMode(OUT found: BOOLEAN; OUT opts: SET);
- VAR c: Containers.Controller; gm: Containers.GetOpts; w: Windows.Window;
- BEGIN
- c := Containers.Focus();
- gm.valid := {};
- IF (c # NIL) & (c.Singleton() # NIL) THEN
- Views.HandlePropMsg(c.Singleton(), gm);
- END;
- IF gm.valid = {} THEN
- w := Windows.dir.Focus(Controllers.path);
- IF (w # NIL) & (w.doc.ThisView() IS Containers.View) THEN
- Views.HandlePropMsg(w.doc.ThisView(), gm);
- END
- END;
- found := gm.valid # {};
- opts := gm.opts
- END GetMode;
-
- PROCEDURE SetMaskMode*;
- (* Guard: SetMaskGuard *)
- BEGIN
- SetMode({Containers.noSelection, Containers.noCaret})
- END SetMaskMode;
-
- PROCEDURE SetEditMode*;
- (* Guard: SetEditGuard *)
- BEGIN
- SetMode({})
- END SetEditMode;
-
- PROCEDURE SetLayoutMode*;
- (* Guard: SetLayoutGuard *)
- BEGIN
- SetMode({Containers.noFocus})
- END SetLayoutMode;
-
- PROCEDURE SetBrowserMode*;
- (* Guard: SetBrowserGuard *)
- BEGIN
- SetMode({Containers.noCaret})
- END SetBrowserMode;
-
-
- (* standard guards *)
-
- PROCEDURE ToggleNoFocusGuard* (VAR par: Dialog.Par);
- VAR c: Containers.Controller; v: Views.View;
- BEGIN
- c := ActFocus();
- IF c # NIL THEN
- v := c.ThisView();
- IF ~((v IS Documents.Document) OR (Containers.noSelection IN c.opts)) THEN
- IF Containers.noFocus IN c.opts THEN par.label := "#System:AllowFocus"
- ELSE par.label := "#System:PreventFocus"
- END
- ELSE par.disabled := TRUE
- END
- ELSE par.disabled := TRUE
- END
- END ToggleNoFocusGuard;
-
- PROCEDURE ReadOnlyGuard* (VAR par: Dialog.Par);
- BEGIN
- par.readOnly := TRUE
- END ReadOnlyGuard;
-
- PROCEDURE WindowGuard* (VAR par: Dialog.Par);
- VAR w: Windows.Window;
- BEGIN
- w := Windows.dir.First();
- IF w = NIL THEN par.disabled := TRUE END
- END WindowGuard;
-
- PROCEDURE ModelViewGuard* (VAR par: Dialog.Par);
- VAR w: Windows.Window;
- BEGIN
- w := Windows.dir.Focus(Controllers.frontPath);
- par.disabled := (w = NIL) OR (w.doc.ThisView().ThisModel() = NIL)
- END ModelViewGuard;
-
- PROCEDURE SetMaskModeGuard* (VAR par: Dialog.Par);
- CONST mode = {Containers.noSelection, Containers.noFocus, Containers.noCaret};
- VAR opts: SET; found: BOOLEAN;
- BEGIN
- GetMode(found, opts);
- IF found THEN
- par.checked := opts * mode = {Containers.noSelection, Containers.noCaret}
- ELSE
- par.disabled := TRUE
- END
- END SetMaskModeGuard;
-
- PROCEDURE SetEditModeGuard* (VAR par: Dialog.Par);
- CONST mode = {Containers.noSelection, Containers.noFocus, Containers.noCaret};
- VAR opts: SET; found: BOOLEAN;
- BEGIN
- GetMode(found, opts);
- IF found THEN
- par.checked := opts * mode = {}
- ELSE
- par.disabled := TRUE
- END
- END SetEditModeGuard;
-
- PROCEDURE SetLayoutModeGuard* (VAR par: Dialog.Par);
- CONST mode = {Containers.noSelection, Containers.noFocus, Containers.noCaret};
- VAR opts: SET; found: BOOLEAN;
- BEGIN
- GetMode(found, opts);
- IF found THEN
- par.checked := opts * mode = {Containers.noFocus}
- ELSE
- par.disabled := TRUE
- END
- END SetLayoutModeGuard;
-
- PROCEDURE SetBrowserModeGuard* (VAR par: Dialog.Par);
- CONST mode = {Containers.noSelection, Containers.noFocus, Containers.noCaret};
- VAR opts: SET; found: BOOLEAN;
- BEGIN
- GetMode(found, opts);
- IF found THEN
- par.checked := opts * mode = {Containers.noCaret}
- ELSE
- par.disabled := TRUE
- END
- END SetBrowserModeGuard;
-
- PROCEDURE SelectionGuard* (VAR par: Dialog.Par);
- VAR ops: Controllers.PollOpsMsg;
- BEGIN
- Controllers.PollOps(ops);
- IF ops.valid * {Controllers.cut, Controllers.copy} = {} THEN par.disabled := TRUE END
- END SelectionGuard;
-
- PROCEDURE SingletonGuard* (VAR par: Dialog.Par);
- VAR ops: Controllers.PollOpsMsg;
- BEGIN
- Controllers.PollOps(ops);
- IF ops.singleton = NIL THEN par.disabled := TRUE END
- END SingletonGuard;
-
- PROCEDURE SelectAllGuard* (VAR par: Dialog.Par);
- VAR ops: Controllers.PollOpsMsg;
- BEGIN
- Controllers.PollOps(ops);
- IF ~ops.selectable THEN par.disabled := TRUE END
- END SelectAllGuard;
-
- PROCEDURE CaretGuard* (VAR par: Dialog.Par);
- VAR ops: Controllers.PollOpsMsg;
- BEGIN
- Controllers.PollOps(ops);
- IF ops.valid * {Controllers.pasteChar .. Controllers.paste} = {} THEN par.disabled := TRUE END
- END CaretGuard;
-
- PROCEDURE PasteCharGuard* (VAR par: Dialog.Par);
- VAR ops: Controllers.PollOpsMsg;
- BEGIN
- Controllers.PollOps(ops);
- IF ~(Controllers.pasteChar IN ops.valid) THEN par.disabled := TRUE END
- END PasteCharGuard;
-
- PROCEDURE PasteLCharGuard* (VAR par: Dialog.Par);
- VAR ops: Controllers.PollOpsMsg;
- BEGIN
- Controllers.PollOps(ops);
- IF ~(Controllers.pasteChar IN ops.valid) THEN par.disabled := TRUE END
- END PasteLCharGuard;
-
- PROCEDURE PasteViewGuard* (VAR par: Dialog.Par);
- VAR ops: Controllers.PollOpsMsg;
- BEGIN
- Controllers.PollOps(ops);
- IF ~(Controllers.paste IN ops.valid) THEN par.disabled := TRUE END
- END PasteViewGuard;
-
- PROCEDURE ContainerGuard* (VAR par: Dialog.Par);
- BEGIN
- IF Containers.Focus() = NIL THEN par.disabled := TRUE END
- END ContainerGuard;
-
- PROCEDURE UndoGuard* (VAR par: Dialog.Par);
- VAR f: Windows.Window; opName: Stores.OpName;
- BEGIN
- Dialog.MapString("#System:Undo", par.label);
- f := Windows.dir.Focus(Controllers.frontPath);
- IF (f # NIL) & f.seq.CanUndo() THEN
- f.seq.GetUndoName(opName);
- Dialog.MapString(opName, opName);
- Append(par.label, " ");
- Append(par.label, opName)
- ELSE
- par.disabled := TRUE
- END
- END UndoGuard;
-
- PROCEDURE RedoGuard* (VAR par: Dialog.Par);
- VAR f: Windows.Window; opName: Stores.OpName;
- BEGIN
- Dialog.MapString("#System:Redo", par.label);
- f := Windows.dir.Focus(Controllers.frontPath);
- IF (f # NIL) & f.seq.CanRedo() THEN
- f.seq.GetRedoName(opName);
- Dialog.MapString(opName, opName);
- Append(par.label, " ");
- Append(par.label, opName)
- ELSE
- par.disabled := TRUE
- END
- END RedoGuard;
-
- PROCEDURE PlainGuard* (VAR par: Dialog.Par);
- VAR props: Properties.StdProp;
- BEGIN
- props := StdProp();
- IF props.known * {Properties.style, Properties.weight} # {} THEN
- par.checked := (Properties.style IN props.valid)
- & (props.style.val = {}) & ({Fonts.italic, Fonts.underline, Fonts.strikeout} - props.style.mask = {})
- & (Properties.weight IN props.valid) & (props.weight = Fonts.normal)
- ELSE
- par.disabled := TRUE
- END
- END PlainGuard;
-
- PROCEDURE BoldGuard* (VAR par: Dialog.Par);
- VAR props: Properties.StdProp;
- BEGIN
- props := StdProp();
- IF Properties.weight IN props.known THEN
- par.checked := (Properties.weight IN props.valid) & (props.weight = Fonts.bold)
- ELSE
- par.disabled := TRUE
- END
- END BoldGuard;
-
- PROCEDURE ItalicGuard* (VAR par: Dialog.Par);
- VAR props: Properties.StdProp;
- BEGIN
- props := StdProp();
- IF Properties.style IN props.known THEN
- par.checked := (Properties.style IN props.valid) & (Fonts.italic IN props.style.val)
- ELSE
- par.disabled := TRUE
- END
- END ItalicGuard;
-
- PROCEDURE UnderlineGuard* (VAR par: Dialog.Par);
- VAR props: Properties.StdProp;
- BEGIN
- props := StdProp();
- IF Properties.style IN props.known THEN
- par.checked := (Properties.style IN props.valid) & (Fonts.underline IN props.style.val)
- ELSE
- par.disabled := TRUE
- END
- END UnderlineGuard;
-
- PROCEDURE StrikeoutGuard* (VAR par: Dialog.Par);
- VAR props: Properties.StdProp;
- BEGIN
- props := StdProp();
- IF Properties.style IN props.known THEN
- par.checked := (Properties.style IN props.valid) & (Fonts.strikeout IN props.style.val)
- ELSE
- par.disabled := TRUE
- END
- END StrikeoutGuard;
-
- PROCEDURE SizeGuard* (size: INTEGER; VAR par: Dialog.Par);
- VAR props: Properties.StdProp;
- BEGIN
- props := StdProp();
- IF Properties.size IN props.known THEN
- par.checked := (Properties.size IN props.valid) & (size = props.size DIV Ports.point)
- ELSE
- par.disabled := TRUE
- END
- END SizeGuard;
-
- PROCEDURE ColorGuard* (color: INTEGER; VAR par: Dialog.Par);
- VAR props: Properties.StdProp;
- BEGIN
- props := StdProp();
- IF Properties.color IN props.known THEN
- par.checked := (Properties.color IN props.valid) & (color = props.color.val)
- ELSE
- par.disabled := TRUE
- END
- END ColorGuard;
-
- PROCEDURE DefaultFontGuard* (VAR par: Dialog.Par);
- VAR props: Properties.StdProp;
- BEGIN
- props := StdProp();
- IF Properties.typeface IN props.known THEN
- par.checked := (Properties.typeface IN props.valid) & (props.typeface = Fonts.default)
- ELSE
- par.disabled := TRUE
- END
- END DefaultFontGuard;
-
- PROCEDURE TypefaceGuard* (VAR par: Dialog.Par);
- VAR props: Properties.StdProp;
- BEGIN
- props := StdProp();
- IF ~(Properties.typeface IN props.known) THEN par.disabled := TRUE END
- END TypefaceGuard;
-
-
- (* standard notifiers *)
-
- PROCEDURE DefaultOnDoubleClick* (op, from, to: INTEGER);
- VAR msg: Controllers.EditMsg; c: Containers.Controller;
- BEGIN
- IF (op = Dialog.pressed) & (from = 1) THEN
- Controllers.SetCurrentPath(Controllers.frontPath);
- c := Containers.Focus();
- Controllers.ResetCurrentPath;
- IF {Containers.noSelection, Containers.noCaret} - c.opts = {} THEN
- msg.op := Controllers.pasteChar;
- msg.char := 0DX; msg.modifiers := {};
- Controllers.ForwardVia(Controllers.frontPath, msg)
- END
- END
- END DefaultOnDoubleClick;
-
-
- PROCEDURE Init;
- BEGIN
- allocator := defaultAllocator;
- propEra := -1
- END Init;
-
-BEGIN
- Init
-END StdCmds.
diff --git a/new/Std/Mod/Coder.txt b/new/Std/Mod/Coder.txt
--- a/new/Std/Mod/Coder.txt
+++ /dev/null
@@ -1,682 +0,0 @@
-MODULE StdCoder;
-
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Coder.odc *)
- (* DO NOT EDIT *)
-
- IMPORT
- Kernel, Files, Converters, Stores, Views, Controllers, Dialog, Documents, Windows,
- TextModels, TextViews, TextControllers, TextMappers,
- StdCmds;
-
- CONST
- N = 16384;
- LineLength = 74;
- OldVersion = 0; ThisVersion = 1;
- Tag = "StdCoder.Decode"; (* first letter of Tag must not to appear within Tag again *)
- Separator = "/";
- View = 1; File = 2; List = 3;
-
- TYPE
- FileList = POINTER TO RECORD
- next: FileList;
- file: Files.File;
- type: Files.Type;
- name:Dialog.String
- END;
-
- ParList* = RECORD
- list*: Dialog.Selection;
- storeAs*: Dialog.String;
- files: FileList
- END;
-
- VAR
- par*: ParList;
- code: ARRAY 64 OF CHAR;
- revCode: ARRAY 256 OF BYTE;
- table: ARRAY N OF BYTE;
- stdDocuType: Files.Type;
-
- PROCEDURE NofSelections(IN list: Dialog.Selection): INTEGER;
- VAR i, n: INTEGER;
- BEGIN
- i := 0; n := 0;
- WHILE i # list.len DO
- IF list.In(i) THEN INC(n) END;
- INC(i)
- END;
- RETURN n
- END NofSelections;
-
- PROCEDURE ShowError(n: INTEGER; par: ARRAY OF CHAR);
- BEGIN
- Dialog.Beep;
- CASE n OF
- 1: Dialog.ShowParamMsg("#Std:bad characters", par, "", "")
- | 2: Dialog.ShowParamMsg("#Std:checksum error", par, "", "")
- | 3: Dialog.ShowParamMsg("#Std:incompatible version", par, "", "")
- | 4: Dialog.ShowParamMsg("#Std:filing error", par, "", "")
- | 5: Dialog.ShowParamMsg("#Std:directory ^0 not found", par, "", "")
- | 6: Dialog.ShowParamMsg("#Std:file ^0 not found", par, "", "")
- | 7: Dialog.ShowParamMsg("#Std:illegal path", par, "", "")
- | 8: Dialog.ShowParamMsg("#Std:no tag", par, "", "")
- | 9: Dialog.ShowParamMsg("#Std:disk write protected", par, "", "")
- | 10: Dialog.ShowParamMsg("#Std:io error", par, "", "")
- END
- END ShowError;
-
- PROCEDURE ShowSizeMsg(x: INTEGER);
- VAR i, j: INTEGER; ch: CHAR; s: ARRAY 20 OF CHAR;
- BEGIN
- ASSERT(x >= 0, 20);
- i := 0;
- REPEAT s[i] := CHR(ORD("0") + x MOD 10); INC(i); x := x DIV 10 UNTIL x = 0;
- s[i] := 0X;
- DEC(i); j := 0;
- WHILE j < i DO ch := s[j]; s[j] := s[i]; s[i] := ch; INC(j); DEC(i) END;
- Dialog.ShowParamStatus("#Std:^0 characters coded", s, "", "")
- END ShowSizeMsg;
-
- PROCEDURE Write(dest: TextModels.Writer; x: INTEGER; VAR n: INTEGER);
- BEGIN
- dest.WriteChar(code[x]); INC(n);
- IF n = LineLength THEN dest.WriteChar(0DX); dest.WriteChar(" "); n := 0 END
- END Write;
-
- PROCEDURE WriteHeader(dest: TextModels.Writer; VAR n: INTEGER;
- name: ARRAY OF CHAR; type: BYTE
- );
- VAR byte, bit, i: INTEGER; ch: CHAR; tag: ARRAY 16 OF CHAR;
- BEGIN
- tag := Tag; i := 0; ch := tag[0];
- WHILE ch # 0X DO dest.WriteChar(ch); INC(n); INC(i); ch := tag[i] END;
- dest.WriteChar(" "); INC(n);
- bit := 0; byte := 0; i := 0;
- REPEAT
- ch := name[i]; INC(byte, ASH(ORD(ch), bit)); INC(bit, 8);
- WHILE bit >= 6 DO Write(dest, byte MOD 64, n); byte := byte DIV 64; DEC(bit, 6) END;
- INC(i)
- UNTIL ch = 0X;
- IF bit # 0 THEN Write(dest, byte, n) END;
- Write(dest, ThisVersion, n); Write(dest, type, n)
- END WriteHeader;
-
- PROCEDURE WriteFileType(dest: TextModels.Writer; VAR n: INTEGER; t: Files.Type);
- VAR byte, bit, i: INTEGER; ch: CHAR;
- BEGIN
- IF t = Kernel.docType THEN t := stdDocuType END;
- bit := 0; byte := 0; i := 0; dest.WriteChar(" ");
- REPEAT
- ch := t[i]; INC(byte, ASH(ORD(ch), bit)); INC(bit, 8);
- WHILE bit >= 6 DO Write(dest, byte MOD 64, n); byte := byte DIV 64; DEC(bit, 6) END;
- INC(i)
- UNTIL ch = 0X;
- IF bit # 0 THEN Write(dest, byte, n) END
- END WriteFileType;
-
- PROCEDURE WriteFile(dest: TextModels.Writer; VAR n: INTEGER; f: Files.File);
- VAR hash, byte, bit, i, j, sum, len: INTEGER; src: Files.Reader; b: BYTE;
- BEGIN
- len := f.Length(); j := len; i := 6;
- WHILE i # 0 DO Write(dest, j MOD 64, n); j := j DIV 64; DEC(i) END;
- i := 0;
- REPEAT table[i] := 0; INC(i) UNTIL i = N;
- hash := 0; bit := 0; byte := 0; sum := 0; src := f.NewReader(NIL);
- WHILE len # 0 DO
- src.ReadByte(b); DEC(len);
- sum := (sum + b MOD 256) MOD (16 * 1024);
- IF table[hash] = b THEN INC(bit) (* 0 bit for correct prediction *)
- ELSE (* Incorrect prediction -> 1'xxxx'xxxx bits *)
- table[hash] := b; INC(byte, ASH(1, bit)); INC(bit);
- INC(byte, ASH(b MOD 256, bit)); INC(bit, 8)
- END;
- WHILE bit >= 6 DO Write(dest, byte MOD 64, n); byte := byte DIV 64; DEC(bit, 6) END;
- hash := (16 * hash + b MOD 256) MOD N
- END;
- IF bit # 0 THEN Write(dest, byte, n) END;
- i := 6;
- WHILE i # 0 DO Write(dest, sum MOD 64, n); sum := sum DIV 64; DEC(i) END;
- IF n # 0 THEN dest.WriteChar(0DX); n := 0 END
- END WriteFile;
-
- PROCEDURE Read(src: TextModels.Reader; VAR x: INTEGER; VAR res: INTEGER);
- VAR ch: CHAR;
- BEGIN
- IF res = 0 THEN
- REPEAT src.ReadChar(ch); x := revCode[ORD(ch)] UNTIL (x >= 0) OR src.eot;
- IF src.eot THEN res := 1 END
- END;
- IF res # 0 THEN x := 0 END
- END Read;
-
- PROCEDURE ReadHeader(src: TextModels.Reader; VAR res: INTEGER;
- VAR name: ARRAY OF CHAR; VAR type: BYTE
- );
- VAR x, bit, i, j: INTEGER; ch: CHAR; tag: ARRAY 16 OF CHAR;
- BEGIN
- tag := Tag; i := 0;
- WHILE ~src.eot & (tag[i] # 0X) DO
- src.ReadChar(ch);
- IF ch = tag[i] THEN INC(i) ELSIF ch = tag[0] THEN i := 1 ELSE i := 0 END
- END;
- IF ~src.eot THEN
- res := 0; i := 0; bit := 0; x := 0;
- REPEAT
- WHILE (res = 0) & (bit < 8) DO Read(src, j, res); INC(x, ASH(j, bit)); INC(bit, 6) END;
- IF res = 0 THEN
- ch := CHR(x MOD 256); x := x DIV 256; DEC(bit, 8); name[i] := ch; INC(i)
- END
- UNTIL (res # 0) OR (ch = 0X);
- Read(src, j, res);
- IF res = 0 THEN
- IF (j = ThisVersion) OR (j = OldVersion) THEN
- Read(src, j, res); type := SHORT(SHORT(j))
- ELSE res := 3
- END
- END
- ELSE res := 8
- END
- END ReadHeader;
-
- PROCEDURE ReadFileType(src: TextModels.Reader; VAR res: INTEGER; VAR ftype: Files.Type);
- VAR x, bit, i, j: INTEGER; ch: CHAR;
- BEGIN
- res := 0; i := 0; bit := 0; x := 0;
- REPEAT
- WHILE (res = 0) & (bit < 8) DO Read(src, j, res); INC(x, ASH(j, bit)); INC(bit, 6) END;
- IF res = 0 THEN ch := CHR(x MOD 256); x := x DIV 256; DEC(bit, 8); ftype[i] := ch; INC(i) END
- UNTIL (res # 0) OR (ch = 0X);
- IF ftype = stdDocuType THEN ftype := Kernel.docType END
- END ReadFileType;
-
- PROCEDURE ReadFile(src: TextModels.Reader; VAR res: INTEGER; f: Files.File);
- VAR hash, x, bit, i, j, len, sum, s: INTEGER; byte: BYTE; dest: Files.Writer;
- BEGIN
- res := 0; i := 0; len := 0;
- REPEAT Read(src, x, res); len := len + ASH(x, 6 * i); INC(i) UNTIL (res # 0) OR (i = 6);
- i := 0;
- REPEAT table[i] := 0; INC(i) UNTIL i = N;
- bit := 0; hash := 0; sum := 0; dest := f.NewWriter(NIL);
- WHILE (res = 0) & (len # 0) DO
- IF bit = 0 THEN Read(src, x, res); bit := 6 END;
- IF ODD(x) THEN (* Incorrect prediction -> 1'xxxx'xxxx *)
- x := x DIV 2; DEC(bit);
- WHILE (res = 0) & (bit < 8) DO Read(src, j, res); INC(x, ASH(j, bit)); INC(bit, 6) END;
- i := x MOD 256;
- IF i > MAX(BYTE) THEN i := i - 256 END;
- byte := SHORT(SHORT(i)); x := x DIV 256; DEC(bit, 8);
- table[hash] := byte
- ELSE byte := table[hash]; x := x DIV 2; DEC(bit) (* correct prediction *)
- END;
- hash := (16 * hash + byte MOD 256) MOD N;
- dest.WriteByte(byte); sum := (sum + byte MOD 256) MOD (16 * 1024); DEC(len)
- END;
- IF res = 0 THEN
- i := 0; s := 0;
- REPEAT Read(src, x, res); s := s + ASH(x, 6 * i); INC(i) UNTIL (res # 0) OR (i = 6);
- IF (res = 0) & (s # sum) THEN res := 2 END
- END
- END ReadFile;
-
- PROCEDURE ShowText (t: TextModels.Model);
- VAR l: INTEGER; v: Views.View; wr: TextMappers.Formatter; conv: Converters.Converter;
- BEGIN
- l := t.Length();
- wr.ConnectTo(t); wr.SetPos(l); wr.WriteString(" --- end of encoding ---");
- ShowSizeMsg(l);
- v := TextViews.dir.New(t);
- conv := Converters.list;
- WHILE (conv # NIL) & (conv.imp # "HostTextConv.ImportText") DO conv := conv.next END;
- Views.Open(v, NIL, "", conv);
- Views.SetDirty(v)
- END ShowText;
-
- PROCEDURE EncodedView*(v: Views.View): TextModels.Model;
- VAR n: INTEGER; f: Files.File; wrs: Stores.Writer; t: TextModels.Model; wr: TextModels.Writer;
- BEGIN
- f := Files.dir.Temp(); wrs.ConnectTo(f); Views.WriteView(wrs, v);
- t := TextModels.dir.New(); wr := t.NewWriter(NIL);
- n := 0; WriteHeader(wr, n, "", View); WriteFileType(wr, n, f.type); WriteFile(wr, n, f);
- RETURN t
- END EncodedView;
-
- PROCEDURE EncodeDocument*;
- VAR v: Views.View; w: Windows.Window;
- BEGIN
- w := Windows.dir.First();
- IF w # NIL THEN
- v := w.doc.OriginalView();
- IF (v.context # NIL) & (v.context IS Documents.Context) THEN
- v := v.context(Documents.Context).ThisDoc()
- END;
- IF v # NIL THEN ShowText(EncodedView(v)) END
- END
- END EncodeDocument;
-
- PROCEDURE EncodeFocus*;
- VAR v: Views.View;
- BEGIN
- v := Controllers.FocusView();
- IF v # NIL THEN ShowText(EncodedView(v)) END
- END EncodeFocus;
-
- PROCEDURE EncodeSelection*;
- VAR beg, end: INTEGER; t: TextModels.Model; c: TextControllers.Controller;
- BEGIN
- c := TextControllers.Focus();
- IF (c # NIL) & c.HasSelection() THEN
- c.GetSelection(beg, end);
- t := TextModels.CloneOf(c.text); t.InsertCopy(0, c.text, beg, end);
- ShowText(EncodedView(TextViews.dir.New(t)))
- END
- END EncodeSelection;
-
- PROCEDURE EncodeFile*;
- VAR n: INTEGER; loc: Files.Locator; name: Files.Name; f: Files.File;
- t: TextModels.Model; wr: TextModels.Writer;
- BEGIN
- Dialog.GetIntSpec("", loc, name);
- IF loc # NIL THEN
- f := Files.dir.Old(loc, name, TRUE);
- IF f # NIL THEN
- t := TextModels.dir.New(); wr := t.NewWriter(NIL);
- n := 0; WriteHeader(wr, n, name, File); WriteFileType(wr, n, f.type); WriteFile(wr, n, f);
- ShowText(t)
- END
- END
- END EncodeFile;
-
- PROCEDURE GetFile(VAR path: ARRAY OF CHAR; VAR loc: Files.Locator; VAR name: Files.Name);
- VAR i, j: INTEGER; ch: CHAR;
- BEGIN
- i := 0; ch := path[0]; loc := Files.dir.This("");
- WHILE (ch # 0X) & (loc # NIL) DO
- j := 0;
- WHILE (ch # 0X) & (ch # Separator) DO name[j] := ch; INC(j); INC(i); ch := path[i] END;
- name[j] := 0X;
- IF ch = Separator THEN loc := loc.This(name); INC(i); ch := path[i] END;
- IF loc.res # 0 THEN loc := NIL END
- END;
- path[i] := 0X
- END GetFile;
-
- PROCEDURE ReadPath(rd: TextModels.Reader; VAR path: ARRAY OF CHAR; VAR len: INTEGER);
- VAR i, l: INTEGER; ch: CHAR;
- BEGIN
- i := 0; l := LEN(path) - 1;
- REPEAT rd.ReadChar(ch) UNTIL rd.eot OR (ch > " ");
- WHILE ~rd.eot & (ch > " ") & (i < l) DO path[i] := ch; INC(i); rd.ReadChar(ch) END;
- path[i] := 0X; len := i
- END ReadPath;
-
- PROCEDURE WriteString(w: Files.Writer; IN str: ARRAY OF CHAR; len: INTEGER);
- VAR i: INTEGER;
- BEGIN
- i := 0;
- WHILE i < len DO
- IF ORD(str[i]) > MAX(BYTE) THEN w.WriteByte(SHORT(SHORT(ORD(str[i]) - 256)))
- ELSE w.WriteByte(SHORT(SHORT(ORD(str[i]))))
- END;
- INC(i)
- END
- END WriteString;
-
- PROCEDURE EncodeFileList*;
- TYPE
- FileList = POINTER TO RECORD
- next: FileList;
- f: Files.File
- END;
- VAR
- beg, end, i, j, n: INTEGER; err: BOOLEAN;
- files, last: FileList;
- list, f: Files.File; w: Files.Writer; loc: Files.Locator;
- rd: TextModels.Reader; wr: TextModels.Writer; t: TextModels.Model;
- c: TextControllers.Controller;
- name: Files.Name; path, next: ARRAY 2048 OF CHAR;
- BEGIN
- c := TextControllers.Focus();
- IF (c # NIL) & c.HasSelection() THEN c.GetSelection(beg, end);
- rd := c.text.NewReader(NIL); rd.SetPos(beg); err := FALSE;
- list := Files.dir.Temp(); w := list.NewWriter(NIL); files := NIL; last := NIL;
- ReadPath(rd, path, i);
- WHILE (path # "") & (rd.Pos() - i < end) & ~err DO
- GetFile(path, loc, name);
- IF loc # NIL THEN
- f := Files.dir.Old(loc, name, TRUE); err := f = NIL;
- IF ~err THEN
- IF last = NIL THEN NEW(last); files := last ELSE NEW(last.next); last := last.next END;
- last.f := f;
- ReadPath(rd, next, j);
- IF (next = "=>") & (rd.Pos() - j < end) THEN
- ReadPath(rd, next, j);
- IF next # "" THEN WriteString(w, next, j + 1); ReadPath(rd, next, j)
- ELSE err := TRUE
- END
- ELSE WriteString(w, path, i + 1)
- END;
- path := next; i := j
- END
- ELSE err := TRUE
- END
- END;
- IF ~err & (files # NIL) THEN
- t := TextModels.dir.New(); wr := t.NewWriter(NIL);
- n := 0; WriteHeader(wr, n, "", List);
- WriteFileType(wr, n, list.type); WriteFile(wr, n, list);
- WHILE files # NIL DO
- WriteFileType(wr, n, files.f.type); WriteFile(wr, n, files.f); files := files.next
- END;
- ShowText(t)
- ELSIF err THEN
- IF path = "" THEN ShowError(7, path)
- ELSIF loc # NIL THEN ShowError(6, path)
- ELSE ShowError(5, path)
- END
- END
- END
- END EncodeFileList;
-
- PROCEDURE DecodeView(rd: TextModels.Reader; name: Files.Name);
- VAR res: INTEGER; f: Files.File; ftype: Files.Type; rds: Stores.Reader; v: Views.View;
- BEGIN
- ReadFileType(rd, res, ftype);
- IF res = 0 THEN
- f := Files.dir.Temp(); ReadFile(rd, res, f);
- IF res = 0 THEN
- rds.ConnectTo(f); Views.ReadView(rds, v); Views.Open(v, NIL, name, NIL);
- Views.SetDirty(v)
- ELSE ShowError(res, "")
- END
- ELSE ShowError(res, "")
- END
- END DecodeView;
-
- PROCEDURE DecodeFile(rd: TextModels.Reader; name: Files.Name);
- VAR res: INTEGER; ftype: Files.Type; loc: Files.Locator; f: Files.File;
- BEGIN
- ReadFileType(rd, res, ftype);
- IF res = 0 THEN
- Dialog.GetExtSpec(name, ftype, loc, name);
- IF loc # NIL THEN
- f := Files.dir.New(loc, Files.ask);
- IF f # NIL THEN
- ReadFile(rd, res, f);
- IF res = 0 THEN
- f.Register(name, ftype, Files.ask, res);
- IF res # 0 THEN ShowError(4, "") END
- ELSE ShowError(res, "")
- END
- ELSIF loc.res = 4 THEN ShowError(9, "")
- ELSIF loc.res = 5 THEN ShowError(10, "")
- END
- END
- ELSE ShowError(res, "")
- END
- END DecodeFile;
-
- PROCEDURE DecodeFileList (rd: TextModels.Reader; VAR files: FileList; VAR len, res: INTEGER);
- VAR i, n: INTEGER; b: BYTE; p: FileList;
- ftype: Files.Type; f: Files.File; frd: Files.Reader; path: Dialog.String;
- BEGIN
- ReadFileType(rd, res, ftype);
- IF res = 0 THEN
- f := Files.dir.Temp(); ReadFile(rd, res, f);
- IF res = 0 THEN
- files := NIL; p := NIL; n := 0;
- frd := f.NewReader(NIL); frd.ReadByte(b);
- WHILE ~frd.eof & (res = 0) DO
- INC(n); i := 0;
- WHILE ~frd.eof & (b # 0) DO path[i] := CHR(b MOD 256); INC(i); frd.ReadByte(b) END;
- IF (i > 4) & (path[i - 4] = ".") & (CAP(path[i - 3]) = "O")
- & (CAP(path[i - 2]) = "D") & (CAP(path[i - 1]) = "C")
- THEN path[i - 4] := 0X
- ELSE path[i] := 0X
- END;
- IF ~frd.eof THEN
- IF p = NIL THEN NEW(p); files := p ELSE NEW(p.next); p := p.next END;
- p.name := path;
- frd.ReadByte(b)
- ELSE res := 1
- END
- END;
- p := files; len := n;
- WHILE (res = 0) & (p # NIL) DO
- ReadFileType(rd, res, p.type);
- IF res = 0 THEN p.file := Files.dir.Temp(); ReadFile(rd, res, p.file) END;
- p := p.next
- END
- END
- END
- END DecodeFileList;
-
- PROCEDURE OpenDialog(files: FileList; len: INTEGER);
- VAR i: INTEGER; p: FileList;
- BEGIN
- par.files := files; par.list.SetLen(len);
- p := files; i := 0;
- WHILE p # NIL DO par.list.SetItem(i, p.name); INC(i); p := p.next END;
- par.storeAs := "";
- Dialog.Update(par); Dialog.UpdateList(par.list);
- StdCmds.OpenAuxDialog("Std/Rsrc/Coder", "Decode")
- END OpenDialog;
-
- PROCEDURE CloseDialog*;
- BEGIN
- par.files := NIL; par.list.SetLen(0); par.storeAs := "";
- Dialog.UpdateList(par.list); Dialog.Update(par)
- END CloseDialog;
-
- PROCEDURE Select*(op, from, to: INTEGER);
- VAR p: FileList; i: INTEGER;
- BEGIN
- IF (op = Dialog.included) OR (op = Dialog.excluded) OR (op = Dialog.set) THEN
- IF NofSelections(par.list) = 1 THEN
- i := 0; p := par.files;
- WHILE ~par.list.In(i) DO INC(i); p := p.next END;
- par.storeAs := p.name
- ELSE par.storeAs := ""
- END;
- Dialog.Update(par)
- END
- END Select;
-
- PROCEDURE CopyFile(from: Files.File; loc: Files.Locator; name: Files.Name; type: Files.Type);
- CONST BufSize = 4096;
- VAR res, k, l: INTEGER; f: Files.File; r: Files.Reader; w: Files.Writer;
- buf: ARRAY BufSize OF BYTE;
- BEGIN
- f := Files.dir.New(loc, Files.ask);
- IF f # NIL THEN
- r := from.NewReader(NIL); w := f.NewWriter(NIL); l := from.Length();
- WHILE l # 0 DO
- IF l <= BufSize THEN k := l ELSE k := BufSize END;
- r.ReadBytes(buf, 0, k); w.WriteBytes(buf, 0, k);
- l := l - k
- END;
- f.Register(name, type, Files.ask, res);
- IF res # 0 THEN ShowError(4, "") END
- ELSIF loc.res = 4 THEN ShowError(9, "")
- ELSIF loc.res = 5 THEN ShowError(10, "")
- END
- END CopyFile;
-
- PROCEDURE StoreSelection*;
- VAR i, n: INTEGER; p: FileList; loc: Files.Locator; name: Files.Name;
- BEGIN
- n := NofSelections(par.list);
- IF n > 1 THEN
- i := 0; p := par.files;
- WHILE n # 0 DO
- WHILE ~par.list.In(i) DO INC(i); p := p.next END;
- GetFile(p.name, loc, name); CopyFile(p.file, loc, name, p.type);
- DEC(n); INC(i); p := p.next
- END
- ELSIF (n = 1) & (par.storeAs # "") THEN
- i := 0; p := par.files;
- WHILE ~par.list.In(i) DO INC(i); p := p.next END;
- GetFile(par.storeAs, loc, name); CopyFile(p.file, loc, name, p.type)
- END
- END StoreSelection;
-
- PROCEDURE StoreSelectionGuard*(VAR p: Dialog.Par);
- VAR n: INTEGER;
- BEGIN
- n := NofSelections(par.list);
- p.disabled := (n = 0) OR ((n = 1) & (par.storeAs = ""))
- END StoreSelectionGuard;
-
- PROCEDURE StoreSingle*;
- VAR i: INTEGER; p: FileList; loc: Files.Locator; name: Files.Name;
- BEGIN
- IF NofSelections(par.list) = 1 THEN
- i := 0; p := par.files;
- WHILE ~par.list.In(i) DO INC(i); p := p.next END;
- GetFile(p.name, loc, name);
- Dialog.GetExtSpec(name, p.type, loc, name);
- IF loc # NIL THEN CopyFile(p.file, loc, name, p.type) END
- END
- END StoreSingle;
-
- PROCEDURE StoreSingleGuard*(VAR p: Dialog.Par);
- BEGIN
- p.disabled := NofSelections(par.list) # 1
- END StoreSingleGuard;
-
- PROCEDURE StoreAllFiles(files: FileList);
- VAR loc: Files.Locator; name: Files.Name;
- BEGIN
- WHILE files # NIL DO
- GetFile(files.name, loc, name); CopyFile(files.file, loc, name, files.type); files := files.next
- END
- END StoreAllFiles;
-
- PROCEDURE StoreAll*;
- BEGIN
- StoreAllFiles(par.files)
- END StoreAll;
-
- PROCEDURE DecodeAllFromText*(text: TextModels.Model; beg: INTEGER; ask: BOOLEAN);
- VAR res, i: INTEGER; type: BYTE; name: Files.Name; rd: TextModels.Reader; files: FileList;
- BEGIN
- CloseDialog;
- rd := text.NewReader(NIL); rd.SetPos(beg);
- ReadHeader(rd, res, name, type);
- i := 0;
- WHILE name[i] # 0X DO INC(i) END;
- IF (i > 4) & (name[i - 4] = ".") & (CAP(name[i - 3]) = "O")
- & (CAP(name[i - 2]) = "D") & (CAP(name[i - 1]) = "C")
- THEN name[i - 4] := 0X
- END;
- IF res = 0 THEN
- IF type = View THEN DecodeView(rd, name)
- ELSIF type = File THEN DecodeFile(rd, name)
- ELSIF type = List THEN
- DecodeFileList(rd, files, i, res);
- IF res = 0 THEN
- IF ask THEN OpenDialog(files, i) ELSE StoreAllFiles(files) END
- ELSE ShowError(res, "")
- END
- ELSE ShowError(3, "")
- END
- ELSE ShowError(res, "")
- END
- END DecodeAllFromText;
-
- PROCEDURE Decode*;
- VAR beg, end: INTEGER; c: TextControllers.Controller;
- BEGIN
- CloseDialog;
- c := TextControllers.Focus();
- IF c # NIL THEN
- IF c.HasSelection() THEN c.GetSelection(beg, end) ELSE beg := 0 END;
- DecodeAllFromText(c.text, beg, TRUE)
- END
- END Decode;
-
- PROCEDURE ListFiles(rd: TextModels.Reader; VAR wr: TextMappers.Formatter);
- VAR i, n, res: INTEGER; b: BYTE;
- ftype: Files.Type; f: Files.File; frd: Files.Reader; path: Dialog.String;
- BEGIN
- ReadFileType(rd, res, ftype);
- IF res = 0 THEN
- f := Files.dir.Temp(); ReadFile(rd, res, f);
- IF res = 0 THEN
- n := 0;
- frd := f.NewReader(NIL); frd.ReadByte(b);
- WHILE ~frd.eof & (res = 0) DO
- INC(n); i := 0;
- WHILE ~frd.eof & (b # 0) DO path[i] := CHR(b MOD 256); INC(i); frd.ReadByte(b) END;
- IF (i > 4) & (path[i - 4] = ".") & (CAP(path[i - 3]) = "O")
- & (CAP(path[i - 2]) = "D") & (CAP(path[i - 1]) = "C")
- THEN path[i - 4] := 0X
- ELSE path[i] := 0X
- END;
- IF ~frd.eof THEN wr.WriteString(path); wr.WriteLn; frd.ReadByte(b) ELSE res := 1 END
- END
- ELSE ShowError(res, "")
- END
- ELSE ShowError(res, "")
- END
- END ListFiles;
-
- PROCEDURE ListSingleton(type, name: ARRAY OF CHAR; VAR wr: TextMappers.Formatter);
- BEGIN
- wr.WriteString(type);
- IF name # "" THEN wr.WriteString(": '"); wr.WriteString(name); wr.WriteChar("'") END;
- wr.WriteLn
- END ListSingleton;
-
- PROCEDURE EncodedInText*(text: TextModels.Model; beg: INTEGER): TextModels.Model;
- VAR res, i: INTEGER; type: BYTE; name: Files.Name;
- rd: TextModels.Reader; report: TextModels.Model; wr: TextMappers.Formatter;
- BEGIN
- report := TextModels.dir.New(); wr.ConnectTo(report);
- rd := text.NewReader(NIL); rd.SetPos(beg);
- ReadHeader(rd, res, name, type);
- i := 0;
- WHILE name[i] # 0X DO INC(i) END;
- IF (i > 4) & (name[i - 4] = ".") & (CAP(name[i - 3]) = "O")
- & (CAP(name[i - 2]) = "D") & (CAP(name[i - 1]) = "C")
- THEN name[i - 4] := 0X
- END;
- IF res = 0 THEN
- IF type = View THEN ListSingleton("View", name, wr)
- ELSIF type = File THEN ListSingleton("File", name, wr)
- ELSIF type = List THEN ListFiles(rd, wr)
- ELSE ShowError(3, "")
- END
- ELSE ShowError(res, "")
- END;
- RETURN report
- END EncodedInText;
-
- PROCEDURE ListEncodedMaterial*;
- VAR beg, end: INTEGER; c: TextControllers.Controller;
- BEGIN
- c := TextControllers.Focus();
- IF c # NIL THEN
- IF c.HasSelection() THEN c.GetSelection(beg, end) ELSE beg := 0 END;
- Views.OpenView(TextViews.dir.New(EncodedInText(c.text, beg)))
- END
- END ListEncodedMaterial;
-
- PROCEDURE InitCodes;
- VAR i: BYTE; j: INTEGER;
- BEGIN
- j := 0;
- WHILE j # 256 DO revCode[j] := -1; INC(j) END;
- code[0] := "."; revCode[ORD(".")] := 0; code[1] := ","; revCode[ORD(",")] := 1;
- i := 2; j := ORD("0");
- WHILE j <= ORD("9") DO code[i] := CHR(j); revCode[j] := i; INC(i); INC(j) END;
- j := ORD("A");
- WHILE j <= ORD("Z") DO code[i] := CHR(j); revCode[j] := i; INC(i); INC(j) END;
- j := ORD("a");
- WHILE j <= ORD("z") DO code[i] := CHR(j); revCode[j] := i; INC(i); INC(j) END;
- ASSERT(i = 64, 60)
- END InitCodes;
-
-BEGIN
- InitCodes;
- stdDocuType[0] := 3X; stdDocuType[1] := 3X; stdDocuType[2] := 3X; stdDocuType[3] := 0X
-END StdCoder.
diff --git a/new/Std/Mod/Debug.txt b/new/Std/Mod/Debug.txt
--- a/new/Std/Mod/Debug.txt
+++ /dev/null
@@ -1,621 +0,0 @@
-MODULE StdDebug;
-
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Debug.odc *)
- (* DO NOT EDIT *)
-
- IMPORT SYSTEM,
- Kernel, Strings, Fonts, Services, Ports, Views, Properties, Dialog, Containers, StdFolds,
- TextModels, TextMappers, TextViews, TextRulers;
-
- CONST
- refViewSize = 9 * Ports.point;
-
- heap = 1; source = 2; module = 3; modules = 4; (* RefView types *)
-
- TYPE
- Name = Kernel.Name;
-
- ArrayPtr = POINTER TO RECORD
- last, t, first: INTEGER; (* gc header *)
- len: ARRAY 16 OF INTEGER (* dynamic array length table *)
- END;
-
- RefView = POINTER TO RefViewDesc;
-
- RefViewDesc = RECORD
- type: SHORTINT;
- command: SHORTINT;
- back: RefView;
- adr: INTEGER;
- desc: Kernel.Type;
- ptr: ArrayPtr;
- name: Name
- END;
-
- Action = POINTER TO RECORD (Services.Action)
- text: TextModels.Model
- END;
-
- Cluster = POINTER TO RECORD [untagged] (* must correspond to Kernel.Cluster *)
- size: INTEGER;
- next: Cluster
- END;
-
-
- VAR
- out: TextMappers.Formatter;
- path: ARRAY 4 OF Ports.Point;
- empty: Name;
-
-
- PROCEDURE NewRuler (): TextRulers.Ruler;
- CONST mm = Ports.mm;
- VAR r: TextRulers.Ruler;
- BEGIN
- r := TextRulers.dir.New(NIL);
- TextRulers.SetRight(r, 140 * mm);
- TextRulers.AddTab(r, 4 * mm); TextRulers.AddTab(r, 34 * mm); TextRulers.AddTab(r, 80 * mm);
- RETURN r
- END NewRuler;
-
- PROCEDURE OpenViewer (t: TextModels.Model; title: Views.Title; ruler:TextRulers.Ruler);
- VAR v: TextViews.View; c: Containers.Controller;
- BEGIN
- Dialog.MapString(title, title);
- v := TextViews.dir.New(t);
- v.SetDefaults(ruler, TextViews.dir.defAttr);
- c := v.ThisController();
- IF c # NIL THEN
- c.SetOpts(c.opts - {Containers.noFocus, Containers.noSelection} + {Containers.noCaret})
- END;
- Views.OpenAux(v, title)
- END OpenViewer;
-
- PROCEDURE OpenFold (hidden: ARRAY OF CHAR);
- VAR fold: StdFolds.Fold; t: TextModels.Model; w: TextMappers.Formatter;
- BEGIN
- Dialog.MapString(hidden, hidden);
- t := TextModels.dir.New();
- w.ConnectTo(t); w.WriteString(hidden);
- fold := StdFolds.dir.New(StdFolds.expanded, "", t);
- out.WriteView(fold)
- END OpenFold;
-
- PROCEDURE CloseFold (collaps: BOOLEAN);
- VAR fold: StdFolds.Fold; m: TextModels.Model;
- BEGIN
- fold := StdFolds.dir.New(StdFolds.expanded, "", NIL);
- out.WriteView(fold);
- IF collaps THEN fold.Flip(); m := out.rider.Base(); out.SetPos(m.Length()) END
- END CloseFold;
-
- PROCEDURE WriteHex (n: INTEGER);
- BEGIN
- out.WriteIntForm(n, TextMappers.hexadecimal, 9, "0", TextMappers.showBase)
- END WriteHex;
-
- PROCEDURE WriteString (adr, len, base: INTEGER; zterm, unicode: BOOLEAN);
- CONST beg = 0; char = 1; code = 2;
- VAR ch: CHAR; sc: SHORTCHAR; val, mode: INTEGER; str: ARRAY 16 OF CHAR;
- BEGIN
- mode := beg;
- IF base = 2 THEN SYSTEM.GET(adr, ch); val := ORD(ch) ELSE SYSTEM.GET(adr, sc); val := ORD(sc) END;
- IF zterm & (val = 0) THEN out.WriteSString('""')
- ELSE
- REPEAT
- IF (val >= ORD(" ")) & (val < 7FH) OR (val > 0A0H) & (val < 100H) OR unicode & (val >= 100H) THEN
- IF mode # char THEN
- IF mode = code THEN out.WriteSString(", ") END;
- out.WriteChar(22X); mode := char
- END;
- out.WriteChar(CHR(val))
- ELSE
- IF mode = char THEN out.WriteChar(22X) END;
- IF mode # beg THEN out.WriteSString(", ") END;
- mode := code; Strings.IntToStringForm(val, Strings.hexadecimal, 1, "0", FALSE, str);
- IF str[0] > "9" THEN out.WriteChar("0") END;
- out.WriteString(str); out.WriteChar("X")
- END;
- INC(adr, base); DEC(len);
- IF base = 2 THEN SYSTEM.GET(adr, ch); val := ORD(ch) ELSE SYSTEM.GET(adr, sc); val := ORD(sc) END
- UNTIL (len = 0) OR zterm & (val = 0)
- END;
- IF mode = char THEN out.WriteChar(22X) END
- END WriteString;
-
- PROCEDURE OutString (s: ARRAY OF CHAR);
- VAR str: Dialog.String;
- BEGIN
- Dialog.MapString(s, str);
- out.WriteString(str)
- END OutString;
-
- (* ------------------- variable display ------------------- *)
-
- PROCEDURE FormOf (t: Kernel.Type): SHORTCHAR;
- BEGIN
- IF SYSTEM.VAL(INTEGER, t) DIV 256 = 0 THEN
- RETURN SHORT(CHR(SYSTEM.VAL(INTEGER, t)))
- ELSE
- RETURN SHORT(CHR(16 + t.id MOD 4))
- END
- END FormOf;
-
- PROCEDURE LenOf (t: Kernel.Type; ptr: ArrayPtr): INTEGER;
- BEGIN
- IF t.size # 0 THEN RETURN t.size
- ELSIF ptr # NIL THEN RETURN ptr.len[t.id DIV 16 MOD 16 - 1]
- ELSE RETURN 0
- END
- END LenOf;
-
- PROCEDURE SizeOf (t: Kernel.Type; ptr: ArrayPtr): INTEGER;
- BEGIN
- CASE FormOf(t) OF
- | 0BX: RETURN 0
- | 1X, 2X, 4X: RETURN 1
- | 3X, 5X: RETURN 2
- | 8X, 0AX: RETURN 8
- | 11X: RETURN t.size
- | 12X: RETURN LenOf(t, ptr) * SizeOf(t.base[0], ptr)
- ELSE RETURN 4
- END
- END SizeOf;
-
- PROCEDURE WriteName (t: Kernel.Type; ptr: ArrayPtr);
- VAR name: Kernel.Name; f: SHORTCHAR;
- BEGIN
- f := FormOf(t);
- CASE f OF
- | 0X: OutString("#Dev:Unknown")
- | 1X: out.WriteSString("BOOLEAN")
- | 2X: out.WriteSString("SHORTCHAR")
- | 3X: out.WriteSString("CHAR")
- | 4X: out.WriteSString("BYTE")
- | 5X: out.WriteSString("SHORTINT")
- | 6X: out.WriteSString("INTEGER")
- | 7X: out.WriteSString("SHORTREAL")
- | 8X: out.WriteSString("REAL")
- | 9X: out.WriteSString("SET")
- | 0AX: out.WriteSString("LONGINT")
- | 0BX: out.WriteSString("ANYREC")
- | 0CX: out.WriteSString("ANYPTR")
- | 0DX: out.WriteSString("POINTER")
- | 0EX: out.WriteSString("PROCEDURE")
- | 0FX: out.WriteSString("STRING")
- | 10X..13X:
- Kernel.GetTypeName(t, name);
- IF name = "!" THEN
- IF f = 11X THEN out.WriteSString("RECORD")
- ELSIF f = 12X THEN out.WriteSString("ARRAY")
- ELSE OutString("#Dev:Unknown")
- END
- ELSIF (t.id DIV 256 # 0) & (t.mod.refcnt >= 0) THEN
- out.WriteSString(t.mod.name); out.WriteChar("."); out.WriteSString(name)
- ELSIF f = 11X THEN
- out.WriteSString(t.mod.name); out.WriteSString(".RECORD")
- ELSIF f = 12X THEN
- out.WriteSString("ARRAY "); out.WriteInt(LenOf(t, ptr)); t := t.base[0];
- WHILE (FormOf(t) = 12X) & ((t.id DIV 256 = 0) OR (t.mod.refcnt < 0)) DO
- out.WriteSString(", "); out.WriteInt(LenOf(t, ptr)); t := t.base[0]
- END;
- out.WriteSString(" OF "); WriteName(t, ptr)
- ELSIF f = 13X THEN
- out.WriteSString("POINTER")
- ELSE
- out.WriteSString("PROCEDURE")
- END
- | 20X: out.WriteSString("COM.IUnknown")
- | 21X: out.WriteSString("COM.GUID")
- | 22X: out.WriteSString("COM.RESULT")
- ELSE OutString("#Dev:UnknownFormat"); out.WriteInt(ORD(f))
- END
- END WriteName;
-
- PROCEDURE WriteGuid (a: INTEGER);
-
- PROCEDURE Hex (a: INTEGER);
- VAR x: SHORTCHAR;
- BEGIN
- SYSTEM.GET(a, x);
- out.WriteIntForm(ORD(x), TextMappers.hexadecimal, 2, "0", FALSE)
- END Hex;
-
- BEGIN
- out.WriteChar("{");
- Hex(a + 3); Hex(a + 2); Hex(a + 1); Hex(a);
- out.WriteChar("-");
- Hex(a + 5); Hex(a + 4);
- out.WriteChar("-");
- Hex(a + 7); Hex(a + 6);
- out.WriteChar("-");
- Hex(a + 8);
- Hex(a + 9);
- out.WriteChar("-");
- Hex(a + 10);
- Hex(a + 11);
- Hex(a + 12);
- Hex(a + 13);
- Hex(a + 14);
- Hex(a + 15);
- out.WriteChar("}")
- END WriteGuid;
-
- PROCEDURE^ ShowVar (ad, ind: INTEGER; f, c: SHORTCHAR; desc: Kernel.Type; ptr: ArrayPtr;
- back: RefView; VAR name, sel: Name);
-
- PROCEDURE ShowRecord (a, ind: INTEGER; desc: Kernel.Type; back: RefView; VAR sel: Name);
- VAR dir: Kernel.Directory; obj: Kernel.Object; name: Kernel.Name; i, j, n: INTEGER; base: Kernel.Type;
- BEGIN
- WriteName(desc, NIL); out.WriteTab;
- IF desc.mod.refcnt >= 0 THEN
- OpenFold("#Dev:Fields");
- n := desc.id DIV 16 MOD 16; j := 0;
- WHILE j <= n DO
- base := desc.base[j];
- IF base # NIL THEN
- dir := base.fields; i := 0;
- WHILE i < dir.num DO
- obj := SYSTEM.VAL(Kernel.Object, SYSTEM.ADR(dir.obj[i]));
- Kernel.GetObjName(base.mod, obj, name);
- ShowVar(a + obj.offs, ind, FormOf(obj.struct), 1X, obj.struct, NIL, back, name, sel);
- INC(i)
- END
- END;
- INC(j)
- END;
- out.WriteSString(" "); CloseFold((ind > 1) OR (sel # ""))
- ELSE
- OutString("#Dev:Unloaded")
- END
- END ShowRecord;
-
- PROCEDURE ShowArray (a, ind: INTEGER; desc: Kernel.Type; ptr: ArrayPtr; back: RefView; VAR sel: Name);
- VAR f: SHORTCHAR; i, n, m, size, len: INTEGER; name: Kernel.Name; eltyp, t: Kernel.Type;
- vi: SHORTINT; vs: BYTE; str: Dialog.String; high: BOOLEAN;
- BEGIN
- WriteName(desc, ptr); out.WriteTab;
- len := LenOf(desc, ptr); eltyp := desc.base[0]; f := FormOf(eltyp); size := SizeOf(eltyp, ptr);
- IF (f = 2X) OR (f = 3X) THEN (* string *)
- n := 0; m := len; high := FALSE;
- IF f = 2X THEN
- REPEAT SYSTEM.GET(a + n, vs); INC(n) UNTIL (n = 32) OR (n = len) OR (vs = 0);
- REPEAT DEC(m); SYSTEM.GET(a + m, vs) UNTIL (m = 0) OR (vs # 0)
- ELSE
- REPEAT
- SYSTEM.GET(a + n * 2, vi); INC(n);
- IF vi DIV 256 # 0 THEN high := TRUE END
- UNTIL (n = len) OR (vi = 0);
- n := MIN(n, 32);
- REPEAT DEC(m); SYSTEM.GET(a + m * 2, vi) UNTIL (m = 0) OR (vi # 0)
- END;
- WriteString(a, n, size, TRUE, TRUE);
- INC(m, 2);
- IF m > len THEN m := len END;
- IF high OR (m > n) THEN
- out.WriteSString(" "); OpenFold("...");
- out.WriteLn;
- IF high & (n = 32) THEN
- WriteString(a, m, size, TRUE, TRUE);
- out.WriteLn; out.WriteLn
- END;
- WriteString(a, m, size, FALSE, FALSE);
- IF m < len THEN out.WriteSString(", ..., 0X") END;
- out.WriteSString(" "); CloseFold(TRUE)
- END
- ELSE
- t := eltyp;
- WHILE FormOf(t) = 12X DO t := t.base[0] END;
- IF FormOf(t) # 0X THEN
- OpenFold("#Dev:Elements");
- i := 0;
- WHILE i < len DO
- Strings.IntToString(i, str);
- name := "[" + SHORT(str$) + "]";
- ShowVar(a, ind, f, 1X, eltyp, ptr, back, name, sel);
- INC(i); INC(a, size)
- END;
- out.WriteSString(" "); CloseFold(TRUE)
- END
- END
- END ShowArray;
-
- PROCEDURE ShowProcVar (a: INTEGER);
- VAR vli, n, ref: INTEGER; m: Kernel.Module; name: Kernel.Name;
- BEGIN
- SYSTEM.GET(a, vli);
- Kernel.SearchProcVar(vli, m, vli);
- IF m = NIL THEN
- IF vli = 0 THEN out.WriteSString("NIL")
- ELSE WriteHex(vli)
- END
- ELSE
- IF m.refcnt >= 0 THEN
- out.WriteSString(m.name); ref := m.refs;
- REPEAT Kernel.GetRefProc(ref, n, name) UNTIL (n = 0) OR (vli < n);
- IF vli < n THEN out.WriteChar("."); out.WriteSString(name) END
- ELSE
- OutString("#Dev:ProcInUnloadedMod");
- out.WriteSString(m.name); out.WriteSString(" !!!")
- END
- END
- END ShowProcVar;
-
- PROCEDURE ShowPointer (a: INTEGER; f: SHORTCHAR; desc: Kernel.Type; back: RefView; VAR sel: Name);
- VAR adr, x: INTEGER; ptr: ArrayPtr; c: Cluster; btyp: Kernel.Type;
- BEGIN
- SYSTEM.GET(a, adr);
- IF f = 13X THEN btyp := desc.base[0] ELSE btyp := NIL END;
- IF adr = 0 THEN out.WriteSString("NIL")
- ELSIF f = 20X THEN
- out.WriteChar("["); WriteHex(adr); out.WriteChar("]");
- out.WriteChar(" "); c := SYSTEM.VAL(Cluster, Kernel.Root());
- WHILE (c # NIL) & ((adr < SYSTEM.VAL(INTEGER, c)) OR (adr >= SYSTEM.VAL(INTEGER, c) + c.size)) DO c := c.next END;
- IF c # NIL THEN
- ptr := SYSTEM.VAL(ArrayPtr, adr)
- END
- ELSE
- IF (f = 13X) OR (f = 0CX) THEN x := adr - 4 ELSE x := adr END;
- IF ((adr < -4) OR (adr >= 65536)) & Kernel.IsReadable(x, adr + 16) THEN
- out.WriteChar("["); WriteHex(adr); out.WriteChar("]");
- IF (f = 13X) OR (f = 0CX) THEN
- out.WriteChar(" "); c := SYSTEM.VAL(Cluster, Kernel.Root());
- WHILE (c # NIL) & ((adr < SYSTEM.VAL(INTEGER, c)) OR (adr >= SYSTEM.VAL(INTEGER, c) + c.size)) DO
- c := c.next
- END;
- IF c # NIL THEN
- ptr := SYSTEM.VAL(ArrayPtr, adr);
- IF (f = 13X) & (FormOf(btyp) = 12X) THEN (* array *)
- adr := SYSTEM.ADR(ptr.len[btyp.id DIV 16 MOD 16])
- END
- ELSE OutString("#Dev:IllegalPointer")
- END
- END
- ELSE OutString("#Dev:IllegalAddress"); WriteHex(adr)
- END
- END
- END ShowPointer;
-
- PROCEDURE ShowSelector (ref: RefView);
- VAR b: RefView; n: SHORTINT; a, a0: TextModels.Attributes;
- BEGIN
- b := ref.back; n := 1;
- IF b # NIL THEN
- WHILE (b.name = ref.name) & (b.back # NIL) DO INC(n); b := b.back END;
- ShowSelector(b);
- IF n > 1 THEN out.WriteChar("(") END;
- out.WriteChar(".")
- END;
- out.WriteSString(ref.name);
- IF ref.type = heap THEN out.WriteChar("^") END;
- IF n > 1 THEN
- out.WriteChar(")");
- a0 := out.rider.attr; a := TextModels.NewOffset(a0, 2 * Ports.point);
- out.rider.SetAttr(a);
- out.WriteInt(n); out.rider.SetAttr(a0)
- END
- END ShowSelector;
-
- PROCEDURE ShowVar (ad, ind: INTEGER; f, c: SHORTCHAR; desc: Kernel.Type; ptr: ArrayPtr; back: RefView;
- VAR name, sel: Name);
- VAR i, j, vli, a: INTEGER; tsel: Name; a0: TextModels.Attributes;
- vc: SHORTCHAR; vsi: BYTE; vi: SHORTINT; vr: SHORTREAL; vlr: REAL; vs: SET;
- BEGIN
- out.WriteLn; out.WriteTab; i := 0;
- WHILE i < ind DO out.WriteSString(" "); INC(i) END;
- a := ad; i := 0; j := 0;
- IF sel # "" THEN
- WHILE sel[i] # 0X DO tsel[i] := sel[i]; INC(i) END;
- IF (tsel[i-1] # ":") & (name[0] # "[") THEN tsel[i] := "."; INC(i) END
- END;
- WHILE name[j] # 0X DO tsel[i] := name[j]; INC(i); INC(j) END;
- tsel[i] := 0X;
- a0 := out.rider.attr;
- IF c = 3X THEN (* varpar *)
- SYSTEM.GET(ad, a);
- out.rider.SetAttr(TextModels.NewStyle(a0, {Fonts.italic}))
- END;
- IF name[0] # "[" THEN out.WriteChar(".") END;
- out.WriteSString(name);
- out.rider.SetAttr(a0); out.WriteTab;
- IF (c = 3X) & (a >= 0) & (a < 65536) THEN
- out.WriteTab; out.WriteSString("NIL VARPAR")
- ELSIF f = 11X THEN
- Kernel.GetTypeName(desc, name);
- IF (c = 3X) & (name[0] # "!") THEN SYSTEM.GET(ad + 4, desc) END; (* dynamic type *)
- ShowRecord(a, ind + 1, desc, back, tsel)
- ELSIF (c = 3X) & (f = 0BX) THEN (* VAR anyrecord *)
- SYSTEM.GET(ad + 4, desc);
- ShowRecord(a, ind + 1, desc, back, tsel)
- ELSIF f = 12X THEN
- IF (desc.size = 0) & (ptr = NIL) THEN SYSTEM.GET(ad, a) END; (* dyn array val par *)
- IF ptr = NIL THEN ptr := SYSTEM.VAL(ArrayPtr, ad - 8) END;
- ShowArray(a, ind + 1, desc, ptr, back, tsel)
- ELSE
- IF desc = NIL THEN desc := SYSTEM.VAL(Kernel.Type, ORD(f)) END;
- WriteName(desc, NIL); out.WriteTab;
- CASE f OF
- | 0X: (* SYSTEM.GET(a, vli); WriteHex(vli) *)
- | 1X: SYSTEM.GET(a, vc);
- IF vc = 0X THEN out.WriteSString("FALSE")
- ELSIF vc = 1X THEN out.WriteSString("TRUE")
- ELSE OutString("#Dev:Undefined"); out.WriteInt(ORD(vc))
- END
- | 2X: WriteString(a, 1, 1, FALSE, FALSE)
- | 3X: WriteString(a, 1, 2, FALSE, TRUE);
- SYSTEM.GET(a, vi);
- IF vi DIV 256 # 0 THEN out.WriteString(" "); WriteString(a, 1, 2, FALSE, FALSE) END
- | 4X: SYSTEM.GET(a, vsi); out.WriteInt(vsi)
- | 5X: SYSTEM.GET(a, vi); out.WriteInt(vi)
- | 6X: SYSTEM.GET(a, vli); out.WriteInt(vli)
- | 7X: SYSTEM.GET(a, vr); out.WriteReal(vr)
- | 8X: SYSTEM.GET(a, vlr); out.WriteReal(vlr)
- | 9X: SYSTEM.GET(a, vs); out.WriteSet(vs)
- | 0AX: SYSTEM.GET(a, vli); SYSTEM.GET(a + 4, i);
- IF (vli >= 0) & (i = 0) OR (vli < 0) & (i = -1) THEN out.WriteInt(vli)
- ELSE out.WriteIntForm(i, TextMappers.hexadecimal, 8, "0", TextMappers.hideBase); WriteHex(vli)
- END
- | 0CX, 0DX, 13X, 20X: ShowPointer(a, f, desc, back, tsel)
- | 0EX, 10X: ShowProcVar(a)
- | 0FX: WriteString(a, 256, 1, TRUE, FALSE)
- | 21X: WriteGuid(a)
- | 22X: SYSTEM.GET(a, vli); WriteHex(vli)
- ELSE
- END
- END
- END ShowVar;
-
-
- PROCEDURE ShowStack;
- VAR ref, end, i, j, x, a, b, c: INTEGER; m, f: SHORTCHAR; mod: Kernel.Module; name, sel: Kernel.Name;
- d: Kernel.Type;
- BEGIN
- a := Kernel.pc; b := Kernel.fp; c := 100;
- REPEAT
- mod := Kernel.modList;
- WHILE (mod # NIL) & ((a < mod.code) OR (a >= mod.code + mod.csize)) DO mod := mod.next END;
- IF mod # NIL THEN
- DEC(a, mod.code);
- IF mod.refcnt >= 0 THEN
- out.WriteChar(" "); out.WriteSString(mod.name); ref := mod.refs;
- REPEAT Kernel.GetRefProc(ref, end, name) UNTIL (end = 0) OR (a < end);
- IF a < end THEN
- out.WriteChar("."); out.WriteSString(name);
- sel := mod.name$; i := 0;
- WHILE sel[i] # 0X DO INC(i) END;
- sel[i] := "."; INC(i); j := 0;
- WHILE name[j] # 0X DO sel[i] := name[j]; INC(i); INC(j) END;
- sel[i] := ":"; sel[i+1] := 0X;
- out.WriteSString(" ["); WriteHex(a);
- out.WriteSString("] ");
- i := Kernel.SourcePos(mod, 0);
- IF name # "$$" THEN
- Kernel.GetRefVar(ref, m, f, d, x, name);
- WHILE m # 0X DO
- IF name[0] # "@" THEN ShowVar(b + x, 0, f, m, d, NIL, NIL, name, sel) END;
- Kernel.GetRefVar(ref, m, f, d, x, name)
- END
- END;
- out.WriteLn
- ELSE out.WriteSString(".???"); out.WriteLn
- END
- ELSE
- out.WriteChar("("); out.WriteSString(mod.name);
- out.WriteSString(") (pc="); WriteHex(a);
- out.WriteSString(", fp="); WriteHex(b); out.WriteChar(")");
- out.WriteLn
- END
- ELSE
- out.WriteSString("<system> (pc="); WriteHex(a);
- out.WriteSString(", fp="); WriteHex(b); out.WriteChar(")");
- out.WriteLn
- END;
- IF (b >= Kernel.fp) & (b < Kernel.stack) THEN
- SYSTEM.GET(b+4, a); (* stacked pc *)
- SYSTEM.GET(b, b); (* dynamic link *)
- DEC(a); DEC(c)
- ELSE c := 0
- END
- UNTIL c = 0
- END ShowStack;
-
- PROCEDURE (a: Action) Do; (* delayed trap window open *)
- BEGIN
- Kernel.SetTrapGuard(TRUE);
- OpenViewer(a.text, "#Dev:Trap", NewRuler());
- Kernel.SetTrapGuard(FALSE);
- END Do;
-
- PROCEDURE GetTrapMsg(OUT msg: ARRAY OF CHAR);
- VAR ref, end, a: INTEGER; mod: Kernel.Module; name: Kernel.Name; head, tail, errstr: ARRAY 32 OF CHAR;
- key: ARRAY 128 OF CHAR;
- BEGIN
- a := Kernel.pc; mod := Kernel.modList;
- WHILE (mod # NIL) & ((a < mod.code) OR (a >= mod.code + mod.csize)) DO mod := mod.next END;
- IF mod # NIL THEN
- DEC(a, mod.code); ref := mod.refs;
- REPEAT Kernel.GetRefProc(ref, end, name) UNTIL (end = 0) OR (a < end);
- IF a < end THEN
- Kernel.SplitName (mod.name$, head, tail);
- IF head = "" THEN head := "System" END;
- Strings.IntToString(Kernel.err, errstr);
- key := tail + "." + name + "." + errstr;
- Dialog.MapString("#" + head + ":" + key, msg);
- (* IF key # msg THEN out.WriteString(" " + msg) END; *)
- IF key = msg THEN msg := "" END;
- END
- END
- END GetTrapMsg;
-
- PROCEDURE Trap;
- VAR a0: TextModels.Attributes; action: Action; msg: ARRAY 512 OF CHAR;
- BEGIN
- out.ConnectTo(TextModels.dir.New());
- a0 := out.rider.attr;
- out.rider.SetAttr(TextModels.NewWeight(a0, Fonts.bold));
- IF Kernel.err = 129 THEN out.WriteSString("invalid WITH")
- ELSIF Kernel.err = 130 THEN out.WriteSString("invalid CASE")
- ELSIF Kernel.err = 131 THEN out.WriteSString("function without RETURN")
- ELSIF Kernel.err = 132 THEN out.WriteSString("type guard")
- ELSIF Kernel.err = 133 THEN out.WriteSString("implied type guard")
- ELSIF Kernel.err = 134 THEN out.WriteSString("value out of range")
- ELSIF Kernel.err = 135 THEN out.WriteSString("index out of range")
- ELSIF Kernel.err = 136 THEN out.WriteSString("string too long")
- ELSIF Kernel.err = 137 THEN out.WriteSString("stack overflow")
- ELSIF Kernel.err = 138 THEN out.WriteSString("integer overflow")
- ELSIF Kernel.err = 139 THEN out.WriteSString("division by zero")
- ELSIF Kernel.err = 140 THEN out.WriteSString("infinite real result")
- ELSIF Kernel.err = 141 THEN out.WriteSString("real underflow")
- ELSIF Kernel.err = 142 THEN out.WriteSString("real overflow")
- ELSIF Kernel.err = 143 THEN out.WriteSString("undefined real result")
- ELSIF Kernel.err = 144 THEN out.WriteSString("not a number")
- ELSIF Kernel.err = 200 THEN out.WriteSString("keyboard interrupt")
- ELSIF Kernel.err = 201 THEN
- out.WriteSString("NIL dereference")
- ELSIF Kernel.err = 202 THEN
- out.WriteSString("illegal instruction: ");
- out.WriteIntForm(Kernel.val, TextMappers.hexadecimal, 5, "0", TextMappers.showBase)
- ELSIF Kernel.err = 203 THEN
- IF (Kernel.val >= -4) & (Kernel.val < 65536) THEN out.WriteSString("NIL dereference (read)")
- ELSE out.WriteSString("illegal memory read (ad = "); WriteHex(Kernel.val); out.WriteChar(")")
- END
- ELSIF Kernel.err = 204 THEN
- IF (Kernel.val >= -4) & (Kernel.val < 65536) THEN out.WriteSString("NIL dereference (write)")
- ELSE out.WriteSString("illegal memory write (ad = "); WriteHex(Kernel.val); out.WriteChar(")")
- END
- ELSIF Kernel.err = 205 THEN
- IF (Kernel.val >= -4) & (Kernel.val < 65536) THEN out.WriteSString("NIL procedure call")
- ELSE out.WriteSString("illegal execution (ad = "); WriteHex(Kernel.val); out.WriteChar(")")
- END
- ELSIF Kernel.err = 257 THEN out.WriteSString("out of memory")
- ELSIF Kernel.err = 10001H THEN out.WriteSString("bus error")
- ELSIF Kernel.err = 10002H THEN out.WriteSString("address error")
- ELSIF Kernel.err = 10007H THEN out.WriteSString("fpu error")
- ELSIF Kernel.err < 0 THEN
- out.WriteSString("Exception "); out.WriteIntForm(-Kernel.err, TextMappers.hexadecimal, 3, "0", TextMappers.showBase)
- ELSE
- out.WriteSString("TRAP "); out.WriteInt(Kernel.err);
- IF Kernel.err = 126 THEN out.WriteSString(" (not yet implemented)")
- ELSIF Kernel.err = 125 THEN out.WriteSString(" (call of obsolete procedure)")
- ELSIF Kernel.err >= 100 THEN out.WriteSString(" (invariant violated)")
- ELSIF Kernel.err >= 60 THEN out.WriteSString(" (postcondition violated)")
- ELSIF Kernel.err >= 20 THEN out.WriteSString(" (precondition violated)")
- END
- END;
- GetTrapMsg(msg);
- IF msg # "" THEN out.WriteLn; out.WriteString(msg) END;
- out.WriteLn; out.rider.SetAttr(a0);
- out.WriteLn; ShowStack;
- NEW(action); action.text := out.rider.Base();
- Services.DoLater(action, Services.now);
- out.ConnectTo(NIL)
- END Trap;
-
-BEGIN
- Kernel.InstallTrapViewer(Trap);
- empty := "";
- path[0].x := refViewSize DIV 2; path[0].y := 0;
- path[1].x := refViewSize; path[1].y := refViewSize DIV 2;
- path[2].x := refViewSize DIV 2; path[2].y := refViewSize;
- path[3].x := 0; path[3].y := refViewSize DIV 2;
-END StdDebug.
diff --git a/new/Std/Mod/Dialog.txt b/new/Std/Mod/Dialog.txt
--- a/new/Std/Mod/Dialog.txt
+++ /dev/null
@@ -1,297 +0,0 @@
-MODULE StdDialog;
-
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Dialog.odc *)
- (* DO NOT EDIT *)
-
- IMPORT
- Kernel, Meta, Strings, Files, Stores, Models, Sequencers, Views,
- Containers, Dialog, Properties, Documents, Converters, Windows;
-
-
- TYPE
- Item* = POINTER TO EXTENSIBLE RECORD
- next*: Item;
- item-, string-, filter-: POINTER TO ARRAY OF CHAR;
- shortcut-: ARRAY 8 OF CHAR;
- privateFilter-, failed, trapped: BOOLEAN; (* filter call failed, caused a trap *)
- res: INTEGER (* result code of failed filter *)
- END;
-
- FilterProcVal = RECORD (Meta.Value) p: Dialog.GuardProc END;
- FilterProcPVal = RECORD (Meta.Value) p: PROCEDURE(n: INTEGER; VAR p: Dialog.Par) END;
-
- ViewHook = POINTER TO RECORD (Views.ViewHook) END;
-
-
- VAR curItem-: Item; (** IN parameter for item filters **)
-
-
- PROCEDURE GetSubLoc* (mod: ARRAY OF CHAR; cat: Files.Name;
- OUT loc: Files.Locator; OUT name: Files.Name);
- VAR sub: Files.Name; file: Files.File; type: Files.Type;
- BEGIN
- IF (cat[0] = "S") & (cat[1] = "y") & (cat[2] = "m") THEN type := Kernel.symType
- ELSIF (cat[0] = "C") & (cat[1] = "o") & (cat[2] = "d") & (cat[3] = "e") THEN type := Kernel.objType
- ELSE type := ""
- END;
- Kernel.SplitName(mod, sub, name); Kernel.MakeFileName(name, type);
- loc := Files.dir.This(sub); file := NIL;
- IF loc # NIL THEN
- loc := loc.This(cat);
- IF sub = "" THEN
- IF loc # NIL THEN
- file := Files.dir.Old(loc, name, Files.shared);
- IF file = NIL THEN loc := NIL END
- END;
- IF loc = NIL THEN
- loc := Files.dir.This("System");
- IF loc # NIL THEN loc := loc.This(cat) END
- END
- END
- END
- END GetSubLoc;
-
-
- PROCEDURE Len (VAR str: ARRAY OF CHAR): INTEGER;
- VAR i: INTEGER;
- BEGIN
- i := 0; WHILE str[i] # 0X DO INC(i) END;
- RETURN i
- END Len;
-
- PROCEDURE AddItem* (i: Item; item, string, filter, shortcut: ARRAY OF CHAR);
- VAR j: INTEGER; ch: CHAR;
- BEGIN
- ASSERT(i # NIL, 20);
- NEW(i.item, Len(item) + 1);
- NEW(i.string, Len(string) + 1);
- NEW(i.filter, Len(filter) + 1);
- ASSERT((i.item # NIL) & (i.string # NIL) & (i.filter # NIL), 100);
- i.item^ := item$;
- i.string^ := string$;
- i.filter^ := filter$;
- i.shortcut := shortcut$;
- j := 0; ch := filter[0]; WHILE (ch # ".") & (ch # 0X) DO INC(j); ch := filter[j] END;
- i.privateFilter := (j > 0) & (ch = 0X);
- i.failed := FALSE; i.trapped := FALSE
- END AddItem;
-
- PROCEDURE ClearGuards* (i: Item);
- BEGIN
- i.failed := FALSE; i.trapped := FALSE
- END ClearGuards;
-
- PROCEDURE GetGuardProc (name: ARRAY OF CHAR; VAR i: Meta.Item;
- VAR par: BOOLEAN; VAR n: INTEGER);
- VAR j, k: INTEGER; num: ARRAY 32 OF CHAR;
- BEGIN
- j := 0;
- WHILE (name[j] # 0X) & (name[j] # "(") DO INC(j) END;
- IF name[j] = "(" THEN
- name[j] := 0X; INC(j); k := 0;
- WHILE (name[j] # 0X) & (name[j] # ")") DO num[k] := name[j]; INC(j); INC(k) END;
- IF (name[j] = ")") & (name[j+1] = 0X) THEN
- num[k] := 0X; Strings.StringToInt(num, n, k);
- IF k = 0 THEN Meta.LookupPath(name, i); par := TRUE
- ELSE Meta.Lookup("", i)
- END
- ELSE Meta.Lookup("", i)
- END
- ELSE
- Meta.LookupPath(name, i); par := FALSE
- END
- END GetGuardProc;
-
- PROCEDURE CheckFilter* (i: Item; VAR failed, ok: BOOLEAN; VAR par: Dialog.Par);
- VAR x: Meta.Item; v: FilterProcVal; vp: FilterProcPVal; p: BOOLEAN; n: INTEGER;
- BEGIN
- IF ~i.failed THEN
- curItem := i;
- par.disabled := FALSE; par.checked := FALSE; par.label := i.item$;
- par.undef := FALSE; par.readOnly := FALSE;
- i.failed := TRUE; i.trapped := TRUE;
- GetGuardProc(i.filter^, x, p, n);
- IF (x.obj = Meta.procObj) OR (x.obj = Meta.varObj) & (x.typ = Meta.procTyp) THEN
- IF p THEN
- x.GetVal(vp, ok);
- IF ok THEN vp.p(n, par) END
- ELSE
- x.GetVal(v, ok);
- IF ok THEN v.p(par) END
- END
- ELSE ok := FALSE
- END;
- IF ok THEN i.res := 0 ELSE i.res := 1 END;
- i.trapped := FALSE; i.failed := ~ok
- END;
- failed := i.failed
- END CheckFilter;
-
- PROCEDURE HandleItem* (i: Item);
- VAR res: INTEGER;
- BEGIN
- IF ~i.failed THEN
- Views.ClearQueue; res := 0;
- Dialog.Call(i.string^, " ", res)
- ELSIF (i # NIL) & i.failed THEN
- IF i.trapped THEN
- Dialog.ShowParamMsg("#System:ItemFilterTrapped", i.string^, i.filter^, "")
- ELSE
- Dialog.ShowParamMsg("#System:ItemFilterNotFound", i.string^, i.filter^, "")
- END
- END
- END HandleItem;
-
- PROCEDURE RecalcView* (v: Views.View);
- (* recalc size of all subviews of v, then v itself *)
- VAR m: Models.Model; v1: Views.View; c: Containers.Controller;
- minW, maxW, minH, maxH, w, h, w0, h0: INTEGER;
- BEGIN
- IF v IS Containers.View THEN
- c := v(Containers.View).ThisController();
- IF c # NIL THEN
- v1 := NIL; c.GetFirstView(Containers.any, v1);
- WHILE v1 # NIL DO
- RecalcView(v1);
- c.GetNextView(Containers.any, v1)
- END
- END
- END;
- IF v.context # NIL THEN
- m := v.context.ThisModel();
- IF (m # NIL) & (m IS Containers.Model) THEN
- m(Containers.Model).GetEmbeddingLimits(minW, maxW, minH, maxH);
- v.context.GetSize(w0, h0); w := w0; h := h0;
- Properties.PreferredSize(v, minW, maxW, minH, maxH, w, h, w, h);
- IF (w # w0) OR (h # h0) THEN v.context.SetSize(w, h) END
- END
- END
- END RecalcView;
-
-
- PROCEDURE Open* (v: Views.View; title: ARRAY OF CHAR;
- loc: Files.Locator; name: Files.Name; conv: Converters.Converter;
- asTool, asAux, noResize, allowDuplicates, neverDirty: BOOLEAN);
- VAR t: Views.Title; flags, opts: SET; done: BOOLEAN; d: Documents.Document; i: INTEGER;
- win: Windows.Window; c: Containers.Controller; seq: ANYPTR;
- BEGIN
- IF conv = NIL THEN conv := Converters.list END; (* use document converter *)
- ASSERT(v # NIL, 20);
- flags := {}; done := FALSE;
- IF noResize THEN
- flags := flags + {Windows.noResize, Windows.noHScroll, Windows.noVScroll}
- END;
- IF asTool THEN INCL(flags, Windows.isTool) END;
- IF asAux THEN INCL(flags, Windows.isAux) END;
- IF neverDirty THEN INCL(flags, Windows.neverDirty) END;
- i := 0;
- WHILE (i < LEN(t) - 1) & (title[i] # 0X) DO t[i] := title[i]; INC(i) END;
- t[i] := 0X;
- IF ~allowDuplicates THEN
- IF ~asTool & ~asAux THEN
- IF (loc # NIL) & (name # "") THEN Windows.SelectBySpec(loc, name, conv, done) END
- ELSE
- IF title # "" THEN Windows.SelectByTitle(v, flags, t, done) END
- END
- ELSE
- INCL(flags, Windows.allowDuplicates)
- END;
- IF ~done THEN
- IF v IS Documents.Document THEN
- IF v.context # NIL THEN
- d := Documents.dir.New(
- Views.CopyOf(v(Documents.Document).ThisView(), Views.shallow),
- Views.undefined, Views.undefined)
- ELSE
- d := v(Documents.Document)
- END;
- ASSERT(d.context = NIL, 22);
- v := d.ThisView(); ASSERT(v # NIL, 23)
- ELSIF v.context # NIL THEN
- ASSERT(v.context IS Documents.Context, 24);
- d := v.context(Documents.Context).ThisDoc();
- IF d.context # NIL THEN
- d := Documents.dir.New(Views.CopyOf(v, Views.shallow), Views.undefined, Views.undefined)
- END;
- ASSERT(d.context = NIL, 25)
- (*IF d.Domain() = NIL THEN Stores.InitDomain(d, v.Domain()) END (for views opened via Views.Old *)
- ELSE
- d := Documents.dir.New(v, Views.undefined, Views.undefined)
- END;
- IF asTool OR asAux THEN
- c := d.ThisController();
- c.SetOpts(c.opts + {Containers.noSelection})
- END;
- ASSERT(d.Domain() = v.Domain(), 100);
- ASSERT(d.Domain() # NIL, 101);
- seq := d.Domain().GetSequencer();
- IF neverDirty & (seq # NIL) THEN
- ASSERT(seq IS Sequencers.Sequencer, 26);
- seq(Sequencers.Sequencer).SetDirty(FALSE)
- END;
- IF neverDirty THEN
- (* change "fit to page" to "fit to window" in secondary windows *)
- c := d.ThisController(); opts := c.opts;
- IF Documents.pageWidth IN opts THEN
- opts := opts - {Documents.pageWidth} + {Documents.winWidth}
- END;
- IF Documents.pageHeight IN opts THEN
- opts := opts - {Documents.pageHeight} + {Documents.winHeight}
- END;
- c.SetOpts(opts)
- END;
- win := Windows.dir.New();
- IF seq # NIL THEN
- Windows.dir.OpenSubWindow(win, d, flags, t)
- ELSE
- Windows.dir.Open(win, d, flags, t, loc, name, conv)
- END
- END
- END Open;
-
- PROCEDURE (h: ViewHook) Open (v: Views.View; title: ARRAY OF CHAR;
- loc: Files.Locator; name: Files.Name; conv: Converters.Converter;
- asTool, asAux, noResize, allowDuplicates, neverDirty: BOOLEAN);
- BEGIN
- Open(v, title, loc, name, conv, asTool, asAux, noResize, allowDuplicates, neverDirty)
- END Open;
-
- PROCEDURE (h: ViewHook) OldView (loc: Files.Locator; name: Files.Name;
- VAR conv: Converters.Converter): Views.View;
- VAR w: Windows.Window; s: Stores.Store; c: Converters.Converter;
- BEGIN
- ASSERT(loc # NIL, 20); ASSERT(name # "", 21);
- Kernel.MakeFileName(name, ""); s := NIL;
- IF loc.res # 77 THEN
- w := Windows.dir.First(); c := conv;
- IF c = NIL THEN c := Converters.list END; (* use document converter *)
- WHILE (w # NIL) & ((w.loc = NIL) OR (w.name = "") OR (w.loc.res = 77) OR
- ~Files.dir.SameFile(loc, name, w.loc, w.name) OR (w.conv # c)) DO
- w := Windows.dir.Next(w)
- END;
- IF w # NIL THEN s := w.doc.ThisView() END
- END;
- IF s = NIL THEN
- Converters.Import(loc, name, conv, s);
- IF s # NIL THEN RecalcView(s(Views.View)) END
- END;
- IF s # NIL THEN RETURN s(Views.View) ELSE RETURN NIL END
- END OldView;
-
- PROCEDURE (h: ViewHook) RegisterView (v: Views.View;
- loc: Files.Locator; name: Files.Name; conv: Converters.Converter);
- BEGIN
- ASSERT(v # NIL, 20); ASSERT(loc # NIL, 21); ASSERT(name # "", 22);
- Kernel.MakeFileName(name, "");
- Converters.Export(loc, name, conv, v)
- END RegisterView;
-
- PROCEDURE Init;
- VAR h: ViewHook;
- BEGIN
- NEW(h); Views.SetViewHook(h)
- END Init;
-
-BEGIN
- Init
-END StdDialog.
diff --git a/new/Std/Mod/ETHConv.txt b/new/Std/Mod/ETHConv.txt
--- a/new/Std/Mod/ETHConv.txt
+++ /dev/null
@@ -1,223 +0,0 @@
-MODULE StdETHConv;
-
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/ETHConv.odc *)
- (* DO NOT EDIT *)
-
- IMPORT
- Fonts, Files, Stores, Ports, Views,
- TextModels, TextRulers, TextViews,
- Stamps := StdStamps, Clocks := StdClocks, StdFolds;
-
- CONST
- V2Tag = -4095; (* 01 F0 *)
- V4Tag = 496; (* F0 01 *)
-
- TYPE
- FontDesc = RECORD
- typeface: Fonts.Typeface;
- size: INTEGER;
- style: SET;
- weight: INTEGER
- END;
-
- VAR default: Fonts.Font;
-
- PROCEDURE Split (name: ARRAY OF CHAR; VAR d: FontDesc);
- VAR i: INTEGER; ch: CHAR;
- BEGIN
- i := 0; ch := name[0];
- WHILE (ch < "0") OR (ch >"9") DO
- d.typeface[i] := ch; INC(i); ch := name[i]
- END;
- d.typeface[i] := 0X;
- d.size := 0;
- WHILE ("0" <= ch) & (ch <= "9") DO
- d.size := d.size * 10 + (ORD(ch) - 30H); INC(i); ch := name[i]
- END;
- CASE ch OF
- "b": d.style := {}; d.weight := Fonts.bold
- | "i": d.style := {Fonts.italic}; d.weight := Fonts.normal
- | "j": d.style := {Fonts.italic}; d.weight := Fonts.bold
- | "m": d.style := {}; d.weight := Fonts.bold
- ELSE d.style := {}; d.weight := Fonts.normal (* unknown style *)
- END
- END Split;
-
- PROCEDURE ThisFont (name: ARRAY OF CHAR): Fonts.Font;
- VAR d: FontDesc;
- BEGIN
- Split(name, d);
- IF d.typeface = "Syntax" THEN d.typeface := default.typeface END;
- IF d.size = 10 THEN d.size := default.size
- ELSE d.size := (d.size - 2) * Ports.point
- END;
- RETURN Fonts.dir.This(d.typeface, d.size, d.style, d.weight)
- END ThisFont;
-
- PROCEDURE ThisChar (ch: CHAR): CHAR;
- BEGIN
- CASE ORD(ch) OF
- 80H: ch := 0C4X | 81H: ch := 0D6X | 82H: ch := 0DCX
- | 83H: ch := 0E4X | 84H: ch := 0F6X | 85H: ch := 0FCX
- | 86H: ch := 0E2X | 87H: ch := 0EAX | 88H: ch := 0EEX | 89H: ch := 0F4X | 8AH: ch := 0FBX
- | 8BH: ch := 0E0X | 8CH: ch := 0E8X | 8DH: ch := 0ECX | 8EH: ch := 0F2X | 8FH: ch := 0F9X
- | 90H: ch := 0E9X
- | 91H: ch := 0EBX | 92H: ch := 0EFX
- | 93H: ch := 0E7X
- | 94H: ch := 0E1X
- | 95H: ch := 0F1X
- | 9BH: ch := TextModels.hyphen
- | 9FH: ch := TextModels.nbspace
- | 0ABH: ch := 0DFX
- ELSE
- ch := 0BFX (* use inverted question mark for unknown character codes *)
- END;
- RETURN ch
- END ThisChar;
-
- PROCEDURE ^ LoadTextBlock (r: Stores.Reader; t: TextModels.Model);
-
- PROCEDURE StdFold (VAR r: Stores.Reader): Views.View;
- CONST colLeft = 0; colRight = 1; expRight = 2; expLeft = 3;
- VAR k: BYTE; state: BOOLEAN; hidden: TextModels.Model; fold: StdFolds.Fold;
- BEGIN
- r.ReadByte(k);
- CASE k MOD 4 OF
- | colLeft: state := StdFolds.collapsed
- | colRight: state := StdFolds.collapsed
- | expRight: state := StdFolds.expanded
- | expLeft: state := StdFolds.expanded
- END;
- IF (k MOD 4 IN {colLeft, expLeft}) & (k < 4) THEN
- hidden := TextModels.dir.New(); LoadTextBlock(r, hidden);
- ELSE hidden := NIL;
- END;
- fold := StdFolds.dir.New(state, "", hidden);
- RETURN fold;
- END StdFold;
-
- PROCEDURE LoadTextBlock (r: Stores.Reader; t: TextModels.Model);
- VAR r0: Stores.Reader; wr: TextModels.Writer;
- org, len: INTEGER; en, ano, i, n: BYTE; col, voff, ch: CHAR; tag: INTEGER;
- fname: ARRAY 32 OF CHAR;
- attr: ARRAY 32 OF TextModels.Attributes;
- mod, proc: ARRAY 32 OF ARRAY 32 OF CHAR;
-
- PROCEDURE ReadNum (VAR n: INTEGER);
- VAR s: BYTE; ch: CHAR; y: INTEGER;
- BEGIN
- s := 0; y := 0; r.ReadXChar(ch);
- WHILE ch >= 80X DO
- INC(y, ASH(ORD(ch)-128, s)); INC(s, 7); r.ReadXChar(ch)
- END;
- n := ASH((ORD(ch) + 64) MOD 128 - 64, s) + y
- END ReadNum;
-
- PROCEDURE ReadSet (VAR s: SET);
- VAR x: INTEGER;
- BEGIN
- ReadNum(x); s := BITS(x)
- END ReadSet;
-
- PROCEDURE Elem (VAR r: Stores.Reader; span: INTEGER);
- VAR v: Views.View; end, ew, eh, n, indent: INTEGER; eno, version: BYTE;
- p: TextRulers.Prop; opts: SET;
- BEGIN
- r.ReadInt(ew); r.ReadInt(eh); r.ReadByte(eno);
- IF eno > en THEN en := eno; r.ReadXString(mod[eno]); r.ReadXString(proc[eno]) END;
- end := r.Pos() + span;
- IF (mod[eno] = "ParcElems") OR (mod[eno] = "StyleElems") THEN
- r.ReadByte(version);
- NEW(p);
- p.valid := {TextRulers.first .. TextRulers.tabs};
- ReadNum(indent); ReadNum(p.left);
- p.first := p.left + indent;
- ReadNum(n); p.right := p.left + n;
- ReadNum(p.lead);
- ReadNum(p.grid);
- ReadNum(p.dsc); p.asc := p.grid - p.dsc;
- ReadSet(opts); p.opts.val := {};
- IF ~(0 IN opts) THEN p.grid := 1 END;
- IF 1 IN opts THEN INCL(p.opts.val, TextRulers.leftAdjust) END;
- IF 2 IN opts THEN INCL(p.opts.val, TextRulers.rightAdjust) END;
- IF 3 IN opts THEN INCL(p.opts.val, TextRulers.pageBreak) END;
- INCL(p.opts.val, TextRulers.rightFixed);
- p.opts.mask := {TextRulers.leftAdjust .. TextRulers.pageBreak, TextRulers.rightFixed};
- ReadNum(n); p.tabs.len := n;
- i := 0; WHILE i < p.tabs.len DO ReadNum(p.tabs.tab[i].stop); INC(i) END;
- v := TextRulers.dir.NewFromProp(p);
- wr.WriteView(v, ew, eh)
- ELSIF mod[eno] = "StampElems" THEN
- v := Stamps.New();
- wr.WriteView(v, ew, eh)
- ELSIF mod[eno] = "ClockElems" THEN
- v := Clocks.New();
- wr.WriteView(v, ew, eh)
- ELSIF mod[eno] = "FoldElems" THEN
- v := StdFold(r);
- wr.WriteView(v, ew, eh);
- END;
- r.SetPos(end)
- END Elem;
-
- BEGIN
- (* skip inner text tags (legacy from V2) *)
- r.ReadXInt(tag);
- IF tag # V2Tag THEN r.SetPos(r.Pos()-2) END;
- (* load text block *)
- org := r.Pos(); r.ReadInt(len); INC(org, len - 2);
- r0.ConnectTo(r.rider.Base()); r0.SetPos(org);
- wr := t.NewWriter(NIL); wr.SetPos(0);
- n := 0; en := 0; r.ReadByte(ano);
- WHILE ano # 0 DO
- IF ano > n THEN
- n := ano; r.ReadXString(fname);
- attr[n] := TextModels.NewFont(wr.attr, ThisFont(fname))
- END;
- r.ReadXChar(col); r.ReadXChar(voff); r.ReadInt(len);
- wr.SetAttr(attr[ano]);
- IF len > 0 THEN
- WHILE len # 0 DO
- r0.ReadXChar(ch);
- IF ch >= 80X THEN ch := ThisChar(ch) END;
- IF (ch >= " ") OR (ch = TextModels.tab) OR (ch = TextModels.line) THEN
- wr.WriteChar(ch)
- END;
- DEC(len)
- END
- ELSE
- Elem(r, -len); r0.ReadXChar(ch)
- END;
- r.ReadByte(ano)
- END;
- r.ReadInt(len);
- r.SetPos(r.Pos() + len);
- END LoadTextBlock;
-
- PROCEDURE ImportOberon* (f: Files.File): TextModels.Model;
- VAR r: Stores.Reader; t: TextModels.Model; tag: INTEGER;
- BEGIN
- r.ConnectTo(f); r.SetPos(0);
- r.ReadXInt(tag);
- IF tag = ORD("o") + 256 * ORD("B") THEN
- (* ignore file header of Oberon for Windows and DOSOberon files *)
- r.SetPos(34); r.ReadXInt(tag)
- END;
- ASSERT((tag = V2Tag) OR (tag = V4Tag), 100);
- t := TextModels.dir.New();
- LoadTextBlock(r, t);
- RETURN t;
- END ImportOberon;
-
-
- PROCEDURE ImportETHDoc* (f: Files.File; OUT s: Stores.Store);
- VAR t: TextModels.Model;
- BEGIN
- ASSERT(f # NIL, 20);
- t := ImportOberon(f);
- IF t # NIL THEN s := TextViews.dir.New(t) END
- END ImportETHDoc;
-
-BEGIN
- default := Fonts.dir.Default()
-END StdETHConv.
diff --git a/new/Std/Mod/Folds.txt b/new/Std/Mod/Folds.txt
--- a/new/Std/Mod/Folds.txt
+++ /dev/null
@@ -1,779 +0,0 @@
-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.
diff --git a/new/Std/Mod/Headers.txt b/new/Std/Mod/Headers.txt
--- a/new/Std/Mod/Headers.txt
+++ /dev/null
@@ -1,436 +0,0 @@
-MODULE StdHeaders;
-
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Headers.odc *)
- (* DO NOT EDIT *)
-
-(* headers / footers support the following macros:
-
- &p - replaced by current page number as arabic numeral
- &r - replaced by current page number as roman numeral
- &R - replaced by current page number as capital roman numeral
- &a - replaced by current page number as alphanumeric character
- &A - replaced by current page number as capital alphanumeric character
- &d - replaced by printing date
- &t - replaced by printing time
- &&- replaced by & character
- &; - specifies split point
- &f - filename with path/title
-
-*)
-
- IMPORT
- Stores, Ports, Models, Views, Properties, Printing, TextModels, Fonts, Dialog,
- TextViews, Dates, Windows, Controllers, Containers;
-
- CONST
- minVersion = 0; maxVersion = 2;
- mm = Ports.mm; point = Ports.point;
- maxWidth = 10000 * mm;
- alternate* = 0; number* = 1; head* = 2; foot* = 3; showFoot* = 4;
-
- TYPE
- Banner* = RECORD
- left*, right*: ARRAY 128 OF CHAR;
- gap*: INTEGER
- END;
-
- NumberInfo* = RECORD
- new*: BOOLEAN;
- first*: INTEGER
- END;
-
- View = POINTER TO RECORD (Views.View)
- alternate: BOOLEAN; (* alternate left/right *)
- number: NumberInfo; (* new page number *)
- head, foot: Banner;
- font: Fonts.Font;
- showFoot: BOOLEAN;
- END;
-
- Prop* = POINTER TO RECORD (Properties.Property)
- alternate*, showFoot*: BOOLEAN;
- number*: NumberInfo;
- head*, foot*: Banner
- END;
-
- ChangeFontOp = POINTER TO RECORD (Stores.Operation)
- header: View;
- font: Fonts.Font
- END;
-
- ChangeAttrOp = POINTER TO RECORD (Stores.Operation)
- header: View;
- alternate, showFoot: BOOLEAN;
- number: NumberInfo;
- head, foot: Banner
- END;
-
- VAR
- dialog*: RECORD
- view: View;
- alternate*, showFoot*: BOOLEAN;
- number*: NumberInfo;
- head*, foot*: Banner;
- END;
-
- PROCEDURE (p: Prop) IntersectWith* (q: Properties.Property; OUT equal: BOOLEAN);
- VAR valid: SET;
- PROCEDURE Equal(IN b1, b2: Banner): BOOLEAN;
- BEGIN
- RETURN (b1.left = b2.left) & (b1.right = b2.right) & (b1.gap = b2.gap)
- END Equal;
- BEGIN
- WITH q: Prop DO
- valid := p.valid * q.valid; equal := TRUE;
- IF p.alternate # q.alternate THEN EXCL(valid, alternate) END;
- IF p.showFoot # q.showFoot THEN EXCL(valid, showFoot) END;
- IF (p.number.new # q.number.new) OR (p.number.first # q.number.first) THEN EXCL(valid, number) END;
- IF ~Equal(p.head, q.head) THEN EXCL(valid, head) END;
- IF ~Equal(p.foot, q.foot) THEN EXCL(valid, foot) END;
- IF p.valid # valid THEN p.valid := valid; equal := FALSE END
- END
- END IntersectWith;
-
- (* SetAttrOp *)
-
- PROCEDURE (op: ChangeFontOp) Do;
- VAR v: View; font: Fonts.Font; asc, dsc, w: INTEGER; c: Models.Context;
- BEGIN
- v := op.header;
- font := op.font; op.font := v.font; v.font := font;
- font.GetBounds(asc, dsc, w);
- c := v.context;
- c.SetSize(maxWidth, asc + dsc + 2*point);
- Views.Update(v, Views.keepFrames)
- END Do;
-
- PROCEDURE DoChangeFontOp (v: View; font: Fonts.Font);
- VAR op: ChangeFontOp;
- BEGIN
- IF v.font # font THEN
- NEW(op); op.header := v; op.font := font;
- Views.Do(v, "#System:SetProp", op)
- END
- END DoChangeFontOp;
-
- PROCEDURE (op: ChangeAttrOp) Do;
- VAR v: View; alternate, showFoot: BOOLEAN; number: NumberInfo; head, foot: Banner;
- BEGIN
- v := op.header;
- alternate := op.alternate; showFoot := op.showFoot; number := op.number; head := op.head; foot := op.foot;
- op.alternate := v.alternate; op.showFoot := v.showFoot; op.number := v.number; op.head := v.head;
- op.foot := v.foot;
- v.alternate := alternate; v.showFoot := showFoot; v.number := number; v.head := head; v.foot := foot;
- Views.Update(v, Views.keepFrames)
- END Do;
-
- PROCEDURE DoChangeAttrOp (v: View; alternate, showFoot: BOOLEAN; number: NumberInfo;
- head, foot: Banner);
- VAR op: ChangeAttrOp;
- BEGIN
- NEW(op); op.header := v; op.alternate := alternate; op.showFoot := showFoot;
- op.number := number; op.head := head; op.foot := foot;
- Views.Do(v, "#Std:HeaderChange", op)
- END DoChangeAttrOp;
-
- PROCEDURE (v: View) CopyFromSimpleView (source: Views.View);
- BEGIN
- WITH source: View DO
- v.alternate := source.alternate;
- v.number.new := source.number.new; v.number.first := source.number.first;
- v.head := source.head;
- v.foot := source.foot;
- v.font := source.font;
- v.showFoot := source.showFoot
- END
- END CopyFromSimpleView;
-
- PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
- BEGIN
- v.Externalize^(wr);
- wr.WriteVersion(maxVersion);
- wr.WriteString(v.head.left);
- wr.WriteString(v.head.right);
- wr.WriteInt(v.head.gap);
- wr.WriteString(v.foot.left);
- wr.WriteString(v.foot.right);
- wr.WriteInt(v.foot.gap);
- wr.WriteString(v.font.typeface);
- wr.WriteInt(v.font.size);
- wr.WriteSet(v.font.style);
- wr.WriteInt(v.font.weight);
- wr.WriteBool(v.alternate);
- wr.WriteBool(v.number.new);
- wr.WriteInt(v.number.first);
- wr.WriteBool(v.showFoot);
- END Externalize;
-
- PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
- VAR version: INTEGER; typeface: Fonts.Typeface; size: INTEGER; style: SET; weight: INTEGER;
-
- BEGIN
- v.Internalize^(rd);
- IF ~rd.cancelled THEN
- rd.ReadVersion(minVersion, maxVersion, version);
- IF ~rd.cancelled THEN
- IF version = 0 THEN
- rd.ReadXString(v.head.left);
- rd.ReadXString(v.head.right);
- v.head.gap := 5*mm;
- rd.ReadXString(v.foot.left);
- rd.ReadXString(v.foot.right);
- v.foot.gap := 5*mm;
- rd.ReadXString(typeface);
- rd.ReadXInt(size);
- v.font := Fonts.dir.This(typeface, size * point, {}, Fonts.normal);
- rd.ReadXInt(v.number.first);
- rd.ReadBool(v.number.new);
- rd.ReadBool(v.alternate)
- ELSE
- rd.ReadString(v.head.left);
- rd.ReadString(v.head.right);
- rd.ReadInt(v.head.gap);
- rd.ReadString(v.foot.left);
- rd.ReadString(v.foot.right);
- rd.ReadInt(v.foot.gap);
- rd.ReadString(typeface);
- rd.ReadInt(size);
- rd.ReadSet(style);
- rd.ReadInt(weight);
- v.font := Fonts.dir.This(typeface, size, style, weight);
- rd.ReadBool(v.alternate);
- rd.ReadBool(v.number.new);
- rd.ReadInt(v.number.first);
- IF version = 2 THEN rd.ReadBool(v.showFoot) ELSE v.showFoot := FALSE END
- END
- END
- END
- END Internalize;
-
- PROCEDURE SetProp(v: View; msg: Properties.SetMsg);
- VAR p: Properties.Property;
- typeface: Fonts.Typeface; size: INTEGER; style: SET; weight: INTEGER;
- alt, sf: BOOLEAN; num: NumberInfo; h, f: Banner;
- BEGIN
- p := msg.prop;
- WHILE p # NIL DO
- WITH p: Properties.StdProp DO
- IF Properties.typeface IN p.valid THEN typeface := p.typeface
- ELSE typeface := v.font.typeface
- END;
- IF Properties.size IN p.valid THEN size := p.size
- ELSE size := v.font.size
- END;
- IF Properties.style IN p.valid THEN style := p.style.val
- ELSE style := v.font.style
- END;
- IF Properties.weight IN p.valid THEN weight := p.weight
- ELSE weight := v.font.weight
- END;
- DoChangeFontOp (v, Fonts.dir.This(typeface, size, style, weight) );
- | p: Prop DO
- IF alternate IN p.valid THEN alt := p.alternate ELSE alt := v.alternate END;
- IF showFoot IN p.valid THEN sf := p.showFoot ELSE sf := v.showFoot END;
- IF number IN p.valid THEN num := p.number ELSE num := v.number END;
- IF head IN p.valid THEN h := p.head ELSE h := v.head END;
- IF foot IN p.valid THEN f := p.foot ELSE f := v.foot END;
- DoChangeAttrOp(v, alt, sf, num, h, f)
- ELSE
- END;
- p := p.next
- END
- END SetProp;
-
- PROCEDURE PollProp(v: View; VAR msg: Properties.PollMsg);
- VAR sp: Properties.StdProp; p: Prop;
- BEGIN
- NEW(sp);
- sp.known := {Properties.size, Properties.typeface, Properties.style, Properties.weight};
- sp.valid := sp.known;
- sp.size := v.font.size; sp.typeface := v.font.typeface;
- sp.style.val := v.font.style; sp.style.mask := {Fonts.italic, Fonts.underline, Fonts.strikeout};
- sp.weight := v.font.weight;
- Properties.Insert(msg.prop, sp);
- NEW(p);
- p.known := {alternate, number, head, foot, showFoot}; p.valid := p.known;
- p.head := v.head; p.foot := v.foot;
- p.alternate := v.alternate;
- p.showFoot := v.showFoot;
- p.number := v.number;
- Properties.Insert(msg.prop, p)
- END PollProp;
-
- PROCEDURE PageMsg(v: View; msg: TextViews.PageMsg);
- BEGIN
- IF Printing.par # NIL THEN
- Dialog.MapString(v.head.left, Printing.par.header.left);
- Dialog.MapString(v.head.right, Printing.par.header.right);
- Dialog.MapString(v.foot.left, Printing.par.footer.left);
- Dialog.MapString(v.foot.right, Printing.par.footer.right);
- Printing.par.header.font := v.font;
- Printing.par.footer.font := v.font;
- Printing.par.page.alternate := v.alternate;
- IF v.number.new THEN
- Printing.par.page.first := v.number.first - msg.current
- END;
- Printing.par.header.gap := 5*Ports.mm;
- Printing.par.footer.gap := 5*Ports.mm
- END
- END PageMsg;
-
- PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- VAR d, w, h: INTEGER; (*line: Line; *)asc, dsc, x0, x1, y: INTEGER;
- win: Windows.Window; title: Views.Title; dec: BOOLEAN;
- pw, ph: INTEGER;
- date: Dates.Date; time: Dates.Time; pageInfo: Printing.PageInfo; banner: Printing.Banner;
- BEGIN
- IF Views.IsPrinterFrame(f) THEN (* am drucken *) END;
-
- v.font.GetBounds(asc, dsc, w);
-
- win := Windows.dir.First();
- WHILE (win # NIL) & (win.doc.Domain() # v.Domain()) DO win := Windows.dir.Next(win) END;
- IF win = NIL THEN title := "(" + Dialog.appName + ")"
- ELSE win.GetTitle(title)
- END;
- d := f.dot;
- v.context.GetSize(w, h);
- win.doc.PollPage(pw, ph, l, t, r, b, dec);
- w := r - l;
-
- f.DrawRect(0, 0, w, h, Ports.fill, Ports.grey25);
- f.DrawRect(0, 0, w, h, 0, Ports.black);
-
- x0 := d; x1 := w-2*d; y := asc + d;
-
- Dates.GetDate(date);
- Dates.GetTime(time);
- pageInfo.alternate := FALSE;
- pageInfo.title := title;
- banner.font := v.font;
- IF v.showFoot THEN
- banner.gap := v.foot.gap;
- Dialog.MapString(v.foot.left, banner.left); Dialog.MapString(v.foot.right, banner.right)
- ELSE
- banner.gap := v.head.gap;
- Dialog.MapString(v.head.left, banner.left); Dialog.MapString(v.head.right, banner.right)
- END;
- Printing.PrintBanner(f, pageInfo, banner, date, time, x0, x1, y)
- END Restore;
-
- PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);
- VAR asc, dsc, w: INTEGER;
- BEGIN
- WITH msg: Properties.SizePref DO
- msg.w := maxWidth;
- IF msg.h = Views.undefined THEN
- v.font.GetBounds(asc, dsc, w);
- msg.h := asc + dsc + 2*point
- END
- | msg: Properties.ResizePref DO
- msg.fixed := TRUE
- | msg: TextModels.Pref DO
- msg.opts := {TextModels.hideable}
- | msg: Properties.PollMsg DO
- PollProp(v, msg)
- | msg: Properties.SetMsg DO
- SetProp(v, msg)
- | msg: TextViews.PageMsg DO
- PageMsg(v, msg)
- ELSE
- END
- END HandlePropMsg;
-
- PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
- VAR focus: Views.View);
- BEGIN
- WITH msg: Properties.EmitMsg DO Views.HandlePropMsg(v, msg.set)
- | msg: Properties.CollectMsg DO Views.HandlePropMsg(v, msg.poll)
- ELSE
- END
- END HandleCtrlMsg;
-
- PROCEDURE New*(p: Prop; f: Fonts.Font): Views.View;
- VAR v: View;
- BEGIN
- NEW(v);
- v.head := p.head;
- v.foot := p.foot;
- v.number := p.number;
- v.alternate := p.alternate;
- v.font := f;
- v.showFoot := FALSE;
- RETURN v;
- END New;
-
- PROCEDURE Deposit*;
- VAR v: View;
- BEGIN
- NEW(v);
- v.head.left := ""; v.head.right := "&d&;&p"; v.head.gap := 5*mm;
- v.foot.left := ""; v.foot.right := ""; v.foot.gap := 5*mm;
- v.font := Fonts.dir.Default();
- v.number.first := 1; v.number.new := FALSE; v.alternate := FALSE; v.showFoot := FALSE;
- Views.Deposit(v)
- END Deposit;
-
- (* property dialog *)
-
- PROCEDURE InitDialog*;
- VAR p: Properties.Property;
- BEGIN
- Properties.CollectProp(p);
- WHILE p # NIL DO
- WITH p: Properties.StdProp DO
- | p: Prop DO
- dialog.alternate := p.alternate; dialog.showFoot := p.showFoot;
- dialog.number := p.number;
- dialog.head := p.head; dialog.head.gap := dialog.head.gap DIV point;
- dialog.foot := p.foot; dialog.foot.gap := dialog.foot.gap DIV point;
- Dialog.Update(dialog)
- ELSE
- END;
- p := p.next
- END
- END InitDialog;
-
- PROCEDURE Set*;
- VAR p: Prop;
- BEGIN
- NEW(p); p.valid := {alternate, number, head, foot, showFoot};
- p.alternate := dialog.alternate; p.showFoot := dialog.showFoot;
- p.number := dialog.number;
- p.head := dialog.head; p.head.gap := p.head.gap * point;
- p.foot := dialog.foot; p.foot.gap := p.foot.gap * point;
- Properties.EmitProp(NIL, p)
- END Set;
-
- PROCEDURE HeaderGuard* (VAR par: Dialog.Par);
- VAR v: Views.View;
- BEGIN
- v := Containers.FocusSingleton();
- IF (v # NIL) & (v IS View) THEN
- par.disabled := FALSE;
- IF (dialog.view = NIL) OR (dialog.view # v) THEN
- dialog.view := v(View);
- InitDialog
- END
- ELSE
- par.disabled := TRUE;
- dialog.view := NIL
- END
- END HeaderGuard;
-
- PROCEDURE AlternateGuard* (VAR par: Dialog.Par);
- BEGIN
- HeaderGuard(par);
- IF ~par.disabled THEN par.disabled := ~ dialog.alternate END
- END AlternateGuard;
-
- PROCEDURE NewNumberGuard* (VAR par: Dialog.Par);
- BEGIN
- HeaderGuard(par);
- IF ~par.disabled THEN par.disabled := ~ dialog.number.new END
- END NewNumberGuard;
-
-END StdHeaders.
diff --git a/new/Std/Mod/Interpreter.txt b/new/Std/Mod/Interpreter.txt
+++ /dev/null
@@ -1,234 +0,0 @@
-MODULE StdInterpreter;
-
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Interpreter.odc *)
- (* DO NOT EDIT *)
-
- IMPORT Kernel, Meta, Strings, Views, Dialog;
-
- TYPE
- IntValue = POINTER TO RECORD (Meta.Value)
- int: INTEGER;
- END;
- StrValue = POINTER TO RECORD (Meta.Value)
- str: Dialog.String;
- END;
- CallHook = POINTER TO RECORD (Dialog.CallHook) END;
-
-
- PROCEDURE (hook: CallHook) Call (IN proc, errorMsg: ARRAY OF CHAR; VAR res: INTEGER);
- TYPE Ident = ARRAY 32 OF CHAR;
- CONST
- modNotFound = 10; procNotFound = 11; identExpected = 12; unknownIdent = 13;
- depositExpected = 14; noDepositExpected = 15; syntaxError = 16;
- lparenExpected = 17; rparenExpected = 18; containerExpected = 19; quoteExpected = 20;
- fileNotFound = 21; noController = 22; noDialog = 23; cannotUnload = 24; commaExpected = 25;
- incompParList = 26;
- CONST
- ident = 0; dot = 1; semicolon = 2; eot = 3; lparen = 4; rparen = 5; quote = 6; comma = 7; int = 8;
- VAR
- i, type: INTEGER; ch: CHAR; id: Ident; x: INTEGER;
- par: ARRAY 100 OF POINTER TO Meta.Value; numPar: INTEGER;
-
- PROCEDURE Concat (a, b: ARRAY OF CHAR; VAR c: ARRAY OF CHAR);
- VAR i, j: INTEGER; ch: CHAR;
- BEGIN
- IF a = " " THEN Dialog.MapString("#System:CommandError", c) ELSE c := a$ END;
- i := 0; WHILE c[i] # 0X DO INC(i) END;
- c[i] := " "; INC(i);
- j := 0; ch := b[0]; WHILE ch # 0X DO c[i] := ch; INC(i); INC(j); ch := b[j] END;
- c[i] := 0X
- END Concat;
-
- PROCEDURE Error (n: INTEGER; msg, par0, par1: ARRAY OF CHAR);
- VAR e, f: ARRAY 256 OF CHAR;
- BEGIN
- IF res = 0 THEN
- res := n;
- IF errorMsg # "" THEN
- Dialog.MapString(errorMsg, e);
- Dialog.MapParamString(msg, par0, par1, "", f);
- Concat(e, f, f);
- Dialog.ShowMsg(f)
- END
- END
- END Error;
-
- PROCEDURE Init (VAR s: ARRAY OF CHAR);
- VAR i: INTEGER;
- BEGIN
- i := 0; WHILE i < LEN(s) DO s[i] := 0X; INC(i) END
- END Init;
-
- PROCEDURE ShowLoaderResult (IN mod: ARRAY OF CHAR);
- VAR res: INTEGER; importing, imported, object: ARRAY 256 OF CHAR;
- BEGIN
- Kernel.GetLoaderResult(res, importing, imported, object);
- CASE res OF
- | Kernel.fileNotFound:
- Error(Kernel.fileNotFound, "#System:CodeFileNotFound", imported, "")
- | Kernel.syntaxError:
- Error(Kernel.syntaxError, "#System:CorruptedCodeFileFor", imported, "")
- | Kernel.objNotFound:
- Error(Kernel.objNotFound, "#System:ObjNotFoundImpFrom", imported, importing)
- | Kernel.illegalFPrint:
- Error(Kernel.illegalFPrint, "#System:ObjInconsImpFrom", imported, importing)
- | Kernel.cyclicImport:
- Error(Kernel.cyclicImport, "#System:CyclicImpFrom", imported, importing)
- | Kernel.noMem:
- Error(Kernel.noMem, "#System:NotEnoughMemoryFor", imported, "")
- ELSE
- Error(res, "#System:CannotLoadModule", mod, "")
- END
- END ShowLoaderResult;
-
- PROCEDURE CallProc (IN mod, proc: ARRAY OF CHAR);
- VAR i, t: Meta.Item; ok: BOOLEAN;
- BEGIN
- ok := FALSE;
- Meta.Lookup(mod, i);
- IF i.obj = Meta.modObj THEN
- i.Lookup(proc, i);
- IF i.obj = Meta.procObj THEN
- i.GetReturnType(t);
- IF (t.typ = 0) & (i.NumParam() = numPar) THEN
- i.ParamCallVal(par, t, ok)
- ELSE ok := FALSE
- END;
- IF ~ok THEN
- Error(incompParList, "#System:IncompatibleParList", mod, proc)
- END
- ELSE
- Error(Kernel.commNotFound, "#System:CommandNotFoundIn", proc, mod)
- END
- ELSE
- ShowLoaderResult(mod)
- END
- END CallProc;
-
- PROCEDURE GetCh;
- BEGIN
- IF i < LEN(proc) THEN ch := proc[i]; INC(i) ELSE ch := 0X END
- END GetCh;
-
- PROCEDURE Scan;
- VAR j: INTEGER; num: ARRAY 32 OF CHAR; r: INTEGER;
- BEGIN
- IF res = 0 THEN
- WHILE (ch # 0X) & (ch <= " ") DO GetCh END;
- IF ch = 0X THEN
- type := eot
- ELSIF ch = "." THEN
- type := dot; GetCh
- ELSIF ch = ";" THEN
- type := semicolon; GetCh
- ELSIF ch = "(" THEN
- type := lparen; GetCh
- ELSIF ch = ")" THEN
- type := rparen; GetCh
- ELSIF ch = "'" THEN
- type := quote; GetCh
- ELSIF ch = "," THEN
- type := comma; GetCh
- ELSIF (ch >= "0") & (ch <= "9") OR (ch = "-") THEN
- type := int; j := 0;
- REPEAT num[j] := ch; INC(j); GetCh UNTIL (ch < "0") OR (ch > "9") & (ch < "A") OR (ch > "H");
- num[j] := 0X; Strings.StringToInt(num, x, r)
- ELSIF (ch >= "a") & (ch <= "z") OR (ch >= "A") & (ch <= "Z") OR
- (ch >= 0C0X) & (ch # "×") & (ch # "÷") & (ch <= 0FFX) OR (ch = "_") THEN
- type := ident;
- id[0] := ch; j := 1; GetCh;
- WHILE (ch # 0X) & (i < LEN(proc)) &
- ((ch >= "a") & (ch <= "z") OR (ch >= "A") & (ch <= "Z") OR
- (ch >= 0C0X) & (ch # "×") & (ch # "÷") & (ch <= 0FFX) OR
- (ch = "_") OR (ch >= "0") & (ch <= "9")) DO
- id[j] := ch; INC(j); GetCh
- END;
- id[j] := 0X
- ELSE Error(syntaxError, "#System:SyntaxError", "", "")
- END
- END
- END Scan;
-
- PROCEDURE String (VAR s: ARRAY OF CHAR);
- VAR j: INTEGER;
- BEGIN
- IF type = quote THEN
- j := 0;
- WHILE (ch # 0X) & (ch # "'") & (j < LEN(s) - 1) DO s[j] := ch; INC(j); GetCh END; s[j] := 0X;
- IF ch = "'" THEN
- GetCh; Scan
- ELSE Error(quoteExpected, "#System:QuoteExpected", "", "")
- END
- ELSE Error(quoteExpected, "#System:QuoteExpected", "", "")
- END
- END String;
-
- PROCEDURE ParamList ();
- VAR iv: IntValue; sv: StrValue;
- BEGIN
- numPar := 0;
- IF type = lparen THEN Scan;
- WHILE (numPar < LEN(par)) & (type # rparen) & (res = 0) DO
- IF type = quote THEN
- NEW(sv);
- String(sv.str);
- par[numPar] := sv;
- INC(numPar)
- ELSIF type = int THEN
- NEW(iv);
- iv.int := x; Scan;
- par[numPar] := iv;
- INC(numPar)
- ELSE Error(syntaxError, "#System:SyntaxError", "", "")
- END;
- IF type = comma THEN Scan
- ELSIF type # rparen THEN Error(rparenExpected, "#System:RParenExpected", "", "")
- END
- END;
- Scan
- END
- END ParamList;
-
- PROCEDURE Command;
- VAR left, right: Ident;
- BEGIN
- (* protect from parasitic anchors on stack *)
- Init(left); Init(right);
- left := id; Scan;
- IF type = dot THEN (* Oberon command *)
- Scan;
- IF type = ident THEN
- right := id; Scan; ParamList();
- CallProc(left, right)
- ELSE Error(identExpected, "#System:IdentExpected", "", "")
- END
- ELSE Error(unknownIdent, "#System:UnknownIdent", id, "")
- END
- END Command;
-
- BEGIN
- (* protect from parasitic anchors on stack *)
- i := 0; type := 0; Init(id); x := 0;
- Views.ClearQueue;
- res := 0; i := 0; GetCh;
- Scan;
- IF type = ident THEN
- Command; WHILE (type = semicolon) & (res = 0) DO Scan; Command END;
- IF type # eot THEN Error(syntaxError, "#System:SyntaxError", "", "") END
- ELSE Error(syntaxError, "#System:SyntaxError", "", "")
- END;
- IF (res = 0) & (Views.Available() > 0) THEN
- Error(noDepositExpected, "#System:NoDepositExpected", "", "")
- END;
- Views.ClearQueue
- END Call;
-
- PROCEDURE Init;
- VAR hook: CallHook;
- BEGIN
- NEW(hook); Dialog.SetCallHook(hook)
- END Init;
-
-BEGIN
- Init
-END StdInterpreter.
diff --git a/new/Std/Mod/Links.txt b/new/Std/Mod/Links.txt
--- a/new/Std/Mod/Links.txt
+++ /dev/null
@@ -1,893 +0,0 @@
-MODULE StdLinks;
-
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Links.odc *)
-
- 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*;
- VAR p: 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);
- VAR left, 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.
diff --git a/new/Std/Mod/Loader.txt b/new/Std/Mod/Loader.txt
--- a/new/Std/Mod/Loader.txt
+++ /dev/null
@@ -1,336 +0,0 @@
-MODULE StdLoader;
-
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Loader.odc *)
- (* DO NOT EDIT *)
-
- IMPORT S := SYSTEM, Kernel, Files;
-
- CONST
- done = Kernel.done;
- fileNotFound = Kernel.fileNotFound;
- syntaxError = Kernel.syntaxError;
- objNotFound = Kernel.objNotFound;
- illegalFPrint = Kernel.illegalFPrint;
- cyclicImport = Kernel.cyclicImport;
- noMem = Kernel.noMem;
- commNotFound = Kernel.commNotFound;
- commSyntaxError = Kernel.commSyntaxError;
- descNotFound = -1;
-
- OFdir = "Code";
- SYSdir = "System";
- initMod = "Init";
- OFtag = 6F4F4346H;
-
- (* meta interface consts *)
- mConst = 1; mTyp = 2; mVar = 3; mProc = 4; mField = 5;
- mBool = 1; mChar = 2; mLChar = 3; mSInt = 4; mInt = 5; mLInt = 6;
- mReal = 7; mLReal = 8; mSet = 9; mString = 10; mLString = 11;
- mRecord = 1; mArray = 2; mPointer = 3; mProctyp = 4;
- mInternal = 1; mReadonly = 2; mPrivate = 3; mExported = 4;
-
- (* fixup types *)
- absolute = 100; relative = 101; copy = 102; table = 103; tableend = 104; deref = 105; halfword = 106;
-
- TYPE
- Name = ARRAY 256 OF CHAR;
- ModSpec = POINTER TO RECORD
- next, link, imp: ModSpec;
- name: Name;
- file: Files.File;
- mod: Kernel.Module;
- hs, ms, ds, cs, vs, mad, dad: INTEGER
- END;
-
- Hook = POINTER TO RECORD (Kernel.LoaderHook) END;
-
- VAR
- res-: INTEGER;
- importing-, imported-, object-: Name;
- inp: Files.Reader;
- m: Kernel.Module;
-
- PROCEDURE Error (r: INTEGER; impd, impg: ModSpec);
- BEGIN
- res := r; imported := impd.name$;
- IF impg # NIL THEN importing := impg.name$ END;
- END Error;
-
- PROCEDURE Append (VAR s: ARRAY OF CHAR; t: ARRAY OF CHAR);
- VAR len, i, j: INTEGER; ch: CHAR;
- BEGIN
- len := LEN(s);
- i := 0; WHILE s[i] # 0X DO INC(i) END;
- j := 0; REPEAT ch := t[j]; s[i] := ch; INC(j); INC(i) UNTIL (ch = 0X) OR (i = len);
- s[len - 1] := 0X
- END Append;
-
- PROCEDURE ThisObjFile (VAR name: ARRAY OF CHAR): Files.File;
- VAR f: Files.File; loc: Files.Locator; dir, fname: Files.Name;
- BEGIN
- Kernel.SplitName(name, dir, fname);
- Kernel.MakeFileName(fname, Kernel.objType);
- loc := Files.dir.This(dir); loc := loc.This(OFdir);
- f := Files.dir.Old(loc, fname, TRUE);
- IF (f = NIL) & (dir = "") THEN
- loc := Files.dir.This(SYSdir); loc := loc.This(OFdir);
- f := Files.dir.Old(loc, fname, TRUE)
- END;
- RETURN f
- END ThisObjFile;
-
- PROCEDURE RWord (VAR x: INTEGER);
- VAR b: BYTE; y: INTEGER;
- BEGIN
- inp.ReadByte(b); y := b MOD 256;
- inp.ReadByte(b); y := y + 100H * (b MOD 256);
- inp.ReadByte(b); y := y + 10000H * (b MOD 256);
- inp.ReadByte(b); x := y + 1000000H * b
- END RWord;
-
- PROCEDURE RNum (VAR x: INTEGER);
- VAR b: BYTE; s, y: INTEGER;
- BEGIN
- s := 0; y := 0; inp.ReadByte(b);
- WHILE b < 0 DO INC(y, ASH(b + 128, s)); INC(s, 7); inp.ReadByte(b) END;
- x := ASH((b + 64) MOD 128 - 64, s) + y
- END RNum;
-
- PROCEDURE RName (VAR name: ARRAY OF CHAR);
- VAR b: BYTE; i, n: INTEGER;
- BEGIN
- i := 0; n := LEN(name) - 1; inp.ReadByte(b);
- WHILE (i < n) & (b # 0) DO name[i] := CHR(b MOD 256); INC(i); inp.ReadByte(b) END;
- WHILE b # 0 DO inp.ReadByte(b) END;
- name[i] := 0X
- END RName;
-
- PROCEDURE Fixup (adr: INTEGER; mod: ModSpec);
- VAR link, offset, linkadr, t, n, x, low, hi: INTEGER;
- BEGIN
- RNum(link);
- WHILE link # 0 DO
- RNum(offset);
- WHILE link # 0 DO
- IF link > 0 THEN linkadr := mod.mad + mod.ms + link
- ELSE link := -link;
- IF link < mod.ms THEN linkadr := mod.mad + link
- ELSE linkadr := mod.dad + link - mod.ms
- END
- END;
- S.GET(linkadr, x); t := x DIV 1000000H;
- n := (x + 800000H) MOD 1000000H - 800000H;
- IF t = absolute THEN x := adr + offset
- ELSIF t = relative THEN x := adr + offset - linkadr - 4
- ELSIF t = copy THEN S.GET(adr + offset, x)
- ELSIF t = table THEN x := adr + n; n := link + 4
- ELSIF t = tableend THEN x := adr + n; n := 0
- ELSIF t = deref THEN S.GET(adr+2, x); INC(x, offset);
- ELSIF t = halfword THEN
- x := adr + offset;
- low := (x + 8000H) MOD 10000H - 8000H;
- hi := (x - low) DIV 10000H;
- S.GET(linkadr + 4, x);
- S.PUT(linkadr + 4, x DIV 10000H * 10000H + low MOD 10000H);
- x := x * 10000H + hi MOD 10000H
- ELSE Error(syntaxError, mod, NIL)
- END;
- S.PUT(linkadr, x); link := n
- END;
- RNum(link)
- END
- END Fixup;
-
- PROCEDURE ReadHeader (mod: ModSpec);
- VAR n, p: INTEGER; name: Name; imp, last: ModSpec;
- BEGIN
- mod.file := ThisObjFile(mod.name);
- IF (mod.file = NIL) & (mod.link # NIL) THEN (* try closing importing obj file *)
- mod.link.file.Close; mod.link.file := NIL;
- mod.file := ThisObjFile(mod.name)
- END;
- IF mod.file # NIL THEN
- inp := mod.file.NewReader(inp);
- IF inp # NIL THEN
- inp.SetPos(0); RWord(n); RWord(p);
- IF (n = OFtag) & (p = Kernel.processor) THEN
- RWord(mod.hs); RWord(mod.ms); RWord(mod.ds); RWord(mod.cs); RWord(mod.vs);
- RNum(n); RName(name);
- IF name = mod.name THEN
- mod.imp := NIL; last := NIL;
- WHILE n > 0 DO
- NEW(imp); RName(imp.name);
- IF last = NIL THEN mod.imp := imp ELSE last.next := imp END;
- last := imp; imp.next := NIL; DEC(n)
- END
- ELSE Error(fileNotFound, mod, NIL)
- END
- ELSE Error(syntaxError, mod, NIL)
- END
- ELSE Error(noMem, mod, NIL)
- END
- ELSE Error(fileNotFound, mod, NIL)
- END
- END ReadHeader;
-
- PROCEDURE ReadModule (mod: ModSpec);
- TYPE BlockPtr = POINTER TO ARRAY [1] 1000000H OF BYTE;
- VAR imptab, x, fp, ofp, opt, a: INTEGER;
- name: Name; dp, mp: BlockPtr; imp: ModSpec; obj: Kernel.Object; in, n: Kernel.Name;
- BEGIN
- IF mod.file = NIL THEN mod.file := ThisObjFile(mod.name) END;
- inp := mod.file.NewReader(inp);
- IF inp # NIL THEN
- inp.SetPos(mod.hs);
- Kernel.AllocModMem(mod.ds, mod.ms + mod.cs + mod.vs, mod.dad, mod.mad);
- IF (mod.dad # 0) & (mod.mad # 0) THEN
- dp := S.VAL(BlockPtr, mod.dad); mp := S.VAL(BlockPtr, mod.mad);
- inp.ReadBytes(mp^, 0, mod.ms);
- inp.ReadBytes(dp^, 0, mod.ds);
- inp.ReadBytes(mp^, mod.ms, mod.cs);
- mod.mod := S.VAL(Kernel.Module, mod.dad);
- Fixup(S.ADR(Kernel.NewRec), mod);
- Fixup(S.ADR(Kernel.NewArr), mod);
- Fixup(mod.mad, mod);
- Fixup(mod.dad, mod);
- Fixup(mod.mad + mod.ms, mod);
- Fixup(mod.mad + mod.ms + mod.cs, mod);
- imp := mod.imp; imptab := S.VAL(INTEGER, mod.mod.imports);
- WHILE (res = done) & (imp # NIL) DO
- RNum(x);
- WHILE (res <= done) & (x # 0) DO
- RName(name); RNum(fp); opt := 0;
- IF imp.mod # NIL THEN
- IF name = "" THEN obj := Kernel.ThisDesc(imp.mod, fp)
- ELSE n := SHORT(name$); obj := Kernel.ThisObject(imp.mod, n)
- END;
- IF (obj # NIL) & (obj.id MOD 16 = x) THEN
- ofp := obj.fprint;
- IF x = mTyp THEN
- RNum(opt);
- IF ODD(opt) THEN ofp := obj.offs END;
- IF (opt > 1) & (obj.id DIV 16 MOD 16 # mExported) THEN
- Error(objNotFound, imp, mod); object := name$
- END;
- Fixup(S.VAL(INTEGER, obj.struct), mod)
- ELSIF x = mVar THEN
- Fixup(imp.mod.varBase + obj.offs, mod)
- ELSIF x = mProc THEN
- Fixup(imp.mod.procBase + obj.offs, mod)
- END;
- IF ofp # fp THEN Error(illegalFPrint, imp, mod); object := name$ END
- ELSIF name # "" THEN
- Error(objNotFound, imp, mod); object := name$
- ELSE
- Error(descNotFound, imp, mod); (* proceed to find failing named object *)
- RNum(opt); Fixup(0, mod)
- END
- ELSE (* imp is dll *)
- IF x IN {mVar, mProc} THEN
- in := SHORT(imp.name$); n := SHORT(name$);
- a := Kernel.ThisDllObj(x, fp, in, n);
- IF a # 0 THEN Fixup(a, mod)
- ELSE Error(objNotFound, imp, mod); object := name$
- END
- ELSIF x = mTyp THEN
- RNum(opt); RNum(x);
- IF x # 0 THEN Error(objNotFound, imp, mod); object := name$ END
- END
- END;
- RNum(x)
- END;
- S.PUT(imptab, imp.mod); INC(imptab, 4); imp := imp.next
- END;
- IF res # done THEN
- Kernel.DeallocModMem(mod.ds, mod.ms + mod.cs + mod.vs, mod.dad, mod.mad); mod.mod := NIL
- END
- ELSE Error(noMem, mod, NIL)
- END
- ELSE Error(noMem, mod, NIL)
- END;
- mod.file.Close; mod.file := NIL
- END ReadModule;
-
- PROCEDURE LoadMod (mod: ModSpec);
- VAR i: ModSpec; ok: BOOLEAN; j: INTEGER; n: Kernel.Name;
- BEGIN
- importing := ""; imported := ""; object := ""; i := mod;
- WHILE (i.link # NIL) & (i.link.name # mod.name) DO i := i.link END;
- IF i.link = NIL THEN ReadHeader(mod)
- ELSE Error(cyclicImport, i, i.link)
- END;
- i := mod.imp;
- WHILE (res = done) & (i # NIL) DO (* get imported module *)
- IF i.name = "$$" THEN i.name := "Kernel" END;
- IF i.name[0] = "$" THEN (* dll *)
- j := 1;
- WHILE i.name[j] # 0X DO i.name[j - 1] := i.name[j]; INC(j) END;
- i.name[j - 1] := 0X; n := SHORT(i.name$);
- Kernel.LoadDll(n, ok);
- IF ~ok THEN Error(fileNotFound, i, NIL) END
- ELSE
- n := SHORT(i.name$);
- i.mod := Kernel.ThisLoadedMod(n); (* loaded module *)
- IF i.mod = NIL THEN i.link := mod; LoadMod(i) END (* new module *)
- END;
- i := i.next
- END;
- IF res = done THEN
- n := SHORT(mod.name$);
- mod.mod := Kernel.ThisLoadedMod(n); (* guaranties uniqueness *)
- IF mod.mod = NIL THEN
- ReadModule(mod);
- IF res = done THEN
- Kernel.RegisterMod(mod.mod);
- res := done
- END
- END
- END;
- IF res = descNotFound THEN res := objNotFound; object := "<TypeDesc>" END;
- IF object # "" THEN Append(imported, "."); Append(imported, object); object := "" END
- END LoadMod;
-
- PROCEDURE (h: Hook) ThisMod (IN name: ARRAY OF SHORTCHAR): Kernel.Module;
- VAR m: Kernel.Module; ms: ModSpec;
- BEGIN
- res := done;
- m := Kernel.ThisLoadedMod(name);
- IF m = NIL THEN
- NEW(ms); ms.link := NIL; ms.name := name$;
- LoadMod(ms);
- m := ms.mod;
- inp := NIL (* free last file *)
- END;
- h.res := res;
- h.importing := importing$;
- h.imported := imported$;
- h.object := object$;
- RETURN m
- END ThisMod;
-
- PROCEDURE Init;
- VAR h: Hook;
- BEGIN
- NEW(h); Kernel.SetLoaderHook(h)
- END Init;
-
-BEGIN
- Init;
- m := Kernel.ThisMod("Init");
- IF res # 0 THEN
- CASE res OF
- | fileNotFound: Append(imported, ": code file not found")
- | syntaxError: Append(imported, ": corrupted code file")
- | objNotFound: Append(imported, " not found")
- | illegalFPrint: Append(imported, ": wrong fingerprint")
- | cyclicImport: Append(imported, ": cyclic import")
- | noMem: Append(imported, ": not enough memory")
- ELSE Append(imported, ": loader error")
- END;
- IF res IN {objNotFound, illegalFPrint, cyclicImport} THEN
- Append(imported, " (imported from "); Append(imported, importing); Append(imported, ")")
- END;
- Kernel.FatalError(res, imported)
- END
-END StdLoader.
-
diff --git a/new/Std/Mod/Log.txt b/new/Std/Mod/Log.txt
--- a/new/Std/Mod/Log.txt
+++ /dev/null
@@ -1,373 +0,0 @@
-MODULE StdLog;
-
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Log.odc *)
- (* DO NOT EDIT *)
-
- IMPORT
- Log, Fonts, Ports, Stores, Models, Views, Dialog, HostDialog, StdDialog,
- TextModels, TextMappers, TextRulers, TextViews, TextControllers;
-
- CONST
- (** IntForm base **)
- charCode* = TextMappers.charCode; decimal* = TextMappers.decimal; hexadecimal* = TextMappers.hexadecimal;
-
- (** IntForm showBase **)
- hideBase* = TextMappers.hideBase; showBase* = TextMappers.showBase;
-
- mm = Ports.mm;
-
- TYPE
- ShowHook = POINTER TO RECORD (Dialog.ShowHook) END;
- LogHook = POINTER TO RECORD (Log.Hook) END;
-
- VAR
- logAlerts: BOOLEAN;
-
- text-, buf-: TextModels.Model;
- defruler-: TextRulers.Ruler;
- dir-: TextViews.Directory;
-
- out, subOut: TextMappers.Formatter;
-
- showHook: ShowHook;
-
-
- PROCEDURE Flush;
- BEGIN
- text.Append(buf); Views.RestoreDomain(text.Domain())
- END Flush;
-
- PROCEDURE Char* (ch: CHAR);
- BEGIN
- out.WriteChar(ch); Flush
- END Char;
-
- PROCEDURE Int* (i: LONGINT);
- BEGIN
- out.WriteChar(" "); out.WriteInt(i); Flush
- END Int;
-
- PROCEDURE Real* (x: REAL);
- BEGIN
- out.WriteChar(" "); out.WriteReal(x); Flush
- END Real;
-
- PROCEDURE String* (IN str: ARRAY OF CHAR);
- BEGIN
- out.WriteString(str); Flush
- END String;
-
- PROCEDURE Bool* (x: BOOLEAN);
- BEGIN
- out.WriteChar(" "); out.WriteBool(x); Flush
- END Bool;
-
- PROCEDURE Set* (x: SET);
- BEGIN
- out.WriteChar(" "); out.WriteSet(x); Flush
- END Set;
-
- PROCEDURE IntForm* (x: LONGINT; base, minWidth: INTEGER; fillCh: CHAR; showBase: BOOLEAN);
- BEGIN
- out.WriteIntForm(x, base, minWidth, fillCh, showBase); Flush
- END IntForm;
-
- PROCEDURE RealForm* (x: REAL; precision, minW, expW: INTEGER; fillCh: CHAR);
- BEGIN
- out.WriteRealForm(x, precision, minW, expW, fillCh); Flush
- END RealForm;
-
- PROCEDURE Tab*;
- BEGIN
- out.WriteTab; Flush
- END Tab;
-
- PROCEDURE Ln*;
- BEGIN
- out.WriteLn; Flush;
- TextViews.ShowRange(text, text.Length(), text.Length(), TextViews.any)
- END Ln;
-
- PROCEDURE Para*;
- BEGIN
- out.WritePara; Flush;
- TextViews.ShowRange(text, text.Length(), text.Length(), TextViews.any)
- END Para;
-
- PROCEDURE View* (v: Views.View);
- BEGIN
- out.WriteView(v); Flush
- END View;
-
- PROCEDURE ViewForm* (v: Views.View; w, h: INTEGER);
- BEGIN
- out.WriteViewForm(v, w, h); Flush
- END ViewForm;
-
- PROCEDURE ParamMsg* (IN msg, p0, p1, p2: ARRAY OF CHAR);
- BEGIN
- out.WriteParamMsg(msg, p0, p1, p2); Flush
- END ParamMsg;
-
- PROCEDURE Msg* (IN msg: ARRAY OF CHAR);
- BEGIN
- out.WriteMsg(msg); Flush
- END Msg;
-
-
- PROCEDURE^ Open*;
-
- PROCEDURE (hook: ShowHook) ShowParamMsg (IN s, p0, p1, p2: ARRAY OF CHAR);
- BEGIN
- IF Dialog.showsStatus THEN
- Dialog.ShowParamStatus(s, p0, p1, p2);
- IF logAlerts THEN
- ParamMsg(s, p0, p1, p2); Ln
- END
- ELSE
- IF logAlerts THEN
- Open;
- ParamMsg(s, p0, p1, p2); Ln
- ELSE
- HostDialog.ShowParamMsg(s, p0, p1, p2)
- END
- END
- END ShowParamMsg;
-
- PROCEDURE (hook: ShowHook) ShowParamStatus (IN s, p0, p1, p2: ARRAY OF CHAR);
- BEGIN
- HostDialog.ShowParamStatus(s, p0, p1, p2)
- END ShowParamStatus;
-
-
- PROCEDURE NewView* (): TextViews.View;
- VAR v: TextViews.View;
- BEGIN
- Flush;
- Dialog.SetShowHook(showHook); (* attach alert dialogs *)
- v := dir.New(text);
- v.SetDefaults(TextRulers.CopyOf(defruler, Views.deep), dir.defAttr);
- RETURN v
- END NewView;
-
- PROCEDURE New*;
- BEGIN
- Views.Deposit(NewView())
- END New;
-
-
- PROCEDURE SetDefaultRuler* (ruler: TextRulers.Ruler);
- BEGIN
- defruler := ruler
- END SetDefaultRuler;
-
- PROCEDURE SetDir* (d: TextViews.Directory);
- BEGIN
- ASSERT(d # NIL, 20); dir := d
- END SetDir;
-
-
- PROCEDURE Open*;
- VAR v: Views.View; pos: INTEGER;
- BEGIN
- v := NewView();
- StdDialog.Open(v, "#Dev:Log", NIL, "", NIL, FALSE, TRUE, FALSE, FALSE, TRUE);
- Views.RestoreDomain(text.Domain());
- pos := text.Length();
- TextViews.ShowRange(text, pos, pos, TextViews.any);
- TextControllers.SetCaret(text, pos)
- END Open;
-
- PROCEDURE Clear*;
- BEGIN
- Models.BeginModification(Models.notUndoable, text);
- text.Delete(0, text.Length());
- buf.Delete(0, buf.Length());
- Models.EndModification(Models.notUndoable, text)
- END Clear;
-
-
- (* Sub support *)
-
- PROCEDURE* Guard (o: ANYPTR): BOOLEAN;
- BEGIN
- RETURN
- (o # NIL) &
- ~( (o IS TextModels.Model) & (o = text)
- OR (o IS Stores.Domain) & (o = text.Domain())
- OR (o IS TextViews.View) & (o(TextViews.View).ThisModel() = text)
- )
- END Guard;
-
- PROCEDURE* ClearBuf;
- VAR subBuf: TextModels.Model;
- BEGIN
- subBuf := subOut.rider.Base(); subBuf.Delete(0, subBuf.Length())
- END ClearBuf;
-
- PROCEDURE* FlushBuf;
- VAR buf: TextModels.Model;
- BEGIN
- buf := subOut.rider.Base();
- IF buf.Length() > 0 THEN
- IF ~Log.synch THEN Open() END;
- text.Append(buf)
- END
- END FlushBuf;
-
- PROCEDURE* SubFlush;
- BEGIN
- IF Log.synch THEN
- FlushBuf;
- IF Log.force THEN Views.RestoreDomain(text.Domain()) END
- END;
- END SubFlush;
-
-
-
-
- PROCEDURE (log: LogHook) Guard* (o: ANYPTR): BOOLEAN;
- BEGIN RETURN Guard(o)
- END Guard;
-
- PROCEDURE (log: LogHook) ClearBuf*;
- BEGIN ClearBuf
- END ClearBuf;
-
- PROCEDURE (log: LogHook) FlushBuf*;
- BEGIN FlushBuf
- END FlushBuf;
-
- PROCEDURE (log: LogHook) Beep*;
- BEGIN Dialog.Beep
- END Beep;
-
- PROCEDURE (log: LogHook) Char* (ch: CHAR);
- BEGIN
- subOut.WriteChar(ch); SubFlush
- END Char;
-
- PROCEDURE (log: LogHook) Int* (n: INTEGER);
- BEGIN
- subOut.WriteChar(" "); subOut.WriteInt(n); SubFlush
- END Int;
-
- PROCEDURE (log: LogHook) Real* (x: REAL);
- BEGIN
- subOut.WriteChar(" "); subOut.WriteReal(x); SubFlush
- END Real;
-
- PROCEDURE (log: LogHook) String* (IN str: ARRAY OF CHAR);
- BEGIN
- subOut.WriteString(str); SubFlush
- END String;
-
- PROCEDURE (log: LogHook) Bool* (x: BOOLEAN);
- BEGIN
- subOut.WriteChar(" "); subOut.WriteBool(x); SubFlush
- END Bool;
-
- PROCEDURE (log: LogHook) Set* (x: SET);
- BEGIN
- subOut.WriteChar(" "); subOut.WriteSet(x); SubFlush
- END Set;
-
- PROCEDURE (log: LogHook) IntForm* (x: INTEGER; base, minWidth: INTEGER; fillCh: CHAR; showBase: BOOLEAN);
- BEGIN
- subOut.WriteIntForm(x, base, minWidth, fillCh, showBase); SubFlush
- END IntForm;
-
- PROCEDURE (log: LogHook) RealForm* (x: REAL; precision, minW, expW: INTEGER; fillCh: CHAR);
- BEGIN
- subOut.WriteRealForm(x, precision, minW, expW, fillCh); SubFlush
- END RealForm;
-
- PROCEDURE (log: LogHook) Tab*;
- BEGIN
- subOut.WriteTab; SubFlush
- END Tab;
-
- PROCEDURE (log: LogHook) Ln*;
- BEGIN
- subOut.WriteLn; SubFlush;
- IF Log.synch THEN Views.RestoreDomain(text.Domain()) END
- END Ln;
-
- PROCEDURE (log: LogHook) Para*;
- BEGIN
- subOut.WritePara; SubFlush;
- IF Log.synch THEN Views.RestoreDomain(text.Domain()) END
- END Para;
-
- PROCEDURE (log: LogHook) View* (v: ANYPTR);
- BEGIN
- IF (v # NIL) & (v IS Views.View) THEN
- subOut.WriteView(v(Views.View)); SubFlush
- END
- END View;
-
- PROCEDURE (log: LogHook) ViewForm* (v: ANYPTR; w, h: INTEGER);
- BEGIN
- ASSERT(v # NIL, 20);
- IF (v # NIL) & (v IS Views.View) THEN
- subOut.WriteViewForm(v(Views.View), w, h); SubFlush
- END
- END ViewForm;
-
- PROCEDURE (log: LogHook) ParamMsg* (IN s, p0, p1, p2: ARRAY OF CHAR);
- VAR msg: ARRAY 256 OF CHAR; i: INTEGER; ch: CHAR;
- BEGIN
- IF logAlerts THEN
- IF Log.synch THEN Open END;
- Dialog.MapParamString(s, p0, p1, p2, msg);
- i := 0; ch := msg[0];
- WHILE ch # 0X DO
- IF ch = TextModels.line THEN subOut.WriteLn
- ELSIF ch = TextModels.para THEN subOut.WritePara
- ELSIF ch = TextModels.tab THEN subOut.WriteTab
- ELSIF ch >= " " THEN subOut.WriteChar(ch)
- END;
- INC(i); ch := msg[i];
- END;
- subOut.WriteLn; SubFlush
- ELSE
- HostDialog.ShowParamMsg(s, p0, p1, p2)
- END
- END ParamMsg;
-
-
- PROCEDURE AttachSubLog;
- VAR h: LogHook;
- BEGIN
- subOut.ConnectTo(TextModels.dir.New());
- NEW(h);
- Log.SetHook(h);
- END AttachSubLog;
-
- PROCEDURE DetachSubLog;
- BEGIN
- Log.SetHook(NIL);
- END DetachSubLog;
-
-
- PROCEDURE Init;
- VAR font: Fonts.Font; p: TextRulers.Prop; x: INTEGER; i: INTEGER;
- BEGIN
- logAlerts := TRUE; (* logReports := FALSE; *)
-
- text := TextModels.dir.New();
- buf := TextModels.CloneOf(text);
- out.ConnectTo(buf);
-
- font := TextModels.dir.attr.font;
- defruler := TextRulers.dir.New(NIL);
- TextRulers.SetRight(defruler, 80*mm);
- dir := TextViews.dir;
- NEW(showHook)
- END Init;
-
-BEGIN
- Init; AttachSubLog
-CLOSE
- DetachSubLog;
-END StdLog.
diff --git a/new/Std/Mod/Logos.txt b/new/Std/Mod/Logos.txt
--- a/new/Std/Mod/Logos.txt
+++ /dev/null
@@ -1,162 +0,0 @@
-MODULE StdLogos;
-
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Logos.odc *)
- (* DO NOT EDIT *)
-
- IMPORT Ports, Stores, Views, Controllers, Properties;
-
- CONST
- W = 4;
- baseSize = 24 * Ports.point;
-
- colBase = 00202020H;
-
- changeColorKey = "#System:ChangeColor";
-
- minVersion = 0; maxVersion = 0;
-
-
- TYPE
- View = POINTER TO RECORD (Views.View)
- c: Ports.Color
- END;
-
- ChangeSizeOp = POINTER TO RECORD (Stores.Operation)
- view: View;
- size: INTEGER;
- END;
-
- ChangeColorOp = POINTER TO RECORD (Stores.Operation)
- view: View;
- color: Ports.Color
- END;
-
- (* curve painting *)
-
- PROCEDURE Paint (f: Views.Frame; size: INTEGER; col, bgnd: Ports.Color);
- VAR i, d, s, g, m, a, b, l, l0, rl, rt, rr, rb: INTEGER; c: Ports.Color;
- BEGIN
- s := size DIV 10; d := size DIV 2; g := d DIV 8; m := size * W DIV 2;
- f.DrawOval(0, s * 2, size * W, size, Ports.fill, col);
- f.DrawOval(s * W, s * 11 DIV 4, (size - s) * W, size - s * 3 DIV 4, Ports.fill, bgnd);
- a := m; b := m + d; c := 7 * colBase; i := 0;
- WHILE i < 4 DO
- f.DrawOval(a, 0, b, d, Ports.fill, c);
- INC(a, g); DEC(b, g); DEC(c, colBase); INC(i)
- END;
- f.rider.GetRect(rl, rt, rr, rb);
- l0 := rl; l := (f.gx + m + d DIV 2) DIV f.unit;
- IF l < rr THEN
- f.rider.SetRect(l, rt, rr, rb);
- a := m; b := m + d; c := 0; i := 0;
- WHILE i < 4 DO
- f.DrawOval(a, 0, b, d, Ports.fill, c);
- INC(a, g); DEC(b, g); INC(c, colBase); INC(i)
- END;
- f.rider.SetRect(l0, rt, rr, rb)
- END
- END Paint;
-
- (* ChangeOp *)
-
- PROCEDURE (op: ChangeSizeOp) Do;
- VAR v: View; size, w: INTEGER;
- BEGIN
- v := op.view;
- size := op.size; v.context.GetSize(w, op.size); v.context.SetSize(size * W, size);
- Views.Update(v, Views.keepFrames)
- END Do;
-
- PROCEDURE (op: ChangeColorOp) Do;
- VAR v: View; color: Ports.Color;
- BEGIN
- v := op.view;
- color := op.color; op.color := v.c; v.c := color;
- Views.Update(v, Views.keepFrames)
- END Do;
-
- (* View *)
-
- PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
- VAR thisVersion: INTEGER;
- BEGIN
- v.Internalize^(rd); IF rd.cancelled THEN RETURN END;
- rd.ReadVersion(minVersion, maxVersion, thisVersion); IF rd.cancelled THEN RETURN END;
- rd.ReadInt(v.c)
- END Internalize;
-
- PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
- BEGIN
- v.Externalize^(wr);
- wr.WriteVersion(maxVersion);
- wr.WriteInt(v.c)
- END Externalize;
-
- PROCEDURE (v: View) CopyFromSimpleView (source: Views.View);
- BEGIN
- WITH source: View DO v.c := source.c END
- END CopyFromSimpleView;
-
- PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- VAR w, h: INTEGER; bgnd: Ports.Color; g: Views.Frame;
- BEGIN
- g := f;
- REPEAT
- g := Views.HostOf(g);
- bgnd := Views.transparent;
- g.view.GetBackground(bgnd)
- UNTIL bgnd # Views.transparent;
- v.context.GetSize(w, h);
- Paint(f, h, v.c, bgnd)
- END Restore;
-
- PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
- VAR focus: Views.View);
- BEGIN
- WITH msg: Properties.CollectMsg DO
- Views.HandlePropMsg(v, msg.poll)
- | msg: Properties.EmitMsg DO
- Views.HandlePropMsg(v, msg.set)
- ELSE (* ignore other messages *)
- END
- END HandleCtrlMsg;
-
- PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);
- VAR q: Properties.Property; p: Properties.StdProp;
- cop: ChangeColorOp;
- BEGIN
- WITH msg: Properties.SizePref DO
- IF (msg.w > Views.undefined) & (msg.h > Views.undefined) THEN
- (* constrain proposed size *)
- Properties.ProportionalConstraint(W, 1, msg.fixedW, msg.fixedH, msg.w, msg.h)
- ELSE
- (* return default size *)
- msg.w := W * baseSize; msg.h := baseSize
- END
- | msg: Properties.PollMsg DO
- NEW(p); p.known := {Properties.color}; p.valid := p.known;
- p.color.val := v.c;
- msg.prop := p
- | msg: Properties.SetMsg DO
- q := msg.prop;
- WHILE q # NIL DO
- WITH q: Properties.StdProp DO
- IF Properties.color IN q.valid THEN
- NEW(cop); cop.view := v; cop.color := q.color.val;
- Views.Do(v, changeColorKey, cop)
- END;
- ELSE
- END;
- q :=q.next
- END
- ELSE
- END
- END HandlePropMsg;
-
- PROCEDURE Deposit*;
- VAR v: View;
- BEGIN
- NEW(v); v.c := Ports.grey50; Views.Deposit(v)
- END Deposit;
-
-END StdLogos.
diff --git a/new/Std/Mod/Scrollers.txt b/new/Std/Mod/Scrollers.txt
+++ /dev/null
@@ -1,853 +0,0 @@
-MODULE StdScrollers;
-
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Scrollers.odc *)
- (* DO NOT EDIT *)
-
- IMPORT Dialog, Ports, Services, Stores, Models, Views, Properties, Controllers, StdCFrames;
-
-
- CONST
- (* properties & options *)
- horBar* = 0; verBar* = 1; horHide* = 2; verHide* = 3; width* = 4; height* = 5; showBorder* = 6; savePos* = 7;
-
-
- TYPE
- Prop* = POINTER TO RECORD (Properties.Property)
- horBar*, verBar*: BOOLEAN;
- horHide*, verHide*: BOOLEAN;
- width*, height*: INTEGER;
- showBorder*: BOOLEAN;
- savePos*: BOOLEAN
- END;
-
- ScrollBar = POINTER TO RECORD (Views.View)
- v: View;
- ver: BOOLEAN
- END;
-
- InnerView = POINTER TO RECORD (Views.View)
- v: View
- END;
-
- View = POINTER TO RECORD (Views.View);
- view: Views.View;
- sbW: INTEGER;
- orgX, orgY: INTEGER;
- w, h: INTEGER; (* = 0: adapt to container *)
- opts: SET;
- (* not persistent *)
- hor, ver: ScrollBar;
- inner: InnerView;
- rgap, bgap: INTEGER; (* = 0: no scrollbar *)
- border: INTEGER;
- update: Action
- END;
-
- Context = POINTER TO RECORD (Models.Context)
- v: View;
- type: INTEGER
- END;
-
- Action = POINTER TO RECORD (Services.Action)
- v: View
- END;
-
- Op = POINTER TO RECORD (Stores.Operation)
- v: View;
- p: Prop
- END;
-
- SOp = POINTER TO RECORD (Stores.Operation)
- v: View;
- x, y: INTEGER
- END;
-
- UpdateMsg = RECORD (Views.Message)
- changed: BOOLEAN
- END;
-
-
- VAR
- dialog*: RECORD
- horizontal*, vertical*: RECORD
- mode*: INTEGER;
- adapt*: BOOLEAN;
- size*: REAL
- END;
- showBorder*: BOOLEAN;
- savePos*: BOOLEAN;
- valid, readOnly: SET
- END;
-
-
- (* tools *)
-
- PROCEDURE CheckPos (v: View; VAR x, y: INTEGER);
- VAR w, h: INTEGER;
- BEGIN
- v.context.GetSize(w, h);
- DEC(w, v.rgap + 2 * v.border);
- DEC(h, v.bgap + 2 * v.border);
- IF x > v.w - w THEN x := v.w - w END;
- IF x < 0 THEN x := 0 END;
- IF y > v.h - h THEN y := v.h - h END;
- IF y < 0 THEN y := 0 END
- END CheckPos;
-
- PROCEDURE InnerFrame (v: View; f: Views.Frame): Views.Frame;
- VAR g, h: Views.Frame;
- BEGIN
- g := Views.ThisFrame(f, v.inner);
- IF g = NIL THEN
- Views.InstallFrame(f, v.inner, v.border, v.border, 0, TRUE);
- g := Views.ThisFrame(f, v.inner)
- END;
- IF g # NIL THEN
- h := Views.ThisFrame(g, v.view);
- IF h = NIL THEN
- Views.InstallFrame(g, v.view, -v.orgX, -v.orgY, 0, TRUE);
- h := Views.ThisFrame(g, v.view)
- END
- END;
- RETURN h
- END InnerFrame;
-
- PROCEDURE Scroll (v: View; dir: INTEGER; ver: BOOLEAN; p: INTEGER; OUT pos: INTEGER);
- VAR x, y: INTEGER; last: Stores.Operation; op: SOp;
- BEGIN
- x := v.orgX; y := v.orgY;
- IF ver THEN pos := y ELSE pos := x END;
- IF dir = StdCFrames.lineUp THEN
- DEC(pos, 10 * Ports.mm)
- ELSIF dir = StdCFrames.lineDown THEN
- INC(pos, 10 * Ports.mm)
- ELSIF dir = StdCFrames.pageUp THEN
- DEC(pos, 40 * Ports.mm)
- ELSIF dir = StdCFrames.pageDown THEN
- INC(pos, 40 * Ports.mm)
- ELSIF dir = Controllers.gotoPos THEN
- pos := p
- END;
- IF ver THEN CheckPos(v, x, pos); y := pos
- ELSE CheckPos(v, pos, y); x := pos
- END;
- IF (x # v.orgX) OR (y # v.orgY) THEN
- last := Views.LastOp(v);
- IF ~(savePos IN v.opts) OR (last # NIL) & (last IS SOp) THEN
- v.orgX := x; v.orgY := y;
- Views.Update(v.view, Views.keepFrames)
- ELSE
- NEW(op); op.v := v; op.x := x; op.y := y;
- Views.Do(v, "#System:Scrolling", op)
- END
- END
- END Scroll;
-
- PROCEDURE PollSection (v: View; ver: BOOLEAN; OUT size, sect, pos: INTEGER);
- VAR w, h: INTEGER;
- BEGIN
- v.context.GetSize(w, h);
- IF ver THEN size := v.h; sect := h - v.bgap - 2 * v.border; pos := v.orgY
- ELSE size := v.w; sect := w - v.rgap - 2 * v.border; pos := v.orgX
- END
- END PollSection;
-
-
- (* SOp *)
-
- PROCEDURE (op: SOp) Do;
- VAR x, y: INTEGER;
- BEGIN
- x := op.x; op.x := op.v.orgX; op.v.orgX := x;
- y := op.y; op.y := op.v.orgY; op.v.orgY := y;
- Views.Update(op.v.view, Views.keepFrames)
- END Do;
-
-
- (* 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 p.horBar # q.horBar THEN EXCL(valid, horBar) END;
- IF p.verBar # q.verBar THEN EXCL(valid, verBar) END;
- IF p.horHide # q.horHide THEN EXCL(valid, horHide) END;
- IF p.verHide # q.verHide THEN EXCL(valid, verHide) END;
- IF p.width # q.width THEN EXCL(valid, width) END;
- IF p.height # q.height THEN EXCL(valid, height) END;
- IF p.showBorder # q.showBorder THEN EXCL(valid, showBorder) END;
- IF p.savePos # q.savePos THEN EXCL(valid, savePos) END;
- IF p.valid # valid THEN p.valid := valid; equal := FALSE END
- END
- END IntersectWith;
-
- PROCEDURE SetProp (v: View; p: Properties.Property);
- VAR op: Op;
- BEGIN
- WITH p: Prop DO
- NEW(op); op.v := v; op.p := p;
- Views.Do(v, "#System:SetProp", op)
- END
- END SetProp;
-
- PROCEDURE PollProp (v: View; OUT prop: Prop);
- VAR p: Prop;
- BEGIN
- NEW(p);
- p.valid := {horBar, verBar, horHide, verHide, width, height, showBorder, savePos};
- p.readOnly := {width, height} - v.opts;
- p.horBar := horBar IN v.opts;
- p.verBar := verBar IN v.opts;
- p.horHide := horHide IN v.opts;
- p.verHide := verHide IN v.opts;
- p.width := v.w;
- p.height := v.h;
- p.showBorder := showBorder IN v.opts;
- p.savePos := savePos IN v.opts;
- p.known := p.valid; prop := p
- END PollProp;
-
-
- (* Op *)
-
- PROCEDURE (op: Op) Do;
- VAR p: Prop; v: View; valid: SET;
- BEGIN
- v := op.v; p := op.p; PollProp(v, op.p); op.p.valid := p.valid;
- valid := p.valid * ({horBar, verBar, horHide, verHide, showBorder, savePos} + v.opts * {width, height});
- IF horBar IN valid THEN
- IF p.horBar THEN INCL(v.opts, horBar) ELSE EXCL(v.opts, horBar) END
- END;
- IF verBar IN valid THEN
- IF p.verBar THEN INCL(v.opts, verBar) ELSE EXCL(v.opts, verBar) END
- END;
- IF horHide IN valid THEN
- IF p.horHide THEN INCL(v.opts, horHide) ELSE EXCL(v.opts, horHide) END
- END;
- IF verHide IN valid THEN
- IF p.verHide THEN INCL(v.opts, verHide) ELSE EXCL(v.opts, verHide) END
- END;
- IF width IN valid THEN v.w := p.width END;
- IF height IN valid THEN v.h := p.height END;
- IF showBorder IN valid THEN
- IF p.showBorder THEN INCL(v.opts, showBorder); v.border := 2 * Ports.point
- ELSE EXCL(v.opts, showBorder); v.border := 0
- END
- END;
- IF savePos IN valid THEN
- IF p.savePos THEN INCL(v.opts, savePos) ELSE EXCL(v.opts, savePos) END
- END;
- Views.Update(v, Views.rebuildFrames)
- END Do;
-
-
- (* Action *)
-
- PROCEDURE (a: Action) Do;
- VAR msg: UpdateMsg;
- BEGIN
- msg.changed := FALSE;
- Views.Broadcast(a.v, msg);
- IF msg.changed THEN Views.Update(a.v, Views.keepFrames)
- ELSE
- Views.Broadcast(a.v.hor, msg);
- Views.Broadcast(a.v.ver, msg)
- END
- END Do;
-
-
- (* ScrollBars *)
-
- PROCEDURE TrackSB (f: StdCFrames.ScrollBar; dir: INTEGER; VAR pos: INTEGER);
- VAR s: ScrollBar; msg: Controllers.ScrollMsg; pmsg: Controllers.PollSectionMsg; host, inner: Views.Frame;
- BEGIN
- s := f.view(ScrollBar); host := Views.HostOf(f);
- msg.focus := FALSE; msg.vertical := s.ver;
- msg.op := dir; msg.done := FALSE;
- inner := InnerFrame(s.v, host);
- IF inner # NIL THEN Views.ForwardCtrlMsg(inner, msg) END;
- IF msg.done THEN
- pmsg.focus := FALSE; pmsg.vertical := s.ver;
- pmsg.valid := FALSE; pmsg.done := FALSE;
- inner := InnerFrame(s.v, host);
- IF inner # NIL THEN Views.ForwardCtrlMsg(inner, pmsg) END;
- IF pmsg.done THEN
- pos := pmsg.partPos
- END
- ELSE
- Scroll(s.v, dir, s.ver, 0, pos);
- Views.ValidateRoot(Views.RootOf(host))
- END
- END TrackSB;
-
- PROCEDURE SetSB (f: StdCFrames.ScrollBar; pos: INTEGER);
- VAR s: ScrollBar; msg: Controllers.ScrollMsg; p: INTEGER; host, inner: Views.Frame;
- BEGIN
- s := f.view(ScrollBar); host := Views.HostOf(f);
- msg.focus := FALSE; msg.vertical := s.ver;
- msg.op := Controllers.gotoPos; msg.pos := pos;
- msg.done := FALSE;
- inner := InnerFrame(s.v, host);
- IF inner # NIL THEN Views.ForwardCtrlMsg(inner, msg) END;
- IF ~msg.done THEN
- Scroll(s.v, Controllers.gotoPos, s.ver, pos, p);
- Views.ValidateRoot(Views.RootOf(host))
- END
- END SetSB;
-
- PROCEDURE GetSB (f: StdCFrames.ScrollBar; OUT size, sect, pos: INTEGER);
- VAR s: ScrollBar; msg: Controllers.PollSectionMsg; host, inner: Views.Frame;
- BEGIN
- s := f.view(ScrollBar); host := Views.HostOf(f);
- msg.focus := FALSE; msg.vertical := s.ver;
- msg.wholeSize := 1; msg.partSize := 0; msg.partPos := 0;
- msg.valid := FALSE; msg.done := FALSE;
- inner := InnerFrame(s.v, host);
- IF inner # NIL THEN Views.ForwardCtrlMsg(inner, msg) END;
- IF msg.done THEN
- IF msg.valid THEN
- size := msg.wholeSize; sect := msg.partSize; pos := msg.partPos
- ELSE
- size := 1; sect := 1; pos := 0
- END
- ELSE
- PollSection(s.v, s.ver, size, sect, pos)
- END
- END GetSB;
-
- PROCEDURE (s: ScrollBar) GetNewFrame (VAR frame: Views.Frame);
- VAR f: StdCFrames.ScrollBar;
- BEGIN
- f := StdCFrames.dir.NewScrollBar();
- f.disabled := FALSE; f.undef := FALSE; f.readOnly := FALSE;
- f.Track := TrackSB; f.Get := GetSB; f.Set := SetSB;
- frame := f
- END GetNewFrame;
-
- PROCEDURE (s: ScrollBar) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- BEGIN
- WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
- END Restore;
-
- PROCEDURE (s: ScrollBar) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
- VAR focus: Views.View);
- BEGIN
- WITH f: StdCFrames.Frame DO
- WITH msg: Controllers.PollCursorMsg DO
- f.GetCursor(msg.x, msg.y, msg.modifiers, msg.cursor)
- | msg: Controllers.TrackMsg DO
- f.MouseDown(msg.x, msg.y, msg.modifiers)
- ELSE
- END
- END
- END HandleCtrlMsg;
-
- PROCEDURE (s: ScrollBar) HandleViewMsg (f: Views.Frame; VAR msg: Views.Message);
- BEGIN
- WITH msg: UpdateMsg DO
- WITH f: StdCFrames.Frame DO f.Update() END
- ELSE
- END
- END HandleViewMsg;
-
-
- (* View *)
-
- PROCEDURE Update (v: View; f: Views.Frame);
- VAR msg: Controllers.PollSectionMsg; w, h: INTEGER; depends: BOOLEAN; inner: Views.Frame;
- BEGIN
- v.bgap := 0; v.rgap := 0; depends := FALSE;
- v.context.GetSize(w, h);
- DEC(w, 2 * v.border); DEC(h, 2 * v.border);
- IF horBar IN v.opts THEN
- IF horHide IN v.opts THEN
- msg.focus := FALSE; msg.vertical := FALSE;
- msg.wholeSize := 1; msg.partSize := 0; msg.partPos := 0;
- msg.valid := FALSE; msg.done := FALSE;
- inner := InnerFrame(v, f);
- IF inner # NIL THEN Views.ForwardCtrlMsg(inner, msg) END;
- IF msg.done THEN
- IF msg.valid THEN v.bgap := v.sbW END
- ELSIF v.w > 0 THEN
- IF w < v.w THEN v.bgap := v.sbW
- ELSIF w - v.sbW < v.w THEN depends := TRUE
- END
- END
- ELSE v.bgap := v.sbW
- END
- END;
- IF verBar IN v.opts THEN
- IF verHide IN v.opts THEN
- msg.focus := FALSE; msg.vertical := TRUE;
- msg.wholeSize := 1; msg.partSize := 0; msg.partPos := 0;
- msg.valid := FALSE; msg.done := FALSE;
- inner := InnerFrame(v, f);
- IF inner # NIL THEN Views.ForwardCtrlMsg(inner, msg) END;
- IF msg.done THEN
- IF msg.valid THEN v.rgap := v.sbW END
- ELSIF v.h > 0 THEN
- IF h - v.bgap < v.h THEN v.rgap := v.sbW END
- END
- ELSE v.rgap := v.sbW
- END
- END;
- IF depends & (v.rgap > 0) THEN v.bgap := v.sbW END;
- CheckPos(v, v.orgX, v.orgY)
- END Update;
-
- PROCEDURE Init (v: View; newView: BOOLEAN);
- CONST min = 2 * Ports.mm; max = MAX(INTEGER); default = 50 * Ports.mm;
- VAR c: Context; x: INTEGER; msg: Properties.ResizePref;
- BEGIN
- IF newView THEN
- v.opts := v.opts + {horBar, verBar, horHide, verHide};
- StdCFrames.dir.GetScrollBarSize(x, v.sbW);
- IF v.view.context # NIL THEN
- v.view.context.GetSize(v.w, v.h);
- v.view := Views.CopyOf(v.view, Views.shallow)
- ELSE
- v.w := Views.undefined; v.h := Views.undefined;
- Properties.PreferredSize(v.view, min, max, min, max, default, default, v.w, v.h)
- END;
- msg.fixed := FALSE;
- msg.horFitToWin := FALSE; msg.verFitToWin := FALSE;
- msg.horFitToPage := FALSE; msg.verFitToPage := FALSE;
- Views.HandlePropMsg(v.view, msg);
- IF ~msg.fixed THEN
- INCL(v.opts, width); INCL(v.opts, height);
- IF msg.horFitToWin OR msg.horFitToPage THEN v.w := 0 END;
- IF msg.verFitToWin OR msg.verFitToPage THEN v.h := 0 END
- END
- END;
- v.rgap := 0; v.bgap := 0;
- IF showBorder IN v.opts THEN v.border := 2 * Ports.point ELSE v.border := 0 END;
- NEW(v.inner); v.inner.v := v;
- NEW(c); c.v := v; c.type := 3; v.inner.InitContext(c);
- NEW(v.hor); v.hor.ver := FALSE; v.hor.v := v;
- NEW(c); c.v := v; c.type := 2; v.hor.InitContext(c);
- NEW(v.ver); v.ver.ver := TRUE; v.ver.v := v;
- NEW(c); c.v := v; c.type := 1; v.ver.InitContext(c);
- NEW(v.update); v.update.v := v;
- Stores.Join(v, v.view);
- Stores.Join(v, v.inner);
- Stores.Join(v, v.hor);
- Stores.Join(v, v.ver);
- Services.DoLater(v.update, Services.now)
- END Init;
-
- PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
- VAR thisVersion: INTEGER;
- BEGIN
- v.Internalize^(rd);
- IF ~rd.cancelled THEN
- rd.ReadVersion(0, 0, thisVersion);
- IF ~rd.cancelled THEN
- Views.ReadView(rd, v.view);
- rd.ReadInt(v.sbW);
- rd.ReadInt(v.orgX);
- rd.ReadInt(v.orgY);
- rd.ReadInt(v.w);
- rd.ReadInt(v.h);
- rd.ReadSet(v.opts);
- Init(v, FALSE)
- END
- END
- END Internalize;
-
- PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
- BEGIN
- v.Externalize^(wr);
- wr.WriteVersion(0);
- Views.WriteView(wr, v.view);
- wr.WriteInt(v.sbW);
- IF savePos IN v.opts THEN
- wr.WriteInt(v.orgX);
- wr.WriteInt(v.orgY)
- ELSE
- wr.WriteInt(0);
- wr.WriteInt(0)
- END;
- wr.WriteInt(v.w);
- wr.WriteInt(v.h);
- wr.WriteSet(v.opts);
- END Externalize;
-
- PROCEDURE (v: View) ThisModel(): Models.Model;
- BEGIN
- RETURN v.view.ThisModel()
- END ThisModel;
-
- PROCEDURE (v: View) CopyFromModelView (source: Views.View; model: Models.Model);
- BEGIN
- WITH source: View DO
- IF model = NIL THEN v.view := Views.CopyOf(source.view, Views.deep)
- ELSE v.view := Views.CopyWithNewModel(source.view, model)
- END;
- v.sbW := source.sbW;
- v.orgX := source.orgX;
- v.orgY := source.orgY;
- v.w := source.w;
- v.h := source.h;
- v.opts := source.opts;
- END;
- Init(v, FALSE)
- END CopyFromModelView;
-
- PROCEDURE (v: View) InitContext (context: Models.Context);
- VAR c: Context;
- BEGIN
- v.InitContext^(context);
- IF v.view.context = NIL THEN
- NEW(c); c.v := v; c.type := 0; v.view.InitContext(c)
- END
- END InitContext;
-
- PROCEDURE (v: View) Neutralize;
- BEGIN
- v.view.Neutralize
- END Neutralize;
-
- PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- VAR w, h: INTEGER;
- BEGIN
- v.context.GetSize(w, h);
- IF showBorder IN v.opts THEN
- v.border := 2 * f.dot;
- f.DrawRect(0, f.dot, w, v.border, Ports.fill, Ports.black);
- f.DrawRect(f.dot, 0, v.border, h, Ports.fill, Ports.black);
- f.DrawRect(0, h - v.border, w, h - f.dot, Ports.fill, Ports.grey25);
- f.DrawRect(w - v.border, 0, w - f.dot, h, Ports.fill, Ports.grey25);
- f.DrawRect(0, 0, w, f.dot, Ports.fill, Ports.grey50);
- f.DrawRect(0, 0, f.dot, h, Ports.fill, Ports.grey50);
- f.DrawRect(0, h - f.dot, w, h, Ports.fill, Ports.white);
- f.DrawRect(w - f.dot, 0, w, h, Ports.fill, Ports.white)
- END;
- Views.InstallFrame(f, v.inner, v.border, v.border, 0, TRUE);
- IF v.bgap > 0 THEN Views.InstallFrame(f, v.hor, v.border, h - v.border - v.bgap, 0, FALSE) END;
- IF v.rgap > 0 THEN Views.InstallFrame(f, v.ver, w - v.border - v.rgap, v.border, 0, FALSE) END
- END Restore;
-
- PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View);
- VAR w, h, p, n: INTEGER;smsg: Controllers.ScrollMsg; inner: Views.Frame;
- BEGIN
- WITH msg: Controllers.WheelMsg DO
- smsg.focus := FALSE; smsg.op := msg.op; smsg.pos := 0; smsg.done := FALSE; n := msg.nofLines;
- IF (v.rgap > 0) OR (v.bgap > 0) THEN
- smsg.vertical := v.rgap > 0;
- REPEAT
- smsg.done := FALSE;
- inner := InnerFrame(v, f);
- IF inner # NIL THEN Views.ForwardCtrlMsg(inner, smsg) END;
- IF ~smsg.done THEN
- Scroll(v, smsg.op, smsg.vertical, 0, p);
- Views.ValidateRoot(Views.RootOf(f))
- END;
- DEC(n)
- UNTIL n <= 0;
- msg.done := TRUE
- ELSE
- focus := v.inner
- END
- | msg: Controllers.CursorMessage DO
- v.context.GetSize(w, h);
- IF msg.x > w - v.border - v.rgap THEN
- IF msg.y <= h - v.border - v.bgap THEN focus := v.ver END
- ELSIF msg.y > h - v.border - v.bgap THEN focus := v.hor
- ELSE focus := v.inner
- END
- | msg: Controllers.PollSectionMsg DO
- inner := InnerFrame(v, f);
- IF inner # NIL THEN Views.ForwardCtrlMsg(inner, msg) END;
- IF ~msg.done THEN
- PollSection(v, msg.vertical, msg.wholeSize, msg.partSize, msg.partPos);
- msg.valid := msg.partSize < msg.wholeSize;
- msg.done := TRUE
- END
- | msg: Controllers.ScrollMsg DO
- inner := InnerFrame(v, f);
- IF inner # NIL THEN Views.ForwardCtrlMsg(inner, msg) END;
- IF ~msg.done THEN
- Scroll(v, msg.op, msg.vertical, msg.pos, p);
- Views.ValidateRoot(Views.RootOf(f));
- msg.done := TRUE
- END
- ELSE focus := v.inner
- END;
- IF ~(msg IS Controllers.TickMsg) THEN
- Services.DoLater(v.update, Services.now)
- END
- END HandleCtrlMsg;
-
- PROCEDURE (v: View) HandleViewMsg (f: Views.Frame; VAR msg: Views.Message);
- VAR b, r: INTEGER;
- BEGIN
- WITH msg: UpdateMsg DO
- b := v.bgap; r := v.rgap;
- Update(v, f);
- IF (v.bgap # b) OR (v.rgap # r) THEN msg.changed := TRUE END
- ELSE
- END
- END HandleViewMsg;
-
- PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);
- VAR w, h: INTEGER; p: Properties.Property; prop: Prop; fv: Views.View;
- BEGIN
- WITH msg: Properties.FocusPref DO
- v.context.GetSize(w, h);
- Views.HandlePropMsg(v.view, msg);
- IF msg.atLocation THEN
- IF (msg.x > w - v.border - v.rgap) & (msg.y > h - v.border - v.bgap) THEN
- msg.hotFocus := FALSE; msg.setFocus := FALSE
- ELSIF ((msg.x > w - v.border - v.rgap) OR (msg.y > h - v.border - v.bgap)) & ~msg.setFocus THEN
- msg.hotFocus := TRUE
- END
- END
- | msg: Properties.SizePref DO
- IF (v.w > 0) & (v.h > 0) THEN
- IF msg.w = Views.undefined THEN msg.w := 50 * Ports.mm END;
- IF msg.h = Views.undefined THEN msg.h := 50 * Ports.mm END
- ELSE
- IF msg.w > v.rgap THEN DEC(msg.w, v.rgap + 2 * v.border) END;
- IF msg.h > v.bgap THEN DEC(msg.h, v.bgap + 2 * v.border) END;
- Views.HandlePropMsg(v.view, msg);
- IF msg.w > 0 THEN INC(msg.w, v.rgap + 2 * v.border) END;
- IF msg.h > 0 THEN INC(msg.h, v.bgap + 2 * v.border) END
- END;
- IF msg.w < 3 * v.sbW THEN msg.w := 3 * v.sbW END;
- IF msg.h < 3 * v.sbW THEN msg.h := 3 * v.sbW END
- | msg: Properties.ResizePref DO
- Views.HandlePropMsg(v.view, msg);
- IF v.w > 0 THEN
- msg.fixed := FALSE;
- msg.horFitToWin := TRUE;
- msg.horFitToPage := FALSE
- END;
- IF v.h > 0 THEN
- msg.fixed := FALSE;
- msg.verFitToWin := TRUE;
- msg.verFitToPage := FALSE
- END
- | msg: Properties.BoundsPref DO
- Views.HandlePropMsg(v.view, msg);
- INC(msg.w, 2 * v.border);
- INC(msg.h, 2 * v.border);
- IF (horBar IN v.opts) & ~(horHide IN v.opts) THEN INC(msg.w, v.sbW) END;
- IF (verBar IN v.opts) & ~(verHide IN v.opts) THEN INC(msg.h, v.sbW) END
- | msg: Properties.PollMsg DO
- Views.HandlePropMsg(v.view, msg);
- PollProp(v, prop); Properties.Insert(msg.prop, prop)
- | msg: Properties.SetMsg DO
- p := msg.prop; WHILE (p # NIL) & ~(p IS Prop) DO p := p.next END;
- IF p # NIL THEN SetProp(v, p) END;
- Views.HandlePropMsg(v.view, msg);
- | msg: Properties.ControlPref DO
- fv := msg.focus;
- IF fv = v THEN msg.focus := v.view END;
- Views.HandlePropMsg(v.view, msg);
- msg.focus := fv
- ELSE
- Views.HandlePropMsg(v.view, msg);
- END;
- END HandlePropMsg;
-
-
- (* InnerView *)
-
- PROCEDURE (v: InnerView) GetBackground (VAR color: Ports.Color);
- BEGIN
- color := Ports.background
- END GetBackground;
-
- PROCEDURE (v: InnerView) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- BEGIN
- Views.InstallFrame(f, v.v.view, -v.v.orgX, -v.v.orgY, 0, TRUE)
- END Restore;
-
- PROCEDURE (v: InnerView) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
- VAR focus: Views.View);
- BEGIN
- focus := v.v.view
- END HandleCtrlMsg;
-
-
- (* Context *)
-
- PROCEDURE (c: Context) MakeVisible (l, t, r, b: INTEGER);
- VAR w, h, x, y: INTEGER;
- BEGIN
- IF ~(savePos IN c.v.opts) THEN
- c.v.context.GetSize(w, h);
- x := c.v.orgX; y := c.v.orgY;
- IF c.v.w > 0 THEN
- DEC(w, c.v.rgap + 2 * c.v.border);
- IF r > x + w - Ports.point THEN x := r - w + Ports.point END;
- IF l < x + Ports.point THEN x := l - Ports.point END;
- END;
- IF c.v.h > 0 THEN
- DEC(h, c.v.bgap + 2 * c.v.border);
- IF b > y + h - Ports.point THEN y := b - h + Ports.point END;
- IF t < y + Ports.point THEN y := t - Ports.point END;
- END;
- IF (x # c.v.orgX) OR (y # c.v.orgY) THEN
- CheckPos(c.v, x, y); c.v.orgX := x; c.v.orgY := y;
- Views.Update(c.v.view, Views.keepFrames)
- END;
- Services.DoLater(c.v.update, Services.now)
- END
- END MakeVisible;
-
- PROCEDURE (c: Context) Consider (VAR p: Models.Proposal);
- BEGIN
- c.v.context.Consider(p)
- END Consider;
-
- PROCEDURE (c: Context) Normalize (): BOOLEAN;
- BEGIN
- RETURN ~(savePos IN c.v.opts)
- END Normalize;
-
- PROCEDURE (c: Context) GetSize (OUT w, h: INTEGER);
- BEGIN
- c.v.context.GetSize(w, h);
- DEC(w, c.v.rgap + 2 * c.v.border);
- DEC(h, c.v.bgap + 2 * c.v.border);
- IF c.type = 0 THEN
- IF c.v.w > 0 THEN w := c.v.w END;
- IF c.v.h > 0 THEN h := c.v.h END
- ELSIF c.type = 1 THEN
- w := c.v.rgap
- ELSIF c.type = 2 THEN
- h := c.v.bgap
- END
- END GetSize;
-
- PROCEDURE (c: Context) SetSize (w, h: INTEGER);
- VAR w0, h0, w1, h1: INTEGER;
- BEGIN
- ASSERT(c.type = 0, 100);
- c.v.context.GetSize(w0, h0); w1 := w0; h1 := h0;
- IF c.v.w > 0 THEN c.v.w := w
- ELSE w1 := w + c.v.rgap + 2 * c.v.border
- END;
- IF c.v.h > 0 THEN c.v.h := h
- ELSE h1 := h + c.v.bgap + 2 * c.v.border
- END;
- IF (w1 # w0) OR (h1 # h0) THEN
- c.v.context.SetSize(w1, h1)
- END
- END SetSize;
-
- PROCEDURE (c: Context) ThisModel (): Models.Model;
- BEGIN
- RETURN NIL
- END ThisModel;
-
-
- (* dialog *)
-
- PROCEDURE InitDialog*;
- VAR p: Properties.Property; u: INTEGER;
- BEGIN
- Properties.CollectProp(p);
- WHILE (p # NIL) & ~(p IS Prop) DO p := p.next END;
- IF p # NIL THEN
- WITH p: Prop DO
- IF Dialog.metricSystem THEN u := Ports.mm DIV 10 ELSE u := Ports.inch DIV 100 END;
- dialog.valid := p.valid;
- dialog.readOnly := p.readOnly;
- IF ~p.horBar THEN dialog.horizontal.mode := 0
- ELSIF p.horHide THEN dialog.horizontal.mode := 1
- ELSE dialog.horizontal.mode := 2
- END;
- IF ~p.verBar THEN dialog.vertical.mode := 0
- ELSIF p.verHide THEN dialog.vertical.mode := 1
- ELSE dialog.vertical.mode := 2
- END;
- dialog.horizontal.size := p.width DIV u / 100;
- dialog.vertical.size := p.height DIV u / 100;
- dialog.horizontal.adapt := p.width = 0;
- dialog.vertical.adapt := p.height = 0;
- dialog.showBorder := p.showBorder;
- dialog.savePos := p.savePos
- END
- END
- END InitDialog;
-
- PROCEDURE Set*;
- VAR p: Prop; u: INTEGER;
- BEGIN
- IF Dialog.metricSystem THEN u := 10 * Ports.mm ELSE u := Ports.inch END;
- NEW(p); p.valid := dialog.valid;
- p.horBar := dialog.horizontal.mode # 0;
- p.verBar := dialog.vertical.mode # 0;
- p.horHide := dialog.horizontal.mode = 1;
- p.verHide := dialog.vertical.mode = 1;
- IF ~dialog.horizontal.adapt THEN p.width := SHORT(ENTIER(dialog.horizontal.size * u)) END;
- IF ~dialog.vertical.adapt THEN p.height := SHORT(ENTIER(dialog.vertical.size * u)) END;
- p.showBorder := dialog.showBorder;
- p.savePos := dialog.savePos;
- Properties.EmitProp(NIL, p)
- END Set;
-
- PROCEDURE DialogGuard* (VAR par: Dialog.Par);
- VAR p: Properties.Property;
- BEGIN
- Properties.CollectProp(p);
- WHILE (p # NIL) & ~(p IS Prop) DO p := p.next END;
- IF p = NIL THEN par.disabled := TRUE END
- END DialogGuard;
-
- PROCEDURE HorAdaptGuard* (VAR par: Dialog.Par);
- BEGIN
- IF width IN dialog.readOnly THEN par.readOnly := TRUE END
- END HorAdaptGuard;
-
- PROCEDURE VerAdaptGuard* (VAR par: Dialog.Par);
- BEGIN
- IF height IN dialog.readOnly THEN par.readOnly := TRUE END
- END VerAdaptGuard;
-
- PROCEDURE WidthGuard* (VAR par: Dialog.Par);
- BEGIN
- IF dialog.horizontal.adapt THEN par.disabled := TRUE
- ELSIF width IN dialog.readOnly THEN par.readOnly := TRUE
- END
- END WidthGuard;
-
- PROCEDURE HeightGuard* (VAR par: Dialog.Par);
- BEGIN
- IF dialog.vertical.adapt THEN par.disabled := TRUE
- ELSIF height IN dialog.readOnly THEN par.readOnly := TRUE
- END
- END HeightGuard;
-
-
- (* commands *)
-
- PROCEDURE AddScroller*;
- VAR poll: Controllers.PollOpsMsg; v: View; replace: Controllers.ReplaceViewMsg;
- BEGIN
- Controllers.PollOps(poll);
- IF (poll.singleton # NIL) & ~(poll.singleton IS View) THEN
- NEW(v); v.view := poll.singleton; Init(v, TRUE);
- replace.old := poll.singleton; replace.new := v;
- Controllers.Forward(replace)
- ELSE Dialog.Beep
- END
- END AddScroller;
-
- PROCEDURE RemoveScroller*;
- VAR poll: Controllers.PollOpsMsg; replace: Controllers.ReplaceViewMsg;
- BEGIN
- Controllers.PollOps(poll);
- IF (poll.singleton # NIL) & (poll.singleton IS View) THEN
- replace.old := poll.singleton;
- replace.new := Views.CopyOf(poll.singleton(View).view, Views.shallow);
- Controllers.Forward(replace)
- ELSE Dialog.Beep
- END
- END RemoveScroller;
-
-END StdScrollers.
diff --git a/new/Std/Mod/Stamps.txt b/new/Std/Mod/Stamps.txt
--- a/new/Std/Mod/Stamps.txt
+++ /dev/null
@@ -1,436 +0,0 @@
-MODULE StdStamps;
-
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Stamps.odc *)
- (* DO NOT EDIT *)
-
-(*
- StdStamps are used to keep track of document changes, in particular program texts.
- StdStamps carry a sequence number and a fingerprint of the document with them.
- Each time the document (and therefore its fingerprint) is changed and stored,
- the sequence number is incremented. (When determining the fingerprint of the
- document, whitespace is ignored, except in string literals.)
-
- Each StdStamp also keeps track of the history of most recent changes.
- For the last maxHistoryEntries sequence numbers, the date and time,
- and an optional one-line comment is stored. To avoid too many entries in the history
- while working on a module, the most recent history entry is overwritten upon the
- generation of a new sequence number if the current date is the same as the date in
- the history entry.
-
-*)
-
- IMPORT
- SYSTEM, (* SYSTEM.ROT only, for fingerprint calculation *)
- Strings, Dates, StdCmds,
- Ports, Models, Stores, Containers, Properties, Views, Controllers, Fonts,
- TextModels, TextSetters, TextMappers, TextViews, TextRulers;
-
- CONST
- setCommentKey = "#Std:Set Comment";
- maxHistoryEntries = 25;
- minVersion = 0; origStampVersion = 0; thisVersion = 2;
-
- TYPE
- History = ARRAY maxHistoryEntries OF RECORD
- fprint, snr: INTEGER; (* fingerprint, sequence number *)
- date: INTEGER; (* days since 1/1/1 *)
- time: INTEGER; (* min + 64 * hour *)
- comment: POINTER TO ARRAY OF CHAR; (* nil if no comment *)
- END;
-
- StdView = POINTER TO RECORD (Views.View)
- (*--snr: LONGINT;*)
- nentries: INTEGER; (* number of entries in history *)
- history: History; (* newest entry in history[0] *)
- cache: ARRAY 64 OF CHAR;
- END;
-
- SetCmtOp = POINTER TO RECORD (Stores.Operation)
- stamp: StdView;
- oldcomment: POINTER TO ARRAY OF CHAR;
- END;
-
- VAR
- comment*: RECORD
- s*: ARRAY 64 OF CHAR;
- END;
-
-
- PROCEDURE (op: SetCmtOp) Do;
- VAR temp: POINTER TO ARRAY OF CHAR;
- BEGIN
- temp := op.stamp.history[0].comment;
- op.stamp.history[0].comment := op.oldcomment;
- op.oldcomment := temp;
- END Do;
-
- PROCEDURE Format (v: StdView);
- VAR s: ARRAY 64 OF CHAR; d: Dates.Date; t: INTEGER;
- BEGIN
- t := v.history[0].time;
- Dates.DayToDate(v.history[0].date, d);
- Dates.DateToString(d, Dates.plainAbbreviated, s); v.cache := s$;
- Strings.IntToStringForm(v.history[0].snr, Strings.decimal, 4, "0", FALSE, s);
- v.cache := v.cache + " (" + s + ")"
- END Format;
-
-
- PROCEDURE FontContext (v: StdView): Fonts.Font;
- VAR c: Models.Context;
- BEGIN
- c := v.context;
- IF (c # NIL) & (c IS TextModels.Context) THEN
- RETURN c(TextModels.Context).Attr().font;
- ELSE
- RETURN Fonts.dir.Default()
- END;
- END FontContext;
-
- PROCEDURE CalcFP (t: TextModels.Model): INTEGER;
- CONST sglQuote = "'"; dblQuote = '"';
- VAR fp: INTEGER; rd: TextModels.Reader; ch, quoteChar: CHAR;
- BEGIN
- quoteChar := 0X; fp := 0;
- rd := t.NewReader(NIL); rd.ReadChar(ch);
- WHILE ~rd.eot DO
- IF ch = quoteChar THEN quoteChar := 0X;
- ELSIF (quoteChar = 0X) & ((ch = dblQuote) OR (ch = sglQuote)) THEN quoteChar := ch;
- END;
- IF (quoteChar = 0X) & (21X <= ch) & (ch # 8BX) & (ch # 8FX) & (ch # 0A0X) (* not in string literal *)
- OR (quoteChar # 0X) & (20X <= ch) (* within string literal *)
- THEN
- fp := SYSTEM.ROT(fp, 1) + 13 * ORD(ch);
- END;
- rd.ReadChar(ch);
- END;
- RETURN fp;
- END CalcFP;
-
- PROCEDURE Update (v: StdView; forcenew: BOOLEAN);
- VAR fp: INTEGER; i: INTEGER; ndays: INTEGER; d: Dates.Date; t: Dates.Time;
- BEGIN
- IF (v.context # NIL) & (v.context IS TextModels.Context) THEN
- fp := CalcFP(v.context(TextModels.Context).ThisModel());
- IF (fp # v.history[0].fprint) OR forcenew THEN
- Dates.GetDate(d); Dates.GetTime(t);
- ndays := Dates.Day(d);
- IF (ndays # v.history[0].date) OR forcenew THEN
- (* move down entries in history list *)
- i := maxHistoryEntries-1;
- WHILE i > 0 DO
- v.history[i] := v.history[i-1];
- DEC(i);
- END;
- v.history[0].comment := NIL;
- END;
- IF v.nentries < maxHistoryEntries THEN INC(v.nentries) END;
- INC(v.history[0].snr);
- v.history[0].fprint := fp;
- v.history[0].date := ndays;
- v.history[0].time := t.minute + t.hour*64;
- Format(v);
- Views.Update(v, Views.keepFrames);
- END;
- END;
- END Update;
-
- PROCEDURE (v: StdView) Externalize (VAR wr: Stores.Writer);
- VAR i, len: INTEGER;
- BEGIN
- Update(v, FALSE);
- v.Externalize^(wr);
- wr.WriteVersion(thisVersion);
- (*--wr.WriteLInt(v.snr);*)
- wr.WriteXInt(v.nentries);
- FOR i := 0 TO v.nentries-1 DO
- wr.WriteInt(v.history[i].fprint);
- wr.WriteInt(v.history[i].snr);
- wr.WriteInt(v.history[i].date);
- wr.WriteXInt(v.history[i].time);
- IF v.history[i].comment # NIL THEN
- len := LEN(v.history[i].comment$);
- wr.WriteXInt(len);
- wr.WriteXString(v.history[i].comment^);
- ELSE wr.WriteXInt(0);
- END
- END;
- END Externalize;
-
- PROCEDURE (v: StdView) Internalize (VAR rd: Stores.Reader);
- VAR version: INTEGER; format: BYTE; i, len: INTEGER;
- d: Dates.Date; t: Dates.Time;
- BEGIN
- v.Internalize^(rd);
- IF ~rd.cancelled THEN
- rd.ReadVersion(minVersion, thisVersion, version);
- IF ~rd.cancelled THEN
- IF version = origStampVersion THEN (* deal with old StdStamp format *)
- (* would like to calculate fingerprint, but hosting model not available at this time *)
- v.history[0].fprint := 0;
- v.history[0].snr := 1; v.nentries := 1;
- rd.ReadXInt(d.year); rd.ReadXInt(d.month); rd.ReadXInt(d.day);
- rd.ReadXInt(t.hour); rd.ReadXInt(t.minute); rd.ReadXInt(t.second);
- rd.ReadByte(format); (* format not used anymore *)
- v.history[0].date := Dates.Day(d);
- v.history[0].time := t.minute + t.hour*64;
- ELSE
- IF version = 1 THEN rd.ReadInt(v.history[0].snr) END; (* red text: to be removed soon *)
- rd.ReadXInt(v.nentries);
- FOR i := 0 TO v.nentries-1 DO
- rd.ReadInt(v.history[i].fprint);
- IF version > 1 THEN rd.ReadInt(v.history[i].snr)
- ELSIF (* (version = 1) & *) i > 0 THEN v.history[i].snr := v.history[i-1].snr - 1;
- END; (* red text: to be removed soon *)
- rd.ReadInt(v.history[i].date);
- rd.ReadXInt(v.history[i].time);
- rd.ReadXInt(len);
- IF len > 0 THEN
- NEW(v.history[i].comment, len + 1);
- rd.ReadXString(v.history[i].comment^);
- ELSE v.history[i].comment := NIL;
- END
- END;
- END;
- Format(v);
- END
- END
- END Internalize;
-
- PROCEDURE (v: StdView) CopyFromSimpleView (source: Views.View);
- VAR i: INTEGER;
- BEGIN
- (* v.CopyFrom^(source); *)
- WITH source: StdView DO
- (*--v.snr := source.snr;*)
- v.nentries := source.nentries;
- v.history := source.history;
- v.cache := source.cache;
- FOR i := 0 TO v.nentries - 1 DO
- IF source.history[i].comment # NIL THEN
- NEW(v.history[i].comment, LEN(source.history[i].comment$) + 1);
- v.history[i].comment^ := source.history[i].comment^$;
- END
- END
- END
- END CopyFromSimpleView;
-
- PROCEDURE (v: StdView) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- VAR a: TextModels.Attributes; color: Ports.Color; c: Models.Context; font: Fonts.Font;
- asc, dsc, fw: INTEGER;
- BEGIN
- c := v.context;
- IF (c # NIL) & (c IS TextModels.Context) THEN
- a := v.context(TextModels.Context).Attr();
- font := a.font;
- color := a.color;
- ELSE font := Fonts.dir.Default(); color := Ports.black;
- END;
- font.GetBounds(asc, dsc, fw);
- f.DrawLine(f.l, asc + f.dot, f.r, asc + f.dot, 1, Ports.grey25 );
- f.DrawString(0, asc, color, v.cache, font);
- END Restore;
-
- PROCEDURE SizePref (v: StdView; VAR p: Properties.SizePref);
- VAR font: Fonts.Font; asc, dsc, w: INTEGER; d: Dates.Date; s: ARRAY 64 OF CHAR;
- BEGIN
- font := FontContext(v);
- font.GetBounds(asc, dsc, w);
- d.day := 28; d.month := 1; d.year := 2222; p.w := 0;
- WHILE d.month <= 12 DO
- Dates.DateToString(d, Dates.plainAbbreviated, s);
- s := s + " (0000)";
- w := font.StringWidth(s);
- IF w > p.w THEN p.w := w END;
- INC(d.month)
- END;
- p.h := asc + dsc;
- END SizePref;
-
- PROCEDURE (v: StdView) HandlePropMsg (VAR msg: Properties.Message);
- VAR font: Fonts.Font; asc, w: INTEGER;
- BEGIN
- WITH msg: Properties.Preference DO
- WITH msg: Properties.SizePref DO
- SizePref(v, msg)
- | msg: Properties.ResizePref DO
- msg.fixed := TRUE
- | msg: Properties.FocusPref DO
- msg.hotFocus := TRUE
- | msg: TextSetters.Pref DO
- font := FontContext(v);
- font.GetBounds(asc, msg.dsc, w);
- ELSE
- END
- ELSE
- END
- END HandlePropMsg;
-
- PROCEDURE NewRuler (): TextRulers.Ruler;
- CONST mm = Ports.mm;
- VAR r: TextRulers.Ruler;
- BEGIN
- r := TextRulers.dir.New(NIL);
- TextRulers.SetRight(r, 140 * mm);
- TextRulers.AddTab(r, 15 * mm); TextRulers.AddTab(r, 35 * mm); TextRulers.AddTab(r, 75 * mm);
- RETURN r
- END NewRuler;
-
- PROCEDURE ShowHistory (v: StdView);
- VAR text: TextModels.Model; f: TextMappers.Formatter;
- i: INTEGER; d: Dates.Date; s: ARRAY 64 OF CHAR;
- tv: TextViews.View; attr: TextModels.Attributes;
- BEGIN
- text := TextModels.dir.New();
- f.ConnectTo(text);
- attr := f.rider.attr;
- f.rider.SetAttr(TextModels.NewStyle(attr, {Fonts.italic}));
- f.WriteString("seq nr."); f.WriteTab;
- f.WriteString("fingerprint"); f.WriteTab;
- f.WriteString("date and time"); f.WriteTab;
- f.WriteString("comment"); f.WriteLn;
- f.rider.SetAttr(attr); f.WriteLn;
- (*--n := v.snr;*)
- FOR i := 0 TO v.nentries-1 DO
- f.WriteIntForm(v.history[i].snr, 10, 4, "0", FALSE);
- (*--DEC(n);*)
- f.WriteTab;
- f.WriteIntForm(v.history[i].fprint, TextMappers.hexadecimal, 8, "0", FALSE);
- f.WriteTab;
- Dates.DayToDate(v.history[i].date, d);
- Dates.DateToString(d, Dates.plainAbbreviated, s);
- f.WriteString(s);
- f.WriteString(" ");
- f.WriteIntForm(v.history[i].time DIV 64, 10, 2, "0", FALSE);
- f.WriteString(":");
- f.WriteIntForm(v.history[i].time MOD 64, 10, 2, "0", FALSE);
- IF v.history[i].comment # NIL THEN
- f.WriteTab;
- f.WriteString( v.history[i].comment^);
- END;
- f.WriteLn;
- END;
- tv := TextViews.dir.New(text);
- tv.SetDefaults(NewRuler(), TextViews.dir.defAttr);
- tv.ThisController().SetOpts({Containers.noFocus, Containers.noCaret});
- Views.OpenAux(tv, "History");
- END ShowHistory;
-
- PROCEDURE Track (v: StdView; f: Views.Frame; x, y: INTEGER; buttons: SET);
- VAR c: Models.Context; w, h: INTEGER; isDown, in, in0: BOOLEAN; m: SET;
- BEGIN
- c := v.context; c.GetSize(w, h); in0 := FALSE; in := TRUE;
- REPEAT
- IF in # in0 THEN
- f.MarkRect(0, 0, w, h, Ports.fill, Ports.invert, Ports.show); in0 := in
- END;
- f.Input(x, y, m, isDown);
- in := (0 <= x) & (x < w) & (0 <= y) & (y < h)
- UNTIL ~isDown;
- IF in0 THEN
- f.MarkRect(0, 0, w, h, Ports.fill, Ports.invert, Ports.hide);
- IF Controllers.modify IN m THEN
- IF v.history[0].comment # NIL THEN comment.s := v.history[0].comment^$;
- ELSE comment.s := "";
- END;
- StdCmds.OpenToolDialog("Std/Rsrc/Stamps", "Comment");
- ELSE ShowHistory(v);
- END
- END
- END Track;
-
- PROCEDURE (v: StdView) HandleCtrlMsg (
- f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View);
- BEGIN
- WITH msg: Controllers.TrackMsg DO
- Track(v, f, msg.x, msg.y, msg.modifiers)
- | msg: Controllers.PollCursorMsg DO
- msg.cursor := Ports.refCursor
- ELSE
- END
- END HandleCtrlMsg;
-
-
- (* ------------ programming interface: ---------------------- *)
-
- PROCEDURE GetFirstInText* (t: TextModels.Model): Views.View;
- VAR r: TextModels.Reader; v: Views.View;
- BEGIN
- IF t # NIL THEN
- r := t.NewReader(NIL);
- REPEAT r.ReadView(v) UNTIL (v = NIL) OR (v IS StdView);
- RETURN v;
- ELSE RETURN NIL;
- END;
- END GetFirstInText;
-
- PROCEDURE IsStamp* (v: Views.View): BOOLEAN;
- BEGIN
- RETURN v IS StdView;
- END IsStamp;
-
- PROCEDURE GetInfo* (v: Views.View; VAR snr, historylen: INTEGER);
- BEGIN
- ASSERT(v IS StdView, 20);
- WITH v: StdView DO
- snr := v.history[0].snr; historylen := v.nentries;
- END
- END GetInfo;
-
- PROCEDURE GetData* (v: Views.View; entryno: INTEGER;
- VAR fprint: INTEGER; VAR date: Dates.Date; VAR time: Dates.Time);
- BEGIN
- ASSERT(v IS StdView, 20);
- WITH v: StdView DO
- IF entryno <= v.nentries THEN
- fprint := v.history[entryno].fprint;
- Dates.DayToDate(v.history[entryno].date, date);
- time.minute := v.history[entryno].time MOD 64;
- time.minute := v.history[entryno].time DIV 64;
- time.second := 0;
- END
- END
- END GetData;
-
- (** Insert new history entry with comment in v. *)
- PROCEDURE Stamp* (v: Views.View; comment: ARRAY OF CHAR);
- BEGIN
- ASSERT(v IS StdView, 20);
- WITH v: StdView DO
- Update(v, TRUE);
- NEW(v.history[0].comment, LEN(comment$) + 1);
- v.history[0].comment^ := comment$;
- END
- END Stamp;
-
- PROCEDURE New* (): Views.View;
- VAR v: StdView; d: Dates.Date; t: Dates.Time;
- BEGIN
- NEW(v); v.history[0].snr := 0; v.nentries := 0;
- v.history[0].fprint := 0;
- Dates.GetDate(d); Dates.GetTime(t);
- v.history[0].date := Dates.Day(d);
- v.history[0].time := t.minute + t.hour*64;
- Format(v);
- RETURN v;
- END New;
-
- PROCEDURE SetComment*;
- VAR v: Views.View; op: SetCmtOp;
- BEGIN
- v := GetFirstInText(TextViews.FocusText());
- IF v # NIL THEN
- WITH v: StdView DO
- NEW(op); op.stamp := v;
- NEW(op.oldcomment, LEN(comment.s$) + 1);
- op.oldcomment^ := comment.s$;
- Views.Do(v, setCommentKey, op);
- END
- END
- END SetComment;
-
- PROCEDURE Deposit*;
- BEGIN
- Views.Deposit(New())
- END Deposit;
-
-END StdStamps.
diff --git a/new/Std/Mod/ViewSizer.txt b/new/Std/Mod/ViewSizer.txt
+++ /dev/null
@@ -1,133 +0,0 @@
-MODULE StdViewSizer;
-
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/ViewSizer.odc *)
- (* DO NOT EDIT *)
-
- IMPORT Services, Ports, Dialog, Views, Containers, Properties;
-
- CONST width = 1; height = 2;
-
- VAR
- size*: RECORD
- typeName-: Dialog.String;
- w*, h*: REAL;
- proportional*, fixedW, fixedH: BOOLEAN;
- unit, scaleW, scaleH, lastChanged: INTEGER;
- unitText: ARRAY 6 OF CHAR;
- view: Views.View;
- container: Containers.Controller
- END;
-
- PROCEDURE ConnectDialog (v: Views.View; c: Containers.Controller);
- VAR pref: Properties.ResizePref;
- BEGIN
- IF (v # NIL) & (v.context # NIL) THEN
- IF Dialog.metricSystem THEN size.unit := Ports.mm * 10; size.unitText := "cm"
- ELSE size.unit := Ports.inch; size.unitText := "inch"
- END;
- size.view := v; size.container := c;
- Services.GetTypeName(v, size.typeName);
- v.context.GetSize(size.scaleW, size.scaleH);
- size.w := size.scaleW / size.unit; size.h := size.scaleH / size.unit;
- pref.fixed := FALSE;
- pref.horFitToPage := FALSE; pref.verFitToPage := FALSE;
- pref.horFitToWin := FALSE; pref.verFitToWin := FALSE;
- Views.HandlePropMsg(v, pref);
- size.fixedW := pref.fixed;
- size.fixedH := pref.fixed;
- size.proportional := FALSE
- ELSE
- size.view := NIL; size.container := c; size.typeName := ""
- END;
- Dialog.Update(size)
- END ConnectDialog;
-
- PROCEDURE SetViewSize*;
- BEGIN
- IF size.view # NIL THEN
- size.view.context.SetSize(SHORT(ENTIER(size.w * size.unit + 0.5)),
- SHORT(ENTIER(size.h * size.unit + 0.5)));
- IF size.container # NIL THEN size.container.SetSingleton(size.view) END;
- ConnectDialog(size.view, size.container)
- ELSE Dialog.Beep
- END
- END SetViewSize;
-
- PROCEDURE InitDialog*;
- VAR v: Views.View; c: Containers.Controller;
- BEGIN
- c := Containers.Focus();
- IF c # NIL THEN v := c.Singleton() ELSE v := NIL END;
- IF (v # size.view) OR (c # size.container) THEN ConnectDialog(v, c) END
- END InitDialog;
-
- PROCEDURE ResetDialog*;
- VAR proportional: BOOLEAN; v: Views.View;
- BEGIN
- proportional := size.proportional; v := size.view;
- size.view := NIL; InitDialog;
- IF proportional & (v = size.view) THEN size.proportional := TRUE; Dialog.Update(size) END
- END ResetDialog;
-
- PROCEDURE WidthGuard* (VAR par: Dialog.Par);
- BEGIN
- InitDialog;
- par.disabled := size.view = NIL;
- par.readOnly := size.fixedW
- END WidthGuard;
-
- PROCEDURE HeightGuard* (VAR par: Dialog.Par);
- BEGIN
- InitDialog;
- par.disabled := size.view = NIL;
- par.readOnly := size.fixedH
- END HeightGuard;
-
- PROCEDURE ProportionGuard* (VAR par: Dialog.Par);
- BEGIN
- par.disabled := (size.view = NIL) OR size.fixedW OR size.fixedH OR (size.scaleW = 0) OR (size.scaleH = 0)
- END ProportionGuard;
-
- PROCEDURE UnitGuard* (VAR par: Dialog.Par);
- BEGIN
- IF size.view # NIL THEN par.label := size.unitText$ ELSE par.label := "" END
- END UnitGuard;
-
- PROCEDURE AdjustDialogToPref (fixedW, fixedH: BOOLEAN);
- VAR w, h: INTEGER; w0, h0: REAL; pref: Properties.SizePref;
- BEGIN
- w := SHORT(ENTIER(size.w * size.unit + 0.5)); h := SHORT(ENTIER(size.h * size.unit + 0.5));
- IF size.proportional & (w > 0) & (h > 0) & (size.scaleW > 0) & (size.scaleH > 0) THEN
- Properties.ProportionalConstraint(size.scaleW, size.scaleH, fixedW, fixedH, w, h)
- END;
- pref.w := w; pref.h := h; pref.fixedW := fixedW; pref.fixedH := fixedH;
- Views.HandlePropMsg(size.view, pref);
- IF ~fixedW THEN w0 := pref.w / size.unit ELSE w0 := size.w END;
- IF ~fixedH THEN h0 := pref.h / size.unit ELSE h0 := size.h END;
- IF (w0 # size.w) OR (h0 # size.h) THEN size.w := w0; size.h := h0; Dialog.Update(size) END
- END AdjustDialogToPref;
-
- PROCEDURE WNotifier* (op, from, to: INTEGER);
- BEGIN
- IF size.w > 0 THEN AdjustDialogToPref(TRUE, FALSE); size.lastChanged := width
- ELSIF size.w # 0 THEN Dialog.Beep
- END
- END WNotifier;
-
- PROCEDURE HNotifier* (op, from, to: INTEGER);
- BEGIN
- IF size.h > 0 THEN AdjustDialogToPref(FALSE, TRUE); size.lastChanged := height
- ELSIF size.h # 0 THEN Dialog.Beep
- END
- END HNotifier;
-
- PROCEDURE ProportionNotifier* (op, from, to: INTEGER);
- BEGIN
- IF (op = Dialog.changed) & size.proportional THEN
- IF size.lastChanged = width THEN AdjustDialogToPref(TRUE, FALSE)
- ELSIF size.lastChanged = height THEN AdjustDialogToPref(FALSE, TRUE)
- END
- END
- END ProportionNotifier;
-
-END StdViewSizer.
diff --git a/new/build-gui b/new/build-gui
index c14316bcac153fd05dc7c4b8a6ddaefdbc64b503..aa1a4e0e85461631399db03fea0655f094a3724e 100755 (executable)
--- a/new/build-gui
+++ b/new/build-gui
TARGET=`uname -s`
# TARGET=Linux
+./clean
./switch-target ${TARGET} Interp
./build
./switch-target ${TARGET} GUI
-./run-BlackBox <<DATA
+./run-dev0 <<DATA
DevCompiler.CompileThis FormModels FormViews FormControllers FormCmds FormGen
DevCompiler.CompileThis Gtk2GLib Gtk2GObject Gtk2Keysyms Gtk2Pango Gtk2Gdk Gtk2Gtk Gtk2Util