<> <> <> <<>> 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]; TrcToolImpl: CEDAR PROGRAM IMPORTS Abutters, Atom, Buttons, Commander, CommandTool, Convert, FS, ImagerFont, IO, Labels, Menus, MessageWindow, PopUpMenus, Process, Rope, Trc, TrcViewers, UserCredentials, UserProfile, ViewerOps, ViewerTools EXPORTS TrcTool ~ BEGIN 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]]; }; <> 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; <<>> <> 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]; <> 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.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]], 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"]; END.