DIRECTORY
CDIO,
CD,
CDApplications,
CDBasics,
CDDirectory,
CDEvents,
CDExtras,
CDOrient,
CDPrivate,
CDProperties,
CDValue,
FileNames,
FS,
IO,
Process,
Rope,
TerminalIO,
TokenIO;

CDOut: CEDAR PROGRAM --monitored by TokenIO
IMPORTS CD, CDApplications, CDBasics, CDIO, CDDirectory, CDEvents, CDExtras, CDOrient, CDPrivate, CDProperties, CDValue, FileNames, FS, IO, Process, Rope, TerminalIO, TokenIO
EXPORTS CDIO
SHARES CDProperties =
BEGIN

xChipndaleFile: INT = 12121983;
xVersion: INT = 4;

designToWrite: CD.Design;
directoryNum: INT;
directoryMark: TokenIO.Mark;
outputKey: REF _ NEW[INT];
thisTime: REF;
lastTime: REF;
isQuiet: BOOL;

WriteRope: PROC [r: Rope.ROPE] =
BEGIN
IF ~isQuiet THEN TerminalIO.WriteRope[r]
END;

WriteLevel: PUBLIC PROC [l: CD.Level] =
BEGIN
TokenIO.WriteAtom[CD.LevelKey[l]];
END;

WriteProperties: PUBLIC PROC [props: CD.Properties] =
BEGIN
FOR l: CD.Properties _ props, l.rest WHILE l#NIL DO
pp: CDProperties.PropertyProcs;
IF NOT ISTYPE[l.first.key, ATOM] THEN LOOP;
pp _ CDProperties.FetchProcs[l.first.key];
IF pp#NIL AND pp.internalWrite#NIL THEN {
TokenIO.WriteAtom[$Property];
TokenIO.WritePushFlag[NARROW[l.first.key, ATOM]];
pp.internalWrite[l.first.key, l.first.val];
TokenIO.WritePopFlag[];
}
ELSE 
WITH l.first.val SELECT FROM
r: Rope.ROPE => {
TokenIO.WriteAtom[$Property];
TokenIO.WritePushFlag[NARROW[l.first.key, ATOM]];
TokenIO.WriteRope[r];
TokenIO.WritePopFlag[];
};
at: ATOM => {
TokenIO.WriteAtom[$Property];
TokenIO.WritePushFlag[NARROW[l.first.key, ATOM]];
TokenIO.WriteAtom[at];
TokenIO.WritePopFlag[];
};
ri: REF INT => {
TokenIO.WriteAtom[$Property];
TokenIO.WritePushFlag[NARROW[l.first.key, ATOM]];
TokenIO.WriteInt[ri^];
TokenIO.WritePopFlag[];
};
pl: CD.Properties => {
TokenIO.WriteAtom[$Property];
TokenIO.WritePushFlag[NARROW[l.first.key, ATOM]];
TokenIO.WritePushFlag[NIL];  -- now comes a property list
WriteProperties[pl];
TokenIO.WritePopFlag[];  -- end of property list
TokenIO.WritePopFlag[];  -- end of this property
};
ENDCASE => NULL; 
ENDLOOP;
END;

WriteApplicationPtr: PUBLIC PROC [ap: CD.ApplicationPtr] =
BEGIN
loc: CD.DesignPosition;
IF xVersion<=2 THEN loc _ ap.location
ELSE loc _ CDBasics.BaseOfRect[CDApplications.ARectI[ap]];
TokenIO.WriteInt[loc.x];
TokenIO.WriteInt[loc.y];
CDIO.WriteOrientation[ap.orientation];
WriteProperties[ap.properties];
WriteObject[ap.ob];
END;

WriteApplicationList: PUBLIC PROC [list: CD.ApplicationList] =
BEGIN
count: INT _ 0;
FOR l: CD.ApplicationList _ list, l.rest WHILE l#NIL DO
count _ count+1;
ENDLOOP;
TokenIO.WriteInt[count];
FOR l: CD.ApplicationList _ list, l.rest WHILE l#NIL DO
WriteApplicationPtr[l.first];
ENDLOOP;
END;

WriteObject: PUBLIC PROC [ob: CD.ObPtr] =
BEGIN
xx: REF = CDProperties.GetPropFromObject[from: ob, prop: thisTime];
IF xx#NIL AND ISTYPE[xx, REF INT] THEN {
WriteRope["."];
TokenIO.WriteInt[NARROW[xx, REF INT]^];
RETURN
};
WriteRope["x"];
DoWriteObject[ob]
END;

DoWriteObject: PROC [ob: CD.ObPtr] = --INLINE--
BEGIN
IF ob.p.internalWrite=NIL THEN {
TokenIO.WritePushFlag[$Unknown];
TokenIO.WritePopFlag[];
WriteRope["unknown object\n"];
RETURN
};
TokenIO.WritePushFlag[NARROW[ob.p.objectType, ATOM]];
ob.p.internalWrite[ob];
IF ob.p.inDirectory THEN {
TokenIO.WriteRope[CDDirectory.Name[ob]];
TokenIO.WriteRope[CDDirectory.Key[ob]];
};
WriteProperties[ob.properties];
CDProperties.PutPropOnObject[onto: ob, prop: lastTime, val: NIL];
TokenIO.WritePopFlag[];
END;

WritePushLevel: PROC [pl: LIST OF CD.PushRec] =
BEGIN
IF pl=NIL THEN RETURN;
IF pl.rest#NIL THEN WritePushLevel[pl.rest];
TokenIO.WriteAtom[$Push];
IF pl.first.mightReplace#NIL THEN WriteApplicationPtr[pl.first.mightReplace]
ELSE TokenIO.WriteAtom[$Nil];
WriteObject[pl.first.dummyCell.ob]
END;

EachChildren: CDDirectory.EnumerateObjectsProc --PROC [me: ObPtr, x: REF]-- =
BEGIN
xx: REF = CDProperties.GetPropFromObject[from: me, prop: thisTime];
IF xx#NIL THEN RETURN; -- it and its children are already out
IF me.p.inDirectory THEN 
CDDirectory.EnumerateChildObjects[me: me, p: EachChildren, x: x];
directoryNum _ directoryNum+1;
TokenIO.WriteInt[directoryNum];
DoWriteObject[me];
CDProperties.PutPropOnObject[onto: me, prop: thisTime, val: NEW[INT_directoryNum]];
END;

EachDirectoryEntry: CDDirectory.EachEntryAction --[name: Rope.ROPE, ob: CD.ObPtr] RETURNS [quit: BOOL_FALSE]-- =
BEGIN
EachChildren[ob, NIL];
END;

DoWriteDesign: PROC [] =
BEGIN
ENABLE TokenIO.WritingStopped => {
RemoveOldProperties[designToWrite, lastTime]; 
REJECT
};
thisTime _ NEW[INT];
lastTime _ CDValue.Fetch[boundTo: designToWrite, key: outputKey, propagation: design];
IF lastTime=NIL THEN {lastTime_NEW[INT]};
CDValue.Store[boundTo: designToWrite, key: outputKey, value: thisTime];
directoryNum_0;
IF Rope.Length[designToWrite.name]<=0 
OR Rope.Fetch[designToWrite.name]='/ 
OR Rope.Fetch[designToWrite.name]='[ THEN TokenIO.WriteRope[NIL]
ELSE TokenIO.WriteRope[designToWrite.name];
directoryMark _ TokenIO.MarkAndWriteInt[directoryNum]; -- number of entries in directory
[] _ CDDirectory.Enumerate[design: designToWrite, action: EachDirectoryEntry];
WriteProperties[designToWrite.properties];
WritePushLevel[designToWrite.actual];
TokenIO.UpdateMark[mark: directoryMark, value: directoryNum];
TokenIO.WriteAtom[$EndOfDesign];
END;

RemoveOldProperties: PROC[design: CD.Design, key: REF] =
TRUSTED BEGIN
Process.SetPriority[Process.priorityBackground];
Process.Detach[FORK CDExtras.RemoveProperties[design, key]]
END;

DontOverWrite: ERROR = CODE;

WriteDesign: PUBLIC PROC [design: CD.Design, to: REF_NIL, quiet: BOOL, emergency: BOOL] RETURNS [done: BOOL_FALSE] =
BEGIN
ENABLE DontOverWrite => GOTO NotOpened;

DoAttach: PROC [] RETURNS [done: BOOL] =
BEGIN
DoRealAttach: PROC [] RETURNS [done: BOOL_FALSE] =
BEGIN
TokenIO.AttachWriter[binFile ! TokenIO.Error => GOTO AttachProblem];
done _ TRUE;
EXITS
AttachProblem => RETURN
END;
count: NAT _ 0;
done _ DoRealAttach[];
WHILE NOT done AND emergency DO
TokenIO.StopWriting[];
Process.Pause[Process.SecondsToTicks[1]];
TokenIO.StopWriting[];
Process.Pause[Process.SecondsToTicks[2]];
count _ count+1;
IO.Reset[binFile];
TerminalIO.WriteRope["TRIES TO BREAK THE LOCK\n"];
TokenIO.ReleaseWriter[]; -- XXXXXXX DANGEROUS
Process.Pause[Process.SecondsToTicks[1]];
done _ DoRealAttach[];
IF NOT done AND count>5 THEN {
count_0;
SIGNAL CDPrivate.DebugCall[what: "cannot attach"];
};
ENDLOOP
END;

InName: PROC [wDir: Rope.ROPE_NIL] RETURNS [name: Rope.ROPE] =
BEGIN

CheckExistance: PROC [name: Rope.ROPE] =
BEGIN
temfile: IO.STREAM _ FS.StreamOpen[name ! FS.Error => IF error.group#bug THEN GOTO NotFound];
TerminalIO.WriteRope["File "];
TerminalIO.WriteRope[name];
TerminalIO.WriteRope[" exists already; "];
IF ~TerminalIO.UserSaysYes[label: "overwrite? ", text: "overwrite?", default: FALSE] THEN ERROR DontOverWrite;
TerminalIO.WriteRope[" yes\n"];
EXITS
NotFound => { --this is the "normal" case of an not yet existing file
NULL
}
END;

IF Rope.IsEmpty[wDir] THEN wDir _ FileNames.CurrentWorkingDirectory[];
IF emergency THEN name _ "///temp/chipndale/emergency/emergency.dale"
ELSE {
TerminalIO.WriteRope["output file name"];
IF ~Rope.IsEmpty[wDir] THEN {
TerminalIO.WriteRope[" ("];
TerminalIO.WriteRope[wDir];
TerminalIO.WriteRope[")"];
};
name _ TerminalIO.RequestRope[" >  "]; 
name _ CDIO.MakeName[name, "dale", wDir];
CheckExistance[name];
}
END;

Help: PROC [] =
BEGIN
WriteRope["  first, try it again; if it still does not work,\n"];
WriteRope["  try SHIFT-SHIFT-SWAT\n"];
WriteRope["  or  hack ""_ CDEmergencyHandling.SaveAll[]"" to an commandtool\n"];
END;

iMadeTheOpen: BOOL_FALSE;
binFile: IO.STREAM;
sealMark: TokenIO.Mark;
name, fileName: Rope.ROPE;
wDir: Rope.ROPE _ CDIO.GetWorkingDirectory[design];
isQuiet _ quiet;
designToWrite _ design;
IF to#NIL AND ISTYPE[to, IO.STREAM] THEN {
binFile _ NARROW[to, IO.STREAM]
}
ELSE {
IF to=NIL THEN {
name _ InName[wDir]; 
}
ELSE IF ISTYPE[to, Rope.ROPE] THEN {
name _ NARROW[to, Rope.ROPE];
IF Rope.IsEmpty[name] THEN name _ InName[wDir];
}
ELSE {
TerminalIO.WriteRope["WriteDesign does not support type of 'to' parameter\n"];
GOTO NotOpened;
};
fileName _ CDIO.MakeName[name, "dale", wDir];
binFile _ FS.StreamOpen[fileName: fileName, accessOptions: $create, keep: 2 ! 
FS.Error => IF error.group#bug THEN {
binFile_NIL; 
GOTO NotOpened
}
];
iMadeTheOpen _ TRUE;
};
IF NOT DoAttach[] THEN {
WriteRope["not attached, locks are hold\n"];
Help[];
RETURN
};
TokenIO.WriteInt[xChipndaleFile];
TokenIO.WriteInt[xVersion];
sealMark _ TokenIO.MarkAndWriteInt[0]; -- this is a bad seal
TokenIO.WriteAtom[designToWrite.technology.key];
TokenIO.WriteRope[designToWrite.technology.name];
IF CDEvents.ProcessEvent[ev: writeEvent, design: designToWrite, x: NIL, listenToDont: TRUE].dont THEN {
WriteRope["write not done\n"];
TokenIO.ReleaseWriter[];
IO.Close[binFile];
RETURN
};
DoWriteDesign[];
TokenIO.UpdateMark[sealMark, -1]; -- validate seal
TokenIO.ReleaseWriter[];
IF iMadeTheOpen THEN IO.Close[binFile];
TerminalIO.WriteRope["design "];
TerminalIO.WriteRope[designToWrite.name];
TerminalIO.WriteRope[" written on file "];
IF iMadeTheOpen THEN TerminalIO.WriteRope[fileName];
TerminalIO.WriteLn[];
done _ TRUE;
EXITS
NotOpened  => {
WriteRope["File not created\n"]; 
};
END;

writeEvent: CDEvents.EventRegistration = CDEvents.RegisterEventType[$WriteTechnologyPrivate];
END.

0CDOut.mesa
Copyright c 1983, 1984 by Xerox Corporation.  All rights reserved.
by Ch. Jacobi, December 12, 1983 2:02 pm
some code from Kim Rachmeler
Last Edited by: Jacobi, November 27, 1984 10:36:14 am PST

-- global variables; are protected by the requirement of attaching Tokenio
--to is either a IO.STREAM, a Rope.ROPE, or NIL
--if emergency, some locks are ignored, interactive input is skipped; you better 
--roll back after an emergency write is done
--Errors DontOverWrite if necessary
--file exists already
--WriteDesign
-- Module initialization
�Ê
;˜š
œ
™
Jšœ
Ïm
œ7™BJš
œ(™(Jš
œ™Jš
œ9™9J™—š
Ïk	˜	Jšžœ
˜Jšžœ
˜Jš
œ˜J˜	Jš
œ˜Jš
œ	˜	J˜	J˜	J˜
J˜
Jš
œ˜Jšœ	ž
˜
Jšžœ
˜Jšžœ
˜J˜J˜J˜J˜—J˜šÏbœžœ
žœ
Ïc˜+Jšžœ
žœžœ
žœXžœžœ$˜®
Jšžœ
ž˜Jšžœ˜—Jš
ž˜J˜Jšœžœ˜Jšœ
žœ˜J˜Jš
œJ™JJšœžœ˜Jšœžœ
˜Jš
œ˜Jšœžœžœ
žœ˜Jšœ
žœ
˜Jšœ
žœ
˜Jšœ	žœ
˜J˜
codešÏn	œžœ
žœ˜ Kš
ž˜Kšžœ
žœ˜(Kš
ž˜—K˜š¡
œžœžœ	˜'Kš
ž˜Jšœžœ˜"Jšžœ
˜—J˜š¡œžœ	žœ˜5Jš
ž˜š	žœžœžœžœ
ž˜3Jš
œ˜Jšžœ
žœ
žœžœžœ
žœ
˜+Jš
œ*˜*šžœžœ
žœžœ˜)J˜Jšœžœžœ˜1Jš
œ+˜+Jš
œ˜J˜
—š
ž˜šžœ
žœ
ž˜šœžœ˜J˜Jšœžœžœ˜1Jš
œ˜Jš
œ˜J˜—šœžœ˜
J˜Jšœžœžœ˜1Jš
œ˜Jš
œ˜J˜—šœžœ
žœ˜J˜Jšœžœžœ˜1Jš
œ˜Jš
œ˜J˜—šœžœ˜J˜Jšœžœžœ˜1Jšœžœ ˜9Jš
œ˜Jšœ ˜0Jšœ ˜0J˜—Jšžœžœ˜——Jšžœ
˜—Jšžœ
˜—J˜š¡œžœ
žœžœ˜:Jš
ž˜J˜Jšžœ
žœ˜%Jšžœ6˜:J˜J˜Jšžœ"˜&J˜J˜Jšžœ
˜J˜—š¡œžœžœ˜>Jš
ž˜Jšœžœ˜š	žœžœ žœžœ
ž˜7J˜Jšžœ
˜—J˜š	žœžœ žœžœ
ž˜7Jš
œ˜Jšžœ
˜—Jšžœ
˜—J˜š¡œžœžœ	˜)Jš
ž˜Jšœžœ<˜Cšžœžœ
žœ
žœžœ
žœžœ˜(Jš
œ˜Jšœžœžœ˜'Jš
ž˜Jš
œ˜—Jš
œ˜Jš
œ˜Jšžœ
˜—J˜š¡
œžœžœ
 
˜/Jš
ž˜šžœžœ
žœ˜ Jš
œ ˜ Jš
œ˜Jš
œ˜Jš
ž˜Jš
œ˜—Jšœžœžœ˜5Jš
œ˜šžœžœ˜Jš
œ(˜(Jš
œ'˜'J˜—Jš
œ˜Jšœ<žœ˜AJš
œ˜Jšžœ
˜—J˜š
¡œžœžœ
žœ
žœ˜/Jš
ž˜Jšžœžœ
žœ
žœ
˜Jšžœ	žœ
žœ˜,Jš
œ˜Jšžœžœ
žœ+˜LJšžœ˜Jš
œ"˜"Jšžœ
˜—J˜š¡œ# œ˜MJš
ž˜Jšœžœ<˜CJš	žœžœ
žœ
žœ &˜=šžœžœ
˜Jš
œA˜A—Jš
œ˜Jš
œ˜Jš
œ˜Jšœ<žœ
žœ˜SJšžœ
˜—J˜š¡œ >œ˜pJš
ž˜Jšœžœ˜Jšžœ
˜—J˜š¡
œžœ˜Jš
ž˜šžœ˜"Jš
œ.˜.Jš
ž˜Jš
œ˜—Jšœžœ
žœ˜Jš
œV˜VJš
žœ
žœ
žœžœ
žœ˜)Jš
œG˜GJš
œ˜šžœ$˜&Jšžœ#˜%Jšžœ#žœžœ
˜@—Jšžœ'˜+Jšœ7 !˜XJš
œN˜NJš
œ*˜*Jš
œ%˜%Jš
œ=˜=Jš
œ ˜ Jšžœ
˜—J˜š¡œžœ	žœžœ˜8Jšžœ
ž˜
Jš
œ0˜0Jšœžœ(˜;Jšžœ
˜—J˜Jšœžœžœ
˜J˜š¡œžœ
žœ
žœ
žœ	žœ
žœžœžœ
žœ˜tJ™/Jš
œQ™QJš
œ,™,Kš
ž˜Kšžœ!˜'K˜š¡œžœžœžœ˜(Kš
ž˜š
¡œžœžœžœ
žœ˜2Kš
ž˜Kšœ0žœ˜DKšœžœ
˜š
ž˜Kšœž˜—Kšžœ
˜—Kšœžœ˜Kš
œ˜šžœ
žœžœž˜Kš
œ˜Kš
œ)˜)Kš
œ˜Kš
œ)˜)Kš
œ˜Kšžœ˜K˜2Kšœ ˜-Kš
œ)˜)Kš
œ˜šžœ
žœžœ	žœ˜Kš
œ˜Kšžœ,˜2Kš
œ˜—Kš
ž˜—Kšžœ
˜K˜š¡œžœ
žœ
žœžœ
žœ˜>Kš
ž˜K˜š¡œžœ
žœ˜(Kš
œ#™#Kš
ž˜Jšœ	žœ
žœžœžœ
žœžœ
žœ˜]Jš
œ™Jš
œ˜Jš
œ˜Jš
œ*˜*JšžœLžœžœ
žœ˜nJš
œ˜š
ž˜šœ 7˜EJš
ž˜Jš
œ
˜
——Kšžœ
˜—K˜Kšžœžœ,˜FKšžœžœ4˜Ešžœ˜Jš
œ)˜)šžœžœ˜Jš
œ˜Jš
œ˜Jš
œ˜J˜—Kš
œ'˜'Kš
œ)˜)Kš
œ˜K˜
—Kšžœ
˜——J˜š¡œžœ˜Jš
ž˜Jš
œA˜AJš
œ&˜&Jš
œP˜PJšžœ
˜—K˜Kš
 
™
Kšœž
œ
˜Kšœ	žœ
žœ
˜Kš
œ˜Kšœžœ
˜Kšœžœ$˜3Kš
œ˜Kš
œ˜šžœžœ
žœ
žœžœ
žœžœ˜*Kšœž
œžœ
žœ
˜Kš
œ
˜
—šžœ˜šžœžœ
žœ˜Kš
œ˜K˜
—š
žœ
žœ
žœ
žœžœ˜$Jšœžœ
žœ˜Jšžœžœ˜/J˜
—šžœ˜Jš
œN˜NJšžœ˜J˜—Jšœžœ˜-šœ
žœB˜Nšžœ
žœžœ˜%Kšœžœ˜
Kšžœ
˜Kš
œ
˜
—Kš
œ˜—Kšœžœ
˜J˜—šžœ
žœžœ˜Kš
œ,˜,J˜Kš
ž˜K˜—Kš
œ!˜!Kš
œ˜Kšœ' ˜<Kš
œ0˜0Kš
œ1˜1šžœAžœžœžœ˜gJš
œ˜Jš
œ˜Jšžœ˜Jš
ž˜Jš
œ˜—K˜Kšœ" ˜2Kš
œ˜Kšžœžœ
žœ˜'Kš
œ ˜ Kš
œ)˜)Kš
œ*˜*Kšžœžœ ˜4Kš
œ˜Kšœžœ
˜š
ž˜š
œ˜Jš
œ!˜!Jš
œ˜——Jšžœ
˜—J˜Jš
œ™Jš
œ]˜]Jšžœ
˜J˜—…—$B3­