CommanderViewerImpl.mesa
Copyright Ó 1989, 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Michael Plass, March 11, 1992 12:43 pm PST
Last changed by Pavel on February 13, 1990 12:58 pm PST
Christian Jacobi, August 7, 1990 3:53 pm PDT
Bier, October 29, 1990 5:14 pm PST
Willie-s, October 18, 1991 12:29 pm PDT
Jules Bloomenthal June 25, 1993 2:18 pm PDT
DIRECTORY Ascii, Atom, Buttons, Commander, CommanderBackdoor, CommanderOps, CommanderViewer, Convert, ConvertUnsafe, EditedStream, Icons, IO, List, MBQueue, Menus, MessageWindow, PFS, PFSNames, Process, RefText, Rope, RopeList, TiogaMenuOps, TiogaOps, TypeScript, UserProfile, ViewerClasses, ViewerIO, ViewerOps, ViewerTools;
CommanderViewerImpl: CEDAR PROGRAM
IMPORTS Atom, Buttons, Commander, CommanderBackdoor, CommanderOps, Convert, ConvertUnsafe, EditedStream, Icons, IO, List, MBQueue, Menus, MessageWindow, PFS, PFSNames, Process, RefText, Rope, RopeList, TiogaMenuOps, TiogaOps, TypeScript, UserProfile, ViewerIO, ViewerOps, ViewerTools
EXPORTS CommanderViewer
~ BEGIN
PATH: TYPE ~ PFSNames.PATH;
ROPE: TYPE ~ Rope.ROPE;
CreateCommanderButtonProc: Buttons.ButtonProc = {
Create a brand-new independent commander
initial: ROPE ~ "CommandsFromProfile CommandTool.PerCommandTool";
Process.SetPriority[Process.priorityNormal];
[] ¬ Create[info: [name: "initializing...", column: right, iconic: FALSE], initial: initial];
};
CommanderViewerCommand: Commander.CommandProc = {
Create a brand-new independent commander
fork: BOOL ~ cmd.procData.clientData = $Fork;
fork: BOOL ~ FALSE; -- fork is handled by the new Fork routine below, Bier, October 29, 1990
[] ¬ Create[info: [
name: "initializing...",
column: IF fork THEN left ELSE right,
iconic: fork
], initial: cmd.commandLine];
};
SwitchesAndCommand: PROC [line: Rope.ROPE] RETURNS [switches, command: Rope.ROPE] = {
lineLength: NAT ¬ 0;
beginCommand: INT ¬ 0;
i: NAT ¬ 0;
inSwitch: BOOL ¬ FALSE;
lineLength ¬ Rope.Length[line];
FOR i: INT IN [0..lineLength) DO
IF inSwitch THEN {
SELECT Rope.Fetch[line, i] FROM
IO.SP, IO.TAB => {inSwitch ¬ FALSE; beginCommand ¬ i};
'- => {beginCommand ¬ -1}; -- in a new switch. Keep going
ENDCASE => {beginCommand ¬ -1} -- keep going in a switch
}
ELSE { -- not in a switch
SELECT Rope.Fetch[line, i] FROM
IO.SP, IO.TAB => {beginCommand ¬ i}; -- keep going
'- => {inSwitch ¬ TRUE; beginCommand ¬ -1};
ENDCASE => { -- command begins here
inSwitch ¬ FALSE;
beginCommand ¬ i;
EXIT;
};
};
ENDLOOP;
IF inSwitch THEN {switches ¬ line; command ¬ NIL}
ELSE {
switches ¬ IF beginCommand > 0 THEN Rope.Substr[line, 0, beginCommand] ELSE NIL;
command ¬ IF beginCommand # -1 THEN Rope.Substr[line, beginCommand] ELSE NIL;
};
};
Fork: Commander.CommandProc = {
Create a brand-new independent commander
open: BOOL ¬ FALSE;
right: BOOL ¬ FALSE;
commandStarts: INT ¬ 0;
switches, command: Rope.ROPE;
[switches, command] ¬ SwitchesAndCommand[cmd.commandLine];
open ¬ Rope.Find[switches, "-open", 0, FALSE] # -1;
right ¬ Rope.Find[switches, "-right", 0, FALSE] # -1;
[] ¬ Create[info: [
name: "initializing...",
column: IF right THEN right ELSE left,
iconic: NOT open
], initial: command];
};
StopHit: Menus.MenuProc = TRUSTED {
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
WITH clientData SELECT FROM
cmd: Commander.Handle => {
CommanderBackdoor.AbortCommander[cmd ! Process.InvalidProcess => CONTINUE];
};
ENDCASE;
};
CurrentWorkingDirectory: PROC RETURNS [ROPE] ~ {
wd: PFS.PATH ~ PFS.GetWDir[];
RETURN [PFS.RopeFromPath[wd]]
};
GetShortName: PROC [path: ROPE] RETURNS [ROPE] = {
len: INT ¬ Rope.Length[path];
bang: INT ¬ len;
pos: INT ¬ len;
WHILE pos # 0 DO
np: INT ¬ pos - 1;
c: CHAR ¬ Rope.Fetch[path, np];
SELECT c FROM
'! => bang ¬ np;
'>, '], '/ => RETURN [Rope.Substr[path, pos, bang-pos]];
ENDCASE;
pos ¬ np;
ENDLOOP;
RETURN [Rope.Substr[path, 0, bang]];
};
GetBaseName: PROC [shortName: ROPE] RETURNS [ROPE] = {
dotPos: INT ¬ Rope.Find[shortName, "."];
IF dotPos<0
THEN RETURN [shortName]
ELSE RETURN [Rope.Substr[shortName, 0, dotPos]]
};
defaultPrompt: ROPE ¬ "%l%% %l";
ViewerPrompt: PROC [cmd: Commander.Handle] ~ {
prompt: ROPE ~ WITH CommanderOps.GetProp[cmd, $Prompt] SELECT FROM
rope: ROPE => rope,
ENDCASE => defaultPrompt;
IO.PutF[cmd.err, prompt, [rope["b"]], [rope["B"]]];
WITH ViewerIO.GetViewerFromStream[cmd.in] SELECT FROM
viewer: ViewerClasses.Viewer => {
wd: ROPE ~ CurrentWorkingDirectory[];
IF ViewerOps.FetchProp[viewer, $WorkingDirectoryInCaption] # wd THEN {
ViewerOps.AddProp[viewer, $WorkingDirectoryInCaption, wd];
viewer.name ¬ Rope.Cat[wd, " ", IO.PutFR[prompt, [rope["b"]], [rope["B"]]]];
ViewerOps.PaintViewer[viewer, caption];
};
};
ENDCASE;
};
CommanderViewerBase: PROC [cmd: Commander.Handle, viewer: ViewerClasses.Viewer, initial: ROPE, wDir: PFS.PATH] ~ {
Inner: PROC ~ {
IF initial # NIL THEN {
[] ¬ CommanderOps.ReadEvalPrintLoop[
CommanderOps.CreateFromStreams[in: IO.RIS[initial], parentCommander: cmd]
];
};
[] ¬ CommanderOps.ReadEvalPrintLoop[cmd];
};
IF Process.GetPriority[]>Process.priorityNormal THEN Process.SetPriority[Process.priorityNormal];
PFS.DoInWDir[wDir: wDir, inner: Inner];
};
stopKey: ATOM ~ Atom.MakeAtom["STOP!"]; -- funny key to prevent casual use.
Abort: PUBLIC PROC [commanderViewer: ViewerClasses.Viewer] ~ {
StopHit[commanderViewer, ViewerOps.FetchProp[commanderViewer, stopKey], red, FALSE, FALSE];
};
Create: PUBLIC PROC [info: ViewerClasses.ViewerRec, initial: ROPE] RETURNS [ViewerClasses.Viewer] ~ {
viewer: ViewerClasses.Viewer ~ TypeScript.Create[info: info, paint: TRUE];
in, out: IO.STREAM;
[in: in, out: out] ¬ ViewerIO.CreateViewerStreams[name: NIL, viewer: viewer];
BEGIN
cmd: Commander.Handle ~ CommanderOps.CreateFromStreams[in: in, out: out];
data: CommanderBackdoor.CommandToolData ~ CommanderBackdoor.GetCommandToolData[cmd];
EditedStream.SetDeliverWhen[in, MyDeliverWhen, cmd];
data.Prompt ¬ ViewerPrompt;
Menus.InsertMenuEntry[viewer.menu, Menus.CreateEntry["STOP!", StopHit, cmd] ];
ViewerOps.PaintViewer[viewer: viewer, hint: menu];
ViewerOps.AddProp[viewer, stopKey, cmd];
TRUSTED {Process.Detach[FORK CommanderViewerBase[cmd, viewer, initial, PFS.GetWDir[]]]};
RETURN [viewer]
END;
};
DequeueProc: PROC [data: REF] ~ {
Too bad MBQueue does not allow us to queue a user action directly...
WITH data SELECT FROM
data: REF MBQueue.Action.user => {
data.proc[data.parent, data.clientData, data.mouseButton, data.shift, data.control];
};
ENDCASE;
};
Queue: PUBLIC PROC [commanderViewer: ViewerClasses.Viewer, commandLine: Rope.ROPE, mouseButton: ViewerClasses.MouseButton ¬ red, shift: BOOL ¬ FALSE, control: BOOL ¬ FALSE] ~ {
queue: MBQueue.Queue ¬ GetMBQueue[commanderViewer];
MBQueue.QueueClientAction[queue, DequeueProc, NEW[MBQueue.Action.user ¬ [user[proc: ButtonImplButtonProc, parent: commanderViewer, clientData: NEW[ButtonImplObject ¬ [cmd: NARROW[ViewerOps.FetchProp[commanderViewer, stopKey]]]], mouseButton: mouseButton, shift: shift, control: control]]]];
};
OpenViewer: PROC [name: ROPE, out: IO.STREAM, column: ViewerClasses.Column] = {
viewer: ViewerClasses.Viewer;
IF Rope.IsEmpty[name] THEN name ¬ CurrentWorkingDirectory[];
viewer ¬ TiogaMenuOps.Open[fileName: name, column: column];
IF viewer = NIL
THEN out.PutF1["\tViewer file not found: %g\n", [rope[name]]]
ELSE out.PutF1["\tCreated Viewer: %g\n", [rope[viewer.name]]];
};
NewCommand: Commander.CommandProc = {
ENABLE PFS.Error => IF error.group = user THEN ERROR CommanderOps.Failed[error.explanation];
argv: CommanderOps.ArgumentVector ¬ CommanderOps.Parse[cmd];
column: ViewerClasses.Column ¬ left;
noFiles: BOOL ¬ TRUE;
dammit: BOOL ¬ FALSE; -- the -d switch
FOR i: NAT IN [1..argv.argc) DO
argi: ROPE ~ argv[i];
IF Rope.Match["-*", argi]
THEN { IF Rope.Match["-d*", argi] THEN dammit ¬ TRUE ELSE column ¬ ColumnFromSwitch[argi, column] }
ELSE {
path: PATH ~ PFS.AbsoluteName[PFS.PathFromRope[argi]];
IF NOT dammit THEN {
ENABLE PFS.Error => IF error.group = user THEN CONTINUE;
exists: PATH ~ PFS.FileInfo[name: path].fullFName;
ERROR CommanderOps.Failed[Rope.Concat[PFS.RopeFromPath[exists], " already exists! Use the -d switch to create a new viewer anyway."]];
};
IF NOT dammit THEN {
IF NOT Rope.Match[pattern: "*.*", object: PFSNames.ComponentRope[PFSNames.ShortName[path]]] THEN {
ERROR CommanderOps.Failed[Rope.Cat["Please supply an extension for ", argi, " or use the -d switch to create a file with no extension"]];
};
};
{
viewer: ViewerClasses.Viewer ~ TiogaMenuOps.Open[fileName: CurrentWorkingDirectory[], column: column];
noFiles ¬ FALSE;
IF viewer = NIL THEN ERROR CommanderOps.Failed["Holey System, Batman, TiogaMenuOps.Open wouldn't even give me a Viewer!"];
viewer.name ¬ viewer.file ¬ PFS.RopeFromPath[path];
ViewerOps.PaintViewer[viewer, caption];
cmd.out.PutF1["\tCreated Viewer: %g\n", [rope[viewer.name]]];
}
};
ENDLOOP;
IF noFiles THEN OpenViewer[NIL, cmd.out, column];
};
ExpandStar: PROC [token: ROPE] RETURNS [LIST OF ROPE] = {
IF Rope.Find[token, "*"] # -1
THEN {
rawPath: PATH ~ PFS.PathFromRope[token];
stripVersion: BOOL ~ PFSNames.ShortName[rawPath].version.versionKind = none;
path: PATH ~ IF stripVersion THEN PFSNames.SetVersionNumber[rawPath, [highest]] ELSE rawPath;
listOfTokens: LIST OF ROPE ¬ NIL;
ConsProc: PFS.NameProc = {
PROC [name: PATH] RETURNS [continue: BOOLTRUE]
IF stripVersion THEN name ¬ PFSNames.StripVersionNumber[name];
listOfTokens ¬ CONS[PFS.RopeFromPath[name], listOfTokens]; -- on front of list
RETURN[continue: TRUE];
};
PFS.EnumerateForNames[pattern: path, proc: ConsProc ! PFS.Error => IF error.group # bug THEN CONTINUE];
RETURN[RopeList.DReverse[listOfTokens]];
}
ELSE RETURN[LIST[token]];
};
ColumnFromSwitch: PROC [switchArg: ROPE, default: ViewerClasses.Column] RETURNS [column: ViewerClasses.Column ¬ left] ~ {
MatchPrefix: PROC [s: LONG STRING] RETURNS [BOOL] ~ {
run: INT ~ Rope.Run[s1: switchArg, s2: ConvertUnsafe.ToRope[s], case: FALSE];
RETURN [run = Rope.Size[switchArg] AND run > 1];
};
SELECT TRUE FROM
MatchPrefix["-right"] => column ¬ right;
MatchPrefix["-left"] => column ¬ left;
MatchPrefix["-color"] => column ¬ color;
ENDCASE => column ¬ default;
};
OpenCommand: Commander.CommandProc = {
ENABLE {
PFS.Error => IF error.group = user THEN ERROR CommanderOps.Failed[error.explanation];
};
argv: CommanderOps.ArgumentVector ¬ CommanderOps.Parse[cmd];
column: ViewerClasses.Column ¬ left;
noFiles: BOOL ¬ TRUE;
FOR i: NAT IN [1..argv.argc) DO
argi: ROPE ~ argv[i];
IF Rope.Match["-*", argi]
THEN { column ¬ ColumnFromSwitch[argi, column] }
ELSE {
list: LIST OF ROPE ¬ ExpandStar[argi];
WHILE list # NIL DO
name: ROPE ¬ list.first;
OpenViewer[name, cmd.out, column];
list ¬ list.rest;
ENDLOOP;
noFiles ¬ FALSE;
};
ENDLOOP;
IF noFiles THEN OpenViewer[NIL, cmd.out, column]
};
OpenImplViewer: PROC [name: ROPE, out: IO.STREAM, column: ViewerClasses.Column] = {
viewer: ViewerClasses.Viewer;
viewer ¬ TiogaMenuOps.OpenImpl[fileName: name, column: column];
IF viewer = NIL THEN out.PutF1["\tImpl not found for %g\n", [rope[name]]]
ELSE out.PutF1["\tCreated Viewer: %g\n", [rope[viewer.name]]];
};
OpenImplCommand: Commander.CommandProc = {
argv: CommanderOps.ArgumentVector ¬ CommanderOps.Parse[cmd];
column: ViewerClasses.Column ¬ left;
FOR i: NAT IN [1..argv.argc) DO
argi: ROPE ~ argv[i];
IF Rope.Match["-*", argi]
THEN { column ¬ ColumnFromSwitch[argi, column] }
ELSE {
OpenImplViewer[argi, cmd.out, column];
};
ENDLOOP;
};
PrepareToDie: PROC [cmd: Commander.Handle, self: ViewerClasses.Viewer] ~ {
Clean: PROC [stream: IO.STREAM] RETURNS [IO.STREAM] ~ {
RETURN [IF ViewerIO.GetViewerFromStream[stream] = self THEN IO.noWhereStream ELSE stream];
};
IF self = NIL THEN RETURN;
UNTIL cmd = NIL DO
data: CommanderBackdoor.CommandToolData ~ CommanderBackdoor.GetCommandToolData[cmd];
cmd.err ¬ Clean[cmd.err];
cmd.out ¬ Clean[cmd.out];
IF ViewerIO.GetViewerFromStream[cmd.in] = self THEN {
IO.Reset[cmd.in];
cmd.in ¬ IO.noInputStream;
};
cmd ¬ data.parentCommander;
ENDLOOP;
};
ViewerCommand: Commander.CommandProc = {
blink: BOOL ¬ FALSE;
changeClose: BOOL ¬ FALSE;
changeColumn: BOOL ¬ FALSE;
close: BOOL ¬ FALSE;
column: ViewerClasses.Column ¬ left;
columnKey: ViewerClasses.Column ¬ static;
columnMatch: BOOL ¬ FALSE;
destroy: BOOL ¬ FALSE;
edited: BOOL ¬ FALSE;
flavor: ATOM ¬ NIL;
grow: BOOL ¬ FALSE;
height: INTEGER ¬ INTEGER.FIRST;
names: BOOL ¬ FALSE;
iconic: BOOL ¬ FALSE;
noniconic: BOOL ¬ FALSE;
icon: ROPE ¬ NIL;
iconNumber: INT ¬ 0;
save: BOOL ¬ FALSE;
top: BOOL ¬ FALSE;
unedited: BOOL ¬ FALSE;
self: ViewerClasses.Viewer ~ ViewerIO.GetViewerFromStream[CommanderBackdoor.AdamOrEve[cmd].err];
Do: PROC [viewer: ViewerClasses.Viewer] ~ {
IF viewer # NIL THEN {
IF viewer.column # static THEN {
IF changeClose AND close THEN ViewerOps.CloseViewer[viewer];
IF height # INTEGER.FIRST THEN {
ViewerOps.SetOpenHeight[viewer, height];
IF NOT viewer.iconic THEN ViewerOps.ComputeColumn[viewer.column];
};
IF changeColumn THEN ViewerOps.ChangeColumn[viewer, column];
IF save THEN [] ¬ ViewerOps.SaveViewer[viewer];
IF changeClose AND NOT close THEN ViewerOps.OpenIcon[icon: viewer, closeOthers: grow, bottom: NOT top];
IF top AND NOT viewer.iconic THEN ViewerOps.TopViewer[viewer];
IF grow AND NOT viewer.iconic THEN ViewerOps.GrowViewer[viewer];
IF names THEN {IO.PutRope[cmd.out, Convert.RopeFromRope[viewer.name]]; IO.PutRope[cmd.out, " "]};
IF icon # NIL THEN viewer.icon ¬ Icons.NewIconFromFile[icon, iconNumber];
IF destroy THEN {
IF blink THEN ViewerOps.BlinkViewer[viewer];
IF viewer = self THEN PrepareToDie[cmd, self];
ViewerOps.DestroyViewer[viewer];
};
};
IF blink THEN ViewerOps.BlinkViewer[viewer];
n ¬ n + 1;
};
};
n: INT ¬ 0;
FOR arg: ROPE ¬ CommanderOps.NextArgument[cmd], CommanderOps.NextArgument[cmd] UNTIL arg = NIL DO
MatchPrefix: PROC [s: LONG STRING] RETURNS [BOOL] ~ {
run: INT ~ Rope.Run[s1: arg, s2: ConvertUnsafe.ToRope[s], case: FALSE];
RETURN [run = Rope.Size[arg] AND run > 1];
};
BadSwitch: PROC = {
CommanderOps.Failed[Rope.Concat["Unknown or ambiguous switch: " , arg]]
};
SELECT TRUE FROM
MatchPrefix["-blink"] => { blink ¬ TRUE };
MatchPrefix["-c"] => { BadSwitch[] };
MatchPrefix["-close"] => { close ¬ TRUE; changeClose ¬ TRUE };
MatchPrefix["-color"] => { column ¬ left; changeColumn ¬ TRUE };
MatchPrefix["-destroy"] => { destroy ¬ TRUE };
MatchPrefix["-edited"] => { edited ¬ TRUE };
MatchPrefix["-flavor"] => { flavor ¬ Atom.MakeAtom[CommanderOps.NextArgument[cmd]] };
MatchPrefix["-grow"] => { grow ¬ TRUE };
MatchPrefix["-height"] => {
h: ROPE ~ CommanderOps.NextArgument[cmd];
height ¬ Convert.IntFromRope[h ! Convert.Error => CommanderOps.Failed["bad -height number"]];
};
MatchPrefix["-iconic"] => { iconic ¬ TRUE };
MatchPrefix["-left"] => { column ¬ left; changeColumn ¬ TRUE };
MatchPrefix["-names"] => { names ¬ TRUE };
MatchPrefix["-o"] => { BadSwitch[] };
MatchPrefix["-onColor"] => { columnKey ¬ color; columnMatch ¬ TRUE };
MatchPrefix["-onLeft"] => { columnKey ¬ left; columnMatch ¬ TRUE };
MatchPrefix["-onRight"] => { columnKey ¬ right; columnMatch ¬ TRUE };
MatchPrefix["-open"] => { close ¬ FALSE; changeClose ¬ TRUE };
MatchPrefix["-right"] => { column ¬ right; changeColumn ¬ TRUE };
MatchPrefix["-s"] => { BadSwitch[] };
MatchPrefix["-save"] => { save ¬ TRUE };
MatchPrefix["-self"] => {
IF self = NIL
THEN CommanderOps.Failed["No Viewer!"]
ELSE Do[self];
};
MatchPrefix["-t"] => { flavor ¬ $Text };
MatchPrefix["-text"] => { flavor ¬ $Text };
MatchPrefix["-top"] => { top ¬ TRUE };
MatchPrefix["-unedited"] => { unedited ¬ TRUE };
MatchPrefix["-~"] => { BadSwitch[] };
MatchPrefix["-~edited"] => { unedited ¬ TRUE };
MatchPrefix["-~iconic"] => { noniconic ¬ TRUE };
MatchPrefix["-setIcon"] => {
icon ¬ CommanderOps.NextArgument[cmd];
iconNumber ¬ Convert.IntFromRope[CommanderOps.NextArgument[cmd]
! Convert.Error => CommanderOps.Failed["bad icon number"]];
};
Rope.Match["-*", arg] => { BadSwitch[] };
ENDCASE => {
viewers: LIST OF REF ¬ NIL;
Each: ViewerOps.EnumProc ~ {
IF edited AND NOT v.newVersion THEN RETURN;
IF unedited AND v.newVersion THEN RETURN;
IF iconic AND NOT v.iconic THEN RETURN;
IF noniconic AND v.iconic THEN RETURN;
IF flavor#NIL AND v.class.flavor#flavor THEN RETURN;
IF columnMatch AND v.column#columnKey THEN RETURN;
IF Rope.Match[pattern: arg, object: v.name, case: FALSE] THEN {
viewers ¬ CONS[v, viewers];
};
};
ViewerOps.EnumerateViewers[Each];
IF viewers=NIL AND Rope.Find[arg, "*"] < 0 THEN {
CommanderOps.Failed[Rope.Concat["No viewers named ", arg]];
};
viewers ¬ List.Sort[viewers, CompareNames];
FOR tail: LIST OF REF ¬ viewers, tail.rest UNTIL tail = NIL DO
WITH tail.first SELECT FROM
v: ViewerClasses.Viewer => Do[v];
ENDCASE => NULL;
ENDLOOP;
List.Kill[viewers]; viewers ¬ NIL;
};
n ¬ n + 1;
ENDLOOP;
IF n = 0 THEN CommanderOps.Failed[cmd.procData.doc];
IF names THEN msg ¬ "\n";
};
CompareNames: List.CompareProc ~ {
PROC [ref1: REF ANY, ref2: REF ANY] RETURNS [Basics.Comparison];
WITH ref1 SELECT FROM
v1: ViewerClasses.Viewer => {
WITH ref2 SELECT FROM
v2: ViewerClasses.Viewer => {
RETURN Rope.Compare[v1.name, v2.name, FALSE]
};
ENDCASE => NULL;
};
ENDCASE => NULL;
RETURN List.Compare[ref1, ref2];
};
ButtonImplRef: TYPE = REF ButtonImplObject;
ButtonImplObject: TYPE = RECORD [
cmd: Commander.Handle,
def: ROPE ¬ NIL
];
CreateButtonCommand: Commander.CommandProc = TRUSTED {
The first token willl be the name of the button. The rest of the commandLine will be the thing to stuff. A special character sequence, $$, will stand for the current selection.
commandLineStream: IO.STREAM = IO.RIS[cmd.commandLine];
name: ROPE;
def: ROPE;
token: REF TEXT ¬ NEW[TEXT[30]];
br: ButtonImplRef ¬ NEW[ButtonImplObject ¬ [cmd: CommanderBackdoor.AdamOrEve[cmd]]];
{
ENABLE {
IO.EndOfStream => GOTO Die;
IO.Error => GOTO Die;
};
token.length ¬ 0;
token ¬ commandLineStream.GetToken[IO.TokenProc, token].token;
name ¬ Rope.FromRefText[token];
[] ¬ commandLineStream.SkipWhitespace[FALSE];
Get the rest of it!
token.length ¬ 0;
token ¬ commandLineStream.GetToken[CRBreak, token ! IO.EndOfStream => CONTINUE].token;
EXITS
Die => NULL;
};
IO.Close[commandLineStream];
def ¬ Rope.FromRefText[token];
SELECT TRUE FROM
Rope.Length[def] = 0 => def ¬ NIL;
Rope.Match["*\n", def] => {};
ENDCASE => def ¬ Rope.Concat[def, "\n"];
br.def ¬ def;
WITH ViewerIO.GetViewerFromStream[br.cmd.err] SELECT FROM
viewer: ViewerClasses.Viewer => {
menu: Menus.Menu ¬ viewer.menu;
Various cases:
(0) no old entry & no new definition => ignore
(1) no old entry & a new definition => create a new entry
(2) old entry & no new definition => remove the old one
(3) old entry & a new definition => replace the old entry
IF menu # NIL THEN {
queue: MBQueue.Queue ¬ GetMBQueue[viewer];
new: Menus.MenuEntry ¬ IF def = NIL THEN NIL ELSE MBQueue.CreateMenuEntry[q: queue, name: name, proc: ButtonImplButtonProc, clientData: br];
old: Menus.MenuEntry ¬ Menus.FindEntry[menu, name];
SELECT TRUE FROM
old # NIL => Menus.ReplaceMenuEntry[menu, old, new];
new # NIL => Menus.AppendMenuEntry[menu, new, 0];
ENDCASE;
ViewerOps.PaintViewer[viewer: viewer, hint: menu, clearClient: FALSE];
};
};
ENDCASE => RETURN [$Failure, "Can't find viewer for CreateButton"];
};
GetMBQueue: PROC [viewer: ViewerClasses.Viewer] RETURNS [MBQueue.Queue] ~ {
WITH ViewerOps.FetchProp[viewer, $ButtonQueue] SELECT FROM
refQ: REF MBQueue.Queue => RETURN [refQ­];
ENDCASE => {
queue: MBQueue.Queue ~ MBQueue.Create[];
ViewerOps.AddProp[viewer, $ButtonQueue, NEW[MBQueue.Queue ¬ queue]];
RETURN [queue]
};
};
RepaintCommand: Commander.CommandProc = {
ViewerOps.PaintEverything[];
};
ClearMenuCommand: Commander.CommandProc = TRUSTED {
This command will clean the current menu back to its ground state (STOP! Find Split).
WITH ViewerIO.GetViewerFromStream[CommanderBackdoor.AdamOrEve[cmd].err] SELECT FROM
viewer: ViewerClasses.Viewer => {
oldMenu: Menus.Menu ¬ viewer.menu;
IF oldMenu # NIL THEN {
There is an old menu, so we make a clean new one.
newMenu: Menus.Menu ¬ Menus.CreateMenu[1];
CopyNamedEntry["STOP!", oldMenu, newMenu];
CopyNamedEntry["Find", oldMenu, newMenu];
CopyNamedEntry["Split", oldMenu, newMenu];
viewer.menu ¬ newMenu;
ViewerOps.PaintViewer[viewer: viewer, hint: menu, clearClient: FALSE];
};
RETURN;
};
ENDCASE => NULL;
};
createButtonSubstitutions: ROPE ~ "
$CurrentSelection$ => replaced by the current selection up to but not including the first carriage return
$CurrentEscapedSelection$ => replaced by a rope literal (minus the surrounding quotes) for the entire current selection
$CurrentSpacedSelection$ => replaced by the whole current selection, with spaces substituted for newlines
$FileNameSelection$ => replaced by the current selection if it appears to be a file name, otherwise replaced by the name of the selected viewer
$ShortFileNameSelection$ => same as $FileNameSelection$ except that version number and directory are omitted
$BaseFileNameSelection$ => same as $ShortFileNameSelection$ except that extensions are ommited
$SpaceFileNameSelection$ => replaced by the current selection if it appears to be a file name (may include white space), otherwise replaced by the name of the selected viewer
$ShortSpaceFileNameSelection$ => same as $SpaceFileNameSelection$ except that version number and directory are omitted
$QuotedFileNameSelection$ => replaced by the current selection if it appears to be a file name (may include white space), otherwise replaced by the name of the selected viewer. The results will have double quotes around it.
$ShortQuotedFileNameSelection$ => same as $QuotedFileNameSelection$ except that version number and directory are omitted.
$SelectedViewerName$ => replaced by the name of the selected viewer
$ViewerPosition$ => replaced by the position of the current selection in a viewer
$MouseButton$ => left|middle|right
$ShiftKey$ => shift|noShift
$ControlKey$ control|noControl";
ButtonImplButtonProc: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
WITH clientData SELECT FROM
br: ButtonImplRef => {
def: ROPE;
curSel, escaped, spaced: ROPE;
viewer: ViewerClasses.Viewer ¬ NIL;
start: TiogaOps.Location;
viewerName: ROPE ¬ NIL;
fileName: ROPE ¬ NIL;
shortFileName: ROPE ¬ NIL;
baseFileName: ROPE ¬ NIL;
spaceFileName: ROPE ¬ NIL;
shortSpaceFileName: ROPE ¬ NIL;
quotedFileName: ROPE ¬ NIL;
shortQuotedFileName: ROPE ¬ NIL;
index: INT ¬ -1;
controlRope: ROPE ¬ IF control THEN "control" ELSE "noControl";
shiftRope: ROPE ¬ IF shift THEN "shift" ELSE "noShift";
buttonRope: ROPE;
SELECT mouseButton FROM
red => buttonRope ¬ "left";
yellow => buttonRope ¬ "middle";
blue => buttonRope ¬ "right";
ENDCASE => ERROR;
IF br = NIL THEN RETURN;
def ¬ br.def;
[viewer: viewer, start: start] ¬ TiogaOps.GetSelection[primary];
curSel ¬ ViewerTools.GetSelectionContents[];
IF viewer # NIL AND NOT viewer.destroyed AND NOT viewer.newFile THEN {
root: TiogaOps.Ref ¬ TiogaOps.Root[start.node];
offset: INT ¬ TiogaOps.LocOffset[loc1: [root, 0], loc2: start, skipCommentNodes: TRUE];
index ¬ offset;
viewerName ¬ viewer.file;
IF viewerName = NIL THEN viewerName ¬ viewer.name;
fileName ¬ viewer.file;
fileName ¬ Rope.Substr[fileName, 0, Rope.SkipTo[fileName, 0, "!"]];
};
escaped ¬ Convert.RopeFromRope[from: curSel, quote: FALSE];
spaced ¬ RopeSubst[old: "\n", new: " ", base: curSel];
Get prefix of current selection before the first CR
curSel ¬ Rope.Substr[base: curSel, start: 0, len: curSel.Index[s2: "\n"]];
The curSel is the fileName if curSel is longer than one character and contains no whitespace.
fileName ¬ IF (Rope.SkipTo[s: curSel, pos: 0, skip: " \t"] = curSel.Length[]) AND (curSel.Length[] > 1) THEN curSel ELSE fileName;
shortFileName ¬ GetShortName[fileName];
baseFileName ¬ GetBaseName[shortFileName];
The curSel is the spaceFileName if curSel is longer than one character.
spaceFileName ¬ IF (curSel.Length[] > 1) THEN curSel ELSE fileName;
shortSpaceFileName ¬ GetShortName[spaceFileName];
Add quotes for the quoted version.
quotedFileName ¬ Rope.Cat["\"", spaceFileName, "\""];
shortQuotedFileName ¬ Rope.Cat["\"", shortSpaceFileName, "\""];
IF Rope.SkipTo[def, 0, "$"] < Rope.Length[def] THEN {
It is likely that we have substitutions to do
def ¬ RopeSubst[old: "$CurrentSelection$", new: curSel, base: def, case: TRUE];
def ¬ RopeSubst[old: "$CurrentEscapedSelection$", new: escaped, base: def, case: TRUE];
def ¬ RopeSubst[old: "$CurrentSpacedSelection$", new: spaced, base: def, case: TRUE];
def ¬ RopeSubst[old: "$FileNameSelection$", new: fileName, base: def, case: TRUE];
def ¬ RopeSubst[old: "$ShortFileNameSelection$", new: shortFileName, base: def, case: TRUE];
def ¬ RopeSubst[old: "$BaseFileNameSelection$", new: baseFileName, base: def, case: TRUE];
def ¬ RopeSubst[old: "$SpaceFileNameSelection$", new: spaceFileName, base: def, case: TRUE];
def ¬ RopeSubst[old: "$ShortSpaceFileNameSelection$", new: shortSpaceFileName, base: def, case: TRUE];
def ¬ RopeSubst[old: "$QuotedFileNameSelection$", new: quotedFileName, base: def, case: TRUE];
def ¬ RopeSubst[old: "$ShortQuotedFileNameSelection$", new: shortQuotedFileName, base: def, case: TRUE];
def ¬ RopeSubst[old: "$SelectedViewerName$", new: viewerName, base: def, case: TRUE];
def ¬ RopeSubst[old: "$ViewerPosition$", new: Convert.RopeFromInt[index, 10, FALSE], base: def, case: TRUE];
def ¬ RopeSubst[old: "$MouseButton$", new: buttonRope, base: def, case: TRUE];
def ¬ RopeSubst[old: "$ControlKey$", new: controlRope, base: def, case: TRUE];
def ¬ RopeSubst[old: "$ShiftKey$", new: shiftRope, base: def, case: TRUE];
};
WITH ViewerIO.GetViewerFromStream[br.cmd.in] SELECT FROM
v: ViewerClasses.Viewer => {
bufferContents: REF TEXT ¬ ViewerIO.GetBuffer[br.cmd.in];
IF bufferContents # NIL AND bufferContents.length > 0 AND bufferContents[bufferContents.length - 1] # '\n THEN {
FOR n: NAT DECREASING IN [0..bufferContents.length) DO
IF bufferContents[n] = '\n THEN {
EditedStream.UnAppendBufferChars[
stream: br.cmd.in, nChars: bufferContents.length - n - 1];
EXIT;
}
REPEAT
FINISHED => EditedStream.UnAppendBufferChars[stream: br.cmd.in, nChars: LAST[NAT]];
ENDLOOP;
};
IF viewer = v THEN {
If the selected viewer is the commandtool, then set the caret to the end, or the ViewerIO.TypeChars won't work.
ViewerTools.SetSelection[viewer: viewer, selection: NIL];
};
ViewerIO.TypeChars[editedViewerStream: br.cmd.in, chars: def];
};
ENDCASE => GOTO Failed;
{
};
};
ENDCASE => GOTO Failed;
EXITS Failed => {
MessageWindow.Append["*** Bug in CommanderViewerImpl.ButtonImplButtonProc ***", TRUE]
};
};
RopeSubst: PROC [old, new, base: ROPE, case: BOOL ¬ FALSE, allOccurrences: BOOL ¬ TRUE] RETURNS [ROPE] = {
if old is not found in base, then value = base.
if allOccurrences THEN substitute for each occurrence of old, otherwise only for first.
lenOld: INT = old.Length[];
lenNew: INT = new.Length[];
i: INT ¬ 0;
WHILE (i ¬ Rope.Find[s1: base, s2: old, case: case, pos1: i]) # -1 DO
base ¬ Rope.Replace[base: base, start: i, len: lenOld, with: new];
IF ~allOccurrences THEN EXIT;
i ¬ i + lenNew;
ENDLOOP;
RETURN[base];
};
CopyNamedEntry: PROC [name: ROPE, oldMenu, newMenu: Menus.Menu] = {
old: Menus.MenuEntry ¬ Menus.FindEntry[oldMenu, name];
IF old # NIL THEN Menus.AppendMenuEntry[newMenu, Menus.CopyEntry[old], 0];
};
CRBreak: IO.BreakProc = {
IF char = '\l OR char = '\r THEN RETURN[break];
RETURN[other];
};
Completion Stuff
completeChar: CHAR ~ Ascii.ESC;
queryChar: CHAR ~ '? + 200B; -- Meta-?
autoHelpThreshhold: INT;
ProfileChanged: UserProfile.ProfileChangedProc ~ {
autoHelpThreshhold ¬ UserProfile.Number["Commander.AutoHelpThreshhold", 10];
};
MyDeliverWhen: EditedStream.DeliverWhenProc = {
[char: CHAR, buffer: REF TEXT, stream: STREAM, context: REF ANY] RETURNS [appendChar: BOOL, activate: BOOL]
cmd: Commander.Handle ~ NARROW[context];
index: INT;
partialName: ROPE;
count: INT ¬ 0;
fullNames, tail: LIST OF ROPE ¬ NIL;
commonPrefix: ROPE;
AddHit: PROC [rope: Rope.ROPE] ~ {
IF tail = NIL THEN {
fullNames ¬ tail ¬ CONS[rope, NIL];
commonPrefix ¬ rope;
}
ELSE {
tail.rest ¬ CONS[rope, NIL];
tail ¬ tail.rest;
commonPrefix ¬ commonPrefix.Substr[len: commonPrefix.Run[s2: rope, case: FALSE]];
};
count ¬ count + 1;
};
MakeCommandList: PROC ~ {
pattern: Rope.ROPE ~ partialName.Concat["*"];
EachCommand: Commander.EnumerateAction ~ {
[key: ROPE, procData: CommandProcHandle] RETURNS [stop: BOOLFALSE]
IF pattern.Match[key, FALSE] THEN
AddHit[key];
};
[] ¬ Commander.Enumerate[EachCommand];
};
MakeFileList: PROC ~ {
patternPath: PFS.PATH ~ PFS.PathFromRope[partialName.Concat["*!H"]];
wDir: PFS.PATH ~ PFS.GetWDir[];
EachName: PFS.NameProc = {
[name: PATH] RETURNS [continue: BOOL ← TRUE]
isAPrefix: BOOL;
relName: PFS.PATH;
[isAPrefix, relName] ¬ PFSNames.IsAPrefix[wDir, name];
IF isAPrefix THEN
AddHit[PFS.RopeFromPath[PFSNames.StripVersionNumber[relName]]]
ELSE
AddHit[PFS.RopeFromPath[PFSNames.StripVersionNumber[name]]];
};
PFS.EnumerateForNames[pattern: patternPath, proc: EachName];
};
OutputPreservingInputBuffer: PROC [action: PROC [out: IO.STREAM]] ~ {
Calls action, allowing it to do output to the handle, but preserving the state of the input buffer.
buffer: Rope.ROPE ~ Rope.FromRefText[ViewerIO.GetBuffer[cmd.in]];
data: CommanderBackdoor.CommandToolData ~ CommanderBackdoor.GetCommandToolData[cmd];
EditedStream.UnAppendBufferChars[stream: cmd.in, nChars: buffer.Length[]];
cmd.out.PutRope[buffer];
cmd.out.PutF["%l<%g>%l\n", [rope["bos"]],
IF char = completeChar THEN [rope["COMPLETE"]] ELSE [rope["HELP"]],
[rope["S"]]];
action[cmd.out];
cmd.out.PutF1["%l\n", [rope["BO"]]];
IF data.Prompt # NIL THEN data.Prompt[cmd];
EditedStream.AppendBufferChars[stream: cmd.in, chars: buffer];
};
SELECT char FROM
completeChar, queryChar => NULL;
ENDCASE => RETURN EditedStream.IsANL[char, buffer, stream, context];
IF buffer = NIL THEN {
buffer ¬ ViewerIO.GetBuffer[stream];
};
IF buffer.length = 0 AND char = completeChar THEN -- Preserve ESC behavior on empty line
RETURN [appendChar: TRUE, activate: FALSE];
FOR index ¬ buffer.length - 1, index - 1 WHILE index >= 0 DO
SELECT buffer[index] FROM
Ascii.SP, Ascii.TAB => EXIT;
ENDCASE => NULL;
ENDLOOP;
index ¬ index + 1; -- index is now the index of the first character in the last "word"
partialName ¬ Rope.FromRefText[buffer, index];
IF index = RefText.SkipOver[buffer, 0, " \t"] THEN -- First word on line
MakeCommandList[]
ELSE
MakeFileList[
! PFS.Error => {
MessageWindow.Append[error.explanation, TRUE];
MessageWindow.Blink[];
GO TO done;
}];
SELECT TRUE FROM
count = 0 => {   -- no names match the partial name
Action: PROC [out: IO.STREAM] ~ {
out.PutF["\t\tThere are %lno%l completion possibilities.",
[rope["z"]], [rope["Z"]]];
};
OutputPreservingInputBuffer[Action];
};
char = completeChar AND count = 1 => { -- exactly one match
IF partialName.Equal[commonPrefix] THEN {
Action: PROC [out: IO.STREAM] ~ {
out.PutF1["\t\t\"%g\" is the only completion possibility.",
[rope[partialName]]];
};
OutputPreservingInputBuffer[Action];
}
ELSE {
EditedStream.UnAppendBufferChars[stream: stream, nChars: buffer.length - index];
EditedStream.AppendBufferChars[stream: stream, chars: fullNames.first];
};
};
char = completeChar
AND commonPrefix.Length[] > partialName.Length[] => { -- complete it
EditedStream.UnAppendBufferChars[stream: stream, nChars: buffer.length - index];
EditedStream.AppendBufferChars[stream: stream, chars: commonPrefix];
};
char = completeChar AND count > autoHelpThreshhold => { -- too many to print
Action: PROC [out: IO.STREAM] ~ {
out.PutF["\t\tThere are %g possibilities for completion; type %l<HELP>%l to see them.", [integer[count]], [rope["s"]], [rope["S"]]];
};
OutputPreservingInputBuffer[Action];
};
ENDCASE => {   -- print out the possibilities
Action: PROC [out: IO.STREAM] ~ {
out.PutChar['\t];
FOR list: LIST OF ROPE ¬ fullNames, list.rest UNTIL list = NIL DO
out.PutF1["\t%g", [rope[list.first]]];
ENDLOOP;
};
OutputPreservingInputBuffer[Action];
};
RETURN [appendChar: FALSE, activate: FALSE];
EXITS
done => RETURN [appendChar: FALSE, activate: FALSE];
};
Initialization
Commander.Register["New", NewCommand, "New (-left | -right | -color | -d | fileName)* open an empty viewer (with the given name, for each name, if any given, else one unnamed)"];
Commander.Register["Open", OpenCommand, "Open [-left | -right | -color ] fileName - open a viewer"];
Commander.Register["OpenImpl", OpenImplCommand, "OpenImpl [-left | -right | -color ] name - open a viewer on the implementation of name"];
Commander.Register[key: "CreateButton", proc: CreateButtonCommand, doc: Rope.Concat["Create a CommandTool herald button; substitutions are:", createButtonSubstitutions], interpreted: FALSE];
Commander.Register[key: "ClearMenu", proc: ClearMenuCommand, doc: "Reset the CommandTool menu"];
Commander.Register[key: "RemoveButton", proc: CreateButtonCommand, doc: "Remove a CommandTool herald button"];
Commander.Register[key: "Repaint", proc: RepaintCommand, doc: "Repaint all viewers"];
Commander.Register[key: "Viewer", proc: ViewerCommand, doc: "Push around viewers
Usage: {switch | viewerNamePattern}*
Action Switches:
-blink
-close
-color
-destroy
-grow
-height k (set open height)
-setIcon <name> <#> (set icon from named icon file and number)
-left
-names (write viewer names to standard out)
-open
-right
-top
Filter Switches:
-edited
-~edited or -unedited
-flavor <id>
-iconic
-~iconic
-onColor
-onLeft
-onRight
-save
-text  (short for -flavor Text)
Object Switches:
-self  (the commander viewer itself)
"];
Commander.Register[key: "CommanderViewer", proc: CommanderViewerCommand, doc: "Create a new Commander Viewer (arguments compose the initial command)"];
Commander.Register[key: "Fork", proc: Fork, doc:
"Fork [-open] [-right]\n Create a new Commander Viewer (default: left column, iconic) (the last argument composes the initial command)", interpreted: FALSE];
Commander.Register[key: "ForkI", proc: Fork, doc:
"ForkI [-open] [-right]\n Create a new Commander Viewer (interpreted command) (default: left column, iconic) (the last argument composes the initial command)", interpreted: TRUE];
[] ¬ Buttons.Create[info: [name: "Cmd"], proc: CreateCommanderButtonProc, fork: TRUE, documentation: "Create a Commander viewer"];
UserProfile.CallWhenProfileChanges[ProfileChanged];
END.