DFInternalImpl.mesa
Copyright © 1984, 1985 by Xerox Corporation. All rights reserved.
Levin on December 16, 1983 2:05 pm
Russ Atkinson, March 19, 1985 6:10:27 pm PST
Russ Atkinson (RRA) May 15, 1985 6:53:19 pm PDT
DIRECTORY
BasicTime USING [GMT, nullGMT],
DFInternal USING [Client, LocalFileInfo, RemoteFileInfo],
DFOperations USING [AbortInteraction, DFInfoInteraction, FileInteraction, InfoClass, InfoInteraction, InteractionProc, YesNoInteraction, YesNoResponse],
DFUtilities USING [Date, DateToRope, RemoveVersionNumber],
FS USING [ComponentPositions, Error, ErrorDesc, ExpandName, FileInfo],
IO USING [PutF, PutFR, rope, STREAM],
Process USING [CheckForAbort, Pause, SecondsToTicks, Ticks],
Rope USING [Concat, Flatten, Fetch, Length, ROPE];
DFInternalImpl:
CEDAR
PROGRAM
IMPORTS DFUtilities, FS, IO, Process, Rope
EXPORTS DFInternal = BEGIN
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
Global "variables"
retryInterval: Process.Ticks ← Process.SecondsToTicks[5];
abort:
REF DFOperations.AbortInteraction ←
NIL;
logically, this is constant; it is set by initialization and never changed
Exported to DFInternal
AbortDF: PUBLIC ERROR = CODE;
SimpleInteraction:
PUBLIC
PROC [client: DFInternal.Client, interaction:
REF
ANY] = {
abort: BOOL;
message: ROPE;
IF client = NIL THEN RETURN;
DoLogging[interaction, client.log];
[abort: abort, abortMessageForLog: message] ← client.proc[interaction, client.data];
IF abort
THEN {
[] ← client.proc[NEW[DFOperations.InfoInteraction ← [class: $abort, message: message]], client.data];
DoAbort[client.log, message];
};
};
YesOrNo:
PUBLIC
PROC [client: DFInternal.Client, message:
ROPE, default:
BOOL, blunder:
BOOL ←
FALSE]
RETURNS [choice:
BOOL] = {
response:
REF
ANY = DoInteraction[
client,
NEW[DFOperations.YesNoInteraction ← [
message: message,
blunder: blunder,
default: default
]]
];
choice ← default;
WITH response
SELECT
FROM
r: REF DFOperations.YesNoResponse => choice ← r^;
ENDCASE;
};
DoInteraction:
PUBLIC
PROC [client: DFInternal.Client, interaction:
REF
ANY]
RETURNS [response:
REF
ANY] = {
abort: BOOL;
message: ROPE;
IF client = NIL THEN RETURN [NIL];
DoLogging[interaction, client.log];
[abort, message, response] ← client.proc[interaction, client.data];
IF abort
THEN {
[] ← client.proc[NEW[DFOperations.InfoInteraction ← [class: $abort, message: message]], client.data];
DoAbort[client.log, message];
};
};
CheckAbort:
PUBLIC
PROC [client: DFInternal.Client] = {
Process.CheckForAbort[];
SimpleInteraction[client, abort];
};
DoAbort:
PUBLIC PROC [log:
STREAM, message:
ROPE ←
NIL, proc: DFOperations.InteractionProc ←
NIL, clientData:
REF
ANY ←
NIL] = {
interaction: REF ANY = NEW[DFOperations.InfoInteraction ← [class: $abort, message: message]];
IF proc # NIL AND message # NIL THEN [] ← proc[interaction, clientData];
DoLogging[interaction, log];
ERROR AbortDF
};
DefaultInteractionProc:
PUBLIC DFOperations.InteractionProc
-- [interaction: REF ANY] RETURNS [abort: BOOL ← FALSE, abortMessageForLog: ROPE ← NIL, response: REF ANY ← NIL] -- = {
WITH interaction
SELECT
FROM
a: REF DFOperations.AbortInteraction => RETURN[abort: a.fromABORTED];
ENDCASE;
};
GetFileInfo:
PUBLIC
PROC [info:
REF
ANY, notFoundOK:
BOOL ←
FALSE, remoteCheck:
BOOL ←
FALSE, client: DFInternal.Client ←
NIL, errorLevel: DFOperations.InfoClass ← $error] = {
WITH info
SELECT
FROM
local:
REF DFInternal.LocalFileInfo => {
date: DFUtilities.Date ← [];
name: ROPE ← local.name;
IF local.date.format # $explicit THEN name ← DFUtilities.RemoveVersionNumber[name];
[fullFName: local.name, attachedTo: local.attachedTo, created: date.gmt, keep: local.keep] ←
FS.FileInfo[name: name, remoteCheck: remoteCheck
!
FS.Error =>
SELECT
TRUE
FROM
error.group = $user AND notFoundOK => CONTINUE;
RetryFSOperation[error, client] => RETRY;
client # NIL => ReportFSError[error, info, client, errorLevel];
ENDCASE
];
IF date.gmt # BasicTime.nullGMT THEN date.format ← $explicit;
local.date ← date;
};
remote:
REF DFInternal.RemoteFileInfo => {
date: DFUtilities.Date ← IF remote.date.format = $explicit THEN remote.date ELSE [];
uName: ROPE ← DFUtilities.RemoveVersionNumber[remote.name];
gmt: BasicTime.GMT ← BasicTime.nullGMT;
RRA: The preferred version, regardless of the one hinted at, is the highest version number. This crock helps avoid problems with deleting elderly (but still correct) versions using Chat. Ideally our tools would play together such that this did not happen.
[fullFName: remote.name, created: gmt] ←
FS.FileInfo[name: uName, wantedCreatedTime: date.gmt, remoteCheck:
TRUE
!
FS.Error =>
SELECT
TRUE
FROM
error.group = $user AND notFoundOK => CONTINUE;
RetryFSOperation[error, client] => RETRY;
client # NIL => ReportFSError[error, info, client, errorLevel];
ENDCASE
];
IF gmt # BasicTime.nullGMT
THEN
We have found an explcit date.
date.format ← $explicit;
date.gmt ← gmt;
remote.date ← date;
};
ENDCASE => ERROR;
};
LocalFile:
PUBLIC
PROC [file:
ROPE]
RETURNS [
BOOL ←
FALSE] = {
len: INT ← Rope.Length[file];
IF len > 2
THEN
SELECT Rope.Fetch[file, 0]
FROM
'[, '/ => {
SELECT Rope.Fetch[file, 1]
FROM
'], '/ => RETURN [TRUE];
ENDCASE => RETURN [FALSE];
};
ENDCASE;
Although the given file name does not start with a server, it could be a local file if the working directory is local, so we have to do this the hard way.
RETURN[FS.ExpandName[file ! FS.Error => CONTINUE].cp.server.length = 0]
};
ShortName:
PUBLIC
PROC [file:
ROPE, keepVersion:
BOOL ←
FALSE]
RETURNS [
ROPE] = {
We do our own parsing here for efficiency.
bang: INT ← Rope.Length[file];
pos: INT ← bang;
WHILE pos # 0
DO
SELECT Rope.Fetch[file, pos ← pos - 1]
FROM
'! => IF NOT keepVersion THEN bang ← pos;
'>, '/, '] => {pos ← pos + 1; EXIT};
ENDCASE;
ENDLOOP;
RETURN [Rope.Flatten[file, pos, bang-pos]];
};
RetryFSOperation:
PUBLIC
PROC [error:
FS.ErrorDesc, client: DFInternal.Client]
RETURNS [retry:
BOOL ←
FALSE] = {
IF error.group # $environment THEN RETURN[FALSE];
retry ← YesOrNo[client: client, message: error.explanation.Concat[". Retry?"], default: TRUE];
SELECT error.code
FROM
$serverInaccessible, $connectionRejected, $connectionTimedOut =>
Process.Pause[retryInterval];
ENDCASE;
};
ReportFSError:
PUBLIC
PROC [error:
FS.ErrorDesc, info:
REF
ANY, client: DFInternal.Client, errorLevel: DFOperations.InfoClass ← $error] = {
name: ROPE;
WITH info
SELECT
FROM
remote: REF DFInternal.RemoteFileInfo => name ← remote.name;
local:
REF DFInternal.LocalFileInfo =>
name ← FS.ExpandName[name ← local.name ! FS.Error => CONTINUE].fullFName;
ENDCASE => ERROR;
SimpleInteraction[
client,
NEW[DFOperations.InfoInteraction ← [
class: errorLevel,
message:
IO.PutFR["%gFS.Error%g: %g",
IO.rope[IF error.group = $user THEN NIL ELSE "Unexpected "],
IO.rope[
IF error.explanation.Length[] = 0 THEN Rope.Concat[" manipulating ", name]
ELSE NIL
],
IO.rope[
IF error.explanation.Length[] # 0 THEN error.explanation
ELSE "(no explanation)"
]
]
]]
];
IF errorLevel = $abort AND client # NIL THEN DoAbort[client.log];
};
Internal Procedures
DoLogging:
PROC [interaction:
REF
ANY, log:
STREAM] = {
IF log = NIL THEN RETURN;
WITH interaction
SELECT
FROM
info:
REF DFOperations.InfoInteraction =>
log.PutF["%g%g\N",
IO.rope[
SELECT info.class
FROM
warning => "Warning: ", error => "Error: ", abort => "Abort: ", ENDCASE => NIL
],
IO.rope[info.message]
];
info:
REF DFOperations.DFInfoInteraction =>
log.PutF["%g: %g%g\N",
IO.rope[
SELECT info.action
FROM
$start => "Start", $end => "End", $abort => "Abort", ENDCASE => NIL
],
IO.rope[info.dfFile],
IO.rope[IF info.message = NIL THEN NIL ELSE IO.PutFR[" (%g)", IO.rope[info.message]]]
];
file:
REF DFOperations.FileInteraction => {
log.PutF["%g %g %g {%g}%g\N",
IO.rope[file.localFile],
IO.rope[
SELECT file.action
FROM
$fetch => "<--", $store => "-->", $check => "<-->", ENDCASE => NIL],
IO.rope[file.remoteFile],
IO.rope[DFUtilities.DateToRope[[$explicit, file.date]]],
IO.rope[
IF file.dateFormat = $explicit THEN NIL
ELSE
IO.PutFR[" ('%g')",
SELECT file.dateFormat
FROM
$greaterThan => [character['>]],
$notEqual => [rope["#"]],
ENDCASE => [null[]]
]
]
];
};
ENDCASE;
};
Initialization
Initialize:
PROC = {
abort ← NEW[DFOperations.AbortInteraction ← [FALSE]];
};
Initialize[];
END.