home *** CD-ROM | disk | FTP | other *** search
/ Chip 2004 July / Chip_2004-07_cd1.bin / tema / aos / files / Oberon.exe / Oberon / Docu.exe / Docu / DocumentSkeleton.Mod (.txt) < prev    next >
Oberon Text  |  2000-02-29  |  5KB  |  139 lines
  1. Oberon10.Scn.Fnt
  2. Syntax10.Scn.Fnt
  3. Syntax10m.Scn.Fnt
  4. (* ETH Oberon, Copyright 2000 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
  5. Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)
  6. MODULE DocumentSkeleton; (** portable *)    (* jm 25.10.93 *)
  7. IMPORT Attributes, Desktops, Display, Documents, Files, Gadgets, Links, Oberon, Objects, Texts, ColorDriver;
  8. CONST Menu = "Desktops.StoreDoc[Store] DocumentSkeleton.Cycle[Cycle]";
  9. VAR W: Texts.Writer;
  10. PROCEDURE Cycle*;
  11.     VAR doc: Documents.Document; F: Gadgets.Frame; col: LONGINT;
  12. BEGIN
  13.     doc := Desktops.CurDoc(Gadgets.context);
  14.     IF (doc # NIL) & (doc.dsc IS Gadgets.Frame) THEN
  15.         F := doc.dsc(Gadgets.Frame);
  16.         Attributes.GetInt(F, "Color", col);
  17.         Attributes.SetInt(F, "Color", (col + 1) MOD 4);
  18.         Gadgets.Update(F)
  19. END Cycle;
  20. PROCEDURE NextColor (doc: Documents.Document; col: INTEGER);
  21.     VAR F: Gadgets.Frame;
  22. BEGIN
  23.     F := doc.dsc(Gadgets.Frame);
  24.     Attributes.SetInt(F, "Color", col);
  25.     Gadgets.Update(F)
  26. END NextColor;
  27. PROCEDURE Load (D: Documents.Document);
  28.     obj: Objects.Object;
  29.     tag, x, y, w, h, col: INTEGER;
  30.     name: ARRAY 64 OF CHAR; F: Files.File; R: Files.Rider; ch: CHAR;
  31.     CM: Gadgets.CmdMsg;
  32. BEGIN
  33.     obj := Gadgets.CreateObject("Panels.NewPanel");
  34.     WITH obj: Gadgets.Frame DO
  35.         x := 0; y := 0; w := 250; h := 200; col := 1; (* default *)
  36.         F := Files.Old(D.name);
  37.         IF F # NIL THEN
  38.             Files.Set(R, F, 0);
  39.             Files.ReadInt(R, tag);
  40.             IF tag = Documents.Id THEN
  41.                 Files.ReadString(R, name);
  42.                 Files.ReadInt(R, x); Files.ReadInt(R, y); Files.ReadInt(R, w); Files.ReadInt(R, h);
  43.                 Files.Read(R, ch);
  44.                 IF ch = 0F7X THEN (* attachments *)
  45.                     Documents.LoadAttachments(R, D.attr, D.link);
  46.                     IF D.link # NIL THEN
  47.                         CM.cmd := "PREPARE"; CM.res := -1; CM.dlink := D; Objects.Stamp(CM);
  48.                         Links.Broadcast(D.link, CM)
  49.                     END
  50.                 ELSE
  51.                     Files.Set(R, F, Files.Pos(R)-1)
  52.                 END;
  53.                 Files.ReadInt(R, col)
  54.             END
  55.         ELSE (* COPY("DefaultName", D.name) *)
  56.         END;
  57.         D.X := x; D.Y := y; D.W := w; D.H := h;
  58.         Attributes.SetInt(obj, "Color", col);
  59.         Documents.Init(D, obj)
  60. END Load;
  61. PROCEDURE Store (D: Documents.Document);
  62.     VAR obj: Gadgets.Frame; F: Files.File; R: Files.Rider; col: LONGINT;
  63. BEGIN
  64.     obj := D.dsc(Gadgets.Frame);
  65.     Texts.WriteString(W, "Store "); Texts.Append(Oberon.Log, W.buf);
  66.     IF D.name # "" THEN
  67.         F := Files.New(D.name);
  68.         IF F = NIL THEN HALT(99) END;
  69.         Files.Set(R, F, 0);
  70.         Files.WriteInt(R, Documents.Id); Files.WriteString(R, "DocumentSkeleton.NewDoc");
  71.         Files.WriteInt(R, D.X); Files.WriteInt(R, D.Y);
  72.         Files.WriteInt(R, D.W); Files.WriteInt(R, D.H);
  73.         IF (D.attr # NIL) OR (D.link # NIL) THEN (* attachments *)
  74.             Documents.StoreAttachments(R, D.attr, D.link)
  75.         END;
  76.         Attributes.GetInt(obj, "Color", col);
  77.         Files.WriteInt(R, SHORT(col));
  78.         Files.Register(F);
  79.         Texts.Write(W, 22X); Texts.WriteString(W, D.name); Texts.Write(W, 22X)
  80.     ELSE Texts.WriteString(W, "[Untitled document]")
  81.     END;
  82.     Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
  83. END Store;
  84. PROCEDURE Handler (D: Objects.Object; VAR M: Objects.ObjMsg);
  85. BEGIN
  86.     WITH D: Documents.Document DO
  87.         IF M IS Objects.AttrMsg THEN
  88.             WITH M: Objects.AttrMsg DO
  89.                 IF M.id = Objects.get THEN
  90.                     IF M.name = "Gen" THEN
  91.                         M.class := Objects.String; M.s := "DocumentSkeleton.NewDoc"; M.res := 0
  92.                     ELSIF M.name = "Adaptive" THEN
  93.                         M.class := Objects.Bool; M.b := FALSE; M.res := 0
  94.                     ELSIF M.name = "Icon" THEN
  95.                         M.class := Objects.String; M.s := "Icons.Tool"; M.res := 0
  96.                     ELSE Documents.Handler(D, M)
  97.                     END
  98.                 ELSE Documents.Handler(D, M)
  99.                 END
  100.             END
  101.         ELSIF M IS Objects.LinkMsg THEN
  102.             WITH M: Objects.LinkMsg DO
  103.                 IF (M.id = Objects.get) & (M.name = "DeskMenu") THEN
  104.                     M.obj := Gadgets.CopyPublicObject("TestMenus.DeskMenu", TRUE);
  105.                     IF M.obj = NIL THEN M.obj := Desktops.NewMenu(Menu) END;
  106.                     M.res := 0
  107.                 ELSIF (M.id = Objects.get) & (M.name = "SystemMenu") THEN
  108.                     M.obj := Gadgets.CopyPublicObject("TestMenus.DeskMenu", TRUE);
  109.                     IF M.obj = NIL THEN M.obj := Desktops.NewMenu(Menu) END;
  110.                     M.res := 0
  111.                 ELSIF (M.id = Objects.get) & (M.name = "UserMenu") THEN
  112.                     M.obj := Gadgets.CopyPublicObject("TestMenus.DeskMenu", TRUE);
  113.                     IF M.obj = NIL THEN M.obj := Desktops.NewMenu(Menu) END;
  114.                     M.res := 0
  115.                 ELSE Documents.Handler(D, M)
  116.                 END
  117.             END
  118.         ELSIF M IS ColorDriver.ColorMsg THEN
  119.             NextColor(D, M(ColorDriver.ColorMsg).col)
  120.         ELSIF M IS Display.DisplayMsg THEN
  121.             WITH M: Display.DisplayMsg DO
  122.                 IF (M.device = Display.printer) & (M.id = Display.contents) & (D.dsc # NIL) THEN
  123.                     (* print *)
  124.                 ELSE Documents.Handler(D, M)
  125.                 END
  126.             END
  127.         ELSE Documents.Handler(D, M)
  128.         END
  129. END Handler;
  130. PROCEDURE NewDoc*;
  131.     VAR D: Documents.Document;
  132. BEGIN
  133.     NEW(D); D.Load := Load; D.Store := Store; D.handle := Handler;
  134.     D.W := 250; D.H := 200; Objects.NewObj := D
  135. END NewDoc;
  136. BEGIN Texts.OpenWriter(W)
  137. END DocumentSkeleton.
  138. Desktops.OpenDoc (DocumentSkeleton.NewDoc)
  139.