<> <> <> <> <> DIRECTORY Atom, CD, CDInstances, CDDirectory, PopUpMenus, CDOps, CDPrivate, CDProperties, CDRopeViewer, CDSequencer, IO, Properties, Rope, RuntimeError USING [UNCAUGHT], TerminalIO, TokenIO, ViewerTools USING [TiogaContents, TiogaContentsRec]; CDPropertyCommands: CEDAR PROGRAM IMPORTS Atom, CD, CDDirectory, CDOps, CDProperties, CDRopeViewer, CDSequencer, IO, PopUpMenus, Rope, RuntimeError, TerminalIO = BEGIN specialRights: BOOL _ FALSE; -- gives the right to access exclusive properties Atomize: PROC [r: Rope.ROPE] RETURNS [ATOM_NIL] = { IF Rope.Length[r]>1 AND Rope.Fetch[r]='$ THEN r _ Rope.Substr[r, 1, Rope.Length[r]-1]; IF ~Rope.IsEmpty[r] THEN RETURN [Atom.MakeAtom[r]] }; EnterSignalNameSP: PROC [comm: CDSequencer.Command] = { inst: CD.Instance _ CDOps.TheInstance[comm.design, "read signal-name"]; IF inst#NIL THEN { name: Rope.ROPE; TerminalIO.PutRopes[" onto ", CDOps.InstRope[inst]]; name _ TerminalIO.RequestRope[" type name: "]; <<--if name = nil, property will be removed>> IF Rope.IsEmpty[name] THEN name_NIL; CDProperties.PutInstanceProp[onto: inst, prop: $SignalName, val: name]; IF name#NIL THEN TerminalIO.PutRope[" done\n"] ELSE TerminalIO.PutRope[" removed\n"]; } }; EnterInstanceNameSP: PROC [comm: CDSequencer.Command] = { inst: CD.Instance _ CDOps.TheInstance[comm.design, "read instance-name"]; IF inst#NIL THEN { name: Rope.ROPE; TerminalIO.PutRopes[" onto ", CDOps.InstRope[inst]]; name _ TerminalIO.RequestRope[" type name: "]; <<--if name = nil, property will be removed>> IF Rope.IsEmpty[name] THEN name_NIL; CDProperties.PutInstanceProp[onto: inst, prop: $InstanceName, val: name]; IF name#NIL THEN TerminalIO.PutRope[" done\n"] ELSE TerminalIO.PutRope[" removed\n"]; } }; <<--XXX make public on next release; probably in ?>> WriteValue: PROC [x: REF] = { ENABLE RuntimeError.UNCAUGHT => GOTO err; IF x=NIL THEN TerminalIO.PutRope["NIL"] ELSE WITH x SELECT FROM ip: REF INT => TerminalIO.PutF["^%g", IO.int[ip^]]; r: Rope.ROPE => TerminalIO.PutRope[r]; a: ATOM => TerminalIO.PutRopes["$", Atom.GetPName[a]]; ra: REF ATOM => TerminalIO.PutRopes["^$", Atom.GetPName[ra^]]; d: CD.Design => TerminalIO.PutRopes["design ", (IF d.name=NIL THEN "no name" ELSE d.name)]; ob: CD.Object => TerminalIO.PutRope[CD.Describe[ob, NIL]]; i: CD.Instance => TerminalIO.PutRope[CDOps.InstRope[i]]; l: CDPrivate.LayerRef => TerminalIO.PutRope[CDOps.LayerRope[l.number]]; ENDCASE => TerminalIO.PutF1["(%b)", IO.int[LOOPHOLE[x]]] EXITS err => TerminalIO.PutRope["??"]; }; RequestValue: PROC [default: REF] RETURNS [REF] = { n: CARDINAL_0; WHILE n=0 DO n _ TerminalIO.RequestSelection["property value", LIST["leave it", "remove", "INT", "ROPE", "ATOM", "REF ANY"]]; SELECT n FROM 2 => {default _ NIL}; 3 => {default _ NEW[INT_TerminalIO.RequestInt["int > "]]}; 4 => {default _ TerminalIO.RequestRope["rope > "]}; 5 => {default _ Atomize[TerminalIO.RequestRope["atom > "]]}; 6 => { TerminalIO.PutRope["(on crash: abort is ok)"]; default _ IO.GetRefAny[IO.RIS[TerminalIO.RequestRope["ref any > "]]] }; ENDCASE --0, 1-- => {NULL}; ENDLOOP; RETURN [default] }; PropertyDesign: PROC [comm: CDSequencer.Command] = { TerminalIO.PutRope["enter property for the design\n"]; PropertyForSome[comm.design]; }; PropertyApp: PROC [comm: CDSequencer.Command] = { inst: CD.Instance _ CDOps.TheInstance[comm.design, "enter property of instance\n"]; IF inst#NIL THEN PropertyForSome[inst]; }; PropertyOb: PROC [comm: CDSequencer.Command] = { inst: CD.Instance _ CDOps.TheInstance[comm.design, "enter property for an object\n"]; IF inst#NIL THEN IF (inst.ob.class.composed AND ~inst.ob.immutable) OR specialRights THEN { PropertyForSome[inst.ob]; IF inst.ob.class.composed AND ~inst.ob.immutable THEN CDDirectory.PropagateChange[inst.ob, comm.design]; } ELSE TerminalIO.PutRope["this object class has no user accessable properties\n"]; }; PropertyForSome: PROC [what: REF] = { value: REF; atom: ATOM _ Atomize[TerminalIO.RequestRope["type property name: "]]; IF atom=NIL THEN { TerminalIO.PutRope[" empty name; not done\n"]; RETURN }; value _ CDProperties.GetProp[what, atom]; TerminalIO.PutRope[" old value: "]; WriteValue[value]; TerminalIO.PutRope["\n"]; IF IsExclusive[atom] THEN { TerminalIO.PutRope[" this property is used exclusively by the program; "]; IF ~specialRights THEN { TerminalIO.PutRope["interactive access is not possible\n"]; RETURN } }; value _ RequestValue[value]; CDProperties.PutProp[onto: what, prop: atom, val: value]; TerminalIO.PutRope[" done\n"]; }; <<--move this procedure to CDProperties>> ShowProperties: PROC [from: REF] = { WITH from SELECT FROM a: CD.Instance => ShowPropertyList[a.properties]; o: CD.Object => ShowPropertyList[o.properties]; d: CD.Design => ShowPropertyList[d.properties^]; t: CD.Technology => ShowPropertyList[t.properties^]; <<--l: CD.LayerRef => ...;>> <<--at: ATOM => ...;>> ENDCASE => TerminalIO.PutRope[" no showable CD properties"]; }; ShowPropertyList: PROC [pl: CD.PropList] = { FOR list: CD.PropList _ pl, list.rest WHILE list#NIL DO WITH list.first.key SELECT FROM ra: REF ATOM => IF ra^=$MayBeRemoved THEN LOOP ENDCASE => NULL; ShowProperty[list.first]; ENDLOOP }; ShowProperty: PROC [pp: Properties.KeyVal] = { TerminalIO.PutRope[" name: "]; WriteValue[pp.key]; TerminalIO.PutRope[" value: "]; WriteValue[pp.val]; TerminalIO.PutRope["\n"]; }; ShowPropertiesSP: PROC [comm: CDSequencer.Command] = { inst: CD.Instance _ CDOps.TheInstance[comm.design, "show property lists\n"]; IF inst#NIL THEN { IF inst.properties#NIL THEN { TerminalIO.PutRope[" --properties on instance\n"]; ShowPropertyList[inst.properties]; }; IF inst.ob.properties#NIL THEN { TerminalIO.PutRope[" --properties on object itself\n"]; ShowPropertyList[inst.ob.properties]; }; TerminalIO.PutRope[" --\n"]; } }; ShowPropertiesDesign: PROC [comm: CDSequencer.Command] = { TerminalIO.PutRope["show properties of design\n"]; ShowPropertyList[comm.design.properties^]; TerminalIO.PutRope[" --\n"]; }; CommentInfo: TYPE ~ RECORD [design: CD.Design, on: REF ANY]; <> SaveComment: CDRopeViewer.SaveProc = { what: REF CommentInfo _ NARROW [clientData]; IF discard THEN RETURN; CDSequencer.MarkChangedIOOnly[what.design]; CDProperties.PutProp[ onto: what.on, prop: $Tioga, val: NEW[ViewerTools.TiogaContentsRec_[contents: contents, formatting: formatting]] ] }; EditComment: PROC [comm: CDSequencer.Command] = { <> caption, comment, formatting: Rope.ROPE _ NIL; what: REF CommentInfo _ NEW [CommentInfo _ [design: comm.design, on: NIL]]; IF comm.design=NIL THEN RETURN; -- don't bother SELECT comm.key FROM $CommentDesign => { TerminalIO.PutRope["edit comment for design\n"]; what.on _ comm.design; caption _ Rope.Cat["design ", CD.DesignName[comm.design]]; }; $CommentOb => { inst: CD.Instance = CDOps.TheInstance[comm.design, "edit comment for object\n"]; SELECT TRUE FROM inst=NIL => NULL; inst.ob.class.composed => { what.on _ inst.ob; caption _ Rope.Cat["object ", CD.Describe[inst.ob, inst.properties, comm.design]]; }; ENDCASE => TerminalIO.PutRope["this object class has no comments\n"]; }; $CommentApp => { inst: CD.Instance = CDOps.TheInstance[comm.design, "edit comment for instance\n"]; IF inst#NIL THEN { what.on _ inst; caption _ Rope.Cat["instance of ", CD.Describe[inst.ob, inst.properties, comm.design]]; }; }; ENDCASE => NULL; IF what.on=NIL THEN RETURN; -- nothing to do ... caption _ Rope.Cat["CD comment on ", caption]; IF comm.design.mutability#editable THEN caption _ Rope.Cat[caption, " [READONLY]"]; WITH CDProperties.GetProp[from: what.on, prop: $Tioga] SELECT FROM t: ViewerTools.TiogaContents => { comment _ t.contents; formatting _ t.formatting; }; r: Rope.ROPE => comment _ r; ENDCASE => NULL; CDRopeViewer.Edit[contents: comment, formatting: formatting, caption: caption, save: IF comm.design.mutability=editable THEN SaveComment ELSE NIL, clientData: what]; }; NameMenuComm: PROC [comm: CDSequencer.Command] = { m: PopUpMenus.Menu; x: REF; inst: CD.Instance _ CDOps.TheInstance[comm.design, "property and name menu\n"]; IF inst=NIL THEN m _ mD ELSE IF inst.ob.class.composed THEN m _ mFull ELSE m _ mInst; x _ PopUpMenus.Call[m, comm]; WITH x SELECT FROM a: ATOM => CDSequencer.ExecuteCommand[comm: comm, key: a] ENDCASE => NULL }; <<>> IsExclusive: PROC [a: ATOM] RETURNS [BOOL_FALSE] = { pType: CDProperties.PropertyProcs = CDProperties.FetchProcs[a]; IF pType#NIL THEN RETURN [pType.exclusive] }; Register: PROC [n: NAT, key: ATOM, entry, doc: Rope.ROPE _ NIL] = { [] _ PopUpMenus.Entry[mFull, entry, NIL, key, doc]; IF n<=1 THEN RETURN; [] _ PopUpMenus.Entry[mInst, entry, NIL, key, doc]; IF n<=2 THEN RETURN; [] _ PopUpMenus.Entry[mD, entry, NIL, key, doc]; }; <<>> mFull: PopUpMenus.Menu _ PopUpMenus.Create["Names & Properties", NIL]; mInst: PopUpMenus.Menu _ PopUpMenus.Create["Names & Properties", NIL]; mD: PopUpMenus.Menu _ PopUpMenus.Create["Names & Properties", NIL]; <<>> <<-- module initialization>> CDSequencer.ImplementCommand[$CommentDesign, EditComment, , doQueue]; CDSequencer.ImplementCommand[$CommentApp, EditComment, , doQueue]; CDSequencer.ImplementCommand[$CommentOb, EditComment, , doQueue]; CDSequencer.ImplementCommand[$SignalNameS, EnterSignalNameSP]; CDSequencer.ImplementCommand[$InstanceNameS, EnterInstanceNameSP]; CDSequencer.ImplementCommand[$PropertyDesign, PropertyDesign]; CDSequencer.ImplementCommand[$PropertyApp, PropertyApp]; CDSequencer.ImplementCommand[$PropertyOb, PropertyOb]; CDSequencer.ImplementCommand[$ShowPropertiesS, ShowPropertiesSP,, doQueue]; CDSequencer.ImplementCommand[$ShowPropertiesDesign, ShowPropertiesDesign,, doQueue]; Register[3, $RenameDesign, "rename design"]; Register[2, $RenameS, "rename object"]; Register[3, $PropertyDesign, "property (design)", "add/change a property"]; Register[2, $PropertyApp, "property (instance)", "add/change a property"]; Register[1, $PropertyOb, "property (object)", "add/change a property"]; Register[3, $CommentDesign, "comment (design)", "edit the comment view"]; Register[2, $CommentApp, "comment (instance)", "edit the comment view"]; Register[1, $CommentOb, "comment (object)", "edit the comment view"]; Register[2, $InstanceNameS, "instance-name", "accept an instancename"]; Register[2, $SignalNameS, "signal-name (instance)", "accept a signalname"]; Register[3, $ShowPropertiesDesign, "list prop (design)", "list properties hanging on design"]; Register[2, $ShowPropertiesS, "list prop (i&o)", " | list properties of selected object"]; Register[3, $DisplayNames, "display signal-names", " | signal names of all visible objects"]; CDSequencer.ImplementCommand[$NameMenu, NameMenuComm, , dontQueue]; END.