MakeDoAuxImpl.Mesa
Copyright Ó 1991 by Xerox Corporation. All rights reserved.
Mike Spreitzer September 4, 1986 10:56:54 pm PDT
Carl Hauser, April 11, 1985 3:43:34 pm PST
Last tweaked by Mike Spreitzer on October 6, 1992 11:19 am PDT
Eduardo Pelegri-Llopart March 17, 1989 8:40:08 am PST
JKF January 11, 1989 10:29:32 am PST
Willie-s, April 10, 1992 4:34 pm PDT
Michael Plass, November 27, 1991 10:38 am PST
DIRECTORY
Basics USING [IsBound],
BasicTime USING [GetClockPulses],
Commander USING [CommandObject, Handle],
CommanderOps USING [DoCommand],
Convert USING [RopeFromTime],
FileNames USING [CurrentWorkingDirectory],
FS,
Icons USING [IconFlavor, NewIconFromFile],
IO USING [card, Close, GetChar, noInputStream, PutChar, PutF1, PutFL, PutFR, rope, STREAM, Value],
List USING [AList, Assoc, PutAssoc],
MakeDo,
MakeDoPrivate USING [Action, ActionRep, IconSeq, IconSeqPrivate, Job, Node, NodeClass, NodeClassRep, NodeList, NodeRep, StartTime],
MakeDoPorting USING [logPath],
ProcessProps USING [AddPropList, GetPropList],
RefTab,
Rope,
SimpleFeedback USING [Append, Blink],
SymTab,
UserProfile USING [CallWhenProfileChanges, ProfileChangeReason, Token];
MakeDoAuxImpl: CEDAR MONITOR
IMPORTS Basics, BasicTime, CommanderOps, Convert, FileNames, FS, Icons, IO, List, MakeDo, MakeDoPrivate, MakeDoPorting, ProcessProps, RefTab, Rope, SimpleFeedback, SymTab, UserProfile
EXPORTS MakeDo, MakeDoPrivate
INVARIANT
Job
node table
=
BEGIN OPEN MakeDo, MakeDoPrivate;
RefTableE: TYPE = MakeDo.RefTable;
ROPE: TYPE = Rope.ROPE;
NodeRep: PUBLIC TYPE = MakeDoPrivate.NodeRep;
ActionRep: PUBLIC TYPE = MakeDoPrivate.ActionRep;
NodeClassRep: PUBLIC TYPE = MakeDoPrivate.NodeClassRep;
Warning: PUBLIC SIGNAL [message: ROPE] = CODE;
debugging: PUBLIC BOOL ¬ FALSE;
leafClass: ActionClass ¬ NEW [ActionClassRep ¬ []];
leaf: PUBLIC Action ¬ NEW [ActionRep ¬ [cmd: "-- leaf", class: leafClass]];
nodes: SymTab.Ref ¬ SymTab.Create[case: FALSE];
installationDirectory: ROPE = FileNames.CurrentWorkingDirectory[];
defaultIconFileShortName: ROPE = "MakeDo-MTV.icons";
iconsFileName: ROPE ¬ NIL;
icons: PUBLIC IconSeq;
LoadIcons: PROC [fileName: ROPE] RETURNS [icons: IconSeq] = {
nIcons: NAT ¬ 0;
flavors: LIST OF Icons.IconFlavor ¬ NIL;
FOR nIcons ¬ 0, nIcons+1 DO
flavor: Icons.IconFlavor = Icons.NewIconFromFile[fileName, nIcons];
IF flavor = unInit THEN EXIT;
flavors ¬ CONS[flavor, flavors];
ENDLOOP;
icons ¬ NEW [IconSeqPrivate[nIcons]];
FOR i: NAT DECREASING IN [0 .. icons.length) DO
icons[i] ¬ flavors.first;
flavors ¬ flavors.rest;
ENDLOOP;
IF flavors # NIL THEN ERROR;
};
DoInWDir: PROC [wDirRope: ROPE, inner: PROC] ~ {
propList: List.AList ~ List.PutAssoc[key: wDirKey, val: wDirRope, aList: NIL];
ProcessProps.AddPropList[propList: propList, inner: inner];
};
wDirKey: ATOM ~ $WorkingDirectory;
NoteProfile: PROC [reason: UserProfile.ProfileChangeReason] --UserProfile.ProfileChangedProc-- = {
proFileName: ROPE = UserProfile.Token["MakeDo.IconFile", defaultIconFileShortName];
Try: PROC [short: ROPE] RETURNS [ok: BOOL ¬ TRUE] ~ {
TryInWDir: PROC ~ {
icons ¬ LoadIcons[short !FS.Error => {
ok ¬ FALSE;
SimpleFeedback.Append[$MakeDo, oneLiner, $info, Rope.Concat["Problem loading MakeDo icons from ", short]];
SimpleFeedback.Blink[$MakeDo, $info];
CONTINUE}];
IF ok THEN iconsFileName ¬ short;
RETURN};
IF short.Equal[iconsFileName, FALSE] THEN RETURN;
DoInWDir[installationDirectory, TryInWDir];
RETURN};
IF Basics.IsBound[Icons.NewIconFromFile] THEN
IF NOT (Try[proFileName] OR Try[defaultIconFileShortName]) THEN {
icons ¬ NEW [IconSeqPrivate[1]];
icons[0] ¬ tool;
iconsFileName ¬ NIL;
};
};
GetNode: PUBLIC ENTRY PROC [someName: ROPE, class: NodeClass, mayAdd: BOOL ¬ TRUE] RETURNS [node: Node] = {
ENABLE UNWIND => NULL;
canonicalName: ROPE ¬ IF class # NIL THEN class.CanonizeName[someName] ELSE someName;
IF (node ¬ NARROW[nodes.Fetch[canonicalName].val]) = NIL AND mayAdd THEN {
node ¬ NEW [NodeRep ¬ [given: someName, name: canonicalName, class: class, memberships: MakeRefTable[]]];
StartTime[node];
IF NOT nodes.Insert[canonicalName, node] THEN ERROR;
}
ELSE IF node = NIL THEN NULL
ELSE IF class # node.class THEN ERROR;
};
EnumerateAndDestroy: PUBLIC ENTRY PROC [to: PROC [Node], andDestroy--table when done--: BOOL] = {
ENABLE UNWIND => {};
PerNode: PROC [key, val: REF ANY] RETURNS [stop: BOOL ¬ FALSE] --RefTab.EachPairAction-- = {
n: Node = NARROW[val];
to[n];
RETURN [FALSE]};
IF nodes.Pairs[PerNode] THEN ERROR;
IF andDestroy THEN nodes.Erase[];
};
IncrementStepCount: PUBLIC ENTRY PROC [job: Job] = {
ENABLE UNWIND => {};
job.nSteps ¬ job.nSteps + 1;
};
AddFailedCmd: PUBLIC ENTRY PROC [job: Job, a: Action] = {
ENABLE UNWIND => {};
job.failedSteps ¬ CONS[a, job.failedSteps];
};
MakeRefTable: PUBLIC PROC RETURNS [table: RefTable] =
{table ¬ RefTab.Create[]};
AddToRefTable: PUBLIC PROC [ra: REF ANY, t: RefTable] =
{IF NOT t.Insert[ra, $T] THEN ERROR; RETURN};
EnsureRefInTable: PUBLIC PROC [ra: REF ANY, t: RefTable] = {
[] ¬ t.Insert[ra, $T];
RETURN};
DeleteFromRefTable: PUBLIC PROC [ra: REF ANY, t: RefTable] RETURNS [found: BOOL] = {
found ¬ t.Delete[ra];
RETURN};
RefInTable: PUBLIC PROC [ra: REF ANY, t: RefTable] RETURNS [BOOL] = {
RETURN [t.Fetch[ra].found]};
MDInstall: PUBLIC PROC [dir, packageName: ROPE] RETURNS [foundFile, failed: BOOL ¬ TRUE] ~ {
log: IO.STREAM ~ FS.StreamOpen[fileName: Rope.Cat[MakeDoPorting.logPath, packageName, ".InstallLog"], accessOptions: create, keep: 10];
searchRules: REF ANY ¬ List.Assoc[$SearchRules, GetCommanderHandle[].propertyList];
processProps: List.AList ~ List.PutAssoc[$WorkingDirectory, dir, NIL];
cmd: Commander.Handle ~ NEW [Commander.CommandObject ¬ [
in: IO.noInputStream,
out: log,
err: log,
commandLine: NIL,
propertyList: List.PutAssoc[$SearchRules, searchRules, NIL]
]];
Doit: PROC ~ {
failed ¬ CommanderOps.DoCommand[Rope.Concat[
"Install ",
packageName
], cmd] = $Failure;
RETURN;
};
ProcessProps.AddPropList[processProps, Doit];
log.Close[];
RETURN};
chKey: ATOM ¬ $CommanderHandle;
GetCommanderHandle: PUBLIC PROC RETURNS [ch: Commander.Handle] = {
ch ¬ NARROW[List.Assoc[chKey, ProcessProps.GetPropList[]]];
IF ch = NIL THEN ERROR;
};
fineTime: BOOL ¬ FALSE;
Log: PUBLIC PROC [fmt: ROPE, v1, v2, v3, v4, v5: IO.Value ¬ [null[]]] =
BEGIN
out: IO.STREAM ¬ GetCommanderHandle[].out;
IF fineTime THEN out.PutF1["%g:", IO.card[BasicTime.GetClockPulses[]]];
out.PutFL[fmt, LIST[v1, v2, v3, v4, v5]];
out.PutChar['\n];
END;
Confirm: PUBLIC PROC [action: ROPE] =
BEGIN
ch: Commander.Handle = GetCommanderHandle[];
in: IO.STREAM = ch.in;
out: IO.STREAM = ch.out;
out.PutF1["Ready to %g ? ", IO.rope[action]];
WHILE in.GetChar[] # '\n DO NULL ENDLOOP;
END;
Exists: PUBLIC PROC [n: Node, zeroLenExists: BOOLTRUE] RETURNS [exists: BOOL] =
{created: Time; length: INT;
[created, length] ¬ GetInfo[n];
RETURN [(created # notExistTime) AND (zeroLenExists OR length#0)]};
InnerExists: PUBLIC PROC [n: Node, zeroLenExists: BOOLTRUE] RETURNS [exists: BOOL] =
{created: Time; length: INT;
[created, length] ¬ InnerGetInfo[n];
RETURN [(created # notExistTime) AND (zeroLenExists OR length#0)]};
FmtTime: PUBLIC PROC [t: Time] RETURNS [asRope: ROPE] = {
asRope ¬ SELECT t FROM
notExistTime => "never",
unknownTime => "unknown",
ENDCASE => Convert.RopeFromTime[from: t, end: seconds, useAMPM: FALSE, includeZone: FALSE];
};
PublicPartsOfNode: PUBLIC PROC [n: Node] RETURNS [name: ROPE, class: NodeClass] = {
RETURN [
name: n.name,
class: n.class];
};
DescribeNode: PUBLIC PROC [n: Node] RETURNS [r: ROPE] = {
SELECT n.class FROM
fileClass => {
r ¬ n.name;
};
ENDCASE => {
r ¬ IO.PutFR["(%g %g)", [refAny[n.class.name]], [refAny[n.name]]];
};
};
PublicPartsOfAction: PUBLIC PROC [a: Action] RETURNS [cmd: ROPE, foundData: REF ANY, class: ActionClass] = {
RETURN [
cmd: a.cmd,
foundData: a.foundData,
class: a.class];
};
DestructivelyReverseActionList: PUBLIC PROC [old: ActionList] RETURNS [new: ActionList] = {
prev: ActionList ¬ NIL;
cur: ActionList ¬ old;
WHILE cur # NIL DO
next: ActionList ¬ cur.rest;
cur.rest ¬ prev;
prev ¬ cur;
cur ¬ next;
ENDLOOP;
new ¬ prev;
};
EnglishList: PUBLIC PROC [nl: NodeList] RETURNS [el: ROPE, ec: CARDINAL] =
BEGIN
twoOfMany: ROPE;
ec ¬ 0;
FOR nl ¬ nl, nl.rest WHILE nl # NIL DO
SELECT ec FROM
=0 => el ¬ nl.first.name;
=1 => {
twoOfMany ¬ nl.first.name.Cat[", and ", el];
el ¬ nl.first.name.Cat[" and ", el];
};
=2 => el ¬ nl.first.name.Cat[", ", twoOfMany];
>2 => el ¬ nl.first.name.Cat[", ", el];
ENDCASE => ERROR;
ec ¬ ec + 1;
ENDLOOP;
END;
IsNode: PUBLIC PROC [ra: REF ANY] RETURNS [BOOL] =
{RETURN [ISTYPE[ra, Node]]};
NarrowToNode: PUBLIC PROC [ra: REF ANY] RETURNS [Node] =
{RETURN[NARROW[ra]]};
IsAction: PUBLIC PROC [ra: REF ANY] RETURNS [BOOL] =
{RETURN [ISTYPE[ra, Action]]};
NarrowToAction: PUBLIC PROC [ra: REF ANY] RETURNS [Action] =
{RETURN[NARROW[ra]]};
IsNodeClass: PUBLIC PROC [ra: REF ANY] RETURNS [BOOL] =
{RETURN [ISTYPE[ra, NodeClass]]};
NarrowToNodeClass: PUBLIC PROC [ra: REF ANY] RETURNS [NodeClass] =
{RETURN[NARROW[ra]]};
UserProfile.CallWhenProfileChanges[NoteProfile];
END.