<> <> <> <> <> DIRECTORY AlpineEnvironment USING[ Property], AlpineFile USING [ PropertySet], Atom USING[ GetPName ], Buttons USING[ Button, ButtonProc, Create, Destroy, SetDisplayStyle ], Commander USING[ CommandProc, Register ], Containers USING[ ChildXBound, ChildYBound, Create ], IO, Labels USING[ Create ], MBQueue USING[ Create, CreateButton, Queue ], Process, Rope, Rules USING[ Create ], TypeScript USING[ Create ], UserProfile USING[ CallWhenProfileChanges, ListOfTokens, ProfileChangedProc ], ViewerClasses USING[ Viewer ], ViewerIO USING[ CreateViewerStreams ], ViewerOps USING[ ComputeColumn, DestroyViewer, MoveViewer, SetOpenHeight ], ViewerTools USING[ GetContents, GetSelectedViewer, MakeNewTextViewer, SetContents, SelPosRec, SetSelection], YodelData; YodelRootImpl: CEDAR MONITOR LOCKS d USING d: MyData IMPORTS Atom, Buttons, Commander, Containers, IO, Labels,MBQueue, Process, Rope, Rules, TypeScript, UserProfile, ViewerIO, ViewerOps, ViewerTools, YodelData EXPORTS YodelData = BEGIN OPEN YodelData ; NamePrefixes: LIST OF ROPE _ NIL; defaultNamePrefixes: LIST OF ROPE = LIST[ "[Luther.Alpine]", "[Ebbetts.Alpine]", "[Ivy]", "[Indigo]", "[Cyan]", "" ]; PropertySetToRopeArray: PUBLIC ARRAY [0..NumberOfAlpineProperties) OF PropertySetToRope _ [ [byteLength, "byteLength"], [createTime, "createTime"], [highWaterMark, "highWaterMark"], [modifyAccess, "modifyAccess"], [owner, "owner"], [readAccess, "readAccess"], [stringName, "stringName"], [version, "version"] ]; <<******** Enquiry operations ******** >> ROPE: TYPE = Rope.ROPE; Create: Commander.CommandProc = { <<[exec: ExecHandle, clientData: REF ANY _ NIL] RETURNS[ok: BOOLEAN _ TRUE]>> d: MyData = NEW[MyDataObject]; <> v: ViewerClasses.Viewer = Containers.Create[ info: [name: "Yodel", column: left, scrollable: FALSE, iconic: TRUE]]; TRUSTED {Process.InitializeCondition[@d.condition, Process.MsecToTicks[250]];}; d.DelVerCount _ 1; BEGIN <> temp1: Buttons.Button = Buttons.Create[ info: [name: "Dest Server:", parent: v, border: FALSE, wx: 0, wy: 0], proc: NIL, clientData: d, fork: FALSE, paint: FALSE]; temp2: Buttons.Button = Buttons.Create[ info: [name: "highWaterMark", parent: v, border: FALSE, wx: 0, wy: 0], proc: NIL, clientData: d, fork: FALSE, paint: FALSE]; d.q _ MBQueue.Create[]; d.maxW _ temp1.ww; d.buttH _ temp1.wh; d.maxBW _ temp2.ww; Buttons.Destroy[temp1]; Buttons.Destroy[temp2]; END; <> d.displayProperties[byteLength] _ TRUE; d.displayProperties[createTime] _ TRUE; <> d.topChild _ CreateSelector[name: "Level:", values: LIST[$User, $FileProperties, $OwnerProperties, $Administrator, $STOP], change: ChangeLevel, clientData: d, viewer: v, x: 2, y: 1].child; <> <> d.script _ TypeScript.Create[ info: [parent: v, wh: v.ch - (d.topChild.wy + d.topChild.wh + 2), ww: v.cw, border: FALSE, wy: d.topChild.wy + d.topChild.wh + 2, wx: 0] ]; Containers.ChildXBound[v, d.script]; Containers.ChildYBound[v, d.script]; [in: d.in, out: d.out] _ ViewerIO.CreateViewerStreams[NIL, d.script]; CreateButtons[d, v]; }; ChangeLevel: PROC[parent: ViewerClasses.Viewer, clientData: REF ANY, value: ATOM] = BEGIN d: MyData = NARROW[clientData]; p: ViewerClasses.Viewer = NARROW[parent]; SELECT value FROM $User => d.level _ user; $FileProperties => d.level _ fileProperties; $OwnerProperties => d.level _ ownerProperties; $Administrator => d.level _ administrator; $STOP => { d.stopFlag _ TRUE ; RETURN; }; ENDCASE => { d.out.PutRope["\nNot Implemented\n"]; }; CreateButtons[d, parent] END; <> CreateButtons: PUBLIC ENTRY PROC[d: MyData, parent: ViewerClasses.Viewer] = { child: ViewerClasses.Viewer _ NIL; EnquiryButton: PROC[q: MBQueue.Queue, name: Rope.ROPE, proc: Buttons.ButtonProc, width: INTEGER _ d.maxW, guarded: BOOL _ FALSE, doc:Rope.ROPE _ NIL] = BEGIN IF q # NIL THEN child _ q.CreateButton[ info: [name: name, parent: kids, border: TRUE, wy: child.wy, wx: child.wx + width - 1, ww: width], proc: proc, clientData: d, paint: FALSE, guarded: guarded, documentation: doc] ELSE child _ Buttons.Create[ info: [name: name, parent: kids, border: TRUE, wy: child.wy, wx: child.wx + width - 1, ww: width], proc: proc, clientData: d, paint: FALSE, guarded: guarded, documentation: doc]; END; LabelText: PROC[q: MBQueue.Queue, name, data: Rope.ROPE, prev: ViewerClasses.Viewer, width: INTEGER _ d.maxW, textWidth: INTEGER _ 2*d.maxW, newline: BOOL _ TRUE, textLabelProc: Buttons.ButtonProc _ OtherTextLabelProc] RETURNS[ViewerClasses.Viewer] = BEGIN x: INTEGER = IF newline THEN 2 ELSE child.wx + width + (textWidth) - 1; y: INTEGER = IF newline THEN child.wy + child.wh + 1 ELSE child.wy; child _ ViewerTools.MakeNewTextViewer[ info: [parent: kids, wh: d.buttH, ww: width + (textWidth), scrollable: FALSE, data: IF prev = NIL THEN data ELSE ViewerTools.GetContents[prev], border: FALSE, wx: x + width + 2, wy: y], paint: FALSE ]; [] _ q.CreateButton[ info: [name: name, parent: kids, wh: d.buttH, border: FALSE, wx: x, wy: y], proc: textLabelProc, clientData: child, paint: FALSE]; RETURN[child] END; Label: PROC[name: Rope.ROPE] = { child _ Labels.Create[ info: [name: name, parent: kids, border: FALSE, wy: child.wy + child.wh + (IF child.class.flavor = $Button THEN -1 ELSE 2), wx: 2], paint: FALSE ]; }; Rule: PROC = { child _ Rules.Create[ info: [parent: kids, border: FALSE, wy: IF child = NIL THEN 0 ELSE child.wy + child.wh + 2, wx: 0, ww: kids.ww, wh: 1], paint: FALSE ]; Containers.ChildXBound[kids, child]; }; userButtons: PROC = { Label["Command: "]; EnquiryButton[q: d.q, name: "List", proc: ListFilesProc]; EnquiryButton[q: d.q, name: "Delete", proc: DeleteFilesProc, guarded: FALSE]; EnquiryButton[q: d.q, name: "Copy", proc: CopyFilesProc]; EnquiryButton[q: d.q, name: "FullCopy", proc: FullCopyFilesProc]; EnquiryButton[q: d.q, name: "Options", proc: OptionsProc]; Label[""]; <> <> <> EnquiryButton[q: d.q, name: "Rename", proc: RenameProc]; IF d.displayOptions THEN { buttonCount: INTEGER _ 0 ; count: INT; option: AlpineEnvironment.Property; propertyName: ROPE ; Rule[]; Label["List options: "]; FOR count IN [0..NumberOfAlpineProperties) DO [option, propertyName] _ PropertySetToRopeArray[count]; IF (buttonCount >= 4) THEN { Label[""]; buttonCount _ 0 ; }; buttonCount _ buttonCount + 1 ; EnquiryButton[q: NIL, name: propertyName, proc: ChangeOptionsProc, width: d.maxBW]; IF d.displayProperties[option] THEN { Buttons.SetDisplayStyle[child, $WhiteOnBlack]; }; ENDLOOP; Label["Priority option:"]; EnquiryButton[q: NIL, name: "Background", proc: ChangePriorityProc, width: d.maxBW]; IF d.background THEN Buttons.SetDisplayStyle[child, $WhiteOnBlack]; Label["Delete options:"]; EnquiryButton[q: NIL, name: "AutoDelete", proc: ChangeAutoDeleteProc, width: d.maxBW]; IF d.AutoDelete THEN Buttons.SetDisplayStyle[child, $WhiteOnBlack]; propertyName _ Rope.Cat["Keep ", IO.PutFR["%g", IO.int[d.DelVerCount]], " versions"]; EnquiryButton[q: NIL, name: propertyName, proc: ChangeDelVerProc, width: d.maxBW]; }; }; filePropertiesButtons: PROC = { Label["Function: "]; EnquiryButton[q: d.q, name: "Examine", proc: ExamineProc]; EnquiryButton[q: d.q, name: "Apply", proc: ApplyProc, guarded: TRUE, doc: "Apply requires confirmation; single file application only"]; Rule[]; d.oStringName _ LabelText[ q: d.q, name: "stringName:", data: "", prev: d.oStringName, width: d.maxBW, textWidth: 5*d.maxW]; d.oByteLength _ LabelText[ q: d.q, name: "byteLength:", data: "", prev: d.oByteLength, width: d.maxBW, textWidth: d.maxW/2 ]; d.oSize _ LabelText[ q: d.q, name: "size:", data: "", prev: d.oSize, width: d.maxBW, textWidth: d.maxW/2, newline: FALSE ]; d.oFileKeep _ LabelText[ q: d.q, name: "keep:", data: "", prev: d.oFileKeep, width: d.maxBW, textWidth: d.maxW/2, newline: FALSE ]; d.oHighWaterMark _ LabelText[ q: d.q, name: "highWaterMark:", data: "", prev: d.oHighWaterMark, width: d.maxBW, textWidth: d.maxW/2 ]; d.oOwner _ LabelText[ q: d.q, name: "owner:", data: "", prev: d.oOwner, width: d.maxBW, textWidth: d.maxW/2, newline: FALSE ]; d.oVersion _ LabelText[ q: d.q, name: "version:", data: "", prev: d.oVersion, width: d.maxBW, textWidth: d.maxW/2, newline: FALSE ]; d.oReadAccess _ LabelText[ q: d.q, name: "readAccess:", data: "", prev: d.oReadAccess, width: d.maxBW, textWidth: 5*d.maxW]; d.oModifyAccess _ LabelText[ q: d.q, name: "modifyAccess:", data: "", prev: d.oModifyAccess, width: d.maxBW, textWidth: 5*d.maxW]; }; ownerPropertiesButtons: PROC = { Label["Function: "]; EnquiryButton[q: d.q, name: "Quota", proc: QuotaProc]; EnquiryButton[q: d.q, name: "Get", proc: GetOwnerPropertiesProc]; EnquiryButton[q: d.q, name: "Put", proc: PutOwnerPropertiesProc, guarded: TRUE, doc: "Put owner properties requires confirmation"]; Rule[]; d.oOwnerKeep _ LabelText[ q: d.q, name: "default Keep:", data: "", prev: d.oOwnerKeep, width: 2*d.maxW, textWidth: d.maxW ]; d.oCreateAccessList _ LabelText[ q: d.q, name: "createAccess:", data: "", prev: d.oCreateAccessList, width: 2*d.maxW, textWidth: 5*d.maxW]; d.oRootReadAccess _ LabelText[ q: d.q, name: "root readAccess:", data: "", prev: d.oRootReadAccess, width: 2*d.maxW, textWidth: 5*d.maxW]; d.oRootModifyAccess _ LabelText[ q: d.q, name: "root modifyAccess:", data: "", prev: d.oRootModifyAccess, width: 2*d.maxW, textWidth: 5*d.maxW]; }; administratorButtons: PROC = { Label["Command: "]; EnquiryButton[q: d.q, name: "CreateOwner", proc: CreateOwnerProc, width: d.maxBW, guarded: TRUE, doc: "Create requires confirmation"]; EnquiryButton[q: d.q, name: "DestroyOwner", proc: DestroyOwnerProc, width: d.maxBW, guarded: TRUE, doc: "Destroy requires confirmation"]; EnquiryButton[q: d.q, name: "WriteQuota", proc: WriteQuotaProc, width: d.maxBW, guarded: TRUE, doc: "Write Quota requires confirmation"]; EnquiryButton[q: d.q, name: "ListOwners", proc: ListOwnersProc, width: d.maxBW]; EnquiryButton[q: d.q, name: "ReadStatistics", proc: ReadDBPropertiesProc, width: d.maxBW]; Rule[]; d.oQuota _ LabelText[ q: d.q, name: "quota:", data: "", prev: d.oQuota, width: d.maxBW, textWidth: 5*d.maxW]; Rule[]; Label["Option: "]; EnquiryButton[q: NIL, name: "Assert Wheel", proc: ChangeAssertWheel, width: d.maxBW]; IF d.assertWheel THEN { Buttons.SetDisplayStyle[child, $WhiteOnBlack]; }; EnquiryButton[q: NIL, name: "Break Locks", proc: ChangeBreakLocks, width: d.maxBW]; IF d.breakLocks THEN { Buttons.SetDisplayStyle[child, $WhiteOnBlack]; }; }; kids: ViewerClasses.Viewer = Containers.Create[ info: [parent: parent, border: FALSE, scrollable: FALSE, wx: 0, wy: -9999, ww: 9999, wh: 0] ]; <> Containers.ChildXBound[parent, kids]; Rule[]; <> d.src _ LabelText[ q: d.q, name: "Source:", data: NamePrefixes.first, prev: d.src, textWidth: 5*d.maxW, textLabelProc: ServerTextLabelProc ]; <> d.dest _ LabelText[ q: d.q, name: "Destination:", data: NamePrefixes.first, prev: d.dest, textWidth: 5*d.maxW, textLabelProc: ServerTextLabelProc ]; IF d.level = user THEN { userButtons[]; IF ~d.AutoDelete THEN { Rule[]; d.oDeleteConfirm _ LabelText[ q: d.q, name: "OK to delete", data: "", prev: NIL, width: d.maxBW, textWidth: 5*d.maxW]; Label[""]; EnquiryButton[q: NIL, name: "", proc: YesProc, width: d.maxBW]; -- Yes d.yesButton _ child; EnquiryButton[q: NIL, name: "", proc: NoProc, width: d.maxBW]; -- No d.noButton _ child; }; } ELSE d.oDeleteConfirm _ NIL; IF d.level = fileProperties THEN filePropertiesButtons[] ELSE { d.oStringName _ d.oByteLength _ d.oHighWaterMark _ d.oSize _ d.oReadAccess _ d.oModifyAccess _ d.oOwner _ d.oFileKeep _ NIL; } ; IF d.level = ownerProperties THEN ownerPropertiesButtons[] ELSE { d.oCreateAccessList _ NIL ; d.oRootReadAccess _ NIL ; d.oRootModifyAccess _ NIL ; d.oOwnerKeep _ NIL ; }; IF d.level = administrator THEN administratorButtons[] ELSE d.oQuota _ NIL; Rule[]; { kidsY: INTEGER = d.topChild.wy + d.topChild.wh + 2; kidsH: INTEGER = child.wy + child.wh + 2; IF d.kids # NIL THEN ViewerOps.DestroyViewer[d.kids, FALSE]; d.kids _ kids; ViewerOps.MoveViewer[viewer: d.script, x: 0, y: kidsY + kidsH, w: d.script.ww, h: parent.ch - (kids.wy + kidsH), paint: FALSE]; ViewerOps.SetOpenHeight[parent, kidsY + kidsH + 8 * d.buttH]; IF NOT parent.iconic THEN ViewerOps.ComputeColumn[parent.column]; ViewerOps.MoveViewer[viewer: kids, x: kids.wx, y: kidsY, w: kids.ww, h: kidsH]; }; }; ServerTextLabelProc: Buttons.ButtonProc = { <> text: ViewerClasses.Viewer = NARROW[clientData]; selection: REF ViewerTools.SelPosRec _ NIL; SELECT mouseButton FROM red => { IF ViewerTools.GetSelectedViewer[] = text THEN { NextName: PROC [this: ROPE, list: LIST OF ROPE] RETURNS [next: ROPE _ NIL] = { IF list = NIL THEN RETURN; FOR l: LIST OF ROPE _ list, l.rest UNTIL l = NIL DO IF this.Equal[l.first, FALSE] THEN RETURN[IF l.rest = NIL THEN list.first ELSE l.rest.first] ENDLOOP; RETURN[list.first] }; contents: ROPE _ ViewerTools.GetContents[text]; ViewerTools.SetContents[text, contents _ NextName[contents, NamePrefixes]]; selection _ NEW[ViewerTools.SelPosRec _ [start: contents.Length[], length: 0]]; }; ViewerTools.SetSelection[text, selection]; }; blue => { ViewerTools.SetContents[text, NIL]; ViewerTools.SetSelection[text, NIL] }; yellow => NULL; ENDCASE => ERROR; }; OtherTextLabelProc: Buttons.ButtonProc = { <> text: ViewerClasses.Viewer = NARROW[clientData]; SELECT mouseButton FROM red => ViewerTools.SetSelection[text, NIL]; blue => { ViewerTools.SetContents[text, NIL]; ViewerTools.SetSelection[text, NIL] }; yellow => NULL; ENDCASE => ERROR; }; Selector: TYPE = REF SelectorRec; SelectorRec: TYPE = RECORD[ value: REF ATOM, change: PROC[parent: ViewerClasses.Viewer, clientData: REF ANY, value: ATOM], clientData: REF ANY, buttons: LIST OF Buttons.Button, values: LIST OF ATOM ]; CreateSelector: PROC[ name: Rope.ROPE, values: LIST OF ATOM, init: REF ATOM _ NIL, change: PROC[parent: ViewerClasses.Viewer, clientData: REF ANY, value: ATOM] _ NIL, clientData: MyData, viewer: ViewerClasses.Viewer, x, y: INTEGER] RETURNS[child: ViewerClasses.Viewer, value: REF ATOM] = { selector: Selector _ NEW[ SelectorRec _ [value: IF init # NIL THEN init ELSE NEW[ATOM_values.first], change: change, clientData: clientData, buttons: NIL, values: values ] ]; last: LIST OF Buttons.Button _ NIL; value _ selector.value; child _ Labels.Create[info: [name: name, parent: viewer, border: FALSE, wx: x, wy: y] ]; FOR a: LIST OF ATOM _ values, a.rest UNTIL a = NIL DO IF a.first = $STOP THEN child _ Buttons.Create[ info: [name: Atom.GetPName[a.first], parent: viewer, border: TRUE, wy: child.wy, wx: child.wx + child.ww + 2], proc: SelectorProc, clientData: selector, fork: TRUE, paint: TRUE] ELSE child _ clientData.q.CreateButton[ info: [name: Atom.GetPName[a.first], parent: viewer, border: TRUE, wy: child.wy, wx: child.wx + child.ww + 2], proc: SelectorProc, clientData: selector, paint: TRUE]; IF last = NIL THEN last _ selector.buttons _ CONS[first: child, rest: NIL] ELSE { last.rest _ CONS[first: child, rest: NIL]; last _ last.rest }; IF a.first = selector.value^ THEN Buttons.SetDisplayStyle[child, $WhiteOnBlack]; ENDLOOP; }; SelectorProc: Buttons.ButtonProc = { <> self: Buttons.Button = NARROW[parent]; selector: Selector = NARROW[clientData]; buttons: LIST OF Buttons.Button _ selector.buttons; changeHighlight: BOOL = NOT Rope.Equal[self.name,"STOP"]; FOR a: LIST OF ATOM _ selector.values, a.rest UNTIL a = NIL DO IF self = buttons.first THEN BEGIN selector.value^ _ a.first; IF selector.change # NIL THEN selector.change[self.parent, selector.clientData, a.first]; IF changeHighlight THEN Buttons.SetDisplayStyle[buttons.first, $WhiteOnBlack]; END ELSE IF changeHighlight THEN Buttons.SetDisplayStyle[buttons.first, $BlackOnWhite]; buttons _ buttons.rest; ENDLOOP; }; ReactToProfile: UserProfile.ProfileChangedProc = { NamePrefixes _ UserProfile.ListOfTokens[ key: "Yodel.NamePrefixes", default: defaultNamePrefixes ]; }; Commander.Register[key: "Yodel", proc: Create, doc: "Performs Chat-like functions for Alpine File Servers"]; ReactToProfile[firstTime]; UserProfile.CallWhenProfileChanges[ReactToProfile]; END. <> <> <<>> <> <> <> <> <<>>