FeedbackCommands.mesa
Copyright Ó 1990 by Xerox Corporation. All rights reserved.
Last tweaked by Mike Spreitzer on May 7, 1990 1:37:03 pm PDT
Bier, January 29, 1991 2:07 pm PST
DIRECTORY Atom, Commander, CommandTool, Feedback, FeedbackClasses, FeedbackOps, FeedbackTypes, IO, Rope, ViewerClasses;
FeedbackCommands:
CEDAR
PROGRAM
IMPORTS Atom, Commander, CommandTool, Feedback, FeedbackClasses, FeedbackOps, IO, Rope
=
BEGIN OPEN Feedback, FeedbackOps, FC:FeedbackClasses;
Viewer: TYPE = ViewerClasses.Viewer;
RecreateNamedTypescript:
PROC [cmd: Commander.Handle]
RETURNS [result:
ATOM ←
NIL, msg:
ROPE ←
NIL]
--Commander.CommandProc-- ~ {
storing: BOOL ~ cmd.procData.clientData = $Storing;
argv: CommandTool.ArgumentVector;
argv ← CommandTool.Parse[cmd !CommandTool.Failed => {msg ← errorMsg; GOTO Fail}];
FOR i:
NAT
IN (0 .. argv.argc)
DO
name: ROPE ~ argv[i];
atom: ATOM ~ Atom.MakeAtom[name];
alreadyExists: BOOL;
typescript: Viewer;
[alreadyExists, typescript] ← CreateNamedTypescript[headerText: name, typescriptName: atom, storing: storing];
IF alreadyExists THEN cmd.out.PutF["%g already existed, with name %g.\n", [rope[name]], [rope[typescript.name]] ];
ENDLOOP;
RETURN;
EXITS Fail => result ← $Failure};
RouteToTypescript:
PROC [cmd: Commander.Handle]
RETURNS [result:
ATOM ←
NIL, msg:
ROPE ←
NIL]
--Commander.CommandProc-- ~ {
argv: CommandTool.ArgumentVector;
router: MsgRouter;
tsname: ATOM;
classes: LIST OF MsgClass ← NIL;
argv ← CommandTool.Parse[cmd !CommandTool.Failed => {msg ← errorMsg; GOTO Fail}];
IF argv.argc < 3 THEN RETURN [$Failure, "Usage: RouteToTypescript routerName typescriptName class*"];
router ← EnsureRouter[Atom.MakeAtom[argv[1]]];
tsname ← Atom.MakeAtom[argv[2]];
IF argv.argc>3
THEN
FOR i:
NAT
DECREASING
IN (2 .. argv.argc)
DO
atom: ATOM ~ Atom.MakeAtom[argv[i]];
classes ← CONS[atom, classes];
ENDLOOP
ELSE classes ← LIST[$Every];
SetMultiTypescript[router, tsname, classes];
RETURN;
EXITS Fail => result ← $Failure};
rmwUsage: ROPE ~ "Usage: RouteToMessageWindow routerName (TRUE|blink|FALSE) class*";
RouteToMessageWindow:
PROC [cmd: Commander.Handle]
RETURNS [result:
ATOM ←
NIL, msg:
ROPE ←
NIL]
--Commander.CommandProc-- ~ {
argv: CommandTool.ArgumentVector;
router: MsgRouter;
classes: LIST OF MsgClass ← NIL;
on: BOOL ← TRUE;
blink: BOOL ← FALSE;
argv ← CommandTool.Parse[cmd !CommandTool.Failed => {msg ← errorMsg; GOTO Fail}];
IF argv.argc < 3 THEN RETURN [$Failure, rmwUsage];
router ← EnsureRouter[Atom.MakeAtom[argv[1]]];
SELECT
TRUE
FROM
argv[2].Equal["TRUE"] => NULL;
argv[2].Equal["FALSE"] => on ← FALSE;
argv[2].Equal["blink", FALSE] => blink ← TRUE;
ENDCASE => RETURN [$Failure, rmwUsage];
IF argv.argc>3
THEN
FOR i:
NAT
DECREASING
IN (2 .. argv.argc)
DO
atom: ATOM ~ Atom.MakeAtom[argv[i]];
classes ← CONS[atom, classes];
ENDLOOP
ELSE classes ← LIST[$Every];
IF on
THEN SetMultiMessageWindow[router, blink, classes]
ELSE SetMultiLabel[router, NIL, FALSE, classes];
RETURN;
EXITS Fail => result ← $Failure};
RouteToDebugger:
PROC [cmd: Commander.Handle]
RETURNS [result:
ATOM ←
NIL, msg:
ROPE ←
NIL]
--Commander.CommandProc-- ~ {
argv: CommandTool.ArgumentVector;
router: MsgRouter;
classes: LIST OF MsgClass ← NIL;
argv ← CommandTool.Parse[cmd !CommandTool.Failed => {msg ← errorMsg; GOTO Fail}];
IF argv.argc < 2 THEN RETURN [$Failure, "Usage: RouteToDebugger routerName class*"];
router ← EnsureRouter[Atom.MakeAtom[argv[1]]];
IF argv.argc>2
THEN
FOR i:
NAT
DECREASING
IN (1 .. argv.argc)
DO
atom: ATOM ~ Atom.MakeAtom[argv[i]];
classes ← CONS[atom, classes];
ENDLOOP
ELSE classes ← LIST[$Every];
SetMultiHandler[router, classes, FC.handleByProblem];
RETURN;
EXITS Fail => result ← $Failure};
RouteToNowhere:
PROC [cmd: Commander.Handle]
RETURNS [result:
ATOM ←
NIL, msg:
ROPE ←
NIL]
--Commander.CommandProc-- ~ {
argv: CommandTool.ArgumentVector;
router: MsgRouter;
classes: LIST OF MsgClass ← NIL;
argv ← CommandTool.Parse[cmd !CommandTool.Failed => {msg ← errorMsg; GOTO Fail}];
IF argv.argc < 2 THEN RETURN [$Failure, "Usage: RouteToDebugger routerName class*"];
router ← EnsureRouter[Atom.MakeAtom[argv[1]]];
IF argv.argc>2
THEN
FOR i:
NAT
DECREASING
IN (1 .. argv.argc)
DO
atom: ATOM ~ Atom.MakeAtom[argv[i]];
classes ← CONS[atom, classes];
ENDLOOP
ELSE classes ← LIST[$Every];
SetMultiHandler[router, classes, FC.doNothing];
RETURN;
EXITS Fail => result ← $Failure};
FeedbackTest:
PROC [cmd: Commander.Handle]
RETURNS [result:
ATOM ←
NIL, msg:
ROPE ←
NIL]
--Commander.CommandProc-- ~ {
argv: CommandTool.ArgumentVector;
router: MsgRouter;
class: ATOM;
argv ← CommandTool.Parse[cmd !CommandTool.Failed => {msg ← errorMsg; GOTO Fail}];
IF argv.argc # 4 THEN RETURN [$Failure, "Usage: FeedbackTest routerName class msg"];
router ← EnsureRouter[Atom.MakeAtom[argv[1]]];
class ← Atom.MakeAtom[argv[2]];
Append[router, oneLiner, class, argv[3]];
RETURN;
EXITS Fail => result ← $Failure};
ListRouters:
PROC [cmd: Commander.Handle]
RETURNS [result:
ATOM ←
NIL, msg:
ROPE ←
NIL]
--Commander.CommandProc-- ~ {
ListRouter:
PROC [name:
ATOM, router: MsgRouter]
RETURNS [
BOOL] ~ {
ListHandler:
PROC [c: MsgClass, h: MsgHandler]
RETURNS [
BOOL] ~ {
cmd.out.PutF["\t%g => %g\n", [atom[c]], [rope[DescribeHandler[h]]]];
RETURN [FALSE]};
cmd.out.PutF["%g\n", [atom[name]]];
IF ScanHandlers[router, ListHandler].stopped THEN ERROR;
RETURN [FALSE]};
IF ScanRouters[ListRouter].stopped THEN ERROR;
BEGIN
dummy: Feedback.MsgHandler ← FeedbackClasses.CreateStoringHandler[10];
default: Feedback.MsgHandler ← Feedback.SetGlobalDefaultHandlersBehavior[dummy];
[] ← Feedback.SetGlobalDefaultHandlersBehavior[default];
cmd.out.PutRope["GlobalDefaultHandler\n"];
cmd.out.PutF["\t* => %g\n", [rope[DescribeHandler[default]]]];
END;
RETURN};
DescribeHandler:
PROC [h: MsgHandler]
RETURNS [
ROPE] ~ {
is, blink: BOOL;
l: Viewer;
h1, h2: MsgHandler;
r: MsgRouter;
tn: ATOM;
buffsize: INT;
[is, tn, l, blink] ← IsViewersHandler[h];
IF is THEN RETURN IO.PutFR["Viewers[tn: %g, l: %g, blink: %g]", [atom[tn]], [rope[IF l=messageWindow THEN "Message Window" ELSE IF l=NIL THEN "no label" ELSE l.name]], [boolean[blink]] ];
IF h = FC.doNothing THEN RETURN ["ye olde bit bucket"];
IF h = FC.handleByProblem THEN RETURN ["debugger"];
[is, r] ← FC.IsHandlerOnRouter[h];
IF is THEN RETURN ["Router"];
[is, h1, h2] ← FC.IsSplittingHandler[h];
IF is THEN RETURN IO.PutFR["Split[%g, %g]", [rope[DescribeHandler[h1]]], [rope[DescribeHandler[h2]]] ];
[is] ← FC.IsHandlerOnStream[h];
IF is THEN RETURN ["STREAM"];
[is, buffsize] ← FC.IsStoringHandler[h];
IF is THEN RETURN IO.PutFR["Storing[%g]", [integer[buffsize]] ];
RETURN ["Unrecognized"]};
Commander.Register["RecreateNamedTypescript", RecreateNamedTypescript, "name*"];
Commander.Register["RecreateStoringNamedTypescript", RecreateNamedTypescript, "name*", $Storing];
Commander.Register["RouteToTypescript", RouteToTypescript, "routerName typescriptName class* - class list defaults to (Every)"];
Commander.Register["RouteToMessageWindow", RouteToMessageWindow, "routerName (TRUE|blink|FALSE) class* - class list defaults to (Every)"];
Commander.Register["RouteToDebugger", RouteToDebugger, "routerName class* - class list defaults to (Every)"];
Commander.Register["RouteToNowhere", RouteToNowhere, "routerName class* - class list defaults to (Every)"];
Commander.Register["FeedbackTest", FeedbackTest, "routerName class msg"];
Commander.Register["ListRouters", ListRouters, "lists Feedback routers"];
END.