<<>> <> <> <> <> <> <> <> <> <<>> DIRECTORY Atom USING [GetPName, MakeAtom], Basics USING [NonNegative], List USING [Length, Sort], NodeProps USING [CopyInfoProc, MapPropsAction, ReadSpecsProc, WriteSpecsProc], Prop USING [PropList, Get, Put, MapAction, Map], RefTab USING [Create, Fetch, Ref, Store], Rope USING [Concat, Equal, Fetch, FromChar, FromRefText, IsEmpty, ROPE, Size, Substr], Rosary USING [ROSARY, FromRuns, MapRuns], TextEdit USING [ItemFromCharSet], Tioga USING [Node, CharSet]; NodePropsImpl: CEDAR MONITOR IMPORTS Atom, Basics, List, Prop, RefTab, Rope, Rosary, TextEdit EXPORTS NodeProps ~ BEGIN ROSARY: TYPE = Rosary.ROSARY; ROPE: TYPE = Rope.ROPE; PropList: TYPE = Prop.PropList; CharSet: TYPE = Tioga.CharSet; CopyInfoProc: TYPE = NodeProps.CopyInfoProc; MapPropsAction: TYPE = NodeProps.MapPropsAction; ReadSpecsProc: TYPE = NodeProps.ReadSpecsProc; WriteSpecsProc: TYPE = NodeProps.WriteSpecsProc; nameFormat: PUBLIC ATOM ¬ $Format; nameComment: PUBLIC ATOM ¬ $Comment; nameCharSets: PUBLIC ATOM ¬ $CharSets; nameCharProps: PUBLIC ATOM ¬ $CharProps; nameStyleDef: PUBLIC ATOM ¬ $StyleDef; namePrefix: PUBLIC ATOM ¬ $Prefix; namePostfix: PUBLIC ATOM ¬ $Postfix; nameArtwork: PUBLIC ATOM ¬ $Artwork; nameActive: PUBLIC ATOM ¬ $Active; ReadComment: PROC [name: ATOM, specs: ROPE] RETURNS [value: REF] ~ { RETURN [ValueFromBool[Rope.Equal[specs, "TRUE", FALSE]]]; }; WriteComment: PROC [name: ATOM, value: REF] RETURNS [specs: ROPE] ~ { comment: BOOL ~ BoolFromValue[value]; specs ¬ IF comment THEN "TRUE" ELSE "FALSE"; }; ReadFormat: PROC [name: ATOM, specs: ROPE] RETURNS [value: REF ¬ NIL] ~ { IF NOT Rope.IsEmpty[specs] THEN value ¬ Atom.MakeAtom[specs]; }; WriteFormat: PROC [name: ATOM, value: REF] RETURNS [specs: ROPE ¬ NIL] ~ { WITH value SELECT FROM atom: ATOM => specs ¬ Atom.GetPName[NARROW[atom]]; ENDCASE => IF value = NIL THEN specs ¬ ""; }; ReadPfix: PROC [name: ATOM, specs: ROPE] RETURNS [value: REF] ~ { RETURN [specs] }; WritePfix: PROC [name: ATOM, value: REF] RETURNS [specs: ROPE ¬ NIL] ~ { WITH value SELECT FROM rope: ROPE => specs ¬ rope; ENDCASE; }; IntByte: TYPE ~ MACHINE DEPENDENT RECORD [more: BOOL, data: [0..128)]; <> GetInt: PROC [get: PROC RETURNS [BYTE]] RETURNS [int: INT ¬ 0] ~ { DO byte: IntByte ~ LOOPHOLE[get[]]; int ¬ int*128+byte.data; IF NOT byte.more THEN EXIT; ENDLOOP; }; PutInt: PROC [int: INT, put: PROC [BYTE], more: BOOL ¬ FALSE] ~ { byte: IntByte ~ [more: more, data: int MOD 128]; IF int>=128 THEN PutInt[int/128, put, TRUE]; put[LOOPHOLE[byte]]; }; ReadCharSets: PROC [name: ATOM, specs: ROPE] RETURNS [value: REF] ~ { <> <)*, where is encoded with the variable-length integer encoding scheme described above, and is just encoded as a byte.>> p: PROC [q: PROC [REF, INT]] ~ { size: INT ~ Rope.Size[specs]; i: INT ¬ 0; GetByte: PROC RETURNS [b: BYTE] ~ {b ¬ ORD[Rope.Fetch[specs, i]]; i ¬ i + 1}; UNTIL i = size DO repeat: INT ~ GetInt[GetByte]; charSet: BYTE ~ GetByte[]; q[TextEdit.ItemFromCharSet[charSet], repeat]; ENDLOOP; }; RETURN [Rosary.FromRuns[p]]; }; WriteCharSets: PROC [name: ATOM, value: REF] RETURNS [specs: ROPE ¬ NIL] ~ { text: REF TEXT ~ NEW[TEXT[48]]; Fold: PROC ~ {specs ¬ Rope.Concat[specs, Rope.FromRefText[text]]; text.length ¬ 0}; PutByte: PROC [b: BYTE] ~ { IF text.length = text.maxLength THEN Fold[]; text[text.length] ¬ VAL[b]; text.length ¬ text.length + 1; }; charSet: CharSet ¬ 0; rept: INT ¬ 0; FlushRun: PROC ~ {IF rept>0 THEN { PutInt[rept, PutByte]; PutByte[charSet]; rept ¬ 0 }}; Action: PROC [item: REF, repeat: INT] RETURNS [quit: BOOL ¬ FALSE] ~ { new: CharSet ¬ WITH item SELECT FROM r: REF CharSet => r­, ENDCASE => 0; IF rept > 0 AND new#charSet THEN FlushRun[]; charSet ¬ new; rept ¬ rept + repeat; }; [] ¬ Rosary.MapRuns[[NARROW[value]], Action]; FlushRun[]; Fold[]; IF Rope.Size[specs] = 0 THEN specs ¬ NIL; }; ReadCharProps: PROC [name: ATOM, specs: ROPE] RETURNS [value: REF] ~ { <> <<(()*)*,>> <> p: PROC [q: PROC [REF, INT]] ~ { i: INT ¬ 0; size: INT ¬ Rope.Size[specs]; GetByte: PROC RETURNS [b: BYTE] ~ {b ¬ ORD[Rope.Fetch[specs, i]]; i ¬ i + 1}; GetRope: PROC RETURNS [rope: ROPE ¬ NIL] ~ { len: INT ~ GetInt[GetByte]; rope ¬ Rope.Substr[specs, i, len]; i ¬ i + len; [] ¬ Basics.NonNegative[size-i]; }; UNTIL i = size DO repeatCount: INT ~ GetInt[GetByte]; propsCount: INT ~ GetInt[GetByte]; head, tail: Prop.PropList ¬ NIL; THROUGH [0..propsCount) DO atom: ATOM ~ Atom.MakeAtom[GetRope[]]; valueSpecs: ROPE ~ GetRope[]; value: REF ~ DoSpecs[atom, valueSpecs]; new: Prop.PropList ~ CONS[[key: atom, val: value], NIL]; IF head=NIL THEN head ¬ new ELSE tail.rest ¬ new; tail ¬ new; ENDLOOP; q[head, repeatCount]; ENDLOOP; }; RETURN [Rosary.FromRuns[p]]; }; WriteCharProps: PROC [name: ATOM, value: REF] RETURNS [specs: ROPE ¬ NIL] ~ { curRope: ROPE ¬ NIL; Grab: PROC RETURNS [rope: ROPE] ~ {rope ¬ curRope; curRope ¬ NIL}; PutByte: PROC [b: BYTE] ~ {curRope ¬ Rope.Concat[curRope, Rope.FromChar[VAL[b]]]}; PutRope: PROC [rope: ROPE] ~ {curRope ¬ Rope.Concat[curRope, rope]}; rept: INT ¬ 0; itemSpecs: ROPE ¬ NIL; FlushRun: PROC ~ {IF rept>0 THEN {PutInt[rept, PutByte]; PutRope[itemSpecs]; rept ¬ 0}}; PutItem: PROC [newItemSpecs: ROPE, repeat: INT] ~ { IF NOT Rope.Equal[newItemSpecs, itemSpecs] THEN FlushRun[]; itemSpecs ¬ newItemSpecs; rept ¬ rept + repeat; }; Action: PROC [item: REF, repeat: INT] RETURNS [quit: BOOL ¬ FALSE] ~ { save: ROPE ~ Grab[]; SpecsList: PROC [propList: Prop.PropList] RETURNS [s: LIST OF REF ¬ NIL] ~ { FOR p: Prop.PropList ¬ propList, p.rest UNTIL p = NIL DO atom: ATOM ~ NARROW[p.first.key]; v: ROPE ~ GetSpecs[atom, p.first.val]; IF v # NIL THEN { a: ROPE ~ Atom.GetPName[atom]; PutInt[Rope.Size[a], PutByte]; PutRope[a]; PutInt[Rope.Size[v], PutByte]; PutRope[v]; s ¬ CONS[Grab[], s]; }; ENDLOOP; }; specList: LIST OF REF ¬ List.Sort[SpecsList[NARROW[item]]]; newItemSpecs: ROPE; PutInt[List.Length[specList], PutByte]; UNTIL specList = NIL DO t: LIST OF REF ¬ specList; PutRope[NARROW[t.first]]; specList ¬ t.rest; t.rest ¬ NIL; ENDLOOP; newItemSpecs ¬ Grab[]; curRope ¬ save; PutItem[newItemSpecs, repeat]; }; [] ¬ Rosary.MapRuns[[NARROW[value]], Action]; FlushRun[]; specs ¬ Grab[]; IF Rope.Size[specs] = 0 THEN specs ¬ NIL; }; emptyAtom: ATOM ~ Atom.MakeAtom[NIL]; AtomFromValue: PUBLIC PROC [value: REF] RETURNS [ATOM] ~ { WITH value SELECT FROM atom: ATOM => RETURN[atom]; ENDCASE => RETURN[NIL]; }; ValueFromAtom: PUBLIC PROC [atom: ATOM] RETURNS [REF] ~ { RETURN[IF atom=emptyAtom THEN NIL ELSE atom]; }; refBoolFromBool: ARRAY BOOL OF REF BOOL ~ [ FALSE: NEW[BOOL ¬ FALSE], TRUE: NEW[BOOL ¬ TRUE] ]; BoolFromValue: PUBLIC PROC [value: REF] RETURNS [BOOL] ~ { WITH value SELECT FROM refBool: REF BOOL => RETURN[refBool­]; ENDCASE => RETURN[FALSE]; }; ValueFromBool: PUBLIC PROC [bool: BOOL] RETURNS [REF] ~ { RETURN[refBoolFromBool[bool]]; }; PutProp: PUBLIC PROC [n: Tioga.Node, name: ATOM, value: REF] ~ { SELECT name FROM nameFormat => n.format ¬ AtomFromValue[value]; nameComment => n.comment ¬ BoolFromValue[value]; nameCharSets, nameCharProps => ERROR; ENDCASE => { oldList: PropList ~ n.nodeProps; newList: PropList ~ Prop.Put[oldList, name, value]; IF newList#oldList THEN { hasProp: BOOL ~ (value#NIL); SELECT name FROM nameStyleDef => n.hasStyleDef ¬ hasProp; namePrefix => n.hasPrefix ¬ hasProp; namePostfix => n.hasPostfix ¬ hasProp; nameArtwork => n.hasArtwork ¬ hasProp; nameActive => n.hasActive ¬ hasProp; ENDCASE; n.nodeProps ¬ newList; }; }; }; <<>> GetProp: PUBLIC PROC [n: Tioga.Node, name: ATOM] RETURNS [value: REF] ~ { SELECT name FROM nameFormat => RETURN[ValueFromAtom[n.format]]; nameComment => RETURN[ValueFromBool[n.comment]]; ENDCASE => RETURN[Prop.Get[n.nodeProps, name]]; }; <<>> MapProps: PUBLIC PROC [n: Tioga.Node, action: MapPropsAction, formatFlag, commentFlag: BOOL ¬ TRUE] RETURNS [quit: BOOL] ~ { <> <> IF n#NIL THEN { IF formatFlag AND n.format#NIL THEN { IF action[nameFormat, ValueFromAtom[n.format]] THEN RETURN [TRUE]; }; IF commentFlag THEN { IF action[nameComment, ValueFromBool[n.comment]] THEN RETURN [TRUE]; }; { -- properties other than $Format and $Comment propAction: Prop.MapAction ~ { RETURN[action[NARROW[key], val]] }; RETURN[Prop.Map[n.nodeProps, propAction]]; }; }; RETURN [FALSE]; }; <> ReaderProcRef: TYPE = REF ReaderProcRec; ReaderProcRec: TYPE = RECORD [proc: ReadSpecsProc]; WriterProcRef: TYPE = REF WriterProcRec; WriterProcRec: TYPE = RECORD [proc: WriteSpecsProc]; CopierProcRef: TYPE = REF CopierProcRec; CopierProcRec: TYPE = RECORD [proc: CopyInfoProc]; readerTable: RefTab.Ref ¬ RefTab.Create[]; writerTable: RefTab.Ref ¬ RefTab.Create[]; copierTable: RefTab.Ref ¬ RefTab.Create[]; Register: PUBLIC PROC [name: ATOM, reader: ReadSpecsProc, writer: WriteSpecsProc, copier: CopyInfoProc] ~ { <> <> IF name=NIL THEN RETURN; [] ¬ RefTab.Store[readerTable, name, NEW[ReaderProcRec ¬ [reader]]]; [] ¬ RefTab.Store[writerTable, name, NEW[WriterProcRec ¬ [writer]]]; [] ¬ RefTab.Store[copierTable, name, NEW[CopierProcRec ¬ [copier]]] }; NullRead: PUBLIC PROC [name: ATOM, specs: ROPE] RETURNS [value: REF] ~ { RETURN [NIL] }; NullWrite: PUBLIC PROC [name: ATOM, value: REF] RETURNS [specs: ROPE] ~ { RETURN [NIL] }; NullCopy: PUBLIC PROC [name: ATOM, value: REF] RETURNS [new: REF] ~ { RETURN [NIL] }; RefCopy: PUBLIC PROC [name: ATOM, value: REF] RETURNS [new: REF] ~ { RETURN [value] }; DoSpecs: PUBLIC PROC [name: ATOM, specs: ROPE] RETURNS [value: REF] ~ { <> <> <> procRef: ReaderProcRef; proc: ReadSpecsProc; value ¬ ( IF name=NIL OR (procRef ¬ NARROW[RefTab.Fetch[readerTable, name].val])=NIL OR (proc ¬ procRef.proc)=NIL THEN specs ELSE proc[name,specs] ); }; GetSpecs: PUBLIC PROC [name: ATOM, value: REF] RETURNS [specs: ROPE] ~ { <> <> <> procRef: WriterProcRef; proc: WriteSpecsProc; IF name=NIL OR (procRef ¬ NARROW[RefTab.Fetch[writerTable, name].val])=NIL OR (proc ¬ procRef.proc)=NIL THEN { IF value=NIL THEN specs ¬ NIL ELSE { WITH value SELECT FROM rope: ROPE => specs ¬ rope; ENDCASE => specs ¬ NIL; }; } ELSE specs ¬ proc[name, value]; }; CopyInfo: PUBLIC PROC [name: ATOM, value: REF] RETURNS [new: REF] ~ { <> <> <> procRef: CopierProcRef; proc: CopyInfoProc; new ¬ IF name=NIL OR (procRef ¬ NARROW[RefTab.Fetch[copierTable, name].val])=NIL OR (proc ¬ procRef.proc)=NIL THEN value ELSE proc[name, value] }; <> attributeTable: LIST OF LIST OF ATOM ¬ NIL; DeclarePropertyAttribute: PUBLIC ENTRY PROC [name: ATOM, attribute: ATOM] ~ { FOR a: LIST OF LIST OF ATOM ¬ attributeTable, a.rest UNTIL a=NIL DO IF a.first.first = name THEN { FOR p: LIST OF ATOM ¬ a.first.rest, p.rest UNTIL p=NIL DO IF p.first = attribute THEN RETURN; ENDLOOP; a.first.rest ¬ CONS[attribute, a.first.rest]; RETURN; }; ENDLOOP; attributeTable ¬ CONS[LIST[name, attribute], attributeTable]; }; Is: PUBLIC ENTRY PROC [name: ATOM, attribute: ATOM] RETURNS [BOOL] ~ { FOR a: LIST OF LIST OF ATOM ¬ attributeTable, a.rest UNTIL a=NIL DO IF a.first.first = name THEN { FOR p: LIST OF ATOM ¬ a.first.rest, p.rest UNTIL p=NIL DO IF p.first = attribute THEN RETURN [TRUE]; ENDLOOP; RETURN [FALSE]; }; ENDLOOP; RETURN [FALSE]; }; GetPropertyAttributes: PUBLIC ENTRY PROC [name: ATOM] RETURNS [LIST OF ATOM] ~ { FOR a: LIST OF LIST OF ATOM ¬ attributeTable, a.rest UNTIL a=NIL DO IF a.first.first = name THEN RETURN [a.first.rest]; ENDLOOP; RETURN [NIL]; }; SetPropertyAttributes: PUBLIC ENTRY PROC [name: ATOM, attributes: LIST OF ATOM] ~ { FOR a: LIST OF LIST OF ATOM ¬ attributeTable, a.rest UNTIL a=NIL DO IF a.first.first = name THEN {a.first.rest ¬ attributes; RETURN}; ENDLOOP; attributeTable ¬ CONS[CONS[name, attributes], attributeTable]; }; <> <<$Visible says whether property affects appearance>> <<$Inheritable says whether property may be inherited when a new node is inserted>> <<$ClientOnly asserts EditTool interface should not change the value>> <> Init: PROC ~ { visible: LIST OF ATOM ~ LIST[$Visible]; visAndInherit: LIST OF ATOM ~ CONS[$Inheritable, visible]; visAndClient: LIST OF ATOM ~ CONS[$ClientOnly, visible]; Register[namePrefix, ReadPfix, WritePfix, RefCopy]; SetPropertyAttributes[namePrefix, visAndInherit]; Register[namePostfix, ReadPfix, WritePfix, RefCopy]; SetPropertyAttributes[namePostfix, visAndInherit]; Register[nameFormat, ReadFormat, WriteFormat, RefCopy]; SetPropertyAttributes[nameFormat, visAndInherit]; Register[nameComment, ReadComment, WriteComment, RefCopy]; SetPropertyAttributes[nameComment, visAndInherit]; Register[nameCharSets, ReadCharSets, WriteCharSets, RefCopy]; SetPropertyAttributes[nameCharSets, visAndClient]; Register[nameCharProps, ReadCharProps, WriteCharProps, RefCopy]; SetPropertyAttributes[nameCharProps, visAndClient]; SetPropertyAttributes[nameStyleDef, visAndInherit]; SetPropertyAttributes[nameArtwork, visible]; SetPropertyAttributes[$NewlineDelimiter, visible]; SetPropertyAttributes[$FileExtension, visible]; SetPropertyAttributes[$Interpress, CONS[$ClientOnly, visible]]; SetPropertyAttributes[$Bounds, visible]; }; Init[]; END.