DIRECTORY
TrcTool,
Abutters USING [Abutter, Create, QuaAbutter, QuaViewer, Series, SetLayout, vanilla],
Atom USING [MakeAtom],
Buttons USING [Button, ButtonProc, Create],
Commander USING [CommandProc, Register],
CommandTool USING [ArgumentVector, CurrentWorkingDirectory, Parse],
Convert USING [RopeFromAtom],
FS USING [ComponentPositions, Error, ExpandName, FileInfo, StreamOpen],
ImagerFont USING [Find],
IO,
Labels USING [Create, Label, Set],
Menus USING [AppendMenuEntry, ClickProc, CreateEntry, CreateMenu, Menu],
MessageWindow USING [Append, Blink],
PopUpMenus USING [Call, Create, Entry, Menu],
Process USING [Detach],
Rope USING [Cat, Fetch, Find, Length, ROPE, Substr],
Trc,
TrcViewers USING [CreateTRCViewer, NewTrc],
UserCredentials USING [Get],
UserProfile USING [ListOfTokens, Token],
ViewerClasses USING [Viewer, ViewerRec],
ViewerOps USING [AddProp, DestroyViewer, FetchProp, PaintViewer, SetNewVersion],
ViewerTools USING [GetSelectionContents];
OPEN TrcTool;
ROPE: TYPE ~ Rope.ROPE;
width: NAT ~ 100;
cWidth: NAT ~ 250;
margin: NAT ~ 5;
sq: NAT ~ 15;
trcToolMenu: Menus.Menu ~ BuildTrcToolMenu[];
MakeTrcTool:
PUBLIC
PROC [info: ViewerClasses.ViewerRec, paint:
BOOL]
RETURNS [v: ViewerClasses.Viewer] ~ {
initialFlavor: ATOM ~ IF info.data#NIL AND ISTYPE[info.data, ATOM] THEN NARROW[info.data] ELSE NIL;
trc: Trc.TRC ← NewSelectableTrc[initialFlavor];
filename: ROPE ← NIL;
filename ← NoVersion[FS.FileInfo[name: info.file, wDir: CommandTool.CurrentWorkingDirectory[] ! FS.Error => {filename←NIL; CONTINUE}].fullFName];
IF filename=NIL THEN filename ← WDOf[FS.ExpandName[name: Rope.Cat[info.file, "foo"], wDir: CommandTool.CurrentWorkingDirectory[]].fullFName];
info.file ← filename;
info.iconic ← TRUE;
info.menu ← trcToolMenu;
v ← Trc.BuildControlViewer[trc: trc, info: info, paint: paint];
ViewerOps.AddProp[viewer: v, prop: $Trc, val: trc];
IF IsWD[filename] THEN InitializeTool[v, FALSE] ELSE LoadTool[viewer: v, filename: filename];
[] ← Trc.InstallListener[trc: trc, listener: [proc: MarkCaptionAsEdited, listenerData: v]];
ViewerOps.PaintViewer[viewer: v, hint: caption];
};
MarkCaptionAsEdited: Trc.ListenerProc = {
[trc: TRC, listenerData: REF ANY]
ViewerOps.SetNewVersion[NARROW[listenerData]];
};
MenuClear: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
viewer: ViewerClasses.Viewer ~ NARROW[parent];
InitializeTool[viewer];
};
MenuGet: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
viewer: ViewerClasses.Viewer ~ NARROW[parent];
filename: ROPE ← ViewerTools.GetSelectionContents[];
IF IsWD[filename]
THEN Complain["\"", filename, "\" is an invalid file name."]
ELSE {
filename ← NoVersion[FS.FileInfo[name: filename, wDir: WDOf[viewer.file] ! FS.Error => {Complain["Couldn't find ", viewer.file, "!"]; GOTO Fail}].fullFName];
LoadTool[viewer, filename];
};
ViewerOps.PaintViewer[viewer: viewer, hint: all];
EXITS Fail => NULL;
};
MenuStore: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
viewer: ViewerClasses.Viewer ~ NARROW[parent];
filename: ROPE ← ViewerTools.GetSelectionContents[];
IF IsWD[filename]
THEN Complain["\"", filename, "\" is an invalid file name."]
ELSE {
filename ← NoVersion[FS.ExpandName[name: filename, wDir: WDOf[viewer.file]].fullFName];
viewer.file ← filename;
StoreTool[viewer];
};
ViewerOps.PaintViewer[viewer: viewer, hint: all];
};
MenuSave: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
viewer: ViewerClasses.Viewer ~ NARROW[parent];
IF viewer.newVersion THEN StoreTool[viewer];
ViewerOps.PaintViewer[viewer: viewer, hint: caption];
};
InitializeTool:
PROC [viewer: ViewerClasses.Viewer, paint:
BOOL ←
TRUE] ~ {
viewer.file ← WDOf[viewer.file];
viewer.newVersion ← FALSE;
ComputeName[viewer];
IF paint THEN ViewerOps.PaintViewer[viewer: viewer, hint: all];
};
LoadTool:
PROC [viewer: ViewerClasses.Viewer, filename:
ROPE] ~ {
ReadTrc:
PROC
RETURNS [trc: Trc.
TRC] ~ {
flavor: ATOM ~ IO.GetAtom[stream];
class: Trc.Class ~ Trc.ClassFromFlavor[flavor];
trc ← Trc.Depickle[class: class, stream: stream];
};
trc: Trc.TRC ~ NARROW[ViewerOps.FetchProp[viewer: viewer, prop: $Trc]];
stream: IO.STREAM ~ FS.StreamOpen[filename];
SelectNewTrc[trc: trc, under: ReadTrc[]];
viewer.file ← filename;
viewer.newVersion ← FALSE;
ComputeName[viewer];
};
StoreTool:
PROC [viewer: ViewerClasses.Viewer] ~ {
stream: IO.STREAM ~ FS.StreamOpen[fileName: viewer.file, accessOptions: create];
IO.PutF[
stream: stream,
format: "-- %g\n-- Created (from TrcTool) by %g %g\n",
v1: [rope[SimpleName[viewer.file]]],
v2: [rope[UserProfile.Token[key: "EditorComforts.LastEdited", default: Rope.Cat[UserCredentials.Get[].name, ","]]]],
v3: IO.time[]
];
Trc.Pickle[trc: NARROW[ViewerOps.FetchProp[viewer: viewer, prop: $Trc]], stream: stream, indentation: "\t"];
IO.PutRope[self: stream, r: "\nEND .\n"];
IO.Close[self: stream];
viewer.newVersion ← FALSE;
ComputeName[viewer];
};
Complain:
PROC [r1, r2, r3, r4, r5:
ROPE ←
NIL] ~ {
MessageWindow.Append[message: Rope.Cat[r1, r2, r3, r4, r5], clearFirst: TRUE];
MessageWindow.Blink[];
};
ComputeName:
PROC [viewer: ViewerClasses.Viewer] ~ {
IF IsWD[viewer.file]
THEN {
viewer.name ← viewer.file;
viewer.label ← NIL;
}
ELSE {
pos: INT;
viewer.name ← FS.FileInfo[name: viewer.file].fullFName;
IF (pos ← Rope.Find[s1: viewer.name, s2: "!"])<0 THEN ERROR;
viewer.name ← Rope.Cat["Trc: ", Rope.Substr[base: viewer.name, len: pos], " (", Rope.Substr[base: viewer.name, start: pos], ")"];
viewer.label ← viewer.file;
FOR each:
LIST
OF
ROPE ← UserProfile.ListOfTokens[key: "Viewers.SuppressIconPrefix", default:
NIL], each.rest
UNTIL each=
NIL
DO
IF Rope.Find[s1: viewer.name, s2: each.first, case:
FALSE]=0
THEN {
viewer.label ← Rope.Substr[base: viewer.file, start: Rope.Length[each.first]];
};
ENDLOOP;
};
};
WDOf:
PROC [filePattern:
ROPE]
RETURNS [wd:
ROPE] ~ {
cp: FS.ComponentPositions;
IF IsWD[filePattern] THEN RETURN [WDOf[Rope.Cat[filePattern, "foo"]]];
[fullFName: filePattern, cp: cp] ← FS.ExpandName[name: filePattern, wDir: "[]<>"];
wd ← Rope.Substr[base: filePattern, len: cp.base.start];
};
IsWD:
PROC [filePattern:
ROPE]
RETURNS [wd:
BOOL] ~ {
IF Rope.Length[filePattern]=0 THEN RETURN [TRUE];
SELECT Rope.Fetch[base: filePattern, index: Rope.Length[filePattern]-1]
FROM
'/, '> => RETURN [TRUE];
ENDCASE => RETURN [FALSE];
};
SimpleName:
PROC [filePattern:
ROPE]
RETURNS [simple:
ROPE] ~ {
cp: FS.ComponentPositions;
[fullFName: filePattern, cp: cp] ← FS.ExpandName[name: filePattern];
simple ← Rope.Substr[base: filePattern, start: cp.base.start, len: cp.ext.start-cp.base.start+cp.ext.length];
};
NoVersion:
PROC [filePattern:
ROPE]
RETURNS [withoutVersion:
ROPE] ~ {
cp: FS.ComponentPositions;
[fullFName: filePattern, cp: cp] ← FS.ExpandName[name: filePattern];
withoutVersion ← Rope.Substr[base: filePattern, len: cp.ext.start+cp.ext.length];
};
BuildTrcToolMenu:
PROC
RETURNS [menu: Menus.Menu] ~ {
menu ← Menus.CreateMenu[];
Menus.AppendMenuEntry[menu: menu, entry: Menus.CreateEntry[name: "Clear", proc: MenuClear]];
Menus.AppendMenuEntry[menu: menu, entry: Menus.CreateEntry[name: "Get", proc: MenuGet]];
Menus.AppendMenuEntry[menu: menu, entry: Menus.CreateEntry[name: "Store", proc: MenuStore, documentation: "Click again to Store", guarded: TRUE]];
Menus.AppendMenuEntry[menu: menu, entry: Menus.CreateEntry[name: "Save", proc: MenuSave]];
};
Selectable Trcs
ClassFromFlavor:
PROC [flavor:
ATOM]
RETURNS [class: Trc.Class] ~ {
IF flavor=NIL THEN flavor ← Atom.MakeAtom[pName: UserProfile.Token[key: "Trc.DefaultTrc", default: "Midtone"]];
class ← Trc.ClassFromFlavor[flavor: flavor];
IF class=NIL THEN class ← Trc.ClassFromFlavor[flavor: $Identity];
};
NewSelectableTrc:
PUBLIC
PROC [underlyingFlavor:
ATOM ←
NIL]
RETURNS [trc: Trc.
TRC] ~ {
underlyingTrc: Trc.
TRC ~
NEW[Trc.TRCRep ← [
class: ClassFromFlavor[flavor: underlyingFlavor],
instance: NIL
]];
data: SelectData ~
NEW[SelectDataRep ← [
under: underlyingTrc
]];
trc ←
NEW[Trc.TRCRep ← [
class: selectableClass,
instance: data
]];
data.listenerReg ← Trc.InstallListener[trc: data.under, listener: [proc: SelectListenerProc, listenerData: trc]];
};
SelectNewTrc:
PUBLIC
PROC [trc, under: Trc.
TRC, paint, notify:
BOOL ←
TRUE] ~ {
data: SelectData ~ NARROW[trc.instance];
IF data.listenerReg#NIL THEN Trc.DeinstallListener[registration: data.listenerReg]; --Break old dependency
data.listenerReg ← NIL;
Build new control viewer
data.under ← under;
data.listenerReg ← Trc.InstallListener[trc: data.under, listener: [proc: SelectListenerProc, listenerData: trc]];
IF data.control#
NIL
THEN {
parent: ViewerClasses.Viewer ~ data.control.parent;
ViewerOps.DestroyViewer[viewer: data.control, paint: FALSE];
ViewerOps.DestroyViewer[viewer: data.control];
data.control ← Trc.BuildControlViewer[trc: data.under, info: [parent: parent, wx: margin, wy: data.trcV.wy+data.trcV.wh+margin], paint: FALSE];
Labels.Set[label: data.label, value: Convert.RopeFromAtom[from: data.under.class.flavor, quote: FALSE], paint: FALSE];
TrcViewers.NewTrc[viewer: data.trcV, trc: data.under, paint: FALSE];
SetSelectLayout[data, FALSE]; --January 25, 1987 5:02:11 am PST. Right?
};
IF notify THEN Trc.NotifyListeners[trc: trc];
IF data.control#NIL AND paint THEN ViewerOps.PaintViewer[viewer: IF data.control.parent=NIL THEN data.control ELSE data.control.parent, hint: client];
};
CurrentSelection:
PUBLIC PROC [trc: Trc.
TRC]
RETURNS [under: Trc.
TRC] ~ {
RETURN [NARROW[trc.instance, SelectData].under];
};
SelectData: TYPE ~ REF SelectDataRep;
SelectDataRep:
TYPE ~
RECORD [
under: Trc.TRC ← NIL,
trcV, selectClass, label, control: ViewerClasses.Viewer ← NIL,
listenerReg: REF ← NIL
];
SelectFcn: Trc.Fcn = {
[trc: TRC, a: REAL] RETURNS [b: REAL]
RETURN [Trc.ApplyFcn[trc: NARROW[trc.instance, SelectData].under, a: a]]
};
SelectBlockFcn: Trc.BlockFcn =
UNCHECKED {
[trc: TRC, from: Trc.UnsafeTable, to: Trc.UnsafeTable, count: NAT]
Trc.ApplyBlockFcn[trc: NARROW[trc.instance, SelectData].under, from: from, to: to, count: count];
};
SelectCopy: Trc.CopyProc = {
[trc: TRC] RETURNS [new: TRC]
new ←
NEW[Trc.TRCRep ← [
class: trc.class,
instance: NEW[SelectDataRep ← [under: Trc.Copy[NARROW[trc.instance, SelectData].under]]]
]];
};
SelectPickle: Trc.PickleProc = {
[trc: TRC, stream: STREAM, indentation: ROPE ← NIL]
data: SelectData ~ NARROW[trc.instance];
Trc.PickleArbitraryTrc[trc: data.under, stream: stream, indentation: indentation];
};
SelectDepickle: Trc.DepickleProc = {
[class: Trc.Class, stream: STREAM] RETURNS [trc: TRC]
trc ← NewSelectableTrc[];
SelectNewTrc[trc: trc, under: Trc.DepickleArbitraryTrc[stream: stream], paint: FALSE, notify: FALSE];
};
SelectNotify: Trc.NotifyProc = {
[viewer: ViewerClasses.Viewer, trc: TRC, input: LIST OF REF ANY]
under: Trc.TRC ~ NARROW[trc.instance, SelectData].under;
under.class.notify[viewer: viewer, trc: under, input: input];
};
SelectBackground: Trc.BackgroundProc = {
[trc: TRC, context: Imager.Context, rectangle: ImagerTransformation.Rectangle, whatChanged: REF ANY ← NIL]
Trc.PaintBackground[trc: NARROW[trc.instance, SelectData].under, context: context, rectangle: rectangle, whatChanged: whatChanged];
};
SelectControl: Trc.BuildControlViewerProc = {
[trc: TRC, info: ViewerClasses.ViewerRec, propList: Properties.PropList ← NIL] RETURNS [viewer: ViewerClasses.Viewer]
TrcRectangle:
PROC
RETURNS [rectangle: Trc.Rectangle ← [x: 0, y: 0, w: 1, h: 1]] ~
INLINE {
WITH Trc.FetchProp[info.parent, $TrcView]
SELECT
FROM
rect: REF Trc.Rectangle => RETURN [rect^];
ENDCASE;
};
TrcSize:
PROC
RETURNS [size:
CARDINAL ← 100] ~
INLINE {
WITH Trc.FetchProp[info.parent, $TrcSize]
SELECT
FROM
int: REF INT => RETURN [int^];
ENDCASE;
};
Dx:
PROC
RETURNS [dx:
REAL] ~
INLINE {
segments: CARDINAL ← 40;
WITH Trc.FetchProp[info.parent, $TrcSegments]
SELECT
FROM
int: REF INT => segments ← int^;
ENDCASE;
dx ← rectangle.w/segments;
};
trcSize: CARDINAL ~ TrcSize[];
rectangle: Trc.Rectangle ~ TrcRectangle[];
dx: REAL ~ Dx[];
data: SelectData ~ IF trc.instance=NIL THEN NEW[SelectDataRep] ELSE NARROW[trc.instance];
abutter: Abutters.Abutter;
childInfo: ViewerClasses.ViewerRec ← info;
info.data ← data;
abutter ← Abutters.Create[viewerFlavor: Abutters.vanilla, info: info, paint: FALSE];
viewer ← Abutters.QuaViewer[abutter];
IF data.under=
NIL
THEN {
data.under ← NEW[Trc.TRCRep ← [class: ClassFromFlavor[NIL], instance: NIL]];
data.under ← TrcStandardClasses.NewIdentityTrc[];
};
data.trcV ← TrcViewers.CreateTRCViewer[trc: data.under, rectangle: rectangle, dx: dx, info: [parent: viewer, wx: margin, wy: margin, ww: trcSize, wh: trcSize], paint: FALSE];
data.selectClass ← Buttons.Create[info: [parent: viewer, name: "Trc Class:", wx: margin+data.trcV.ww+margin, wy: margin, border: FALSE], proc: SelectClass, clientData: trc, font: ImagerFont.Find[name: "Xerox/TiogaFonts/Tioga10B"], paint: FALSE];
data.label ← Labels.Create[info: [parent: viewer, wy: margin, ww: 150, border: FALSE, name: Convert.RopeFromAtom[from: data.under.class.flavor, quote: FALSE]], paint: FALSE];
data.control ← Trc.BuildControlViewer[trc: data.under, info: [parent: viewer, wx: margin, wy: data.trcV.wy+data.trcV.wh+margin], paint: FALSE];
SetSelectLayout[data: data, paint: paint];
};
SelectListenerProc: Trc.ListenerProc = {
[trc: TRC, listenerData: REF ANY]
Trc.NotifyListeners[trc: NARROW[listenerData]];
};
SetSelectLayout:
PROC [data: SelectData, paint:
BOOL] ~ {
Abutters.SetLayout[
a: Abutters.QuaAbutter[data.trcV.parent],
rules: [
left: [
rigid: NIL,
end: parallel [ p: LIST [
[
rigid: LIST [[data.trcV, margin], [data.selectClass, margin], [data.label, margin]],
end: none [spaceAfter: margin, setParentSize: TRUE]
],
[
rigid: LIST [[data.control, margin]],
end: none [spaceAfter: margin, setParentSize: TRUE]
]
]]
],
right: [rigid: NIL, end: none []],
top: [
rigid: LIST [[data.trcV, margin], [data.control, margin]],
end: none [spaceAfter: margin, setParentSize: TRUE]
],
bottom: [rigid: NIL, end: none []]
],
paint: paint
]
Abutters.SetLayout[
a: Abutters.QuaAbutter[data.trcV.parent],
rules: [
left: [
rigid: NIL,
end: parallel [ p:
LIST [
[
rigid: LIST [[data.trcV, margin], [data.selectClass, margin]],
end: stretch [[data.label, margin]]
],
[
rigid: NIL,
end: stretch [[data.control, margin]]
]
]]
],
right: [
rigid: NIL,
end: parallel [ p:
LIST [
[
rigid: NIL,
end: stretch [[data.label, margin]]
],
[
rigid: NIL,
end: stretch [[data.control, margin]]
]
]]
],
top: [
rigid: LIST [[data.trcV, margin]],
end: stretch [[data.control, margin]]
],
bottom: [rigid: NIL, end: stretch [[data.control, margin]]]
],
paint: paint
]
};
SelectClass: Buttons.ButtonProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
EachClass: Trc.ClassEnumProc = {
[class: Trc.Class] RETURNS [quit: BOOL ← FALSE]
IF class.control#NIL THEN [] ← PopUpMenus.Entry[menu: pumenu, entry: Convert.RopeFromAtom[from: class.flavor, quote: FALSE], entryData: class];
};
pumenu: PopUpMenus.Menu ~ PopUpMenus.Create[header: "TRC Classes"];
newClass: Trc.Class;
Trc.EnumerateRegisteredClasses[proc: EachClass];
newClass ← NARROW[PopUpMenus.Call[menu: pumenu, callData: clientData]];
IF newClass#
NIL
THEN {
trc: Trc.TRC ~ NARROW[clientData];
data: SelectData ~ NARROW[trc.instance];
TRUSTED {Process.Detach[FORK SelectNewTrc[trc: trc, under: NEW[Trc.TRCRep ← [class: newClass, instance: NIL]]]]};
};
};
selectableClass: Trc.Class ~
NEW[Trc.ClassRep ← [
flavor: $Selectable,
fcn: SelectFcn,
blockFcn: SelectBlockFcn,
copy: SelectCopy,
pickle: SelectPickle,
depickle: SelectDepickle,
notify: SelectNotify,
background: SelectBackground,
control: SelectControl
]];
TrcToolCommand: Commander.CommandProc = {
[cmd: Commander.Handle] RETURNS [result: REF ANY ← NIL, msg: ROPE ← NIL]
arg: CommandTool.ArgumentVector ~ CommandTool.Parse[cmd: cmd, starExpand: TRUE];
IF arg.argc=1 THEN [] ← MakeTrcTool[info: [file: CommandTool.CurrentWorkingDirectory[]], paint: TRUE]
ELSE
FOR k:
NAT
IN [1..arg.argc)
DO
[] ← MakeTrcTool[info: [file: arg[k]], paint: TRUE];
ENDLOOP;
};
Trc.RegisterClass[class: selectableClass];
Commander.Register[key: "TrcTool", proc: TrcToolCommand, doc: "Open a trc tool for a given trc file"];