X11ViewersCommandsImpl.mesa
Copyright Ó 1991, 1992 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, January 18, 1991 4:09:38 pm PST
Christian Jacobi, August 20, 1993 12:50 pm PDT
Willie-s, June 4, 1992 10:55 am PDT
Offload some commands from X11ViewersImpl.
X11ViewersImpl used to be too large for the optimizer.
DIRECTORY
Atom, Commander, CommanderOps, Convert, Imager, ImagerColor, Process, Rope, Termination, ViewerErrors, Xl, XTk, XTkMigration, XTkShellWidgets, X11Viewers, X11ViewersAccess, X11ViewersInstance;
X11ViewersCommandsImpl:
CEDAR
MONITOR
IMPORTS Atom, Commander, CommanderOps, Convert, ImagerColor, Process, Rope, Termination, ViewerErrors, Xl, XTk, XTkMigration, XTkShellWidgets, X11Viewers, X11ViewersAccess, X11ViewersInstance
SHARES X11Viewers =
BEGIN
IgnoreViewerError: ViewerErrors.PreCatchProc = {
continue ¬ TRUE
};
noOpDoc: Rope.ROPE ~ "A no-op in X11Viewers";
DisabledCommand: Commander.CommandProc = {
msg ¬ Rope.Cat[" X11Viewers ignores the ", CommanderOps.ArgN[cmd, 0], " command"];
};
SSDataOrFail:
PROC []
RETURNS [X11Viewers.ScreenServerData] = {
ssd: X11Viewers.ScreenServerData ~ X11ViewersInstance.Last[];
IF ssd=NIL THEN CommanderOps.Failed["world has not yet been started"];
RETURN [ssd]
};
TopWidgetOrFail:
PROC []
RETURNS [top: XTk.Widget] = {
ssd: X11Viewers.ScreenServerData ~ SSDataOrFail[];
IF (top ¬ ssd.top) = NIL THEN CommanderOps.Failed["world not active"];
};
WithdrawCommand: Commander.CommandProc = {
XTkShellWidgets.WithDraw[TopWidgetOrFail[]];
};
ReOpenCommand: Commander.CommandProc = {
XTkShellWidgets.OpenIcon[TopWidgetOrFail[]];
};
ModeCommand: Commander.CommandProc = {
Fail:
PROC [] = {
CommanderOps.Failed["usage: X11ViewersMode [-default] (color8 | bw | bwX2 | db)\n"]
};
mode: ATOM ¬ NIL;
default: BOOL ¬ FALSE;
arg: Rope.ROPE ¬ CommanderOps.NextArgument[cmd];
IF Rope.Equal[arg, "-default"]
THEN {
default ¬ TRUE;
arg ¬ CommanderOps.NextArgument[cmd];
};
SELECT
TRUE
FROM
Rope.Equal[arg, "color8", FALSE] => mode ¬ $color8;
Rope.Equal[arg, "color4", FALSE] => mode ¬ $color4;
Rope.Equal[arg, "color", FALSE] => mode ¬ $color8;
Rope.Equal[arg, "bw", FALSE] => mode ¬ $bw;
Rope.Equal[arg, "bwX2", FALSE] => mode ¬ $bwX2;
Rope.Equal[arg, "db", FALSE] => mode ¬ $db;
ENDCASE => Fail[];
IF default
THEN X11ViewersAccess.SetDefaultDisplayMode[mode]
ELSE X11ViewersAccess.SetDisplayMode[mode];
};
MoveCommand: Commander.CommandProc = {
top: XTk.Widget ~ TopWidgetOrFail[];
serverName: Rope.ROPE ¬ CommanderOps.NextArgument[cmd];
IF serverName=NIL THEN CommanderOps.Failed["must specify a server"];
msg ¬ XTkMigration.Migrate[top, serverName];
IF ~Rope.IsEmpty[msg] THEN CommanderOps.Failed[msg];
msg ¬ "migration...\n";
};
X11CursorColorCommand: Commander.CommandProc = {
ENABLE Convert.Error => CommanderOps.Failed["needs rgb arguments (REAL)"];
r, g, b: REAL; color: Imager.Color;
ssd: X11Viewers.ScreenServerData ~ SSDataOrFail[];
IF CommanderOps.NumArgs[cmd]#4
THEN
CommanderOps.Failed["needs rgb arguments (REAL)"];
r ¬ Convert.RealFromRope[CommanderOps.NextArgument[cmd]];
g ¬ Convert.RealFromRope[CommanderOps.NextArgument[cmd]];
b ¬ Convert.RealFromRope[CommanderOps.NextArgument[cmd]];
IF r<0
OR r>1
OR b<0
OR b>1
OR g<0
OR g>1
THEN
CommanderOps.Failed["arguments in 0.0 .. 1.0 please"];
color ¬ ImagerColor.ColorFromRGB[[r, g, b]];
ssd.class.setCursorColor[ssd, color, NIL];
};
DebugSetOverheadCost: Commander.CommandProc = {
ENABLE Convert.Error => CommanderOps.Failed["needs an integer argument"];
value: REF INT ¬ NIL;
ssd: X11Viewers.ScreenServerData ~ SSDataOrFail[];
SELECT CommanderOps.NumArgs[cmd]
FROM
1 => value ¬ NIL;
2 => value ¬ NEW[INT ¬ Convert.IntFromRope[CommanderOps.NextArgument[cmd]]];
ENDCASE => CommanderOps.Failed["needs zero or one integer argument"];
XTk.PutWidgetProp[ssd.bitmap, $OverheadCost, value];
};
StartX11ViewersCommand: Commander.CommandProc = {
--Given todays viewer this can be called once only
--Use this procedure for initial start only as it might terminate the world on failure
ssd: X11Viewers.ScreenServerData ~ X11ViewersInstance.Last[];
IF ssd#
NIL
THEN {
XTkShellWidgets.OpenIcon[TopWidgetOrFail[]];
CommanderOps.Failed["X11Viewers has already been started"];
};
DO
repeat: BOOL ¬ FALSE;
result ¬ NIL;
X11Viewers.Start[
! Xl.connectionNotCreated => {
msg: Rope.ROPE ¬ "Can't start Cedar because can't create X window connection";
IF why#NIL THEN msg ¬ Rope.Cat[msg, " because ", why.reason];
SELECT cmd.procData.clientData
FROM
$abort => Termination.QuitWorld[userMsg: msg, interceptable: TRUE];
$repeat => {repeat ¬ TRUE; Process.PauseMsec[5000]; CONTINUE};
ENDCASE => CommanderOps.Failed[msg];
result ¬ $Failure;
}
];
IF result=
NIL
THEN {
--Hack to stop exiting the world when the default commander is exited
Atom.PutProp[$CommanderOnStandardStreams, $DontExit, $DontExit];
};
IF ~repeat THEN EXIT;
ENDLOOP
};
ViewerErrors.Register[LOOPHOLE[Xl.XError], IgnoreViewerError];--occurs legally when using synchronous mode, or, for dead connection while migration
Commander.Register[
key: "X11ViewersInitialStartUp!",
proc: StartX11ViewersCommand,
doc: "Initial start up for X11Viewers; on failure exit cedar world",
clientData: $abort
];
Commander.Register[
key: "X11ViewersInitialStartUp+",
proc: StartX11ViewersCommand,
doc: "Initial start up for X11Viewers; on failure retry...",
clientData: $repeat
];
Commander.Register[
key: "X11ViewersInitialStartUp",
proc: StartX11ViewersCommand,
doc: "Initial start up for X11Viewers; on failure make message"
];
Commander.Register[key: "XVW", proc: StartX11ViewersCommand, doc: "Start X11Viewers"];
Commander.Register["X11ViewersMove", MoveCommand, "Migrate window"];
Commander.Register["X11ViewersMode", ModeCommand, "Set display mode"];
Commander.Register["X11ViewersWithdraw", WithdrawCommand, "Withdraw window"];
Commander.Register["X11ViewersReOpen", ReOpenCommand, "Re-open withdrawn window"];
Commander.Register["RawViewersRestart", DisabledCommand, noOpDoc];
Commander.Register["ColorMap", DisabledCommand, noOpDoc];
Commander.Register["MouseGain", DisabledCommand, noOpDoc];
Commander.Register["MouseGainXY", DisabledCommand, noOpDoc];
Commander.Register["X11ViewersSetCursorColor", X11CursorColorCommand, "Set cursor color (r,g,b: REAL)"];
Commander.Register["X11ViewersOverHeadCost", DebugSetOverheadCost, "For ChJ's private tweaking of cost function"];
END.