<<>> <> <> <> <> <<>> DIRECTORY IO, Prop, Rope, TEditDocument, TEditOps, TEditSelection, TiogaAccess, TiogaAccessViewers, ViewerClasses, PropRegistry; TiogaRegistryImpl: CEDAR PROGRAM IMPORTS IO, Prop, Rope, TEditOps, TEditSelection, TiogaAccess, TiogaAccessViewers, PropRegistry = BEGIN ROPE: TYPE = PropRegistry.ROPE; Doc: TYPE = PropRegistry.Doc; Key: TYPE = PropRegistry.Key; lf: ROPE = "\l"; LFNewLine: PROC [in: ROPE] RETURNS [out: ROPE] = { size: INT = Rope.Size[in]; out ¬ in; FOR index: INT ¬ Rope.SkipTo[s: in, pos: 0, skip: "\l\r"], Rope.SkipTo[s: in, pos: index+1, skip: "\l\r"] UNTIL index = size DO out ¬ Rope.Replace[base: out, start: index, len: 1, with: lf]; ENDLOOP; }; TiogaPropGet: PropRegistry.PropGetProc = { <> reader: TiogaAccess.Reader = TiogaAccessViewers.FromSelection[]; -- really should use locked selection <> firstTime: BOOL ¬ TRUE; -- look for uniqueness val: REF; IF TiogaAccess.EndOf[reader] THEN RETURN[NIL, "empty Tioga selection"]; BEGIN notFound: ROPE = IO.PutFR1["Property %g not found", IO.atom[key] ]; UNTIL TiogaAccess.EndOf[reader] DO tc: TiogaAccess.TiogaChar ¬ TiogaAccess.Get[reader]; IF tc.endOfNode THEN LOOP; -- only do char props, not node props val ¬ Prop.Get[tc.propList, key]; IF firstTime THEN { prop ¬ IF val=NIL THEN notFound ELSE TiogaAccess.GetExternalProp[key, val]; firstTime ¬ FALSE; } ELSE { sameProp: ROPE ¬ IF val=NIL THEN notFound ELSE TiogaAccess.GetExternalProp[key, val]; IF NOT Rope.Equal[prop, sameProp] THEN GOTO NotUniqueVal; }; ENDLOOP; TiogaAccess.DoneWith[reader]; prop ¬ LFNewLine[prop]; -- fix up stupid newline characters EXITS NotUniqueVal => { prop ¬ NIL; error ¬ IO.PutFR1["Characters don't have uniform property values for prop: %g", IO.atom[key]]; TiogaAccess.DoneWith[reader]; }; END; }; TiogaPropSet: PropRegistry.PropSetProc = { <> out: TiogaAccess.Writer ¬ TiogaAccess.Create[]; in: TiogaAccess.Reader ¬ TiogaAccessViewers.FromSelection[]; -- really should use locked selection UNTIL TiogaAccess.EndOf[in] DO tc: TiogaAccess.TiogaChar; DO tc ¬ TiogaAccess.Get[in]; IF tc.endOfNode THEN EXIT; tc.propList ¬ Prop.Put[tc.propList, key, TiogaAccess.GetInternalProp[key, prop]]; TiogaAccess.Put[out, tc]; ENDLOOP; TiogaAccess.Put[out, tc]; ENDLOOP; TiogaAccess.DoneWith[in]; TiogaAccessViewers.WriteSelection[out]; }; TiogaPropRem: PropRegistry.PropRemProc = { <> out: TiogaAccess.Writer ¬ TiogaAccess.Create[]; in: TiogaAccess.Reader ¬ TiogaAccessViewers.FromSelection[]; -- really should use locked selection UNTIL TiogaAccess.EndOf[in] DO tc: TiogaAccess.TiogaChar; DO tc ¬ TiogaAccess.Get[in]; IF tc.endOfNode THEN EXIT; tc.propList ¬ Prop.Rem[tc.propList, key]; TiogaAccess.Put[out, tc]; ENDLOOP; TiogaAccess.Put[out, tc]; ENDLOOP; TiogaAccess.DoneWith[in]; TiogaAccessViewers.WriteSelection[out]; }; TiogaPropList: PropRegistry.PropListProc = { <> reader: TiogaAccess.Reader = TiogaAccessViewers.FromSelection[]; <> UNTIL TiogaAccess.EndOf[reader] DO tc: TiogaAccess.TiogaChar ¬ TiogaAccess.Get[reader]; IF tc.endOfNode THEN LOOP; -- only do char props, not node props FOR keys: Prop.PropList ¬ tc.propList, keys.rest UNTIL keys=NIL DO props ¬ CONS[NARROW[keys.first.key], props]; ENDLOOP; ENDLOOP; }; TiogaGetTarget: PropRegistry.GetTargetProc = { <> IF TEditSelection.IsDown[primary] THEN RETURN[ FALSE, [doc, NIL] ] ELSE { newSel: TEditDocument.Selection ¬ TEditSelection.Create[]; TEditSelection.Copy[source: TEditOps.GetSelData[], dest: newSel]; RETURN [TRUE, [doc, newSel]]; }; }; TiogaSetTarget: PropRegistry.SetTargetProc = { <> sel: TEditDocument.Selection ¬ NARROW[t.targetData]; [success, error] ¬ TiogaValidateTarget[doc: doc, hint: hint, t: t]; IF success THEN TEditSelection.MakeSelection[sel, primary]; }; TiogaValidateTarget: PropRegistry.ValidateTargetProc = { <> v: ViewerClasses.Viewer ~ NARROW[doc]; success ¬ NOT (v.destroyed OR v.iconic); IF NOT success THEN error ¬ IF v.destroyed THEN "target viewer destroyed" ELSE "target viewer iconic" }; RegisterTioga: PROC = { class: PropRegistry.RegistryClass ¬ NEW[PropRegistry.RegistryClassObj]; class­¬ [ name: $Text, getProp: TiogaPropGet, setProp: TiogaPropSet, remProp: TiogaPropRem, listProps: TiogaPropList, getTarget: TiogaGetTarget, setTarget: TiogaSetTarget, validTarget: TiogaValidateTarget ]; PropRegistry.Register[class]; }; RegisterTypescript: PROC = { class: PropRegistry.RegistryClass ¬ NEW[PropRegistry.RegistryClassObj]; class­¬ [ name: $Typescript, getProp: TiogaPropGet, setProp: TiogaPropSet, remProp: TiogaPropRem, listProps: TiogaPropList, getTarget: TiogaGetTarget, setTarget: TiogaSetTarget, validTarget: TiogaValidateTarget ]; PropRegistry.Register[class]; }; RegisterTioga[]; RegisterTypescript[]; END.