FontInstallerImpl.mesa
Copyright © 1984, 1985 by Xerox Corporation. All rights reserved.
Willie-Sue, July 30, 1984 3:56:10 pm PDT
Russ Atkinson (RRA) August 20, 1985 11:30:21 am PDT
Doug Wyatt, May 23, 1985 5:01:01 pm PDT
Tim Diebert: July 8, 1986 1:48:57 pm PDT
DIRECTORY
Ascii USING [BS, ControlA, ControlQ, ControlW, ControlX, CR, DEL, SP],
BasicTime USING [GMT, nullGMT],
DFOperations USING [BringOver, ChoiceInteraction, ChoiceResponse, Choices, DFInfoInteraction, FileInteraction, InfoInteraction, InteractionProc, YesNoInteraction, YesNoResponse],
DFUtilities USING [DateToRope],
FS USING [Close, GetInfo, GetName, Error, Open, OpenFile],
IO USING [GetChar, EraseChar, PutChar, PutF, PutF1, PutRope, STREAM],
List USING [PutAssoc],
PrinterDefaultRemoteNames USING [Get],
ProcessProps USING [PushPropList],
Rope USING [Cat, Concat, Equal, Fetch, FromChar, Length, ROPE, Substr],
SimpleTerminal USING [InputTimeout, TurnOff, TurnOn];
FontInstallerImpl: CEDAR PROGRAM
IMPORTS DFOperations, DFUtilities, FS, IO, List, PrinterDefaultRemoteNames, ProcessProps, Rope, SimpleTerminal
= BEGIN
ROPE: TYPE = Rope.ROPE;
in, out: IO.STREAM ← NIL;
User interaction stuff
GetChoice: PROC [c: REF DFOperations.ChoiceInteraction] RETURNS [choice: NAT] = {
DO
default: ROPE = c.choices[choice ← c.default];
ans: ROPE ← NIL;
firstChar: BOOL ← TRUE;
FlushVisible: PROC = {
r: ROPE = IF firstChar THEN default ELSE ans;
FOR i: INT DECREASING IN [0..r.Length[]) DO
out.EraseChar[r.Fetch[i]];
ENDLOOP;
ans ← NIL;
choice ← c.default;
firstChar ← FALSE;
};
THROUGH [0..2*depth) DO out.PutChar[Ascii.SP]; ENDLOOP;
out.PutRope[c.message]; out.PutChar[Ascii.SP];
out.PutRope[default];
DO
oldAns: ROPE = ans;
char: CHAR ← Ascii.CR;
char ← in.GetChar[ ! SimpleTerminal.InputTimeout => {char ← Ascii.CR; CONTINUE}];
SELECT char FROM
Ascii.DEL => {out.PutRope[" XXX\N"]; GO TO startOver};
Ascii.CR => IF ans.Length[] = 0 THEN GO TO done;
Ascii.BS, Ascii.ControlA =>
IF firstChar THEN FlushVisible[]
ELSE
IF ans.Length[] > 0 THEN {
out.EraseChar[ans.Fetch[ans.Length[]-1]];
ans ← ans.Substr[len: ans.Length[]-1];
};
Ascii.ControlQ, Ascii.ControlW, Ascii.ControlX => FlushVisible[];
'? => {
out.PutRope[" XXX\NChoices are: "];
FOR i: NAT IN [0..c.choices.length) DO
IF i ~= 0 THEN out.PutRope[", "];
out.PutRope[c.choices[i]];
ENDLOOP;
out.PutChar[Ascii.CR];
IF c.explanations ~= NIL THEN
FOR i: NAT IN [0..c.explanations.length) DO
IF c.explanations[i] ~= NIL THEN {
out.PutRope[c.explanations[i]];
out.PutChar[Ascii.CR];
};
ENDLOOP;
GO TO startOver
};
ENDCASE => {
state: {notFound, found, ambiguous} ← notFound;
IF firstChar THEN FlushVisible[];
ans ← ans.Concat[Rope.FromChar[char]];
FOR i: NAT IN [0..c.choices.length) DO
IF ans.Equal[s2: c.choices[i].Substr[len: ans.Length[]], case: FALSE] THEN {
IF ans.Length[] = c.choices[i].Length[] THEN {choice ← i; state ← found; EXIT};
SELECT state FROM
notFound => {choice ← i; state ← found};
found => state ← ambiguous;
ENDCASE;
};
ENDLOOP;
SELECT state FROM
notFound => {
ans ← oldAns;
};
found => {
out.PutRope[c.choices[choice].Substr[start: oldAns.Length[]]];
GO TO done
};
ambiguous => out.PutChar[c.choices[choice].Fetch[oldAns.Length[]]];
ENDCASE;
};
REPEAT
startOver => NULL;
ENDLOOP;
REPEAT
done => NULL;
ENDLOOP;
out.PutChar[Ascii.CR];
};
Confirm: PROC [message: ROPE, default: BOOL ← TRUE] RETURNS [BOOL] = {
c: REF DFOperations.ChoiceInteraction = NEW[DFOperations.ChoiceInteraction ← [
message: message,
choices: yesNo,
explanations: NIL,
default: default.ORD
]];
OpenTerminal[];
RETURN[VAL[GetChoice[c]]]
};
autoConfirm: BOOL ← TRUE;
depth: INT ← -1;
Interact: DFOperations.InteractionProc = {
OpenTerminal[];
WITH interaction SELECT FROM
info: REF DFOperations.InfoInteraction => {
prompt: BOOL ← TRUE;
THROUGH [0..2*depth) DO out.PutChar[Ascii.SP]; ENDLOOP;
SELECT info.class FROM
info => prompt ← FALSE;
warning => out.PutRope["Warning: "];
error => out.PutRope["Error: "];
abort => NULL;
ENDCASE;
out.PutRope[info.message];
out.PutChar[Ascii.CR];
IF prompt THEN {
IF Confirm["Shall I continue anyway?"] THEN RETURN;
out.PutRope["Giving up..."];
Die[];
};
};
info: REF DFOperations.DFInfoInteraction => {
SELECT info.action FROM
start => {
depth ← depth.SUCC;
THROUGH [0..2*depth) DO out.PutChar[Ascii.SP]; ENDLOOP;
out.PutRope["BringOver of "];
out.PutRope[info.dfFile];
};
end => {
THROUGH [0..2*depth) DO out.PutChar[Ascii.SP]; ENDLOOP;
out.PutRope["End BringOver of "];
out.PutRope[info.dfFile];
depth ← depth.PRED;
};
abort => {
out.PutRope["BringOver of "];
out.PutRope[info.dfFile];
out.PutRope[" aborted"];
depth ← -1;
};
ENDCASE;
IF info.message ~= NIL THEN IO.PutF1[out, " (%g)", [rope[info.message]]];
out.PutChar[Ascii.CR];
};
c: REF DFOperations.ChoiceInteraction =>
IF c.blunder OR ~autoConfirm THEN
RETURN[response: NEW[DFOperations.ChoiceResponse ← [GetChoice[c]]]];
yn: REF DFOperations.YesNoInteraction =>
IF yn.blunder OR ~autoConfirm THEN {
c: REF DFOperations.ChoiceInteraction = NEW[DFOperations.ChoiceInteraction ← [
message: yn.message,
choices: ynqa,
explanations: NIL,
default: IF yn.default THEN YNQA.yes.ORD ELSE YNQA.no.ORD
]];
choice: YNQA = VAL[GetChoice[c]];
SELECT choice FROM
$yes => RETURN[response: NEW[DFOperations.YesNoResponse ← [TRUE]]];
$no => RETURN[response: NEW[DFOperations.YesNoResponse ← [FALSE]]];
$quit => {
abort ← TRUE;
abortMessageForLog ← "(requested by user)";
};
$all => {
autoConfirm ← TRUE;
RETURN[response: NEW[DFOperations.YesNoResponse ← [TRUE]]]
};
ENDCASE;
};
file: REF DFOperations.FileInteraction =>
IF autoConfirm THEN {
THROUGH [0..2*depth) DO out.PutChar[Ascii.SP]; ENDLOOP;
IO.PutF[out, "%g %g %g {%g}%g\N",
[rope[file.localFile]],
[rope[SELECT file.action FROM
$fetch => "<--", $store => "-->", $check => "<-->", ENDCASE => NIL]],
[rope[file.remoteFile]],
[rope[DFUtilities.DateToRope[[$explicit, file.date]]]],
[rope[
SELECT file.dateFormat FROM
$greaterThan => " > ",
$notEqual => " ~= ",
ENDCASE => NIL]]
];
};
ENDCASE;
};
Rubout: ERROR = CODE;
FileDesc: TYPE = RECORD [name: ROPE ← NIL, date: BasicTime.GMT ← BasicTime.nullGMT];
DFList: TYPE = REF DFListObject;
DFListObject: TYPE = RECORD [head: LIST OF FileDesc ← NIL, tail: LIST OF FileDesc ← NIL];
profileDFList: DFList = NEW[DFListObject ← []];
newProfileDFList: DFList = NEW[DFListObject ← []];
TryForFonts: PROC = {
GetFonts: PROC [name: ROPE, wDir: ROPE] ~ {
dfFile: ROPE ~ Rope.Cat[PrinterDefaultRemoteNames.Get[].currentFont, "Printer", name, ".df"];
innerGetFonts: PROC = {
IF TryFile[dfFile, NIL].desc.date # BasicTime.nullGMT THEN
[] ← DFOperations.BringOver[dfFile: dfFile, interact: Interact, action: fetch];
};
ProcessProps.PushPropList[List.PutAssoc[$WorkingDirectory, wDir, NIL], innerGetFonts];
};
GetFonts["PressFonts", "///Fonts/Xerox/PressFonts"];
GetFonts["XC1-2-2-Fonts", "///Fonts/Xerox/XC1-2-2"];
};
Miscellaneous
OpenInfo: PROC [name: ROPE, wDir: ROPE ← NIL] RETURNS [fullFName: ROPE, attachedTo: ROPE, created: BasicTime.GMT] = {
This procedure is similar to FS.FileInfo, except that it also makes certain that the file is on the local disk. Any errors raised by FS.Open are the respobsibility of the caller.
file: FS.OpenFile ← FS.Open[name: name, wDir: wDir];
{
ENABLE UNWIND => FS.Close[file];
[fullFName, attachedTo] ← FS.GetName[file];
created ← FS.GetInfo[file].created;
FS.Close[file];
};
};
OpenTerminal: PROC = {
IF in # NIL THEN RETURN;
[in, out] ← SimpleTerminal.TurnOn[];
out.PutChar[Ascii.CR];
};
CloseTerminal: PROC = {
IF in = NIL THEN RETURN;
SimpleTerminal.TurnOff[];
in ← out ← NIL;
};
TryFile: PROC [shortName, prefix: ROPE ← NIL] RETURNS [desc: FileDesc ← [], attachedTo: ROPE ← NIL] = {
[fullFName: desc.name, attachedTo: attachedTo, created: desc.date] ←
OpenInfo[name: shortName, wDir: prefix ! FS.Error => CONTINUE];
};
Die: PROC = {DO ENDLOOP};
Main body
working: BOOL ← FALSE;
YNQA: TYPE = {yes, no, quit, all};
ynqa: REF DFOperations.Choices = NEW[DFOperations.Choices[YNQA.LAST.ORD.SUCC - YNQA.FIRST.ORD]];
yesNo: REF DFOperations.Choices = NEW[DFOperations.Choices[BOOL.LAST.ORD.SUCC - BOOL.FIRST.ORD]];
yesNo[BOOL.TRUE.ORD] ← "Yes";
yesNo[BOOL.FALSE.ORD] ← "No";
ynqa[YNQA.yes.ORD] ← "Yes";
ynqa[YNQA.no.ORD] ← "No";
ynqa[YNQA.quit.ORD] ← "Quit";
ynqa[YNQA.all.ORD] ← "All";
TryForFonts[];
END.