DIRECTORY Ascii USING [Lower], Atom USING [GetPName, MakeAtomFromRefText], MessageWindow USING [Append, Clear], NodeStyle USING [DataEntry, DataList, Ref], NodeStyleWorks USING [bindingDict, executingName, StyleError, StyleForFrame], RefText USING [AppendRope, ObtainScratch, ReleaseScratch], Rope USING [ActionType, Fetch, Length, Map, ROPE, Translate], TJaM USING [APut, Array, AtomFromRope, Cmd, CommandProc, CvLit, CvX, Def, Dict, Execute, Frame, Load, NewArray, Object, Pop, PopAtom, PopInt, PopReal, PopRope, Push, PushBool, PushInt, PushReal, PushRope, Put, Register, RopeFromAtom, StackIsEmpty, TopType, TryToLoad]; NodeStyleWorks2Impl: CEDAR MONITOR IMPORTS Ascii, Atom, MessageWindow, NodeStyleWorks, RefText, Rope, TJaM EXPORTS NodeStyleWorks ~ BEGIN OPEN NodeStyle, NodeStyleWorks; Frame: TYPE ~ TJaM.Frame; Object: TYPE ~ TJaM.Object; ROPE: TYPE ~ Rope.ROPE; GetCommand: PUBLIC PROC [frame: Frame, name: ATOM] RETURNS [TJaM.Cmd] ~ { known: BOOL; obj: Object; [known, obj] _ TJaM.TryToLoad[frame, name]; IF NOT known THEN ERROR; RETURN [TypeCheckCommand[obj]]; }; ForceLowerName: PUBLIC PROC [n: ATOM] RETURNS [ATOM] ~ { IF n#NIL THEN { rope: ROPE ~ Atom.GetPName[n]; CheckLower: Rope.ActionType ~ {quit _ c IN ['A..'Z]}; IF Rope.Map[base: rope, action: CheckLower] THEN { len: NAT ~ Rope.Length[rope]; text: REF TEXT ~ RefText.ObtainScratch[len]; FOR i: NAT IN[0..len) DO text[i] _ Ascii.Lower[Rope.Fetch[rope, i]] ENDLOOP; text.length _ len; n _ Atom.MakeAtomFromRefText[text]; RefText.ReleaseScratch[text]; }; }; RETURN [n]; }; ForceLowerRope: PUBLIC PROC [r: ROPE] RETURNS [ROPE] ~ { ForceCharLower: PROC [old: CHAR] RETURNS [new: CHAR] ~ { RETURN [Ascii.Lower[old]] }; RETURN [Rope.Translate[base: r, translator: ForceCharLower]]; }; PopName: PUBLIC PROC [frame: Frame] RETURNS [name: ATOM] ~ { ok: BOOL _ TRUE; obj: Object _ NIL; IF TJaM.StackIsEmpty[frame] THEN ok _ FALSE; IF ok THEN SELECT TJaM.TopType[frame] FROM atom => RETURN [TJaM.PopAtom[frame]]; rope => RETURN [TJaM.AtomFromRope[TJaM.PopRope[frame]]] ENDCASE => { ok _ FALSE; obj _ TJaM.Pop[frame]; }; IF NOT ok THEN { TJaM.PushRope[frame, " -- found where a name was expected."]; TJaM.Push[frame, obj]; StyleError[frame, 2]; }; }; TryToPopName: PUBLIC PROC [frame: Frame] RETURNS [name: ATOM, ok: BOOL] ~ { IF NOT TJaM.StackIsEmpty[frame] THEN SELECT TJaM.TopType[frame] FROM atom => RETURN [name: TJaM.PopAtom[frame], ok: TRUE]; rope => RETURN [name: TJaM.AtomFromRope[TJaM.PopRope[frame]], ok: TRUE]; ENDCASE; RETURN[name: NIL, ok: FALSE]; }; TryToPopReal: PUBLIC PROC [frame: Frame] RETURNS [value: REAL, ok: BOOL] ~ { IF NOT TJaM.StackIsEmpty[frame] THEN SELECT TJaM.TopType[frame] FROM number => RETURN [value: TJaM.PopReal[frame], ok: TRUE]; ENDCASE; RETURN[value: 0, ok: FALSE]; }; TryToPopRope: PUBLIC PROC [frame: Frame] RETURNS [rope: ROPE, ok: BOOL] ~ { IF NOT TJaM.StackIsEmpty[frame] THEN SELECT TJaM.TopType[frame] FROM atom => RETURN [rope: TJaM.RopeFromAtom[TJaM.PopAtom[frame]], ok: TRUE]; rope => RETURN [rope: TJaM.PopRope[frame], ok: TRUE]; ENDCASE; RETURN[rope: NIL, ok: FALSE]; }; TypeCheckName: PUBLIC PROC [obj: Object] RETURNS [ATOM] ~ { WITH obj SELECT FROM x: ATOM => RETURN [x]; x: ROPE => RETURN [TJaM.AtomFromRope[x]]; ENDCASE; ERROR; }; TypeCheckDict: PUBLIC PROC [obj: Object] RETURNS [TJaM.Dict] ~ { WITH obj SELECT FROM x: TJaM.Dict => RETURN [x]; ENDCASE; ERROR; }; TypeCheckCommand: PUBLIC PROC [obj: Object] RETURNS [TJaM.Cmd] ~ { WITH obj SELECT FROM x: TJaM.Cmd => RETURN [x]; ENDCASE; ERROR; }; IsCommentOp: TJaM.CommandProc ~ { style: Ref _ StyleForFrame[frame]; TJaM.PushBool[frame, style.isComment]; }; IsPrintOp: TJaM.CommandProc ~ { style: Ref _ StyleForFrame[frame]; TJaM.PushBool[frame, style.print]; }; NestingLevelOp: TJaM.CommandProc ~ { style: Ref _ StyleForFrame[frame]; TJaM.PushInt[frame, style.nestingLevel]; }; StyleParamOp: TJaM.CommandProc ~ { initialValue: Object _ TJaM.Pop[frame]; -- the initial value name: ATOM _ PopName[frame]; -- the parameter name key: ATOM; array: TJaM.Array; [key, array] _ SpecialOpArray[name, $SpecialOp]; TJaM.Def[frame, name, TJaM.CvX[array]]; -- store the definition TJaM.Def[frame, key, initialValue]; -- store the initial value }; SpecialOpArray: PUBLIC PROC [name: ATOM, op: Object] RETURNS [key: ATOM, array: TJaM.Array] ~ { key _ StyleParamKey[name]; array _ TJaM.NewArray[2]; TJaM.APut[array, 0, TJaM.CvLit[key]]; TJaM.APut[array, 1, op]; }; StyleParamKey: PUBLIC PROC [name: ATOM] RETURNS [key: ATOM] ~ { scratch: REF TEXT ~ RefText.ObtainScratch[50]; text: REF TEXT _ scratch; text _ RefText.AppendRope[text, "!!"]; text _ RefText.AppendRope[text, Atom.GetPName[name]]; key _ Atom.MakeAtomFromRefText[text]; RefText.ReleaseScratch[scratch]; }; SpecialOp: TJaM.CommandProc ~ { aName: BOOL; name: ATOM; var: ATOM; style: Ref _ StyleForFrame[frame]; Error: PROC ~ { TJaM.Push[frame, name]; TJaM.PushRope[frame, "has illegal qualifier:"]; TJaM.Push[frame, var]; StyleError[frame, 3]; }; FindObject: PROC RETURNS [Object] ~ { FOR x: DataList _ style.dataList, x.next UNTIL x=NIL DO xx: REF DataEntry.object ~ NARROW[x]; IF xx.name = var THEN RETURN [xx.object]; ENDLOOP; TJaM.Push[frame, var]; TJaM.Execute[frame, load]; -- get the initial value RETURN [TJaM.Pop[frame]]; }; Store: PROC [ob: Object] ~ { style.dataList _ NEW[DataEntry _ [style.dataList, object[var, ob]]]; }; Load: PROC ~ { TJaM.Push[frame, FindObject[]] }; AddReal: PROC [inc: REAL] ~ { value: REAL; Load[]; value _ TJaM.PopReal[frame]; SetReal[value+inc]; }; SetReal: PROC [x: REAL] ~ { TJaM.PushReal[frame, x]; Store[TJaM.Pop[frame]]; }; SetName: PROC [n: ATOM] ~ { TJaM.Push[frame, n]; Store[TJaM.Pop[frame]]; }; Percent: PROC [percent: REAL] ~ { value: REAL; Load[]; value _ TJaM.PopReal[frame]; SetReal[(percent/100)*value]; }; var _ PopName[frame]; -- the name of the special parameter [name, aName] _ TryToPopName[frame]; IF NOT aName THEN Store[TJaM.Pop[frame]] ELSE SELECT name FROM $the => Load[]; $bigger => BEGIN [name, aName] _ TryToPopName[frame]; IF NOT aName THEN AddReal[TJaM.PopReal[frame]] ELSE IF name = $percent THEN Percent[100+TJaM.PopReal[frame]] ELSE { Error; RETURN }; END; $smaller => BEGIN [name, aName] _ TryToPopName[frame]; IF NOT aName THEN AddReal[-TJaM.PopReal[frame]] ELSE IF name = $percent THEN Percent[100-TJaM.PopReal[frame]] ELSE { Error; RETURN }; END; $percent => Percent[TJaM.PopReal[frame]]; ENDCASE => SetName[name]; }; RegisterStyleCommand: PUBLIC PROC [frame: Frame, name: ATOM, proc: TJaM.CommandProc] ~ { TJaM.Register[frame, name, proc]; TJaM.Put[bindingDict, name, TJaM.Load[frame, name]]; }; RegisterStyleLiteral: PUBLIC PROC [frame: Frame, name: ATOM] ~ { TJaM.Put[bindingDict, name, name]; TJaM.Def[frame, name, TJaM.CvLit[name]]; }; ReportStyleErrorOp: TJaM.CommandProc ~ { num: INT _ TJaM.PopInt[frame]; msg: ROPE; ok: BOOL; MessageWindow.Clear[]; IF executingName # NIL THEN { TJaM.PushRope[frame, "style rule. "]; TJaM.Push[frame, executingName]; TJaM.PushRope[frame, "Error in"]; num _ num+3; }; UNTIL num=0 DO [msg, ok] _ TryToPopRope[frame]; IF NOT ok THEN EXIT; MessageWindow.Append[msg]; num _ num-1; IF num # 0 THEN MessageWindow.Append[" "]; ENDLOOP; }; load: PUBLIC TJaM.Cmd; get: PUBLIC TJaM.Cmd; run: PUBLIC TJaM.Cmd; RegisterWorks2: PUBLIC PROC [frame: Frame] ~ { TJaM.Register[frame, $isComment, IsCommentOp]; TJaM.Register[frame, $isPrint, IsPrintOp]; TJaM.Register[frame, $nestingLevel, NestingLevelOp]; TJaM.Register[frame, $StyleParam, StyleParamOp]; TJaM.Register[frame, $SpecialOp, SpecialOp]; TJaM.Register[frame, $ReportStyleError, ReportStyleErrorOp]; }; END. zNodeStyleWorks2Impl.mesa Copyright c 1985 by Xerox Corporation. All rights reserved. Written by Bill Paxton, January 1981 Paxton, June 3, 1983 3:35 pm Maxwell, January 6, 1983 10:05 am Russ Atkinson, March 7, 1985 3:37:01 am PST Paul Rovner, August 10, 1983 4:43 pm Rick Beach, March 28, 1985 9:56:35 am PST Michael Plass, May 22, 1985 9:30:26 am PDT Doug Wyatt, September 14, 1986 5:19:50 pm PDT Support Procs Readonly Style Variables StyleParam Implementation called to declare a special style parameter create a 2-element array with (name, objectToExecute) create a key which is "!!name" (sort of unique, don't you think) like DoStyleOperation, but for special parameters store the object as new value -- add it to the binding dictionary -- add it to the binding dictionary -- add it to the current dictionary register the various style commands and JaM commands in this module Κ ˜codešœ™Kšœ Οmœ1™K˜K˜—š  œž œžœ žœžœ˜_K™5K˜Kšœ˜Kšœ%˜%Kšœ˜K˜K˜—š   œžœžœžœžœžœ˜?K™@Kšœ žœžœ˜.Kšœžœžœ ˜K˜&Kšœ5˜5Kšœ%˜%K˜ K˜K˜—š  œ˜Kšœ1™1Kšœžœ˜ Kšœžœ˜ Kšœžœ˜ K˜"š œžœ˜K˜Kšœ/˜/K˜K˜K˜—š  œžœžœ ˜%šžœ&žœžœž˜7Kšœžœžœ˜%Kšžœžœžœ ˜)Kšžœ˜—K˜Kšœ‘˜3Kšžœ˜Kšœ˜—š œžœ˜Kšœžœ0˜DK˜—Kš œžœ&˜0š œžœžœ˜Kšœžœ˜ K˜K˜K˜K˜—š œžœžœ˜Kšœ˜Kšœ˜Kšœ˜—š œžœžœ˜Kšœ˜Kšœ˜Kšœ˜—š œžœ žœ˜!Kšœžœ˜ K˜K˜K˜K˜—Kšœ‘$˜:K˜$šžœžœžœ˜(Kšœ™—šžœžœž˜K˜˜ Kšž˜K˜$šžœžœ˜ Kšžœ˜!šžœžœžœ!˜=Kšžœ žœ˜——Kšžœ˜—˜ Kšž˜Kšœ$˜$šžœžœ˜ Kšžœ˜"šžœžœžœ!˜=Kšžœ žœ˜——Kšžœ˜—K˜)Kšžœ˜—K˜K™—š œžœžœžœ˜YKšœ!˜!Kšœ#™#Kšœ4˜4šœ˜K˜——š œžœžœžœ˜@Kšœ#™#K˜"Kšœ#™#K˜(K˜K˜—š œ˜(Kšœžœ˜Kšœžœ˜ Kšœžœ˜ K˜šžœžœžœ˜K˜%Kšœ ˜ K˜!Kšœ ˜ Kšœ˜—šžœž˜Kšœ ˜ Kšžœžœžœžœ˜Kšœ˜K˜ Kšžœ žœ˜*Kšžœ˜—K˜K˜—Kšœžœ ˜Kšœžœ ˜Kšœžœ ˜K˜š œžœžœ˜.KšœC™CK˜.K˜*K˜4K˜0Kšœ,˜,K˜<šœ˜K˜———K˜Kšžœ˜—…—Έ+Ο