CDEnvironmentImpl.mesa (part of ChipNDale)
Copyright © 1983, 1987 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, August 11, 1983 11:32 am
Last Edited by: Christian Jacobi, March 23, 1987 4:40:50 pm PST
DIRECTORY
Ascii,
Atom,
CD,
CDEnvironment,
CDEvents,
CDOps,
CDValue,
Commander,
CommandTool,
FileNames,
FS,
Icons,
IO,
List,
PopUpSelection,
ProcessProps,
Rope,
RuntimeError,
SystemNames,
TerminalIO,
TEditImpl USING [ReloadTable], --crazy, wonderful tiptable load procedure
TIPUser,
UserProfile;
CDEnvironmentImpl: CEDAR PROGRAM
IMPORTS Atom, CD, CDEvents, CDOps, CDValue, Commander, CommandTool, FileNames, FS, Icons, IO, List, PopUpSelection, ProcessProps, RuntimeError, Rope, SystemNames, TEditImpl, TerminalIO, TIPUser, UserProfile
EXPORTS CDEnvironment =
BEGIN
-- versions ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
cdVersion: PUBLIC NAT ← 25;
preRelease: PUBLIC BOOLTRUE;
date: Rope.ROPE = "March 30, 1987";
profilePrefix: PUBLIC Rope.ROPEIO.PutFR["ChipNDale%g.", [integer[cdVersion]]];
commandsPrefix: Rope.ROPE ← FileNames.ConvertToSlashFormat[SystemNames.LocalDir["Commands"]];
systemPrefix: Rope.ROPE ← FileNames.ConvertToSlashFormat[SystemNames.LocalDir["System"]];
Prefixed: PROC [r1, r2: Rope.ROPENIL] RETURNS [Rope.ROPE] = {
RETURN [Rope.Cat[profilePrefix, r1, r2]]
};
copyRight: Rope.ROPE = "Copyright (C) 1984, 1987 by Xerox Corporation. All rights reserved.\n\n";
-- tip tables ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SetTipTable: PUBLIC PROC [for: REF, tipTable: Rope.ROPE] = {
TryExplicitTipTable: PROC [for: REF, name: Rope.ROPE] RETURNS [tipTable: TIPUser.TIPTable] = {
name ← MakeName[base: name, ext: "tip", wDir: TechWDir[for]];
tipTable ← TIPUser.InstantiateNewTIPTable[name !
FS.Error => {
TerminalIO.PutRopes["Tip-table not installed; ", error.explanation, "\n"];
GOTO oops
};
TIPUser.InvalidTable => {
TerminalIO.PutRopes["Tip-table not installed; ", errorMsg, "\n"];
GOTO oops
};
];
EXITS oops => NULL
};
InstallStandardTip: PROC [for: REF] RETURNS [tipTable: TIPUser.TIPTable ← NIL] = {
WITH for SELECT FROM
tech: CD.Technology => {
techPart: Rope.ROPE ← MakeName[base: "ChipNDale", ext: "tip", modifier: tech.name, wDir: GetWorkingDirectory[tech]];
base: Rope.ROPE ← MakeName[base: "ChipNDale", ext: "tip", wDir: GetWorkingDirectory[NIL]];
default: Rope.ROPE ← Rope.Cat[techPart, " ", base];
tipTable ← TEditImpl.ReloadTable[oldTIP: NIL, profileKey: Prefixed[tech.name, ".TIP"], default: default];
IF tipTable=NIL THEN {
TerminalIO.PutRopes["* tip-table for ", tech.name, " not installed\n"];
tipTable ← TryExplicitTipTable[for, "ChipNDale.tip"];
};
};
d: CD.Design => tipTable ← InstallStandardTip[d.technology];
ENDCASE => TerminalIO.PutRope["* tip-table not installed\n"];
};
tipTab: TIPUser.TIPTable ← NIL;
IF Rope.IsEmpty[tipTable] THEN tipTable ← "Standard";
CDValue.Store[for, $TipTableName, tipTable];
IF Rope.Equal[tipTable, "Standard"] THEN tipTab ← InstallStandardTip[for]
ELSE tipTab ← TryExplicitTipTable[for, tipTable];
IF tipTab#NIL THEN CDValue.Store[for, $TipTable, tipTab];
};
GetTipTable: PUBLIC PROC [for: REF] RETURNS [TIPUser.TIPTable] = {
WITH CDValue.Fetch[boundTo: for, key: $TipTable, propagation: global] SELECT FROM
tipTable: TIPUser.TIPTable => RETURN [tipTable];
ENDCASE => RETURN [NIL];
};
ReInstallStandardTipTables: Commander.CommandProc = {
EachTech: CD.TechnologyEnumerator = {
WITH CDValue.Fetch[tech, $TipTableName] SELECT FROM
r: Rope.ROPE => IF Rope.Equal[r, "Standard"] THEN SetTipTable[tech, r];
ENDCASE => NULL;
};
[] ← CD.EnumerateTechnologies[EachTech];
[] ← CDEvents.ProcessEvent[reInstallTipTables, NIL];
};
-- Icons ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
FetchIconFromFile: PROC [for: REF, file: Rope.ROPE, n: NAT] RETURNS [icon: REF Icons.IconFlavor] = {
if: Icons.IconFlavor;
icon ← NEW[Icons.IconFlavor←tool];
file ← MakeName[base: file, ext: "icon", wDir: TechWDir[for]];
if ← Icons.NewIconFromFile[file, n ! RuntimeError.UNCAUGHT => GOTO Oops];
icon^ ← if;
EXITS Oops => TerminalIO.PutRope["** icon not loaded\n"];
};
SetIcon: PUBLIC PROC [for: REF, file: Rope.ROPE, n: NAT] = {
icon: REF Icons.IconFlavor ← FetchIconFromFile[for, file, n];
CDValue.Store[for, $Icon, icon];
};
GetIcon: PUBLIC PROC [for: REF] RETURNS [Icons.IconFlavor] = {
WITH CDValue.Fetch[for, $Icon, global] SELECT FROM
ip: REF Icons.IconFlavor => RETURN [ip^];
ENDCASE => RETURN [Icons.IconFlavor[unInit]]
};
SetPanelIcon: PUBLIC PROC [for: REF, file: Rope.ROPE, n: NAT] = {
icon: REF Icons.IconFlavor ← FetchIconFromFile[for, file, n];
CDValue.Store[for, $PanelIcon, icon];
};
GetPanelIcon: PUBLIC PROC [for: REF] RETURNS [Icons.IconFlavor] = {
WITH CDValue.Fetch[for, $PanelIcon, global] SELECT FROM
ip: REF Icons.IconFlavor => RETURN [ip^];
ENDCASE => RETURN [Icons.IconFlavor[unInit]]
};
-- Working Directories ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
CheckWDir: PROC [wDir: Rope.ROPE] RETURNS [slashWDir: Rope.ROPE] = {
--if wDir is a directory, return it in slash format
--else return NIL
length: INT;
IF FileNames.IsADirectory[wDir] AND ~FileNames.IsAPattern[wDir] THEN {
slashWDir ← FileNames.ConvertToSlashFormat[wDir];
length ← Rope.Length[slashWDir];
IF length>0 AND slashWDir.Fetch[length-1]='/ THEN RETURN [slashWDir];
};
RETURN [NIL]
};
SetWorkingDirectory: PUBLIC PROC [for: REF, wDir: Rope.ROPE] = {
IF wDir=NIL THEN {
WITH for SELECT FROM
t: CD.Technology => {
techName: Rope.ROPE ← t.name;
IF techName=NIL THEN techName ← Atom.GetPName[t.key];
wDir ← UserProfile.Token[Prefixed[techName, ".BaseDirectory"]];
};
d: CD.Design => NULL;
ENDCASE => IF for=NIL THEN {
wDir ← UserProfile.Token[Prefixed["BaseDirectory"]];
};
IF wDir=NIL THEN wDir ← FileNames.CurrentWorkingDirectory[];
};
CDValue.Store[for, $WorkingDirectory, CheckWDir[wDir]];
};
GetWorkingDirectory: PUBLIC PROC [for: REF] RETURNS [wDir: Rope.ROPENIL] = {
WITH CDValue.Fetch[for, $WorkingDirectory, global] SELECT FROM
r: Rope.ROPE => wDir ← CheckWDir[r];
ENDCASE => NULL;
};
DoWithWDir: PUBLIC PROC [wDir: Rope.ROPE, proc: PROC] = {
ProcessProps.AddPropList[
propList: Atom.PutPropOnList[NIL, $WorkingDirectory, wDir],
inner: proc
];
};
-- Commander ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
RegisterCommander: PUBLIC PROC [key: Rope.ROPE, proc: Commander.CommandProc ← NIL, doc: Rope.ROPENIL, clientData: REFNIL, interpreted: BOOLTRUE, technology: CD.Technology ← NIL] = {
gWDir: Rope.ROPE ← GetWorkingDirectory[NIL];
Commander.Register[key: key, proc: proc, doc: doc, clientData: clientData, interpreted: interpreted];
Commander.Register[key: Rope.Cat[gWDir, key], proc: proc, doc: doc, clientData: clientData, interpreted: interpreted];
IF technology#NIL THEN {
tWDir: Rope.ROPE ← GetWorkingDirectory[technology];
IF ~Rope.Equal[gWDir, tWDir] THEN
Commander.Register[key: Rope.Cat[tWDir, key], proc: proc, doc: doc, clientData: clientData, interpreted: interpreted]
}
};
-- Names ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
MakeName: PUBLIC PROC [base: Rope.ROPE, ext: Rope.ROPENIL, wDir: Rope.ROPENIL, modifier: Rope.ROPENIL] RETURNS [Rope.ROPE] = {
TrailingChar: PROC [base: Rope.ROPE, char: CHAR] RETURNS [INT] = {
--position of last "char", only before '!, '], '>, '/ considered
len: INT ← Rope.Length[base];
pos: INT ← len;
WHILE pos > 0 DO
SELECT Rope.Fetch[base, pos ← pos - 1] FROM
char => RETURN [pos];
'!, '], '>, '/ => EXIT;
ENDCASE;
ENDLOOP;
RETURN [len];
};
bang: INT = TrailingChar[base, '!];
--remove version number
r: Rope.ROPE ← Rope.Substr[base: base, len: bang];
--include modifier
IF ~modifier.IsEmpty[] THEN r ← Rope.Concat[r, modifier];
--include extension
IF ~ext.IsEmpty[] AND (TrailingChar[r, '.]>=Rope.Length[r]) THEN {
dot2: INT ← TrailingChar[ext, '.];
IF dot2>=Rope.Length[ext] THEN r ← Rope.Cat[r, ".", ext]
ELSE r ← Rope.Concat[r, ext.Substr[dot2]]
};
--include working directory
IF wDir#NIL THEN {
IF Rope.IsEmpty[r] OR (Rope.Fetch[r]#'/ AND Rope.Fetch[r]#'[) THEN {
dir: Rope.ROPE ← FileNames.Directory[wDir];
IF ~Rope.IsEmpty[dir] THEN r ← Rope.Cat[FileNames.ConvertToSlashFormat[dir], r]
}
};
--put version number back
IF bang<Rope.Length[base] THEN {
r ← Rope.Concat[r, Rope.Substr[base, bang]]
};
RETURN [r]
};
FindFile: PUBLIC PROC [base: Rope.ROPE, ext: Rope.ROPENIL, for: REFNIL] RETURNS [fn: Rope.ROPE] = {
searchPath: LIST OF Rope.ROPELIST[commandsPrefix, systemPrefix];
AddToWDir: PROC [r: Rope.ROPE] = {
IF ~Rope.IsEmpty[r] AND ~Rope.Equal[searchPath.first, r] THEN
searchPath ← CONS[r, searchPath];
};
AddToWDir[GetWorkingDirectory[NIL]];
WITH for SELECT FROM
rl: LIST OF Rope.ROPE => searchPath ← rl;
r: Rope.ROPE => searchPath ← LIST[r];
r: REF TEXT => searchPath ← LIST[Rope.FromRefText[r]];
d: CD.Design => {
AddToWDir[GetWorkingDirectory[d.technology]];
AddToWDir[GetWorkingDirectory[d]];
};
t: CD.Technology => {
AddToWDir[GetWorkingDirectory[t]];
};
ENDCASE => NULL;
AddToWDir[FileNames.CurrentWorkingDirectory[]];
IF Rope.Length[ext]>0 AND Rope.Fetch[ext, 0]#'. THEN ext ← Rope.Concat[".", ext];
fn ← FileNames.FileWithSearchRules[root: base, defaultExtension: ext, requireExtension: FALSE, requireExact: TRUE, searchRules: searchPath].fullPath;
};
-- Loader ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
RemoveSpaces: PUBLIC PROC [line: Rope.ROPE] RETURNS [Rope.ROPENIL] = {
leng: INT ← Rope.Length[line];
start: INT ← 0;
WHILE start<leng DO
SELECT Rope.Fetch[line, start] FROM
Ascii.SP, Ascii.TAB => start ← start+1;
ENDCASE => EXIT;
ENDLOOP;
WHILE leng>start DO
SELECT Rope.Fetch[line, leng-1] FROM
Ascii.SP, Ascii.TAB => leng ← leng-1;
ENDCASE => EXIT;
ENDLOOP;
IF leng>start THEN RETURN [Rope.Substr[line, start, leng-start]];
};
SplitLine: PUBLIC PROC [line: Rope.ROPE] RETURNS [key, rest: Rope.ROPENIL] = {
leng: INT ← Rope.Length[line];
nextPos: INT ← 0;
startPos: INT ← 0;
--skip leading spaces
WHILE startPos<leng DO
SELECT Rope.Fetch[line, startPos] FROM
Ascii.SP, Ascii.TAB => startPos ← startPos+1;
ENDCASE => EXIT;
ENDLOOP;
--find position of separator
nextPos ← startPos;
WHILE nextPos<leng DO
SELECT Rope.Fetch[line, nextPos] FROM
Ascii.SP, ':, Ascii.TAB => EXIT;
ENDCASE => nextPos ← nextPos+1;
ENDLOOP;
IF startPos<nextPos THEN key ← Rope.Substr[line, startPos, nextPos-startPos];
nextPos ← nextPos+1;
--skip leading spaces again
WHILE nextPos<leng DO
SELECT Rope.Fetch[line, nextPos] FROM
Ascii.SP, Ascii.TAB => nextPos ← nextPos+1;
ENDCASE => {rest ← Rope.Substr[line, nextPos, leng-nextPos]; RETURN}
ENDLOOP;
};
FetchKeyLine: PUBLIC PROC [fileName: Rope.ROPE, key: Rope.ROPE] RETURNS [entry: Rope.ROPENIL] = {
--Searches for a line starting with key in file
--Returns the rest of the line found or NIL if not found
line, first, rest: Rope.ROPE; file: IO.STREAM;
file ← FS.StreamOpen[fileName ! FS.Error => GOTO finish];
DO
line ← IO.GetLineRope[file ! IO.EndOfStream => GOTO finish];
IF ~Rope.IsEmpty[line] THEN {
[first, rest] ← SplitLine[line];
IF Rope.Equal[first, key] THEN RETURN [rest]
}
ENDLOOP;
EXITS finish => NULL;
};
StuffToCommandTool: PUBLIC PROC [r: Rope.ROPE, wDir: Rope.ROPENIL, searchPath: LIST OF Rope.ROPENIL, catchErrors: BOOLTRUE, continueErrors: BOOLTRUE] RETURNS [result: REFNIL] = {
RopeListPath: PROC [rl: LIST OF Rope.ROPE] RETURNS [path: List.LORANIL] = {
last: Rope.ROPENIL;
FOR l: LIST OF Rope.ROPE ← rl, l.rest WHILE l#NIL DO
IF ~Rope.IsEmpty[l.first] AND ~Rope.Equal[last, l.first, FALSE] THEN {
last ← l.first;
path ← CONS[last, path];
}
ENDLOOP;
RETURN [List.DReverse[path]]
};
propertyList: List.AList ← List.PutAssoc[key: $StopOnFailure, val: $TRUE, aList: NIL]; --temporary
out: Rope.ROPE; --for the result rope returned by the CommandTool
cmd: Commander.Handle ← NEW[Commander.CommandObject ← [
out: TerminalIO.TOS[],
err: TerminalIO.TOS[],
in: IO.noInputStream,
propertyList: List.PutAssoc[key: $SearchRules, val: RopeListPath[searchPath], aList: propertyList]
]];
Exec: PROC [] = {
[out, result] ← CommandTool.DoCommandRope[commandLine: r, parent: cmd];
};
IF Rope.IsEmpty[r] THEN TerminalIO.PutRopes["executes empty command\n"]
ELSE {
TerminalIO.PutRopes["executes: """, r, """\n"];
DoWithWDir[wDir, Exec !
ABORTED => {TerminalIO.PutRope["\n**aborted\n"]; IF continueErrors THEN CONTINUE};
RuntimeError.UNCAUGHT => {
IF ~catchErrors THEN REJECT
ELSE
SELECT PopUpSelection.Request[
header: "ERROR",
choice: LIST["continue with ChipNDale", "debug"],
headerDoc: "error while executing stuff",
choiceDoc: LIST["usually ok", "land in debugger (abort will continue ChipNDale)"],
timeOut: 600 --10 minutes
] FROM
1 => CONTINUE;
-1 => {TerminalIO.PutRope["\n**Timed out request for debugging: reject will probably open a debugger window\n"]; REJECT};
2 => REJECT;
ENDCASE => CONTINUE;
};
];
TerminalIO.PutRopes["\n{", out, "}\n"];
};
};
ExecFileEntry: PUBLIC PROC [key: Rope.ROPE, technology: CD.Technology←NIL, modifier: Rope.ROPENIL, catchErrors: BOOLTRUE, continueErrors: BOOLTRUE] = {
--checks whether a particular key is mentioned in a .CDLoadList file
--if particular key is found, executes the rest of the line with a command tool
--technology and modifier are used to make the name of the used .CDLoadList file
--(using modifier .CDLoadList files for particular feature classes can be distinguished)
--building of name for the .CDLoadList files:
-- ChipNDale-CD.CDLoadList if {technology=NIL, modifier=NIL}
-- ChipNDale-CD-modifier.CDLoadList if {technology=NIL, modifier#NIL}
-- ChipNDale-technologyName.CDLoadList if {technology#NIL, modifier=NIL}
-- ChipNDale-technologyName-modifier.CDLoadList if {technology#NIL, modifier#NIL}
wDir: Rope.ROPE; --for working directories
entry: Rope.ROPE; --for the line which will be stuffed into a command tool
Fetch: PROC [mod: Rope.ROPE] = {
--internal procedure
--makes up the full path name of the .CDLoadList file
--and looks for a particular entry line in it
--mod: name for the technology
IF modifier#NIL THEN mod ← Rope.Cat[mod, "-", modifier];
mod ← MakeName["ChipNDale-", "CDLoadList", wDir, mod];
entry ← FetchKeyLine[mod, key];
};
searchPath: LIST OF Rope.ROPELIST[GetWorkingDirectory[NIL], commandsPrefix, systemPrefix];
IF technology#NIL THEN {
wDir ← GetWorkingDirectory[technology];
searchPath ← CONS[wDir, searchPath];
Fetch[technology.name];
};
IF entry=NIL THEN {
wDir ← GetWorkingDirectory[NIL];
Fetch["CD"];
};
IF entry=NIL THEN TerminalIO.PutRopes["command line for ", key, " not found\n"]
ELSE [] ← StuffToCommandTool[entry, wDir, searchPath, catchErrors, continueErrors];
};
LoadTechnology: PUBLIC PROC [key: ATOM, name: Rope.ROPE] RETURNS [tech: CD.Technology←NIL] = {
--makes all the necessary messages if not loaded
IF key#NIL THEN {
tech ← CD.FetchTechnology[key];
IF tech=NIL THEN tech ← GetTechnology[key];
};
IF tech=NIL THEN {
IF name#NIL THEN tech ← GetTechnology[name];
IF tech=NIL THEN {
autoLoadDefault: BOOL ← UserProfile.Boolean[Prefixed["AutoLoad.Default"], TRUE];
IF Rope.IsEmpty[name] THEN name ← Atom.GetPName[key];
IF UserProfile.Boolean[Prefixed["AutoLoad.", name], autoLoadDefault] THEN {
TerminalIO.PutRopes["load technology """, name, """ \n"];
ExecFileEntry[name, NIL, NIL, TRUE, TRUE];
IF key#NIL THEN tech ← GetTechnology[key];
IF tech=NIL THEN tech ← GetTechnology[name];
};
IF tech=NIL THEN TerminalIO.PutRopes["technology '", name, "' not loaded\n"];
};
};
};
AskAndExecute: Commander.CommandProc = {
question: Rope.ROPE;
cl: Rope.ROPE ← cmd.commandLine;
IF Rope.IsEmpty[cl] THEN RETURN;
question ← Rope.Cat["execute: ", Rope.Substr[base: cl, len: Rope.Length[cl]-1]];
IF ~TerminalIO.Confirm[text: question, dontLog: TRUE] THEN
RETURN [$Failure, "denied"];
result ← CommandTool.DoCommand[commandLine: cl, parent: cmd];
};
GetTechnology: PUBLIC PROC [hint: REF] RETURNS [technology: CD.Technology] = {
GetWithRope: PROC [name: Rope.ROPE] RETURNS [t: CD.Technology←NIL] = {
EachTechnology: CD.TechnologyEnumerator = {
IF Rope.Equal[tech.name, name, FALSE]
OR Rope.Equal[Atom.GetPName[tech.key], name, FALSE]
THEN {quit ← TRUE; technology ← tech}
};
IF Rope.IsEmpty[name] THEN RETURN;
[] ← CD.EnumerateTechnologies[EachTechnology];
};
WITH hint SELECT FROM
tech: CD.Technology => RETURN [tech];
d: CD.Design => RETURN [d.technology];
a: ATOM => technology ← CD.FetchTechnology[a];
ENDCASE => NULL;
IF technology=NIL THEN RETURN [GetWithRope[CDOps.ToRope[hint]]]
};
-- internals ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
TechWDir: PROC [for: REF] RETURNS [Rope.ROPE] = {
WITH for SELECT FROM
d: CD.Design => for ← d.technology
ENDCASE => NULL;
RETURN [GetWorkingDirectory[for]]
};
TechnologyHasBeenRegisterd: CDEvents.EventProc = {
WITH x SELECT FROM
t: CD.Technology => {
SetWorkingDirectory[t, NIL];
};
ENDCASE => NULL
};
NewDesignHasBeenCreated: CDEvents.EventProc = {
IF design#NIL THEN SetWorkingDirectory[design, FileNames.CurrentWorkingDirectory[]];
};
reInstallTipTables: CDEvents.EventRegistration ← CDEvents.RegisterEventType[ $CDReRegisterTipTables];
CDValue.RegisterKey[$TipTable, NIL, $CD];
CDValue.RegisterKey[$TipTableName, NIL, $CD];
CDValue.RegisterKey[$Icon, NIL, $CD];
CDValue.RegisterKey[$WorkingDirectory, NIL, $CD];
SetIcon[NIL, "ChipNDale.icons", 0];
SetPanelIcon[NIL, "ChipNDale.icons", 1];
SetWorkingDirectory[NIL, NIL];
CDEvents.RegisterEventProc[$CreateNewDesign, NewDesignHasBeenCreated];
CDEvents.RegisterEventProc[$RegisterTechnology, TechnologyHasBeenRegisterd];
RegisterCommander["CDReInstallTipTables", ReInstallStandardTipTables, "Reload TIP tables for standard ChipNDale technologies"];
RegisterCommander["AskFirst", AskAndExecute, "Conditionally executes command"];
TerminalIO.PutF["ChipNDale\n %g Version %g.%g for Cedar %g\n %g\n Copyright (C) 1984, 1987 by Xerox Corporation. All rights reserved.\n\n",
[rope[IF preRelease THEN "PRE RELEASED" ELSE ""]],
[integer[cdVersion/10]],
[integer[cdVersion MOD 10]],
[rope[SystemNames.ReleaseName[]]],
[rope[date]]
];
END.