XSyntax10.Scn.FntSyntax10i.Scn.FntIStampElemsAlloc17 Dec 985qBalloonElemsAllocSyntax10.Scn.Fnt Syntax10i.Scn.Fnt  @'(,('(+ %*S      d/#- 1A !J  H$*Y(    23     g g/j;       ] ) : ' ] , Z J  be- I";& ^ "% "~ v  G DY` KeplerElemsAllocKeplerGraphsGraphDescKeplerGraphsStarDesc}|}||{}}}||}|}}Kepler1RectangleDescKeplerFramesCaptionDescfSyntax10.Scn.FntsubSyntax10.Scn.Fntnew subSyntax10.Scn.FntKepler1AttrDesc   TX ( -  .  )T 0V ) &$""*r jG,e" &  V    !O + 7      #( 8 i;   "%"get" see AttrMsg "set" see AttrMsg "enum" see AttrMsg "enumProps" see AttrMsg "delete" see AttrMsg "String" typeindicator of attribute see AttrMsg "Int" typeindicator of attribute see AttrMsg "Real" typeindicator of attribute see AttrMsg "LongReal" typeindicator of attribute see AttrMsg "Bool" typeindicator of attribute see AttrMsg "Set" typeindicator of attribute see AttrMsg "Text" typeindicator of attribute see AttrMsg "NoClass" typeindicator of attribute see AttrMsg "foreign" the indicator for a macro, referencing a foreign attribute "own" the indicator for a macro, referencing an own attribute "special" a special attribute-name to get special settings from an elem. "back" state of an elem to indicate that it should always stay in background. Only interesting and used inside panels "overlap" state of an elem to indicate that this elem implements its own overlap handling "invisible" not yet used "EnumNames" EnumNames = PROCEDURE (name : ARRAY OF CHAR; class : INTEGER); is used for the type of AttrMsg property enum "Elem" Elem = POINTER TO Elems.ElemDesc Base class of the extended Textelements. locked indicates if an elem is resizeable. For some elements further behavior depends on locked. "ElemDesc" ElemDesc = RECORD (Texts.ElemDesc) locked : BOOLEAN; END "AttrMsg" AttrMsg = RECORD(Texts.ElemMsg) id : INTEGER; (* get, set, enum, enumProps *) hasProps : BOOLEAN; enum : EnumNames; name : ARRAY 64 OF CHAR; class : INTEGER; s : ARRAY 256 OF CHAR; set : SET; b : BOOLEAN; i : LONGINT; r : REAL; lr : LONGREAL; t : Texts.Text; END The receiving element has to do some actions on his attributes, depending of the id. If id = get the elem has to set class to the datatype of the attribute indicated by name and set the corresponding field (s, set, b, i, r, lr, t). If id = set the elem has to set his attribute with name name. If id = enum then the procedure enum has to be called for every public attribute. If id = enumProps then the procedure enum has to be called for every property of the attribute with name name (see StaticTextElems). If id = delete the dynamic attribute with name name will be deleted. See the Elems.Text for examples how to use this message. "GetContextMsg" GetContextMsg = RECORD (Display.FrameMsg) fx, fy : INTEGER; p : Texts.Elem; context : Display.Frame END Is used to find the frame which displayes the elem p and who's coordinates are equal to fx, fy. This message is forced by the procedure ToFrame. Elems which also have frames and want their frame to handle the input have to call the ToFrame procedure. Their frame has to know the GetContextMsg. "TabStopMsg" TabStopMsg = RECORD (Texts.ElemMsg) accepted : BOOLEAN; END; The receiving element has to set accepted = TRUE if it wants to get the cursor. "ExecMsg" ExecMsg = RECORD (Texts.ElemMsg) e : Elem; x, y : INTEGER; unload : BOOLEAN; f : Display.Frame; END Every elem sends this message to himself if the execution action took place. The Elems.Handler handles this message in the correct way. Just handle it for your self if you want a special behavior. e indicates the elem which invoked the message. x, y represent the mouse position. unload inidicates if a module unload must be forced (in most cases MM-ML). f is the frame in which the elem was tracked. "OverlapMsg" OverlapMsg = RECORD (Texts.ElemMsg) x, y, w, h : INTEGER; ex, ey, ew, eh : INTEGER; overlaps : BOOLEAN; END The receiving elem has to check if it overlaps the area with the coordinates x, y, w, h. This message is only sent if the elems state is set to overlap (see special and overlap). It's useful for elems who have a special bounding (e.g: FrameElems). If the area is overlapped overlaps has to be set TRUE. "CmdContext" VAR CmdContext : Texts.Text The text in which the elem is placed which invoked the last command-execution. CmdContext is only set if the elem is an extension of Elems.ElemDesc, in the other case CmdContext is undefined. "CmdFrame" VAR CmdFrame : Display.Frame The frame in which the last invokation of a command took place. See also CmdContext "CmdElem" VAR CmdElem : Elems.Elem The elem which invoked the last command-execution. See also CmdContext "clp" VAR clp : SHORTINT The size of the sensitiv corner/border of an elem to be resized or moved. "Done" VAR Done : BOOLEAN indicates the success of the last request for an attribute using the AttrMsg. "CopyText" CopyText (T: Texts.Text): Texts.Text; returns a copy of T. "DoCall" DoCall (cmd : ARRAY OF CHAR; v : Viewers.Viewer; f : Display.Frame; partext : Texts.Text; pos : LONGINT; free : BOOLEAN); Executes the OberonCommand cmd and sets the Oberon.Par to v, f, partext, pos. If free = TRUE the module containing cmd is unloaded before execution. If v, f or partext are NIL they are set to default values. With some commands v, f and partext must be set correctly. "CreateElem" CreateElem (creator : ARRAY OF CHAR) : Elem; creates and returns an elem which is created with the Oberoncommand creator. "ToFrame" ToFrame (e : Texts.Elem; msg : TextFrames.TrackMsg); converts msg into a Oberon.InputMsg and sends it to the frame containing e. "Focusing" Focusing (msg : TextFrames.FocusMsg); Sends an Oberon.InputMsg to the coresponding frame. Is used to activate a elems frame and set the cursor in one step (see TextFieldElems). "TabStop" TabStop (e : Elem; f : Display.Frame); If an elem wants to give up the tabstop it has to call this procedure (e.g.: tab pressed inside a TextFieldElems.Elem). Sends a TabStopMsg to all following elems until one wants the tabstop. "AdjustSubFrame" AdjustSubFrame (f, sub : Display.Frame); truncates sub to fit in f. Used for simple clipping.  "GetLook" GetLook (e : Texts.Elem; VAR fnt : Fonts.Font; VAR col : SHORTINT); sets fnt and col to the elem's font and color. e must be placed in a text. "WriteAttr" WriteAttr (VAR W : Texts.Writer; attr : AttrMsg); Writes the value of the message attr to the writer W. "InCorner" InCorner (mX, mY, x, y, w : INTEGER; e : Texts.Elem) : BOOLEAN; Returns if the mouse (mX, mY) hits the elem e placed at x, y with width w inside his bottomright corner. "SetContext" SetContext (x, y : INTEGER; f : Display.Frame); Sets Elems.CmdFrame to f and sets other information depending on x, y. An elem which handles the ExecMsg himself has to call this procedure before invoking an Oberon-Command. "SetString" SetString (e : Texts.Elem; name, s : ARRAY OF CHAR); Sets the attribute with name name of e to the given value of s. If e doesn't have an attribute called name, a dynamic attribute is created. "SetBoolean" SetBoolean (e : Texts.Elem; name : ARRAY OF CHAR; b : BOOLEAN); see SetString "SetInteger" SetInteger (e : Texts.Elem; name : ARRAY OF CHAR; i : LONGINT); see SetString "SetReal" SetReal (e : Texts.Elem; name : ARRAY OF CHAR; r : REAL); see SetString "SetLReal" SetLReal (e : Texts.Elem; name : ARRAY OF CHAR; lr : REAL); see SetString "SetSet" SetSet (e : Texts.Elem; name : ARRAY OF CHAR; s : SET); see SetString "SetText" SetText (e : Texts.Elem; name : ARRAY OF CHAR; t : Texts.Text); see SetString Notice that t is pointer and only the pointer is set. So the caller has to copy the text he wants to assign a copy. "SetFont" SetFont (e : Texts.Elem; name : ARRAY OF CHAR; sel : SET; f : Fonts.Font; col, voff : SHORTINT); see SetString SetFont behaves like Texts.ChangeLooks. Only succeeds if the attribute called name is a text. "GetClass" GetClass (e : Texts.Elem; name : ARRAY OF CHAR) : INTEGER; Returns the class of the attribute called name. The return value is one of the following: Elems.Int, Elems.String, Elems.Real, Elems.LongReal, Elems.Bool, Elems.Set, Elems.Text. Elems.NoClass indicates that elem e doesn't have an attribute called name. "GetString" GetString (e : Texts.Elem; name : ARRAY OF CHAR; VAR s : ARRAY OF CHAR); Set s to the value of the attribute called name of the elem e. Elems.Done indicates the success. "GetInteger" see GetString "GetReal" see GetString "GetLReal" see GetString "GetSet" see GetString "GetText" see GetString t points to the elems text. So the caller has to make a copy if necessary. "CopyElem" CopyElem (src, dest : Elem); Copies the fields of src into dest. "NamedElem" NamedElem (name : ARRAY OF CHAR; context : Texts.Text) : Elem; returns the first elem with name name in the given context. If no elem is found then NIL is returned. "UpdateElem" UpdateElem (e : Texts.Elem); invokes displaying of elem e. "Track" Track (e : Texts.Elem; VAR msg : Texts.ElemMsg; VAR done : BOOLEAN); If e is hit inside his bottomright corner it is resized an done is set TRUE. msg must be a regular TextFrames.TrackMsg. "Init" Init (e : Elem); Initializes e. Every inheritage of Elems.Elem has to call it. "GetPar" GetPar (e : Elem; VAR s : Texts.Scanner); Reads the parameters and sets the standard fields of e. Inherited elems may read their specific fields afterwards. Must be used within the insert command of every inheritage of Elems.Elem. "Extract" Extract (e : Elem; macro : ARRAY OF CHAR; VAR dest : Texts.Text); Extracts the macro macro and writes the result into dest. For references to foreign attributes Elems.CmdContext is used. "Call" Call (e : Elem; unload : BOOLEAN); Calls the command defined in the attribute Cmd of elem e. unload indicates whether the module containing the command has to be unloaded. Macros are supported. "Handle" Handle (e: Texts.Elem; VAR msg: Texts.ElemMsg) is the default handler for Elems based on Elems.Elem. Basically reacts to Elems.AttrMsg, Texts.FileMsg Elems.ExecMsg, TextFrames.TrackMsg. ApVersionElemsAllocBeg#Syntax10.Scn.FntWindows PowerMac LinuxWindowsWindows PowerMac$Syntax10i.Scn.Fnt(* PowerMac *)Linux$Syntax10i.Scn.Fnt (* Linux *) pVersionElemsAllocEndn8FoldElemsNewSyntax10b.Scn.Fnt  #    */ "      p#Syntax10.Scn.FntWindows PowerMac LinuxWindowsWindows PowerMacSyntax10.Scn.FntSyntax10i.Scn.FntSyntax10b.Scn.Fnt   M (* POWERMAC *) LF* = 0A4X; BACKSPC* = 008X; HOME* = 091X; EOL* = 093X; LinuxSyntax10i.Scn.Fnt Syntax10.Scn.FntSyntax10b.Scn.Fnt   E(* Linux *) LF* = CR; BACKSPC* = 0A1X; HOME* = 0C8X; EOL* = 0C7X;    p88$8#Syntax10.Scn.Fnt dynamic attributes 868#8/88.8!8,8#828%8-8#8.8%8688 68 ,88    88#Syntax10.Scn.Fnt used in toframe 8 8( 8 8 88 8 8: 88R888   ) H A58 MarkElemsAllocr 88 P$'8h8 [f %8D8 BIm.88 BIm 8j8 $Ls88 w $88 h,8#Syntax10.Scn.Fnt!! send InputMsg to the elems frame8 M 8Q8 18G|8 v8#Syntax10.Scn.Fnt truncates sub to fit in f i8 2O !8^8 E<88 N  (88  78U8 k %8G8 p +8y8 r 58u8 ! 58t8  "28r8  " 78y8 P$18r8  "88r8  "Y$8:8 T 288 p ?8f8 r 98d8 ! 98d8  "68a8  " ;8d8 P$58b8  "<8a8-88?8 ]38e8 88B838988V88 o888>8888 )0-8#8 f.88   8q8 ԃ  588 M 88 ˕s"8M888 @?8T8 {,8+8T88 88#8888 S 818 N#8#Syntax10.Scn.Fnt## scan parameters of insert command 8  WO8 P88`8 Yy.88 P@:8Q-hd8 4868 K+8aL81gMODULE Elems; (* CE  *)  (* Windows *) IMPORT Texts, Out, TextFrames, Viewers, Oberon, Display, Input, GU := GUtils, Files, Fonts, Strings; CONST  get* = 1; set* = 2; enum* = 3; enumProps* = 4; delete* = 5; String* = 2; Int* = 3; Real* = 4; LongReal* = 5; Bool* = 7; Set* = 8; Text* = 9; NoClass* = -1; DUnit = TextFrames.Unit; (** makro chars *) foreign* = "%"; own* = "#"; modifier* = "\"; special* = "!#cstate"; back* = 2; (* always in background e.g. FrameElems *) overlap* = 3; (* has its own overlap check e.g. FrameElems *) invisible* = 4; (** set string id *) name* = 0; cmd* = 1; par* = 2; MR = 0; MM = 1; ML = 2; TAB* = 9X; CR* = 0DX; CRSL* = 0C4X; CRSR* = 0C3X; CRSU* = 0C1X; CRSD* = 0C2X; DEL* = 7FX;  (* WINDOWS *) LF* = CR; BACKSPC* = 0A1X; HOME* = 0C8X; EOL* = 0C7X;   TYPE  Str = POINTER TO ARRAY OF CHAR;  Attr = POINTER TO AttrDesc; AttrDesc = RECORD name : Str; next : Attr; END; BoolAttr = POINTER TO BoolDesc; BoolDesc = RECORD (AttrDesc) b : BOOLEAN END; IntAttr = POINTER TO IntDesc; IntDesc = RECORD (AttrDesc) i : LONGINT END; RealAttr = POINTER TO RealDesc; RealDesc = RECORD (AttrDesc) r : REAL END; LRealAttr = POINTER TO LRealDesc; LRealDesc = RECORD (AttrDesc) lr : LONGREAL END; StringAttr = POINTER TO StringDesc; StringDesc = RECORD (AttrDesc) s : Str END; SetAttr = POINTER TO SetAttrDesc; SetAttrDesc = RECORD (AttrDesc) s : SET END; TextAttr = POINTER TO TextAttrDesc; TextAttrDesc = RECORD (AttrDesc) t : Texts.Text END;  EnumNames* = PROCEDURE (name : ARRAY OF CHAR; class : INTEGER); (* Enum AttrMsg *) Elem* = POINTER TO ElemDesc; ElemDesc* = RECORD (Texts.ElemDesc) attr : Attr; locked* : BOOLEAN; END; AttrMsg* = RECORD(Texts.ElemMsg) id* : INTEGER; (* get, set, enum, enumProps *) hasProps* : BOOLEAN; enum* : EnumNames; name* : ARRAY 64 OF CHAR; class* : INTEGER; s* : ARRAY 256 OF CHAR; set* : SET; b* : BOOLEAN; i* : LONGINT; r* : REAL; lr* : LONGREAL; t* : Texts.Text; END; GetContextMsg* = RECORD (Display.FrameMsg) fx*, fy* : INTEGER; p* : Texts.Elem; context* : Display.Frame; (* return value *) END; GetFrameMsg* = RECORD (Display.FrameMsg) (* for locating next frame at tabstop *) f* : Display.Frame; (* result *) e* : Texts.Elem; END; TabStopMsg* = RECORD (Texts.ElemMsg) accepted* : BOOLEAN; END; ExecMsg* = RECORD (Texts.ElemMsg) e* : Elem; x*, y* : INTEGER; unload* : BOOLEAN; f* : Display.Frame; context* : Texts.Text; END; OverlapMsg* = RECORD (Texts.ElemMsg) (* for elems which have special overlap e.g. FrameElems *) x*, y*, w*, h* : INTEGER; ex*, ey*, ew*, eh* : INTEGER; overlaps* : BOOLEAN; END; Task = POINTER TO TaskDesc; (* realizes the leftclick *) TaskDesc = RECORD (Oberon.TaskDesc) x, y : INTEGER; f : Display.Frame; END;  VAR  CmdContext* : Texts.Text; (** base Text of CmdElem *) CmdFrame* : Display.Frame; CmdElem* : Elem; (** Elem which initiated the last call *) clp* : SHORTINT; (** areawidth in which the elem can be touched for resizing or moving *) Done* : BOOLEAN; (** indicates the success of the last request for an attribute *) CmdContextV : Viewers.Viewer; W : Texts.Writer;  (* AUXILIARY *) PROCEDURE CopyText* (T: Texts.Text): Texts.Text; VAR t: Texts.Text; buf: Texts.Buffer; BEGIN NEW(buf); Texts.OpenBuf(buf); Texts.Save(T, 0, T.len, buf); t := TextFrames.Text(""); t.notify := T.notify; Texts.Append(t, buf); RETURN t END CopyText; PROCEDURE CopyString (src : ARRAY OF CHAR) : Str; VAR dest : Str; BEGIN NEW(dest, Strings.Length(src) + 1); COPY(src, dest^); RETURN dest END CopyString; PROCEDURE IntToString*(i : LONGINT; VAR s : ARRAY OF CHAR); VAR s1 : ARRAY 2 OF CHAR; neg : BOOLEAN; BEGIN IF i = 0 THEN COPY("0", s); RETURN END; COPY("", s); neg := i < 0; IF neg THEN i := i * (-1) END; WHILE i # 0 DO s1[0] := CHR(ORD('0') + i MOD 10); s1[1] := 0X; Strings.Insert(s1, 0, s); i := i DIV 10 END; IF neg THEN Strings.Insert("-", 0, s) END END IntToString; PROCEDURE LeftClick (x, y : INTEGER; f : Display.Frame); VAR input : Oberon.InputMsg; BEGIN input.id := Oberon.track; input.keys := {2}; input.X := x; input.Y := y; f.handle(f, input) END LeftClick; PROCEDURE DoClick (); VAR T : Task; BEGIN T := Oberon.CurTask(Task); LeftClick(T.x, T.y, T.f); Oberon.Remove(T) END DoClick; PROCEDURE DoCall* (cmd : ARRAY OF CHAR; v : Viewers.Viewer; f : Display.Frame; partext : Texts.Text; pos : LONGINT; free : BOOLEAN); VAR parList : Oberon.ParList; res : INTEGER; i : INTEGER; BEGIN i := 0; WHILE (cmd[i] # 0X) & (cmd[i] # " ") DO INC(i) END; cmd[i] := 0X; (* delete blanks *) NEW(parList); parList.pos := pos; IF v = NIL THEN parList.vwr := Viewers.This(0,0) ELSE parList.vwr := v END; IF f = NIL THEN parList.frame := Viewers.This(0, 0) ELSE parList.frame := f END; IF partext = NIL THEN parList.text := TextFrames.Text("") ELSE parList.text := partext END; Oberon.Call(cmd, parList, free, res); IF res # 0 THEN Out.String("-- Call error: "); Out.String(cmd); Out.String(" not found$") END END DoCall; PROCEDURE CreateElem* (generator : ARRAY OF CHAR) : Elem; VAR e : Texts.Elem; BEGIN DoCall(generator, NIL, NIL, NIL, 0, FALSE); e := Texts.new; Texts.new := NIL; RETURN e(Elem) END CreateElem; PROCEDURE ToFrame*(e : Texts.Elem; msg : TextFrames.TrackMsg); VAR input : Oberon.InputMsg; getct : GetContextMsg; BEGIN input.keys := msg.keys; input.id := Oberon.track; input.X := msg.X; input.Y := msg.Y; input.fnt := msg.fnt; input.col := msg.col; getct.fx := msg.X; getct.fy := msg.Y; getct.p := e; getct.context := NIL; Viewers.Broadcast(getct); IF getct.context # NIL THEN getct.context.handle(getct.context, input) END END ToFrame; PROCEDURE Focusing* (msg : TextFrames.FocusMsg); VAR T : Task; keys : SET; BEGIN IF msg.focus THEN NEW(T); T.f := msg.elemFrame; Input.Mouse(keys, T.x, T.y); IF (T.x < T.f.X) OR (T.x > T.f.X + T.f.W) OR (T.y < T.f.Y) OR (T.y > T.f.Y + T.f.H) THEN T.x := T.f.X; T.y := T.f.Y; END; T.time := 0; T.safe := FALSE; T.handle := DoClick; Oberon.Install(T) END END Focusing; PROCEDURE TabStop* (e : Elem; f : Display.Frame); VAR r : Texts.Reader; tab : TabStopMsg; v : Viewers.Viewer; get : GetFrameMsg; BEGIN v := Viewers.This(f.X, f.Y); tab.accepted := FALSE; Texts.OpenReader(r, Texts.ElemBase(e), Texts.ElemPos(e) + 1); Texts.ReadElem(r); WHILE ~tab.accepted & (r.elem # e) DO IF r.eot THEN Texts.OpenReader(r, Texts.ElemBase(e), 0); Texts.ReadElem(r); ELSIF r.elem # NIL THEN r.elem.handle(r.elem, tab); IF tab.accepted THEN get.e := r.elem; get.f := NIL; v.dsc.next.handle(v.dsc.next, get); IF get.f # NIL THEN LeftClick(get.f.X, get.f.Y, v.dsc.next) ELSE (* not visible *) tab.accepted := FALSE; Texts.ReadElem(r) END; ELSE Texts.ReadElem(r) END; END; END; END TabStop; PROCEDURE AdjustSubFrame* (f, sub : Display.Frame); BEGIN IF sub.Y < f.Y THEN sub.H := sub.H - (f.Y - sub.Y); sub.Y := f.Y END; IF sub.X + sub.W > f.X + f.W THEN sub.W := sub.W - (sub.X + sub.W - (f.X + f.W)) END; IF sub.Y + sub.H - 1 > f.Y + f.H THEN sub.H := sub.H - (sub.Y + sub.H - (f.Y + f.H)) END; IF sub.X < f.X THEN sub.W := sub.W - (f.X - sub.X); sub.X := f.X END END AdjustSubFrame; PROCEDURE StringLength* (str : ARRAY OF CHAR) : INTEGER; VAR i : INTEGER; BEGIN i := 0; WHILE str[i] # 0X DO INC(i) END; RETURN i END StringLength; PROCEDURE GetLook* (e : Texts.Elem; VAR fnt : Fonts.Font; VAR col : SHORTINT); VAR t : Texts.Text; r : Texts.Reader; BEGIN IF e = NIL THEN fnt := Fonts.Default; col := 15; RETURN END; t := Texts.ElemBase(e); Texts.OpenReader(r, t, Texts.ElemPos(e)); Texts.ReadElem(r); fnt := r.fnt; col := r.col END GetLook; PROCEDURE WriteAttr* (VAR W : Texts.Writer; attr : AttrMsg); BEGIN IF attr.class = Int THEN Texts.WriteInt(W, attr.i, 0) ELSIF attr.class = String THEN Texts.WriteString(W, attr.s) ELSIF attr.class = Real THEN Texts.WriteReal(W, attr.r, 0) ELSIF attr.class = LongReal THEN Texts.WriteLongReal(W, attr.lr, 0) ELSIF attr.class = Bool THEN IF attr.b THEN Texts.Write(W, "Y") ELSE Texts.Write(W, "N") END ELSIF attr.class = Text THEN Texts.Save(attr.t, 0, attr.t.len, W.buf) END; END WriteAttr; PROCEDURE InCorner* (mX, mY, x, y, w : INTEGER; e : Texts.Elem) : BOOLEAN; BEGIN RETURN (e IS Elem) & (mX > x + w - 2 * clp) & (mY < y + 2 * clp) END InCorner; PROCEDURE SetContext* (x, y : INTEGER; f : Display.Frame); BEGIN CmdContextV := Viewers.This(x, y); CmdFrame := f END SetContext; (* ACCESSING ATTRIBUTES *) PROCEDURE SetString* (e : Texts.Elem; name, s : ARRAY OF CHAR); VAR m : AttrMsg; BEGIN m.id := set; m.class := String; COPY(name, m.name); COPY(s, m.s); e.handle(e,m) END SetString; PROCEDURE SetBoolean* (e : Texts.Elem; name : ARRAY OF CHAR; b : BOOLEAN); VAR m : AttrMsg; BEGIN m.id := set; m.class := Bool; COPY(name, m.name); m.b := b; e.handle(e, m) END SetBoolean; PROCEDURE SetInteger* (e : Texts.Elem; name : ARRAY OF CHAR; i : LONGINT); VAR m : AttrMsg; BEGIN m.id := set; m.class := Int; COPY(name, m.name); m.i := i; e.handle(e, m) END SetInteger; PROCEDURE SetReal* (e : Texts.Elem; name : ARRAY OF CHAR; r : REAL); VAR m : AttrMsg; BEGIN m.id := set; m.class := Real; COPY(name, m.name); m.r := r; e.handle(e, m) END SetReal; PROCEDURE SetLReal* (e : Texts.Elem; name : ARRAY OF CHAR; lr : LONGREAL); VAR m : AttrMsg; BEGIN m.id := set; m.class := LongReal; COPY(name, m.name); m.lr := lr; e.handle(e, m) END SetLReal; PROCEDURE SetSet* (e : Texts.Elem; name : ARRAY OF CHAR; s : SET); VAR m : AttrMsg; BEGIN m.id := set; m.class := Set; COPY(name, m.name); m.set := s; e.handle(e, m) END SetSet; PROCEDURE SetText* (e : Texts.Elem; name : ARRAY OF CHAR; t : Texts.Text); VAR m : AttrMsg; BEGIN m.id := set; m.class := Text; COPY(name, m.name); m.t := t; e.handle(e, m) END SetText; PROCEDURE SetFont* (e : Texts.Elem; name : ARRAY OF CHAR; sel : SET; f : Fonts.Font; col, voff : SHORTINT);(* behaves like Texts.Changelooks *) VAR m : AttrMsg; BEGIN m.id := get; COPY(name, m.name); e.handle(e, m); IF m.class = Text THEN Texts.ChangeLooks(m.t, 0, m.t.len, sel, f, col, voff); IF Texts.ElemBase(e) # NIL THEN Texts.ChangeLooks(Texts.ElemBase(e), Texts.ElemPos(e), Texts.ElemPos(e) + 1, sel, f, col, voff) END END END SetFont; PROCEDURE GetClass* (e : Texts.Elem; name : ARRAY OF CHAR) : INTEGER; VAR m : AttrMsg; BEGIN m.id := get; COPY(name, m.name); e.handle(e, m); IF Done THEN RETURN m.class ELSE RETURN NoClass END END GetClass; PROCEDURE GetString* (e : Texts.Elem; name : ARRAY OF CHAR; VAR s : ARRAY OF CHAR); VAR m : AttrMsg; BEGIN m.id := get; COPY(name, m.name); e.handle(e,m); COPY(m.s, s) END GetString; PROCEDURE GetBoolean* (e : Texts.Elem; name : ARRAY OF CHAR; VAR b : BOOLEAN); VAR m : AttrMsg; BEGIN m.id := get; COPY(name, m.name); e.handle(e, m); b := m.b END GetBoolean; PROCEDURE GetInteger* (e : Texts.Elem; name : ARRAY OF CHAR; VAR i : LONGINT); VAR m : AttrMsg; BEGIN m.id := get; COPY(name, m.name); e.handle(e, m); i := m.i END GetInteger; PROCEDURE GetReal* (e : Texts.Elem; name : ARRAY OF CHAR; VAR r : REAL); VAR m : AttrMsg; BEGIN m.id := get; COPY(name, m.name); e.handle(e, m); r := m.r END GetReal; PROCEDURE GetLReal* (e : Texts.Elem; name : ARRAY OF CHAR; VAR lr : LONGREAL); VAR m : AttrMsg; BEGIN m.id := get; COPY(name, m.name); e.handle(e, m); lr := m.lr END GetLReal; PROCEDURE GetSet* (e : Texts.Elem; name : ARRAY OF CHAR; VAR s : SET); VAR m : AttrMsg; BEGIN m.id := get; COPY(name, m.name); e.handle(e, m); s := m.set END GetSet; PROCEDURE GetText* (e : Texts.Elem; name : ARRAY OF CHAR; VAR t : Texts.Text); VAR m : AttrMsg; BEGIN m.id := get; COPY(name, m.name); e.handle(e, m); t := m.t END GetText; (* DYNAMIC ATTRIBUTES *) PROCEDURE GetAttrClass (a : Attr) : INTEGER; BEGIN WITH a : BoolAttr DO RETURN Bool | a : IntAttr DO RETURN Int | a : RealAttr DO RETURN Real | a : LRealAttr DO RETURN LongReal | a : StringAttr DO RETURN String | a : SetAttr DO RETURN Set | a : TextAttr DO RETURN Text END END GetAttrClass; PROCEDURE StoreAttributes (VAR r : Files.Rider; attr : Attr); PROCEDURE WriteString(s : Str); BEGIN IF s = NIL THEN Files.WriteString(r, "") ELSE Files.WriteString(r, s^) END END WriteString; BEGIN Files.Write(r, 0X); (* version *) WHILE attr # NIL DO WITH attr : BoolAttr DO Files.WriteInt(r, Bool); WriteString(attr.name); IF attr.b THEN Files.Write(r, 1X) ELSE Files.Write(r, 0X) END | attr : IntAttr DO Files.WriteInt(r, Int); WriteString(attr.name);Files.WriteLInt(r, attr.i) | attr : RealAttr DO Files.WriteInt(r, Real); WriteString(attr.name);Files.WriteReal(r, attr.r) | attr : LRealAttr DO Files.WriteInt(r, LongReal); WriteString(attr.name); Files.WriteLReal(r, attr.lr) | attr : StringAttr DO Files.WriteInt(r, String); WriteString(attr.name); WriteString(attr.s) | attr : SetAttr DO Files.WriteInt(r, Set); WriteString(attr.name);Files.WriteSet(r, attr.s) | attr : TextAttr DO Files.WriteInt(r, Text); WriteString(attr.name); Texts.Store(r, attr.t) END; attr := attr.next END; Files.WriteInt(r, -1) END StoreAttributes; PROCEDURE LoadAttributes (VAR R : Files.Rider; VAR attr : Attr); VAR class : INTEGER; a, last : Attr; ai : IntAttr; ab : BoolAttr; ar : RealAttr; alr : LRealAttr; as : StringAttr; s : ARRAY 256 OF CHAR; aset : SetAttr; at : TextAttr; name : ARRAY 256 OF CHAR; ch : CHAR; BEGIN attr := NIL; Files.Read(R, ch); (* version -> not yet used *) Files.ReadInt(R, class); WHILE (class > -1) & ~R.eof DO Files.ReadString(R, name); IF class = Bool THEN Files.Read(R, ch); NEW(ab); a := ab; ab.b := ch = 1X ELSIF class = Int THEN NEW(ai); a := ai; Files.ReadLInt(R, ai.i) ELSIF class = Real THEN NEW(ar); a := ar; Files.ReadReal(R, ar.r) ELSIF class = LongReal THEN NEW(alr); a := alr; Files.ReadLReal(R, alr.lr) ELSIF class = String THEN Files.ReadString(R, s); NEW(as); a := as; as.s := CopyString(s) ELSIF class = Set THEN NEW(aset); a := aset; Files.ReadSet(R, aset.s) ELSIF class = Text THEN NEW(at); a := at; at.t := TextFrames.Text(""); Texts.Load(R, at.t) ELSE HALT(99) END; a.name := CopyString(name); IF attr = NIL THEN attr := a; last := a ELSE last.next := a; last := a END; (* same order *) Files.ReadInt(R, class) END END LoadAttributes; PROCEDURE CopyAttributes (src : Attr; VAR dest : Attr); VAR attr, a, last : Attr; ai : IntAttr; ab : BoolAttr; ar : RealAttr; alr : LRealAttr; as : StringAttr; aset : SetAttr;at : TextAttr; BEGIN a := src; dest := NIL; last := NIL; WHILE a # NIL DO WITH a : BoolAttr DO NEW(ab); ab.b := a.b; attr:= ab | a : IntAttr DO NEW(ai); ai.i := a.i; attr := ai | a : RealAttr DO NEW(ar); ar.r := a.r; attr := ar | a : LRealAttr DO NEW(alr); alr.lr := a.lr; attr := alr | a : StringAttr DO NEW(as); as.s := CopyString(a.s^); attr := as | a : SetAttr DO NEW(aset); aset.s := a.s; attr := aset | a : TextAttr DO NEW(at); at.t := CopyText(a.t); attr := at END; attr.name := a.name; IF dest = NIL THEN dest := attr ELSE last.next := attr END; last := attr; a := a.next END END CopyAttributes; PROCEDURE FindAttribute (name : ARRAY OF CHAR; attr : Attr; VAR prev : Attr) : Attr; BEGIN prev := attr; WHILE (attr # NIL) & (attr.name^ # name) DO prev := attr; attr := attr.next END; RETURN attr END FindAttribute; PROCEDURE DeleteAttribute (name : ARRAY OF CHAR; VAR attr : Attr); VAR a, prev : Attr; BEGIN IF attr = NIL THEN RETURN END; IF name = attr.name^ THEN attr := attr.next ELSE a := FindAttribute(name, attr, prev); IF a # NIL THEN prev.next := a.next ELSE Done := FALSE END END END DeleteAttribute; PROCEDURE SetAttribute (VAR attr : Attr; VAR msg : AttrMsg); VAR a, prev : Attr; ai : IntAttr; ab : BoolAttr; ar : RealAttr; alr : LRealAttr; as : StringAttr; aset : SetAttr;at : TextAttr; PROCEDURE NewAttr() : Attr; BEGIN IF msg.class = Bool THEN NEW(ab); ab.b := msg.b; RETURN ab ELSIF msg.class = Int THEN NEW(ai); ai.i := msg.i; RETURN ai ELSIF msg.class = Real THEN NEW(ar); ar.r := msg.r; RETURN ar ELSIF msg.class = LongReal THEN NEW(alr); alr.lr := msg.lr; RETURN alr ELSIF msg.class = String THEN NEW(as); as.s := CopyString(msg.s); RETURN as ELSIF msg.class = Set THEN NEW(aset); aset.s := msg.set; RETURN aset ELSIF msg.class = Text THEN NEW(at); at.t := msg.t; RETURN at ELSE HALT(98) END END NewAttr; BEGIN IF msg.name = "" THEN RETURN END; IF attr = NIL THEN attr := NewAttr(); attr.name := CopyString(msg.name); ELSE a := FindAttribute(msg.name, attr, prev); IF a = NIL THEN a := NewAttr(); a.name := CopyString(msg.name); prev.next := a; a.next := NIL ELSE IF GetAttrClass(a) = msg.class THEN WITH a : BoolAttr DO a.b := msg.b | a : IntAttr DO a.i := msg.i | a : RealAttr DO a.r := msg.r | a : LRealAttr DO a.lr := msg.lr | a : StringAttr DO a.s := CopyString(msg.s) | a : SetAttr DO a.s := msg.set | a : TextAttr DO a.t := msg.t END ELSE Done := FALSE END END END END SetAttribute; PROCEDURE GetAttribute(attr : Attr; VAR msg : AttrMsg); VAR a, prev : Attr; BEGIN a := FindAttribute(msg.name, attr, prev); IF a = NIL THEN Done := FALSE; msg.class := String; msg.s := ""; (* for inspector: cmd, par, name *) msg.hasProps := FALSE; msg.set := {}; msg.b := FALSE; msg.i := 0; msg.r := 0.0; msg.lr := 0.0; msg.t := NIL; ELSE WITH a : BoolAttr DO msg.class := Bool; msg.b := a.b | a : IntAttr DO msg.class := Int; msg.i := a.i | a : RealAttr DO msg.class := Real; msg.r := a.r | a : LRealAttr DO msg.class := LongReal; msg.lr := a.lr | a : StringAttr DO msg.class := String; COPY(a.s^, msg.s) | a : SetAttr DO msg.class := Set; msg.set := a.s | a : TextAttr DO msg.class := Text; msg.t := a.t END END END GetAttribute; PROCEDURE EnumAttributes(attr : Attr; enum : EnumNames); BEGIN WHILE attr # NIL DO IF (attr.name^ # "Name") & (attr.name^ # "Cmd") & (attr.name^ # "Par") THEN enum(attr.name^ , GetAttrClass(attr)) END; attr := attr.next END END EnumAttributes; (* ELEM *) PROCEDURE CopyElem* (src, dest : Elem); BEGIN Texts.CopyElem(src, dest); CopyAttributes(src.attr, dest.attr); dest.locked := src.locked END CopyElem; PROCEDURE NamedElem* (name : ARRAY OF CHAR; context : Texts.Text) : Elem; VAR r : Texts.Reader; done : BOOLEAN; ename : ARRAY 256 OF CHAR; BEGIN done := FALSE; Texts.OpenReader(r, context, 0); Texts.ReadElem(r); REPEAT IF r.elem # NIL THEN IF r.elem IS Elem THEN GetString(r.elem, "Name", ename); done := name = ename END END; IF ~done THEN Texts.ReadElem(r) END UNTIL r.eot OR done; IF ~done THEN RETURN NIL ELSE RETURN r.elem(Elem) END END NamedElem; PROCEDURE UpdateElem* (e : Texts.Elem); VAR t : Texts.Text; pos : LONGINT; BEGIN t := Texts.ElemBase(e); IF t # NIL THEN pos := Texts.ElemPos(e); t.notify(t, Texts.replace, pos, pos + 1) END END UpdateElem; PROCEDURE Resize (e : Elem; x, y : INTEGER); VAR keys, keysum : SET; dx, dy, X, Y, ox, oy, h, w : INTEGER; PROCEDURE InvertFrame(); BEGIN IF (ox-x+dx > 0) & (y-oy+h+dy > 0) THEN GU.Frame(NIL, 15, x, oy-dy, ox-x+dx, y-oy+h+dy, 1, Display.invert) END END InvertFrame; BEGIN h := SHORT(e.H DIV DUnit); w := SHORT(e.W DIV DUnit); Input.Mouse(keys, X, Y); GU.Frame(NIL, 15, x, y, w, h, 1, Display.invert); dx := x+w-X; dy := Y-y; ox := X; oy := Y; keysum := {}; keys := {}; REPEAT Input.Mouse(keys, X, Y); keysum := keysum + keys; Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y); IF (ox # X) OR (oy # Y) THEN InvertFrame(); ox := X; oy := Y; InvertFrame(); END; UNTIL (keys = {}) OR (MR IN keysum) OR (ML IN keysum); InvertFrame(); IF keysum = {MM} THEN e.W := ox-x+dx; IF e.W < 1 THEN e.W := 1 END; e.W := e.W * DUnit; e.H := y-oy+h+dy; IF e.H < 1 THEN e.H := 1 END; e.H := e.H * DUnit; END; REPEAT Input.Mouse(keys, X, Y); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y) UNTIL (keys = {}) END Resize; PROCEDURE Track* (e : Texts.Elem; VAR msg : Texts.ElemMsg; VAR done : BOOLEAN); VAR X, Y : INTEGER; keys : SET; BEGIN done := FALSE; WITH msg : TextFrames.TrackMsg DO WITH e : Elem DO IF msg.keys = {MM} THEN Input.Mouse(keys, X, Y); IF ~e.locked & InCorner(X, Y, msg.X0, msg.Y0, SHORT(e.W DIV DUnit), e) THEN Resize(e(Elem), msg.X0, msg.Y0); done := TRUE; END END ELSE END END END Track; PROCEDURE HandleAttrMsg (e : Elem; VAR msg : AttrMsg); BEGIN Done := TRUE; IF msg.id = get THEN IF msg.name = "W" THEN msg.class := Int; msg.i := SHORT(e.W DIV DUnit) ELSIF msg.name = "H" THEN msg.class := Int; msg.i := SHORT(e.H DIV DUnit) ELSIF msg.name = "Locked" THEN msg.class := Bool; msg.b := e.locked ELSIF msg.name = special THEN msg.class := set; msg.set := {} ELSE GetAttribute(e.attr, msg) END ELSIF msg.id = set THEN IF (msg.name = "W") & (msg.class = Int) THEN e.W := msg.i * DUnit ELSIF (msg.name = "H") & (msg.class = Int) THEN e.H := msg.i * DUnit ELSIF (msg.name = "Locked") & (msg.class = Bool) THEN e.locked := msg.b ELSE SetAttribute(e.attr, msg) END; ELSIF msg.id = delete THEN DeleteAttribute(msg.name, e.attr)  ELSIF msg.id = enum THEN msg.enum("Name", String); msg.enum("Cmd", String); msg.enum("Par", String); msg.enum("W", Int); msg.enum("H", Int); msg.enum("Locked", Bool); EnumAttributes(e.attr, msg.enum) END END HandleAttrMsg; PROCEDURE Init* (e : Elem); BEGIN e.attr := NIL; e.locked := FALSE END Init; PROCEDURE GetPar* (e : Elem; VAR s : Texts.Scanner); VAR ct : INTEGER; ready : BOOLEAN; BEGIN ct := 0; ready := FALSE; Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s); WHILE ~ready & (ct < 5) & ~s.eot DO IF (ct = 0) & (s.class IN {Texts.String, Texts.Name}) THEN SetString(e, "Name", s.s); INC(ct) ELSIF (ct = 1) & (s.class IN {Texts.String, Texts.Name}) THEN SetString(e, "Cmd", s.s); INC(ct) ELSIF (ct = 2) & (s.class IN {Texts.String, Texts.Name}) THEN SetString(e, "Par", s.s); INC(ct) ELSIF (ct = 3) & (s.class = Texts.Int) THEN IF s.i > 0 THEN e.W := s.i * DUnit END; INC(ct) ELSIF (ct = 4) & (s.class = Texts.Int) THEN IF s.i > 0 THEN e.H := s.i * DUnit END; INC(ct) ELSE ready := TRUE END; IF ~ready THEN Texts.Scan(s) END END END GetPar; PROCEDURE ParseRef(s : ARRAY OF CHAR; VAR name1, name2 : ARRAY OF CHAR; VAR i : INTEGER); PROCEDURE Name(VAR n : ARRAY OF CHAR); VAR j : INTEGER; len : LONGINT; BEGIN len := LEN(n); j := 0; WHILE (j < len) & (s[i] # 0X) & (s[i] # ".") & (s[i] # " ") & (s[i] # "'") & (s[i] # foreign) & (s[i] # own) DO n[j] := s[i]; INC(i); INC(j) END; n[j] := 0X END Name; BEGIN Name(name1); name2[0] := 0X; IF s[i] = "." THEN INC(i); Name(name2) END; END ParseRef; PROCEDURE Error (id, pos : INTEGER; n1 : ARRAY OF CHAR); BEGIN IF id = 1 THEN Out.String("-- attrName of "); Out.String(n1); Out.F(" missing : pos #", pos) ELSIF id = 2 THEN Out.String("-- "); Out.String("Elem <"); Out.String(n1); Out.String("> not found") END; Out.Ln END Error; PROCEDURE Expand* (e : Elem; macro : ARRAY OF CHAR; VAR dest : Texts.Text); VAR i : INTEGER; refE : Elem; name1, name2 : ARRAY 64 OF CHAR; msg : AttrMsg; wasBlank : BOOLEAN; selBeg, selEnd, selTime : LONGINT; selText : Texts.Text; BEGIN dest := TextFrames.Text(""); msg.id := get; i := 0; wasBlank := FALSE; WHILE macro[i] # 0X DO IF macro[i] = foreign THEN INC(i); wasBlank := FALSE; ParseRef(macro, name1, name2, i); IF name2 = "" THEN Error(1, i, name1); RETURN END; refE := NamedElem(name1, CmdContext); IF refE = NIL THEN Error(2, 0, name1) ELSE COPY(name2, msg.name); refE.handle(refE, msg); WriteAttr(W, msg) END ELSIF macro[i] = own THEN INC(i); wasBlank := FALSE; ParseRef(macro, name1, name2, i); COPY(name1, msg.name); e.handle(e, msg); WriteAttr(W, msg) ELSIF macro[i] = modifier THEN INC(i); wasBlank := FALSE; IF CAP(macro[i]) = 'S' THEN (* insert current selection *) selTime := 0; Oberon.GetSelection(selText, selBeg, selEnd, selTime); IF (selText # NIL) & (selTime >= 0) THEN Texts.Save(selText, selBeg, selEnd, W.buf) END; ELSIF CAP(macro[i]) = 'N' THEN Texts.WriteLn(W) ELSIF CAP(macro[i]) = 'T' THEN Texts.Write(W, TAB) ELSE wasBlank := macro[i] = " "; Texts.Write(W, macro[i]) END; INC(i) ELSE IF macro[i] = "'" THEN (* replace single quote with double quote *) Texts.Write(W, '"') ELSE IF wasBlank OR (macro[i] # " ") THEN Texts.Write(W, macro[i]) END; (* ignore one blank *) wasBlank := macro[i] = " " END; INC(i) END END; Texts.Append(dest, W.buf) END Expand; PROCEDURE  Call* (e : Elem; context : Texts.Text; unload : BOOLEAN); VAR ct, text : Texts.Text; cmd, par : ARRAY 512 OF CHAR; r : Texts.Reader; i : INTEGER; ch : CHAR; BEGIN CmdElem := e; IF context = NIL THEN CmdContext := Texts.ElemBase(e) ELSE CmdContext := context END; GetString(e, "Cmd", cmd); Expand(e, cmd, ct); (* convert ct to string cmd *) Texts.OpenReader(r, ct, 0); Texts.Read(r, ch); i := 0; WHILE ~r.eot DO IF ch # Texts.ElemChar THEN cmd[i] := ch; INC(i) END; Texts.Read(r, ch) END; cmd[i] := 0X; IF cmd = "" THEN RETURN END; GetString(e, "Par", par); Expand(e, par, text); DoCall(cmd, CmdContextV, CmdFrame, text, 0, unload) END Call; PROCEDURE Handle* (e : Texts.Elem; VAR msg : Texts.ElemMsg); VAR done : BOOLEAN; BEGIN WITH e : Elem DO WITH msg : AttrMsg DO HandleAttrMsg(e, msg) | msg : TabStopMsg DO msg.accepted := FALSE | msg : Texts.FileMsg DO IF msg.id = Texts.load THEN LoadAttributes(msg.r, e.attr); Files.ReadBool(msg.r, e.locked); ELSIF msg.id = Texts.store THEN StoreAttributes(msg.r, e.attr); Files.WriteBool(msg.r, e.locked); END | msg : ExecMsg DO SetContext(msg.x, msg.y, msg.f); Call(e, msg.context, msg.unload) | msg : TextFrames.TrackMsg DO Track(e, msg, done); IF done THEN UpdateElem(e); msg.keys := {} END ELSE END (*ELSE Elems.Handle only should be used if e is inherited from Elems.elem *) END END Handle; BEGIN Texts.OpenWriter(W); clp := 3 END Elems.