CDTipEtcImpl.mesa (part of ChipNDale)
Copyright © 1983, 1985 by Xerox Corporation. All rights reserved.
by Christian Jacobi, August 11, 1983 11:32 am
last edited by Christian Jacobi, January 15, 1985 9:44:07 am PST
DIRECTORY
CD,
CDIO,
CDTipEtc,
CDValue,
Icons,
Rope,
RuntimeError,
TerminalIO,
TEditImpl USING [ReloadTable], --crazy tiptable load procedure
TIPUser,
UserProfile;
CDTipEtcImpl:
CEDAR
PROGRAM
IMPORTS CDIO, CDValue, Icons, RuntimeError, Rope, TEditImpl, TerminalIO, TIPUser, UserProfile
EXPORTS CDTipEtc =
BEGIN
-- tip tables ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SetTipTable:
PUBLIC
PROC [onto:
REF, tipTable: Rope.
ROPE] =
BEGIN
tTable: TIPUser.TIPTable ← NIL;
IF tipTable=
NIL
OR Rope.Equal[tipTable, "Standard"]
THEN
tTable ← NewMakeTipTable[onto]
ELSE
tTable ← OldMakeTipTable[onto, tipTable];
IF tTable#NIL THEN CDValue.Store[boundTo: onto, key: $TipTable, value: tTable];
END;
rememberList: LIST OF CD.Technology←NIL;
NoteProfileChange: UserProfile.ProfileChangedProc =
-- PROC [reason: ProfileChangeReason]
BEGIN
FOR l:
LIST
OF
CD.Technology ← rememberList, l.rest
WHILE l#
NIL
DO
SetTipTable[onto: l.first, tipTable: NIL]
ENDLOOP
END;
NewMakeTipTable:
PROC [onto:
REF, remember:
BOOL←
TRUE]
RETURNS [tTable: TIPUser.TIPTable ←
NIL] =
BEGIN
WITH onto
SELECT
FROM
d: CD.Design => tTable ← NewMakeTipTable[d.technology, FALSE];
tech:
CD.Technology => {
profileKey: Rope.ROPE ← Rope.Cat["ChipNDale.", tech.name, ".TIP"];
default: Rope.
ROPE ← Rope.Cat[
CDIO.MakeName[base: "ChipNDale", ext: "tip", modifier: tech.name, wDir: CDIO.GetWorkingDirectory[tech]],
" ",
CDIO.MakeName[base: "ChipNDale", ext: "tip", wDir: CDIO.GetWorkingDirectory[NIL]]
];
tTable ← TEditImpl.ReloadTable[oldTIP: NIL, profileKey: profileKey, default: default];
IF tTable=NIL THEN TerminalIO.WriteRope["Tiptable not installed\n"];
IF remember
THEN
FOR l:
LIST
OF
CD.Technology ← rememberList, l.rest
WHILE l#
NIL
DO
IF l.first=tech THEN EXIT;
REPEAT
FINISHED => rememberList ← CONS[tech, rememberList]
ENDLOOP
};
ENDCASE => TerminalIO.WriteRope["Tiptable not installed\n"];
END;
OldMakeTipTable:
PROC [onto:
REF, tipTable: Rope.
ROPE]
RETURNS [tTable: TIPUser.TIPTable ←
NIL] =
BEGIN
tipTable ← CDIO.MakeName[base: tipTable, ext: "tip", wDir: GlobalWDir[onto]];
tTable ← TIPUser.InstantiateNewTIPTable[tipTable !
TIPUser.InvalidTable => {
TerminalIO.WriteRope["Tiptable not installed; "];
TerminalIO.WriteRope[errorMsg];
TerminalIO.WriteLn[];
GOTO NotDone
}
];
END;
GetTipTable:
PUBLIC
PROC [for:
REF]
RETURNS [TIPUser.TIPTable] =
BEGIN
WITH CDValue.Fetch[boundTo: for, key: $TipTable, propagation: global]
SELECT
FROM
ttr: TIPUser.TIPTable => RETURN [ttr];
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.EnregisterKey[key: $TipTable];
CDValue.EnregisterKey[key: $Icon];
designIcon^ ← Icons.NewIconFromFile["ChipNDale.icons", 0 ! RuntimeError.UNCAUGHT => CONTINUE];
CDValue.Store[boundTo: NIL, key: $Icon, value: designIcon];
CDValue.EnregisterKey[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.