(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *) MODULE Documents IN Oberon; (** portable *) (** jm 18.1.95 *) (**The Documents module forms the basis of the Gadgets document model. *) (* 6.4.94 - VERY SPECIAL DOCUMENT WITH DSC HAVING THE SAME COORDINATES AS THE DOCUMENT Old version can be found in DocumentsOld.Mod. This important change allows the contents of the document to experience its change in coordinates, so that it can optimize updates occordingly. This feature is especially used in TextGadgets0.ModifyFrame 6.4.94 - Introduced a default document type 2.5.94 - Added copy over on selection 2.5.94 - Added deep copy support 30.5.94 - added handling of Documents.This load errors 9.6.94 - default documents are open larger 7.11.94 - removed lib from standard types 3.1.95 - Documents.This renamed to Documents.Open - added check to ensure invariant from 6.4.94. I am not sure if this fix is correct or not, at least it allows text documents to flow inside a text - added "DocumentName" attribute 4.12.95 - fixed name overflow in TitleToFilename 15.12.95 - added historyHook 7.3.96 - removed TitleToFilename 30.12.96 - removed MapName *) IMPORT Texts, Objects, Display, Attributes, Links, Gadgets, Modules, Files, Display3, Effects, Oberon, Fonts, Strings, Out, Input (*fof*); CONST MaxDocTypes = 48; TYPE Document* = POINTER TO DocumentDesc; DocumentDesc* = RECORD (Gadgets.FrameDesc) name*: ARRAY 128 OF CHAR; (** Document name. *) Load*: PROCEDURE (D: Document); (** Load document contents from disk. *) Store*: PROCEDURE (D: Document); (** Store document contents to disk. *) time: LONGINT END; (** Find out what document is located at X, Y on the display. *) LocateMsg* = RECORD (Display.FrameMsg) doc*: Document; (** Result, NIL if no document found. *) X*, Y*: INTEGER; END; VAR Id*: INTEGER; (** 07F7H little-endian magic number/flag identifying document files. *) historyHook*: PROCEDURE (VAR D: Document); (** Called for each document opened. *) reg: INTEGER; DocExt: ARRAY MaxDocTypes, 32 OF CHAR; DocNewProc: ARRAY MaxDocTypes, 64 OF CHAR; DocService: ARRAY MaxDocTypes OF BOOLEAN; errMsg*: ARRAY 256 OF CHAR; (* ================ Loading/storing of Document Attachments ================= *) (* The attachment format is as follows: tag document-header F7X 08X Len4 Attributes Library Links Len4 is the length from after Len4 to the end of Links. *) PROCEDURE LoadAttachments*(VAR R: Files.Rider; VAR attr: Attributes.Attr; VAR link: Links.Link); VAR len: LONGINT; F: Files.File; ch: CHAR; lib: Objects.Library; BEGIN F := Files.Base(R); Files.Read(R, ch); ASSERT(ch = 08X); Files.ReadLInt(R, len); Attributes.LoadAttributes(R, attr); NEW(lib); Objects.OpenLibrary(lib); Files.Read(R, ch); ASSERT(ch = Objects.LibBlockId); Objects.LoadLibrary(lib, F, Files.Pos(R), len); Files.Set(R, F, Files.Pos(R) + len); Links.LoadLinks(R, lib, link) END LoadAttachments; PROCEDURE StoreAttachments*(VAR R: Files.Rider; attr: Attributes.Attr; link: Links.Link); VAR r: Files.Rider; F: Files.File; patch, len: LONGINT; lib: Objects.Library; M: Objects.BindMsg; BEGIN F := Files.Base(R); Files.Write(R, 0F7X); Files.Write(R, 08X); patch := Files.Pos(R); Files.WriteLInt(R, 0); (* patch *) Attributes.StoreAttributes(R, attr); NEW(lib); Objects.OpenLibrary(lib); M.lib := lib; Links.BindLinks(link, M); Objects.StoreLibrary(lib, F, Files.Pos(R), len); Files.Set(R, F, Files.Pos(R) + len); Links.StoreLinks(R, lib, link); len := Files.Pos(R) - patch - 4; Files.Set(r, F, patch); Files.WriteLInt(r, len); END StoreAttachments; (* How to skip attachments: PROCEDURE SkipAttachments(VAR R: Files.Rider); VAR F: Files.File; len: LONGINT; BEGIN F := Files.Base(R); Files.Read(R, ch); ASSERT(ch = 08X); Files.ReadLInt(R, len); Files.Set(R, F, Files.Pos(R) + len) END SkipAttachments; *) (* ================ Loading of Document types ================= *) PROCEDURE SplitName (VAR name, MName, PName: ARRAY OF CHAR); VAR i, j: INTEGER; BEGIN i := 0; WHILE name[i] # "." DO MName[i] := name[i]; INC(i) END; MName[i] := 0X; INC(i); j := 0; WHILE name[i] # 0X DO PName[j] := name[i]; INC(i); INC(j) END; PName[j] := 0X END SplitName; (* Try to load generic document *) PROCEDURE generic(name, newproc: ARRAY OF CHAR; VAR loaderror: BOOLEAN): Document; VAR D: Document; MName, PName: ARRAY 64 OF CHAR; Mod: Modules.Module; Cmd: Modules.Command; BEGIN SplitName(newproc, MName, PName); Mod := Modules.ThisMod(MName); IF Modules.res = 0 THEN Cmd := Modules.ThisCommand(Mod, PName); IF Modules.res = 0 THEN Objects.NewObj := NIL; Cmd; IF (Objects.NewObj # NIL) & (Objects.NewObj IS Document) THEN D := Objects.NewObj(Document); COPY(name, D.name); D.Load(D) ELSE loaderror := TRUE END ELSE loaderror := TRUE END ELSE loaderror := TRUE END; RETURN D END generic; PROCEDURE Generic(name: ARRAY OF CHAR; VAR loaderror: BOOLEAN): Document; VAR D: Document; newproc: ARRAY 64 OF CHAR; F: Files.File; R: Files.Rider; tag: INTEGER; BEGIN D := NIL; loaderror := FALSE; F := Files.Old(name); IF F # NIL THEN Files.Set(R, F, 0); Files.ReadInt(R, tag); IF (tag = Id) OR (tag = 0727H) THEN Files.ReadString(R, newproc); D := generic(name, newproc, loaderror) END END; RETURN D END Generic; PROCEDURE Cap(ch: CHAR): CHAR; BEGIN IF (ch >= "a") & (ch <= "z") THEN RETURN CAP(ch) ELSE RETURN ch END END Cap; (** Open the give document with name name. NIL is returned on failure. Unknown document types are opened as text documents. *) PROCEDURE Open*(name: ARRAY OF CHAR): Document; VAR i, j, colonpos, dotpos: INTEGER; ext: ARRAY 64 OF CHAR; D: Document; loaderror: BOOLEAN; BEGIN COPY(name, errMsg); Strings.AppendCh(errMsg, " "); D := Generic(name, loaderror); IF (D = NIL) & ~loaderror THEN (* not found *) i := 0; j := -1; colonpos := -1; WHILE name[i] # 0X DO (* find last period *) IF name[i] = "." THEN j := i ELSIF name[i] = ":" THEN IF colonpos = -1 THEN colonpos := i END; END; INC(i) END; dotpos := j; IF colonpos > 1 THEN (* jm *) i := 0; j := 0; WHILE i < colonpos DO IF name[i] > " " THEN ext[j] := Cap(name[i]); INC(j) END; INC(i) END; ext[j] := 0X; i := 0; WHILE (i # reg) & (~DocService[i] OR (DocExt[i] # ext)) DO INC(i) END; IF i = reg THEN (* unknown type *) colonpos := -1 (* ignore colon and try with extension *) END END; IF colonpos <= 1 THEN j := dotpos; IF (j >= 0) THEN i := 0; INC(j); WHILE (name[j] # 0X) & (i # 31) DO ext[i] := Cap(name[j]); INC(i); INC(j) END; (* copy extension *) ext[i] := 0X; i := 0; WHILE (i # reg) & (DocService[i] OR (DocExt[i] # ext)) DO INC(i) END ELSE i := reg (* no period *) END END; IF i = reg THEN (* nothing, use the default *) COPY("TextDocs.NewDoc", DocNewProc[i]) END; D := generic(name, DocNewProc[i], loaderror) END; Objects.NewObj := NIL; (* for GC *) IF (D # NIL) & (D.dsc # NIL) THEN IF historyHook # NIL THEN historyHook(D) END; RETURN D ELSE IF loaderror THEN Strings.Append(errMsg, Modules.resMsg) ELSE Strings.Append(errMsg, " loading document failed") END; RETURN NIL END END Open; PROCEDURE Register(ext, newproc: ARRAY OF CHAR; service: BOOLEAN); VAR i: INTEGER; BEGIN i := 0; WHILE ext[i] # 0X DO ext[i] := Cap(ext[i]); INC(i) END; i := 0; WHILE (i # reg) & ((ext # DocExt[i]) OR (service # DocService[i])) DO INC(i) END; IF i = reg THEN COPY(ext, DocExt[reg]); COPY(newproc, DocNewProc[reg]); DocService[reg] := service; INC(reg) ELSE COPY(newproc, DocNewProc[i]); END END Register; PROCEDURE RegisterStandardTypes(section: ARRAY OF CHAR; service: BOOLEAN); VAR S: Texts.Scanner; ext, newproc: ARRAY 32 OF CHAR; err: BOOLEAN; BEGIN Oberon.OpenScanner(S, section); IF S.class = Texts.Inval THEN Out.String("Oberon.Text - "); Out.String(section); Out.String(" not found"); Out.Ln ELSE err := FALSE; WHILE (S.class IN {Texts.Name, Texts.String}) & ~err DO COPY(S.s, ext); Texts.Scan(S); IF (S.class = Texts.Char) & (S.c = "=") THEN Texts.Scan(S); IF S.class IN {Texts.Name, Texts.String} THEN COPY(S.s, newproc); Texts.Scan(S); Register(ext, newproc, service) ELSE err := TRUE END ELSE err := TRUE END END; err := err OR (S.class # Texts.Char) OR (S.c # "}"); IF err THEN Out.String("Error in "); Out.String(section); Out.Ln END END END RegisterStandardTypes; (* ===================== default handler for document frames ================ *) PROCEDURE SetMask(F: Display.Frame; M: Display3.Mask); VAR O: Display3.OverlapMsg; BEGIN O.M := M; O.x := 0; O.y := 0; O.F := F; O.dlink := NIL; O.res := -1; F.handle(F, O); END SetMask; PROCEDURE SetMainMask(F: Document); VAR R: Display3.Mask; BEGIN IF F.dsc # NIL THEN IF F.mask = NIL THEN SetMask(F.dsc, NIL) ELSE Display3.Copy(F.mask, R); R.x := 0; R.y := 0; (* Display3.Intersect(R, F.dsc.X, F.dsc.Y, F.dsc.W, F.dsc.H); R.x := -F.dsc.X; R.y := -(F.dsc.Y + F.dsc.H - 1); Display3.Shift(R); *) SetMask(F.dsc, R) END END END SetMainMask; PROCEDURE ToMain(F: Document; ox, oy: INTEGER; VAR M: Display.FrameMsg); VAR Mdlink, Fdlink: Objects.Object; tx, ty: INTEGER; BEGIN IF F.dsc # NIL THEN tx := M.x; ty := M.y; M.x := ox; M.y := oy; Fdlink := F.dlink; Mdlink := M.dlink; F.dlink := M.dlink; M.dlink := F; F.dsc.handle(F.dsc, M); F.dlink := Fdlink; M.dlink := Mdlink; M.x := tx; M.y := ty END END ToMain; PROCEDURE Absolute(dlink: Objects.Object): BOOLEAN; VAR A: Objects.AttrMsg; BEGIN IF (dlink # NIL) & (dlink.handle # NIL) THEN (* NIL test because of Script *) A.id := Objects.get; A.name := "Absolute"; A.res := -1; dlink.handle(dlink, A); RETURN (A.res >= 0) & (A.class = Objects.Bool) & A.b ELSE RETURN FALSE END END Absolute; (* new *) PROCEDURE AdjustDocument(F: Document; VAR M: Display.ModifyMsg); VAR A: Display.ModifyMsg; old, x, y, w, h: INTEGER; R: Display3.Mask; BEGIN IF Absolute(M.dlink) (*TRUE (* 31 IN F.state *) *) THEN (* in viewer system, may optimize *) old := M.mode; M.mode := Display.state; Gadgets.framehandle(F, M); M.mode := old; IF F.dsc # NIL THEN (* Adjust main *) A.id := Display.extend; A.F := F.dsc; A.mode := M.mode; A.X := M.X; A.Y := M.Y; A.W := M.W; A.H := M.H; A.dX := M.dX; A.dY := M.dY; A.dW := M.dW; A.dH := M.dH; A.dlink := M.dlink; A.res := -1; Objects.Stamp(A); ToMain(F, M.x, M.y, A); IF (Gadgets.selected IN F.state) & (M.mode = Display.display) THEN x := M.x + F.X; y := M.y + F.Y; w := F.W; h := F.H; Gadgets.MakeMask(F, x, y, M.dlink, R); Display3.FillPattern(R, Display3.blue, Display3.selectpat, 0, 0, x, y, w, h, Display.paint); END; END ELSE (* unoptimized *) IF (F.dsc # NIL) & (M.stamp # F.stamp) THEN F.stamp := M.stamp; (* Adjust main *) A.id := Display.extend; A.F := F.dsc; A.mode := Display.state; A.X := M.X; A.Y := M.Y; A.W := M.W; A.H := M.H; A.dX := M.dX; A.dY := M.dY; A.dW := M.dW; A.dH := M.dH; A.dlink := M.dlink; A.res := -1; Objects.Stamp(A); ToMain(F, M.x, M.y, A) END; Gadgets.framehandle(F, M) END END AdjustDocument; (* -- docviewer main frame changed; have to adjust docviewer size *) PROCEDURE AdjustChildDocument(F: Document; VAR M: Display.ModifyMsg); VAR A: Display.ModifyMsg; BEGIN IF M.stamp # F.stamp THEN F.stamp := M.stamp; A.id := Display.extend; A.F := F; A.mode := Display.display; A.X := M.X; A.Y := M.Y; A.W := M.W; A.H := M.H; A.dX := M.dX; A.dY := M.dY; A.dW := M.dW; A.dH := M.dH; Display.Broadcast(A) END END AdjustChildDocument; PROCEDURE check(F: Document); BEGIN IF F.dsc # NIL THEN IF (F.X # F.dsc.X) OR (F.Y # F.dsc.Y) OR (F.W # F.dsc.W) OR (F.H # F.dsc.H) THEN F.dsc.X := F.X; F.dsc.Y := F.Y; F.dsc.W := F.W; F.dsc.H := F.H; END END END check; PROCEDURE RestoreDocument(F: Document; R: Display3.Mask; ox, oy, x, y, w, h: INTEGER; VAR M: Display.DisplayMsg); VAR D: Display.DisplayMsg; PROCEDURE ClipAgainst(VAR x, y, w, h: INTEGER; x1, y1, w1, h1: INTEGER); VAR r, t, r1, t1: INTEGER; BEGIN r := x + w - 1; r1 := x1 + w1 - 1; t := y + h - 1; t1 := y1 + h1 - 1; IF x < x1 THEN x := x1 END; IF y < y1 THEN y := y1 END; IF r > r1 THEN r := r1 END; IF t > t1 THEN t := t1 END; w := r - x + 1; h := t - y + 1; END ClipAgainst; BEGIN check(F); Oberon.RemoveMarks(x, y, w, h); IF M.id = Display.area THEN IF F.dsc # NIL THEN (* display main frame *) D.device := Display.screen; D.id := Display.area; D.F := F.dsc; D.u := M.u; D.v := M.v; D.w := M.w; D.h := M.h; ClipAgainst(D.u, D.v, D.w, D.h, 0, -F.dsc.H +1, F.dsc.W, F.dsc.H); D.dlink := M.dlink; D.res := -1; Objects.Stamp(D); ToMain(F, ox, oy, D); ELSE Display3.FilledRect3D(R, Display3.FG, Display3.FG, Display3.BG, x, y, w, h, 1, Display.replace); Display3.String(R, Display3.FG, x + 5, y + h - 20, Fonts.Default, "Document not found", Display.paint); END; ELSE IF F.dsc # NIL THEN D.device := Display.screen; D.id := Display.full; D.F := F.dsc; D.dlink := M.dlink; D.res := -1; Objects.Stamp(D); ToMain(F, ox, oy, D) ELSE Display3.FilledRect3D(R, Display3.FG, Display3.FG, Display3.BG, x, y, w, h, 1, Display.replace); Display3.String(R, Display3.FG, x + 5, y + h - 20, Fonts.Default, "Document not found", Display.paint); END; END; IF Gadgets.selected IN F.state THEN Display3.FillPattern(R, Display3.blue, Display3.selectpat, 0, 0, x, y, w, h, Display.paint); END END RestoreDocument; PROCEDURE Copy*(VAR M: Objects.CopyMsg; from, to: Document); VAR C: Objects.CopyMsg; BEGIN Gadgets.CopyFrame(M, from, to); IF from.dsc # NIL THEN C.id := M.id; Objects.Stamp(C); from.dsc.handle(from.dsc, C); to.dsc := C.obj(Gadgets.Frame) ELSE to.dsc := NIL END; to.Load := from.Load; to.Store := from.Store; COPY(from.name, to.name); END Copy; PROCEDURE DocumentAttr(F: Document; VAR M: Objects.AttrMsg); BEGIN IF M.id = Objects.get THEN IF M.name = "Gen" THEN HALT(99) ELSIF M.name = "DocumentName" THEN M.class := Objects.String; COPY(F.name, M.s); M.res := 0 ELSE Gadgets.framehandle(F, M) END ELSIF M.id = Objects.set THEN IF M.name = "DocumentName" THEN IF M.class = Objects.String THEN COPY(M.s, F.name); M.res := 0 END; ELSE Gadgets.framehandle(F, M) END ELSIF M.id = Objects.enum THEN M.Enum("DocumentName"); Gadgets.framehandle(F, M) END END DocumentAttr; PROCEDURE Neutralize(F: Document); VAR main: Gadgets.Frame; S: Display.SelectMsg; BEGIN IF F.dsc # NIL THEN main := F.dsc(Gadgets.Frame); IF Gadgets.selected IN main.state THEN S.F := main; S.res := -1; S.x := 0; S.y := 0; S.id := Display.reset; F.time := -1; ToMain(F, 0, 0, S); Gadgets.Update(main) END END END Neutralize; PROCEDURE HandleSelect(F: Document; VAR M: Oberon.InputMsg); VAR main: Gadgets.Frame; S: Display.SelectMsg; N: Oberon.ControlMsg; keysum: SET; C: Objects.CopyMsg; BEGIN IF F.dsc = NIL THEN RETURN END; main := F.dsc(Gadgets.Frame); S.F := main; S.res := -1; S.x := 0; S.y := 0; IF Gadgets.selected IN main.state THEN (* do nothing if already selected *) (* S.id := Display.reset; F.time := 0; *) ELSE N.id := Oberon.neutralize; N.F := NIL; N.res := -1; ToMain(F, 0, 0, N); S.id := Display.set; F.time := Oberon.Time(); ToMain(F, M.x, M.y, S); Gadgets.Update(main); keysum := M.keys; REPEAT Effects.TrackMouse(M.keys, M.X, M.Y, Effects.Arrow); keysum := keysum + M.keys UNTIL M.keys = {}; M.res := 0; IF keysum = {0, 2} THEN (* RL delete selection *) (* nothing *) ELSIF keysum = {0, 1} THEN (* RM copy to focus *) C.id := Objects.shallow; C.obj := NIL; Objects.Stamp(C); F.dsc.handle(F.dsc, C); IF C.obj # NIL THEN (* C.obj(Gadgets.Frame).state := C.obj(Gadgets.Frame).state - {Gadgets.noselect, Gadgets.nodelete, Gadgets.noresize, Gadgets.nomove}; *) Gadgets.Integrate(C.obj) END END END; END HandleSelect; PROCEDURE Handler*(F: Objects.Object; VAR M: Objects.ObjMsg); VAR x, y, w, h: INTEGER; F0: Document; R: Display3.Mask; N: Oberon.ControlMsg; tmp: SET; tM: Display.DisplayMsg; obj: Objects.Object; keys: SET; (*fof*) BEGIN WITH F: Document DO IF M IS Display.FrameMsg THEN WITH M: Display.FrameMsg DO IF (M.F = NIL) OR (M.F = F) THEN (* message addressed to this frame *) x := M.x + F.X; y := M.y + F.Y; w := F.W; h := F.H; (* calculate display coordinates *) IF M IS Display.DisplayMsg THEN WITH M: Display.DisplayMsg DO IF M.device = Display.screen THEN IF (M.id = Display.full) OR (M.F = NIL) THEN Gadgets.MakeMask(F, x, y, M.dlink, R); RestoreDocument(F, R, M.x, M.y, x, y, w, h, M) ELSIF M.id = Display.area THEN Gadgets.MakeMask(F, x, y, M.dlink, R); Display3.AdjustMask(R, x + M.u, y + h - 1 + M.v, M.w, M.h); RestoreDocument(F, R, M.x, M.y, x, y, w, h, M) END ELSIF M.device = Display.printer THEN ToMain(F, M.x, M.y, M) END END ELSIF M IS Oberon.InputMsg THEN WITH M: Oberon.InputMsg DO IF (M.id = Oberon.track) & ~(Gadgets.selected IN F.state) THEN Input.KeyState(keys); (* fof *) IF ~Gadgets.InActiveArea(F, M) THEN IF (M.keys = {0}) & (Input.SHIFT IN keys) THEN HandleSelect(F, M) ELSE Gadgets.framehandle(F, M) END ELSE ToMain(F, M.x, M.y, M); IF (M.res < 0) & (M.keys = {0}) & (Input.SHIFT IN keys) THEN HandleSelect(F, M) END; IF (M.res < 0) & ~Gadgets.InActiveArea(F, M) THEN Gadgets.framehandle(F, M) END END ELSIF ~(Gadgets.selected IN F.state) THEN ToMain(F, M.x, M.y, M) ELSE Gadgets.framehandle(F, M) END END ELSIF M IS Display.ModifyMsg THEN IF M.F = F THEN AdjustDocument(F, M(Display.ModifyMsg)); ELSE Gadgets.framehandle(F, M) END ELSIF M IS LocateMsg THEN WITH M: LocateMsg DO Gadgets.MakeMask(F, x, y, M.dlink, R); IF Effects.Inside(M.X, M.Y, x, y, w, h) & Display3.Visible(R, M.X, M.Y, 1, 1) THEN M.doc := F; ToMain(F, M.x, M.y, M) END END ELSIF M IS Display.LocateMsg THEN WITH M: Display.LocateMsg DO IF (M.loc = NIL) & Effects.Inside(M.X, M.Y, x, y, w, h) THEN ToMain(F, M.x, M.y, M); IF M.loc = NIL THEN M.loc := F; M.u := M.X - x; M.v := M.Y - (y + h - 1); M.res := 0 END; END END ELSIF M IS Display.SelectMsg THEN WITH M: Display.SelectMsg DO IF M.id = Display.set THEN Neutralize(F); N.id := Oberon.neutralize; N.F := NIL; N.res := -1; ToMain(F, M.x, M.y, N) ELSIF M.id = Display.reset THEN ELSIF M.id = Display.get THEN IF (((M.time-F.time) < 0) OR (M.time = -1)) & (Gadgets.selected IN F.dsc(Gadgets.Frame).state) THEN M.time := F.time; M.sel := F; M.obj := F.dsc END END; IF M.F # NIL THEN Gadgets.framehandle(F, M) ELSE ToMain(F, M.x, M.y, M) END END ELSIF M IS Oberon.ControlMsg THEN WITH M: Oberon.ControlMsg DO ToMain(F, M.x, M.y, M); IF M.id = Oberon.neutralize THEN Neutralize(F) END END ELSIF M IS Display3.UpdateMaskMsg THEN WITH M: Display3.UpdateMaskMsg DO NEW(F.mask); Display3.Open(F.mask); Display3.Add(F.mask, 0, -F.H+1, F.W, F.H); SetMainMask(F); M.res := 0; END ELSIF M IS Display3.OverlapMsg THEN WITH M: Display3.OverlapMsg DO F.mask := M.M; SetMainMask(F); END ELSIF M IS Display3.UpdateMaskMsg THEN WITH M: Display3.UpdateMaskMsg DO IF F.mask = NIL THEN Gadgets.MakeMask(F, x, y, M.dlink, R) END; SetMainMask(F) END ELSIF M IS Gadgets.UpdateMsg THEN WITH M: Gadgets.UpdateMsg DO IF M.obj = F.dsc THEN Gadgets.MakeMask(F, x, y, M.dlink, R); tM.device := Display.screen; tM.id := Display.full; tM.dlink := M.dlink; RestoreDocument(F, R, M.x, M.y, x, y, w, h, tM); IF Gadgets.lockedsize IN F.dsc(Gadgets.Frame).state THEN INCL(F.state, Gadgets.lockedsize) ELSE EXCL(F.state, Gadgets.lockedsize) END ELSE ToMain(F, M.x, M.y, M) END END ELSIF M.F # NIL THEN Gadgets.framehandle(F, M) ELSE ToMain(F, M.x, M.y, M) END ELSE (* not for this frame but perhaps for a child *) IF M IS Display3.UpdateMaskMsg THEN WITH M: Display3.UpdateMaskMsg DO IF M.F = F.dsc THEN IF F.mask = NIL THEN Gadgets.MakeMask(F, M.x + F.X, M.y + F.Y, M.dlink, R) END; SetMainMask(F) ELSE ToMain(F, M.x, M.y, M) END END ELSIF M IS Display.ConsumeMsg THEN WITH M: Display.ConsumeMsg DO IF FALSE & ~(30 IN F.state) & (M.obj IS Document) THEN (* prevent consumption *) ELSE ToMain(F, M.x, M.y, M) END END ELSIF M IS Display.ModifyMsg THEN IF M.F = F.dsc THEN AdjustChildDocument(F, M(Display.ModifyMsg)) ELSE ToMain(F, M.x, M.y, M) END ELSE ToMain(F, M.x, M.y, M) END END END (* Object messages *) ELSIF M IS Objects.AttrMsg THEN DocumentAttr(F, M(Objects.AttrMsg)) ELSIF M IS Objects.LinkMsg THEN WITH M: Objects.LinkMsg DO IF (M.id = Objects.get) & (M.name = "Model") THEN M.obj := F.dsc; M.res := 0 ELSE Gadgets.framehandle(F, M) END END ELSIF M IS Objects.FileMsg THEN WITH M: Objects.FileMsg DO IF M.id = Objects.store THEN (* store private data here *) IF F.lib.name = "" THEN (* private library *) Files.WriteInt(M.R, 1); Files.WriteString(M.R, F.name); Files.WriteSet(M.R, {}); Gadgets.framehandle(F, M) ELSE (* public library *) Files.WriteInt(M.R, 2); Files.WriteString(M.R, F.name); Gadgets.WriteRef(M.R, F.lib, F.dsc); Gadgets.framehandle(F, M) END ELSIF M.id = Objects.load THEN (* load private data here *) Files.ReadInt(M.R, x); IF x = 1 THEN (* private library *) Files.ReadString(M.R, F.name); Files.ReadSet(M.R, tmp); Gadgets.framehandle(F, M); F.Load(F) ELSIF x = 2 THEN (* public library *) Files.ReadString(M.R, F.name); Gadgets.ReadRef(M.R, F.lib, obj); Gadgets.framehandle(F, M); IF (obj # NIL) & (obj IS Gadgets.Frame) THEN F.dsc := obj(Display.Frame) ELSE F.Load(F) END; END END END ELSIF M IS Objects.BindMsg THEN WITH M: Objects.BindMsg DO Gadgets.framehandle(F, M); IF (M.lib.name # "") & (F.dsc # NIL) THEN (* public library, bind document contents *) F.dsc.handle(F.dsc, M); END; END ELSIF M IS Objects.CopyMsg THEN WITH M: Objects.CopyMsg DO IF M.stamp = F.stamp THEN M.obj := F.dlink (* copy msg arrives again *) ELSE (* first time copy message arrives *) NEW(F0); F.stamp := M.stamp; F.dlink := F0; Copy(M, F, F0); M.obj := F0 END END ELSIF M IS Objects.FindMsg THEN WITH M: Objects.FindMsg DO Gadgets.framehandle(F, M); IF (F.dsc # NIL) & (M.obj = NIL) THEN F.dsc.handle(F.dsc, M) END END ELSE (* unknown msg, framehandler might know it *) Gadgets.framehandle(F, M) END END END Handler; PROCEDURE New*; VAR F: Document; BEGIN NEW(F); F.handle := Handler; F.W := 250; F.H := 200; Objects.NewObj := F; END New; (** Initialize document D with main as contents. *) PROCEDURE Init*(D: Document; main: Gadgets.Frame); VAR f: Files.File; M: Display.ModifyMsg; BEGIN D.dsc := main; IF main # NIL THEN IF (main.lib # NIL) & (main.lib.name # "") THEN (* public object ! *) D.X := main.X; D.Y := main.Y; D.W := main.W; D.H := main.H ELSE M.X := D.X; M.Y := D.Y; M.W := D.W; M.H := D.H; M.x := 0; M.y := 0; M.dX := M.X - main.X; M.dY := M.Y - main.Y; M.dW := M.W - main.W; M.dH := M.H - main.H; M.F := main; M.id := Display.extend; M.mode := Display.state; M.res := -1; Objects.Stamp(M); main.handle(main, M); main.X := D.X; main.Y := D.Y; main.W := D.W; main.H := D.H END; INCL(D.state, Gadgets.lockedcontents); IF Gadgets.lockedsize IN main.state THEN INCL(D.state, Gadgets.lockedsize) END END; f := Files.Old(D.name); IF f # NIL THEN Files.GetName(f, D.name) END END Init; (** Returns the marked document (with F1). NIL is returned when no document is marked. The visibility of the Oberon pointer is ignored. *) PROCEDURE MarkedDoc*(): Document; VAR M: LocateMsg; V: Display.Frame; BEGIN IF TRUE (* Oberon.Pointer.on *) THEN M.X := Oberon.Pointer.X; M.Y := Oberon.Pointer.Y; M.F := NIL; M.doc := NIL; V := Oberon.MarkedViewer(); IF V # NIL THEN M.res := -1; M.x := 0; M.y := 0; V.handle(V, M) ELSE Display.Broadcast(M) END; RETURN M.doc ELSE RETURN NIL END END MarkedDoc; PROCEDURE InitM; BEGIN reg := 0; Register("Text", "TextDocs.NewDoc", FALSE); Register("Tool", "TextDocs.NewDoc", FALSE); Register("Mod", "TextDocs.NewDoc", FALSE); Register("Panel", "PanelDocs.NewDoc", FALSE); Register("Pict", "RembrandtDocs.NewDoc", FALSE); RegisterStandardTypes("Gadgets.Documents", FALSE); RegisterStandardTypes("Gadgets.DocumentServices", TRUE) END InitM; BEGIN Id := 07F7H; InitM END Documents. (** Remarks: 1. Documents Documents are nothing more than collections of objects, saved together in the same file. Such object collections require additional functionality that are not provided by the objects in the collection themselves. This additional functionality are provided by the document gadgets. Document gadgets act as a wrapper for a object/gadget collection, giving it a filename, icon, menu bar and printing capability. They are a type of container having a single child called the document main frame. The main frame of a document gadget is remembered in the dsc field of a document. The document gadget has exactly the same size as its main frame. The Documents.Init procedure "merges" the document with its main frame. Each document class has a generator procedure. Just as the generator procedures of other gadgets, calling the generator of a document creates an "empty" instance of that document class. By filling in the name record field of a document, and calling its Load method, the document will "fill" its contents from the file with that name. Correspondingly, calling the Store method stores the document under that name to disk. 2. Document Format All documents are provided with a standard header on disk so that they can be recreated or opened when just the filename is known. The header has the following format: Tag DocumentGeneratorProcedure X Y W H. Tag = 0F7X 07X. DocumentGeneratorProcedure = {alpha} 0X. (* Generator name *) X, Y, W, H = INTEGER. (* Prefered document position and size. *) The document header is followed by the byte stream content of the document. DocumentGeneratorProcedure is called by Documents.Open to create an empty instance of the document gadget, which is then filled by a call to the Load method (as described above). To provide compatibility with the non-Oberon world that does not use such an identification header, an internal table of the Documents module pairs file extensions with document generator procedures. Should no document header be present, the file extension is used to file the (hopefully) correct document generator. The Load method of this document must then load the headerless file. It is allowed (but not recommended) to store a document without a header, should the extension table be set up correctly. The extension table can be extended by adding an entry to the Documents section of the Oberon registry. Eeach entry is a "Extension=Generator" pair. 3. Menus Each document requires a menu bar with commands associated with the document type when opened with Desktops.OpenDoc. This menubar is gathered from the links "SystemMenu", "UserMenu" and "DeskMenu" provided by the document when the Desktops.OpenDoc command is executed. The menu can be constructed with the procedure Desktops.NewMenu or can be taken from a public library. The string given as parameter to procedure NewMenu must contain a sequence of Oberon commands. By immediately following a menu command with a word in square brackets, that word will be used as the menu bar button caption. A typical menu string might look as follows: "MyDoc.Search[Search] MyDoc.Save[Store]" Note that the Desktops module automatically adds additional buttons like [Close], [Grow], [Min] and [Copy]. For more flexibility, documents may also defined their own menu bars by "exporting" them as public objects from a public library. The public library should contain three menubars for the Desktop, System track and User track respectively. These menus should have the names "DeskMenu", "SystemMenu" and "UserMenu" respectively. For example, the text documents have such a library (called "TextDocs.Lib"). When the library is missing the default menubars are used. Programmers must add support for this feature in their Document handlers. The desktop uses the LinkMsg to request the document to return its menu bar. You should always return a DEEP COPY of the menu-bar from the library. Best is to lock the menubars and to set the Border of the Panel to 0. Note that the menu bar can have any height and content. For example (copied from PanelDocs.Mod): IF M IS Objects.LinkMsg THEN WITH M: Objects.LinkMsg DO IF (M.id = Objects.get) & (M.name = "DeskMenu") THEN M.obj := Gadgets.CopyPublicObject("PanelDocs.DeskMenu", TRUE); IF M.obj = NIL THEN M.obj := Desktops.NewMenu(Menu) END; M.res := 0 ELSIF (M.id = Objects.get) & (M.name = "SystemMenu") THEN M.obj := Gadgets.CopyPublicObject("PanelDocs.SystemMenu", TRUE); IF M.obj = NIL THEN M.obj := Desktops.NewMenu(Menu) END; M.res := 0 ELSIF (M.id = Objects.get) & (M.name = "UserMenu") THEN M.obj := Gadgets.CopyPublicObject("PanelDocs.UserMenu", TRUE); IF M.obj = NIL THEN M.obj := Desktops.NewMenu(Menu) END; M.res := 0 ELSE Documents.Handler(D, M) END END ELSE ... 4. Icon A document can indicate through its "Icon" attribute what public object should be regarded as its pictorial icon representation. The document should return a string attribute in the form "L.O", where L identifies the public library, and O the object in that library. The gadget identified this way is then packed by the desktop inside an icon gadget when Desktops.MakeIcon is executed. 5. Load failure A document can indicate a failure to load by setting D.dsc to NIL before returning from the Load method. 6. Example Code Examples of how documents are programmed can be found in the files DocumentSkeleton.Mod, OpenDemo.Mod and OpenDemo2.Mod. 7. Uniform Resource Locator (URL) notation URL are unique references to documents located on the network. An URL is identified as a protocol specifier followed by a document location and name: "protocol://location/name" Typical protocols are http, mailto, ftp and so forth. The Documents module handles documents with URL-like names in a special way. Should the Open procedure be requested to open a document name with a protocol name followed by a ":", the protocol name is looked up in extension table instead of the filename extension. That is, protocols have precedence over filename extensions. *)