CDTipEtcImpl.mesa (part of ChipNDale)
Copyright © 1983, 1986 by Xerox Corporation. All rights reserved.
by Christian Jacobi, August 11, 1983 11:32 am
last edited by Christian Jacobi, March 29, 1986 7:17:39 pm PST
DIRECTORY
CD,
CDIO,
CDTipEtc,
CDValue,
Icons,
Rope,
RuntimeError,
TerminalIO,
TEditImpl USING [ReloadTable], --crazy tiptable load procedure
TIPUser,
UserProfile;
CDTipEtcImpl:
CEDAR
PROGRAM
IMPORTS CD, CDIO, CDValue, Icons, RuntimeError, Rope, TEditImpl, TerminalIO, TIPUser, UserProfile
EXPORTS CDTipEtc =
BEGIN
-- tip tables ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SetTipTable:
PUBLIC
PROC [onto:
REF, tipTable: Rope.
ROPE] =
BEGIN
tipTab: TIPUser.TIPTable ← NIL;
IF Rope.IsEmpty[tipTable]
OR Rope.Equal[tipTable, "Standard"]
THEN
tipTab ← FindStandardTipTable[onto]
ELSE tipTab ← FindExplicitTipTable[onto, tipTable];
IF tipTab#NIL THEN CDValue.Store[onto, $TipTable, tipTab];
END;
NoteProfileChange: UserProfile.ProfileChangedProc =
BEGIN
EachTech:
CD.TechnologyEnumerator = {
IF CDValue.Fetch[tech, $HasDefaultTipTable]#
NIL
THEN
SetTipTable[onto: tech, tipTable: NIL]
};
[] ← CD.EnumerateTechnologies[EachTech];
END;
FindStandardTipTable:
PROC [onto:
REF]
RETURNS [tipTable: TIPUser.TIPTable ←
NIL] =
BEGIN
WITH onto
SELECT
FROM
tech:
CD.Technology => {
profileKey: Rope.ROPE ← Rope.Cat["ChipNDale.", tech.name, ".TIP"];
techPart: Rope.ROPE ← CDIO.MakeName[base: "ChipNDale", ext: "tip", modifier: tech.name, wDir: CDIO.GetWorkingDirectory[tech]];
base: Rope.ROPE ← CDIO.MakeName[base: "ChipNDale", ext: "tip", wDir: CDIO.GetWorkingDirectory[NIL]];
default: Rope.ROPE ← Rope.Cat[techPart, " ", base];
tipTable ← TEditImpl.ReloadTable[oldTIP: NIL, profileKey: profileKey, default: default];
IF tipTable=
NIL
THEN
TerminalIO.WriteRopes["Tip-table for ", tech.name, " not installed\n"];
CDValue.Store[tech, $HasDefaultTipTable, $T];
};
d: CD.Design => tipTable ← FindStandardTipTable[d.technology];
ENDCASE => TerminalIO.WriteRope["Tip-table not installed\n"];
END;
FindExplicitTipTable:
PROC [onto:
REF, name: Rope.
ROPE]
RETURNS [tipTable: TIPUser.TIPTable ←
NIL] =
BEGIN
name ← CDIO.MakeName[base: name, ext: "tip", wDir: GlobalWDir[onto]];
tipTable ← TIPUser.InstantiateNewTIPTable[name !
TIPUser.InvalidTable => {
TerminalIO.WriteRopes["Tiptable not installed; ", errorMsg, "\n"];
GOTO oops
}
];
CDValue.Store[onto, $HasDefaultTipTable, NIL];
EXITS oops => NULL
END;
GetTipTable:
PUBLIC
PROC [for:
REF]
RETURNS [TIPUser.TIPTable] =
BEGIN
WITH CDValue.Fetch[boundTo: for, key: $TipTable, propagation: global]
SELECT
FROM
tipTable: TIPUser.TIPTable => RETURN [tipTable];
ENDCASE => RETURN [NIL];
END;
-- Icons ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SetIcon:
PUBLIC PROC [onto:
REF, file: Rope.
ROPE, n:
NAT] =
--onto: Design, Technology or global
--only new viewers will get the new icon
BEGIN
icon: REF Icons.IconFlavor = NEW[Icons.IconFlavor←tool];
file ← CDIO.MakeName[base: file, ext: "icon", wDir: GlobalWDir[onto]];
icon^ ← Icons.NewIconFromFile[file, n ! RuntimeError.UNCAUGHT => GOTO notDone];
CDValue.Store[boundTo: onto, key: $Icon, value: icon];
EXITS notDone => TerminalIO.WriteRope["**Icon not initialized\n"];
END;
GetIcon:
PUBLIC PROC [for:
REF]
RETURNS [Icons.IconFlavor] =
--for: Design, Technology or global
BEGIN
WITH CDValue.Fetch[boundTo: for, key: $Icon, propagation: global]
SELECT
FROM
ip: REF Icons.IconFlavor => RETURN [ip^];
ENDCASE => RETURN [Icons.IconFlavor[unInit]]
END;
SetPanelIcon:
PUBLIC PROC [onto:
REF, file: Rope.
ROPE, n:
NAT] =
--onto: Design, Technology or global
--only new viewers will get the new icon
BEGIN
icon: REF Icons.IconFlavor = NEW[Icons.IconFlavor←tool];
file ← CDIO.MakeName[base: file, ext: "icon", wDir: GlobalWDir[onto]];
icon^ ← Icons.NewIconFromFile[file, n ! RuntimeError.UNCAUGHT => GOTO notDone];
CDValue.Store[boundTo: onto, key: $PanelIcon, value: icon];
EXITS notDone => TerminalIO.WriteRope["**Panel-Icon not initialized\n"];
END;
GetPanelIcon:
PUBLIC PROC [for:
REF]
RETURNS [Icons.IconFlavor] =
--for: Design, Technology or global
BEGIN
WITH CDValue.Fetch[boundTo: for, key: $PanelIcon, propagation: global]
SELECT
FROM
ip: REF Icons.IconFlavor => RETURN [ip^];
ENDCASE => RETURN [Icons.IconFlavor[unInit]]
END;
-- init ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
GlobalWDir:
PROC [onto:
REF]
RETURNS [Rope.
ROPE] =
BEGIN
WITH onto
SELECT
FROM
d: CD.Design => onto ← d.technology
ENDCASE => NULL;
RETURN [CDIO.GetWorkingDirectory[onto]]
END;
Init:
PROC [] =
BEGIN
panelIcon: REF Icons.IconFlavor = NEW[Icons.IconFlavor←tool];
designIcon: REF Icons.IconFlavor = NEW[Icons.IconFlavor←tool];
CDValue.RegisterKey[key: $TipTable];
CDValue.RegisterKey[key: $HasDefaultTipTable];
CDValue.RegisterKey[key: $Icon];
designIcon^ ← Icons.NewIconFromFile["ChipNDale.icons", 0 ! RuntimeError.UNCAUGHT => CONTINUE];
CDValue.Store[boundTo: NIL, key: $Icon, value: designIcon];
CDValue.RegisterKey[key: $PanelIcon];
panelIcon^ ← Icons.NewIconFromFile["ChipNDale.icons", 1 ! RuntimeError.UNCAUGHT => CONTINUE];
CDValue.Store[boundTo: NIL, key: $PanelIcon, value: panelIcon];
UserProfile.CallWhenProfileChanges[NoteProfileChange];
END;
Init[];
END.