DIRECTORY
Commander USING [CommandProc, Handle, Register],
CommandTool USING [NextArgument],
Convert USING [ IntFromRope ],
Idle USING [ IsIdle ],
IO,
List USING [Length],
Process USING [ Detach, SecondsToTicks, SetTimeout ],
RuntimeError USING [ UNCAUGHT ],
Rope USING [Cat, Concat, Equal, Fetch, Find, Length, ROPE, Substr],
SymTab USING [ Create, EachPairAction, Fetch, Ref, Pairs, Store ],
UserProfile USING [ Token ],
ViewerClasses USING [ Menu, MenuEntry, Viewer ],
ViewerOps USING [ EnumerateViewers, EnumProc ],
ViewerTools USING [ TiogaContents ],
WalnutDefs USING [dontCareMsgSetVersion ],
WalnutOps USING [AddMsg, CreateMsg, dontCareDomainVersion, GetHandleForRootfile, GetMsg, MoveMsg, MsgExists, MsgSetExists, MsgSetNames, GetDisplayProps, GetMsgText, MsgSetVersion, RemoveMsg, SetHasBeenRead, SizeOfMsgSet, MsgsInSetEnumeration, WalnutOpsHandle ],
WalnutNewMail USING [ CheckMailBoxes ],
WalnutWindowPrivate USING [ WalnutHandle ]
;
WalnutKeyboardImpl:
CEDAR
MONITOR
IMPORTS Commander, CommandTool, Convert, Idle, IO, List, Process, Rope, RuntimeError, SymTab, UserProfile, ViewerOps, WalnutOps, WalnutNewMail
SHARES ViewerClasses ~ {
OPEN IO;
ROPE: TYPE = Rope.ROPE;
Handle: TYPE = WalnutOps.WalnutOpsHandle;
DB: TYPE = REF DBBody;
DBBody:
TYPE =
RECORD [
dbName: ROPE,
dbFileName: ROPE,
handle: Handle ← NIL,
retryCount: INT ← 0
];
Entries: TYPE ~ REF EntrySequence;
EntrySequence: TYPE ~ RECORD[e: SEQUENCE len: NAT OF EntryRecord];
EntryRecord:
TYPE ~
RECORD [
msgID: ROPE, toc: ROPE, tocValid: BOOL, hasBeenRead: BOOL, deleted: BOOL←FALSE];
MsgSet: TYPE = REF MsgSetBody;
MsgSetBody:
TYPE =
RECORD [
db: DB, -- belongs to this database.
msgSetName: ROPE,
msgSetVersion: WalnutOps.MsgSetVersion,
entries: Entries
];
NewFilter:
TYPE = {none, read, unread};
dbs: SymTab.Ref; -- Indexed by db short name (e.g., "default", "voice", "old")
msgSets: SymTab.Ref; -- Cached indices, indexed by dbname.msgSetName
defaultSource: MsgSet;
defaultDest: MsgSet;
thisSource: MsgSet;
thisDest: MsgSet;
firstMessageNumber: INT𡤁
lastMessageNumber: INT𡤁
thisSourceFilter: ROPE←NIL;
thisSourceNewFilter: NewFilter←$none;
disableIdleReqt: BOOL←FALSE;
checkMinutes: INT ← 10;
ListDBsCmd: Commander.CommandProc = {
[cmd: Commander.Handle] RETURNS [result: REF ANY ← NIL, msg: ROPE ← NIL]
ENABLE RuntimeError.UNCAUGHT => GOTO Failed;
ListOneDB: SymTab.EachPairAction = {
[key: ROPE, val: SymTab.Val] RETURNS [quit: BOOL ← FALSE]
db: DB ← NARROW[val];
cmd.out.PutF[" %g: %g\n",
rope[db.dbName],
rope[db.dbFileName]];
};
[]←SymTab.Pairs[dbs, ListOneDB];
EXITS Failed => RETURN[$Failed, "*** Uncaught signal ***"]
};
ListMsgSetsCmd: Commander.CommandProc = {
[cmd: Commander.Handle] RETURNS [result: REF ANY ← NIL, msg: ROPE ← NIL]
ENABLE RuntimeError.UNCAUGHT => GOTO Failed;
msgSetNames: LIST OF ROPE;
[result, msg] ← ParseArguments[cmd: cmd, dbOnly: TRUE];
IF result = $Failed THEN RETURN;
msgSetNames ← WalnutOps.MsgSetNames[thisSource.db.handle].mL;
cmd.out.PutF["Message sets from database %g\n", rope[thisSource.db.dbName]];
FOR mN:
LIST
OF
ROPE ← msgSetNames, mN.rest
WHILE mN#
NIL
DO
cmd.out.PutF[" %g\n", rope[mN.first]]; ENDLOOP;
EXITS Failed => RETURN[$Failed, "*** Uncaught signal ***"]
};
SelectMsgSetCmd: Commander.CommandProc = {
[cmd: Commander.Handle] RETURNS [result: REF ANY ← NIL, msg: ROPE ← NIL]
ENABLE RuntimeError.UNCAUGHT => GOTO Failed;
[result, msg] ← ParseArguments[cmd];
IF result = $Failed THEN RETURN;
defaultSource ← thisSource;
defaultDest ← thisDest;
cmd.out.PutF["Selected message sets: Source = %g, Dest = %g\n", rope[FullName[defaultSource]], rope[FullName[defaultDest]]];
EXITS Failed => RETURN[$Failed, "*** Uncaught signal ***"]
};
ListMsgsInMsgSetCmd: Commander.CommandProc = {
[cmd: Commander.Handle] RETURNS [result: REF ANY ← NIL, msg: ROPE ← NIL]
ENABLE RuntimeError.UNCAUGHT => GOTO Failed;
handle: Handle;
refresh: BOOL ← cmd.procData.clientData#$Again;
[result, msg, handle] ← ParseRange[cmd: cmd, refresh: refresh, fullRange: TRUE];
cmd.out.PutF["Messages in message set %g:\n", rope[FullName[thisSource]]];
FOR i:
INT
IN [firstMessageNumber..
MIN[lastMessageNumber, thisSource.entries.len]]
DO
hasBeenRead, deleted: BOOL;
tocEntry: ROPE;
[hasBeenRead, deleted, tocEntry] ← GetTocEntry[thisSource, i];
IF FilterOut[i] THEN LOOP;
cmd.out.PutF["%g %3d %g%g\n",
char[IF hasBeenRead THEN '\040 ELSE '?], int[i],
rope[tocEntry], rope[IF deleted THEN " (deleted)" ELSE ""]];
ENDLOOP;
EXITS Failed => RETURN[$Failed, "*** Uncaught signal ***"]
};
PrintMsgInMsgSetCmd: Commander.CommandProc = {
[cmd: Commander.Handle] RETURNS [result: REF ANY ← NIL, msg: ROPE ← NIL]
ENABLE RuntimeError.UNCAUGHT => GOTO Failed;
contents: REF TEXT;
handle: Handle;
cr: ROPE;
[result, msg, handle] ← ParseRange[cmd: cmd, refresh: FALSE, fullRange: TRUE];
IF result = $Failed THEN RETURN;
FOR i:
INT
IN [firstMessageNumber..
MIN[lastMessageNumber, thisSource.entries.len]]
DO
hasBeenRead, deleted: BOOL;
tocEntry, msgID: ROPE;
[hasBeenRead, deleted, tocEntry] ← GetTocEntry[thisSource, i];
IF FilterOut[i] THEN LOOP;
msgID ← thisSource.entries[i-1].msgID;
contents ← WalnutOps.GetMsgText[handle, msgID, contents];
TRUSTED { cr ← LOOPHOLE[contents]; };
cmd.out.PutF["-- Message %g:%g\n%g\n\n",
int[i], rope[IF deleted THEN " (deleted)" ELSE ""], rope[cr]];
IF
NOT thisSource.entries[i-1].hasBeenRead
THEN {
WalnutOps.SetHasBeenRead[handle, msgID];
thisSource.entries[i-1].hasBeenRead ← TRUE;
};
ENDLOOP;
EXITS Failed => RETURN[$Failed, "*** Uncaught signal ***"]
};
MoveMsgCmd: Commander.CommandProc = {
[cmd: Commander.Handle] RETURNS [result: REF ANY ← NIL, msg: ROPE ← NIL]
ENABLE RuntimeError.UNCAUGHT => GOTO Failed;
handle: Handle;
op: ROPE ← "Moved ";
destExists: BOOL;
move: BOOL ← cmd.procData.clientData = $Move;
[result, msg, handle] ← ParseRange[cmd: cmd, refresh: FALSE, fullRange: FALSE];
IF result = $Failed THEN RETURN;
destExists ← WalnutOps.MsgSetExists[opsHandle: handle, name: thisDest.msgSetName, msDomainVersion: WalnutOps.dontCareDomainVersion].exists;
IF ~destExists THEN RETURN[$Failed, "No destination message set"];
FOR i:
INT
IN [firstMessageNumber..
MIN[lastMessageNumber, thisSource.entries.len]]
DO
IF FilterOut[i] THEN LOOP;
IF thisSource.entries[i-1].deleted
THEN {
cmd.out.PutF["** Can't move message %g from set %g (deleted)\n",
int[i], rope[FullName[thisSource]]];
LOOP;
};
IF move
THEN {
thisSource.entries[i-1].deleted ← TRUE;
[]←WalnutOps.MoveMsg[handle,
thisSource.entries[i-1].msgID, [thisSource.msgSetName], [thisDest.msgSetName]];
}
ELSE {
op ← "Copied ";
[]←WalnutOps.AddMsg[handle,
thisSource.entries[i-1].msgID, [thisSource.msgSetName], [thisDest.msgSetName]];
};
cmd.out.PutF["%gmessage %g from set %g to %g\n", rope[op],
int [i], rope[FullName[thisSource]], rope[FullName[thisDest]]];
ENDLOOP;
EXITS Failed => RETURN[$Failed, "*** Uncaught signal ***"]
};
XferMsgCmd: Commander.CommandProc = {
[cmd: Commander.Handle] RETURNS [result: REF ANY ← NIL, msg: ROPE ← NIL]
ENABLE RuntimeError.UNCAUGHT => GOTO Failed;
sourceHandle, destHandle: Handle;
destExists: BOOL;
[result, msg, sourceHandle] ← ParseRange[cmd: cmd, refresh: FALSE, fullRange: FALSE];
IF result = $Failed THEN RETURN;
destHandle ← thisDest.db.handle;
destExists ← WalnutOps.MsgSetExists[opsHandle: destHandle, name: thisDest.msgSetName, msDomainVersion: WalnutOps.dontCareDomainVersion].exists;
IF ~destExists THEN RETURN[$Failed, "No destination message set"];
FOR i:
INT
IN [firstMessageNumber..
MIN[lastMessageNumber, thisSource.entries.len]]
DO
pos: INT;
msgID, msgName: ROPE;
tc: ViewerTools.TiogaContents;
IF FilterOut[i] THEN LOOP;
IF thisSource.entries[i-1].deleted
THEN {
cmd.out.PutF["** Can't transfer message %g from set %g (deleted)\n",
int[i], rope[FullName[thisSource]]];
LOOP;
};
msgID ← msgName ← thisSource.entries[i-1].msgID;
pos ← Rope.Find[msgID, "$"];
IF pos # 0 THEN msgName ← msgID.Substr[pos];
tc ← WalnutOps.GetMsg[sourceHandle, msgID].contents;
IF
NOT WalnutOps.MsgExists[destHandle, msgName]
THEN {
WalnutOps.CreateMsg[destHandle, msgID, tc];
WalnutOps.SetHasBeenRead[destHandle, msgName];
};
IF
NOT thisDest.msgSetName.Equal["active",
FALSE]
THEN
[]←WalnutOps.MoveMsg[destHandle,
msgID, ["active"], [thisDest.msgSetName]];
cmd.out.PutF["Transferred message %g from set %g to %g\n",
int [i], rope[FullName[thisSource]], rope[FullName[thisDest]]];
ENDLOOP;
EXITS Failed => RETURN[$Failed, "*** Uncaught signal ***"]
};
DeleteMsgCmd: Commander.CommandProc = {
[cmd: Commander.Handle] RETURNS [result: REF ANY ← NIL, msg: ROPE ← NIL]
ENABLE RuntimeError.UNCAUGHT => GOTO Failed;
handle: Handle;
[result, msg, handle] ← ParseRange[cmd: cmd, refresh: FALSE, fullRange: FALSE];
IF result = $Failed THEN RETURN;
FOR i:
INT
IN [firstMessageNumber..
MIN[lastMessageNumber, thisSource.entries.len]]
DO
IF FilterOut[i] THEN LOOP;
IF thisSource.entries[i-1].deleted
THEN {
cmd.out.PutF["** Can't delete message %g from set %g (already deleted)\n",
int[i], rope[FullName[thisSource]]];
LOOP;
};
thisSource.entries[i-1].deleted ← TRUE;
[]←WalnutOps.RemoveMsg[handle,
thisSource.entries[i-1].msgID, [thisSource.msgSetName], WalnutDefs.dontCareMsgSetVersion];
cmd.out.PutF["Deleted message %g from set %g\n",
int [i], rope[FullName[thisSource]]];
ENDLOOP;
EXITS Failed => RETURN[$Failed, "*** Uncaught signal ***"]
};
GetNewMailCmd: Commander.CommandProc = {
[cmd: Commander.Handle] RETURNS [result: REF ANY ← NIL, msg: ROPE ← NIL]
SELECT Check[]
FROM
$running => NULL;
$retried => RETURN[$Failed, "** Walnut had to be restarted; wait a few seconds and try again **"];
$failed => RETURN[$Failed, "** Something broke during attempt to restart or retrieve mail. **"];
$quit => RETURN[$Failed, "** Walnut was demanding to be stopped, so it was. **"];
$timedout => RETURN[$Failed, "** Walnut cannot be restarted, apparently. **"];
$noNewMail => RETURN[$Failed, "** No Walnut instance can read mail. **"];
ENDCASE => ERROR;
};
Checker:
PROC =
TRUSTED {
DO IF disableIdleReqt OR Idle.IsIdle[] THEN [] ← Check[]; Wait[]; ENDLOOP;
};
Wait:
ENTRY
PROC =
TRUSTED {
ENABLE UNWIND => NULL;
checker: CONDITION;
Process.SetTimeout[@checker, Process.SecondsToTicks[60*checkMinutes]];
WAIT checker;
};
Check:
ENTRY
PROC
RETURNS[whatHappened: WhatHappened←$failed] =
TRUSTED {
ENABLE { RuntimeError.UNCAUGHT => GOTO Failed; UNWIND => NULL; };
db: DB;
[whatHappened, db] ← CheckAndRetry[];
IF whatHappened = $running THEN WalnutNewMail.CheckMailBoxes[db.handle];
EXITS Failed => NULL;
};
WhatHappened:
TYPE = { running, retried, timedout, failed, quit, noNewMail };
running: Walnut is not demanding a Quit or Retry.
retried: Walnut was demanding it, so we "pushed" the Retry button.
timedout: We have retried too many times.
failed: Something bad happened.
quit: Walnut was demanding we push "Quit", so we did.
maxRetryCount:
INT ← 72;
-- 12 hours without success and we quit; should we?
CheckAndRetry:
INTERNAL
PROC
RETURNS [whatHappened: WhatHappened←$noNewMail, db: DB←NIL] = {
CheckOne: ViewerOps.EnumProc ~ {
menu: ViewerClasses.Menu ← v.menu;
menuLine: ViewerClasses.MenuEntry;
quitEntry: ViewerClasses.MenuEntry;
retryEntry: ViewerClasses.MenuEntry;
db1: DB;
waHoppen: WhatHappened ← $running;
IF menu = NIL THEN RETURN;
menuLine ← menu.lines[0];
IF menuLine = NIL THEN RETURN;
db1 ← GetDBFromWalnutHandle[menuLine.clientData];
IF db1=NIL THEN RETURN;
quitEntry ← FindEntry[menuLine, "Quit"];
retryEntry ← FindEntry[menuLine, "Retry"];
IF quitEntry=NIL THEN db1.retryCount ← 0
ELSE IF retryEntry#NIL THEN waHoppen ← $retried;
IF db1.retryCount > maxRetryCount
THEN {
retryEntry ← quitEntry; waHoppen ← $timedout; };
IF retryEntry#
NIL
THEN {
db1.retryCount ← db1.retryCount + 1;
retryEntry.proc[parent: v, clientData: retryEntry.clientData];
};
IF FindEntry[menuLine, "NewMail"]#
NIL
THEN {
db ← db1; whatHappened ← waHoppen; };
};
ViewerOps.EnumerateViewers[CheckOne];
};
FindEntry:
PROC[menuLine: ViewerClasses.MenuEntry, menuLabel:
ROPE]
RETURNS [entry: ViewerClasses.MenuEntry] ~ {
FOR entry ← menuLine, entry.link
WHILE entry#
NIL
DO
IF entry.name.Equal[menuLabel, FALSE] THEN RETURN;
ENDLOOP;
};
GetDBFromWalnutHandle:
PROC[wH:
REF]
RETURNS[ db: DB←
NIL ] ~ {
handle: Handle;
IsItTheOne: SymTab.EachPairAction = {
[key: ROPE, val: SymTab.Val] RETURNS [quit: BOOL ← FALSE]
oneDB: DB ← NARROW[val];
IF handle.rootName.Equal[oneDB.dbFileName,
FALSE]
THEN {
[]←SetHandle[oneDB];
db ← oneDB;
RETURN[quit:TRUE];
};
};
WITH wH
SELECT
FROM
wwh: WalnutWindowPrivate.WalnutHandle => handle ← wwh.opsH;
ENDCASE => RETURN;
[]←SymTab.Pairs[dbs, IsItTheOne];
};
GetDBFromName:
PROC[dbName:
ROPE]
RETURNS[ db: DB←NIL] ~ {
db ← NARROW[dbs.Fetch[dbName].val];
};
CacheMsgSet:
PROC[cmd: Commander.Handle, msgSet: MsgSet, refresh:
BOOL←
FALSE]
RETURNS[handle: Handle] = {
ListLength:
PROC [l:
LIST
OF
ROPE]
RETURNS [i:
INT] ~
TRUSTED {
RETURN [List.Length[LOOPHOLE[l]]];
};
numMsgs: INT;
i: INT;
version1, version2: WalnutOps.MsgSetVersion;
msgs: LIST OF ROPE;
msgSetName: ROPE ← msgSet.msgSetName;
entries: Entries ← msgSet.entries;
handle ← SetHandle[msgSet.db];
IF (NOT refresh) AND entries#NIL THEN RETURN; -- have it already
[numMsgs, version1] ← WalnutOps.SizeOfMsgSet[handle, msgSetName];
IF entries#NIL AND version1 = msgSet.msgSetVersion THEN RETURN;
DO
[numMsgs, version1] ← WalnutOps.SizeOfMsgSet[handle, msgSetName];
[msgs, version2] ← WalnutOps.MsgsInSetEnumeration[handle, msgSetName];
IF version2=version1 THEN EXIT;
ENDLOOP;
IF numMsgs # (i ← ListLength[msgs])
THEN {
cmd.out.PutF["*** Curious that Walnut says %g messages but provided %g TOC entries\n", int[numMsgs], int[i]];
numMsgs ← i;
};
msgSet.msgSetVersion ← version2;
entries ← msgSet.entries ← NEW[EntrySequence[numMsgs]];
i←-1;
FOR ml:
LIST
OF
ROPE ← msgs, ml.rest
WHILE ml#
NIL
DO
entries[i←i+1].msgID ← ml.first; ENDLOOP;
cmd.out.PutF["Message set %g contains %g messages\n", rope[FullName[msgSet]], int[i+1]];
};
FilterOut:
PROC[msgNo:
INT]
RETURNS[
BOOL] = {
-- TRUE IFF entry does NOT match filter
tocEntry: ROPE; read: BOOL;
[read,,tocEntry] ← GetTocEntry[thisSource, msgNo];
RETURN[
(
SELECT thisSourceNewFilter
FROM
$read => NOT read, $unread => read, ENDCASE => FALSE) OR
(thisSourceFilter#NIL AND Rope.Find[s1: tocEntry, s2: thisSourceFilter, case: FALSE]<0)];
};
ParseRange:
PROC [
cmd: Commander.Handle, refresh: BOOL←FALSE, fullRange: BOOL←FALSE]
RETURNS [result: REF ANY←NIL, msg: ROPE←NIL, handle: Handle←NIL] ~ {
[result, msg] ← ParseArguments[cmd: cmd];
IF result = $Failed THEN RETURN;
handle ← CacheMsgSet[cmd, thisSource, refresh];
IF thisSourceFilter#NIL OR thisSourceNewFilter # $none THEN fullRange ← TRUE;
IF fullRange THEN [result, msg] ← ParseArguments[cmd: cmd, rangeDefaults: $all];
IF result = $Failed THEN RETURN;
IF firstMessageNumber = lastMessageNumber
AND lastMessageNumber = -1
THEN
RETURN[$Failed, "No message range was specified"];
IF firstMessageNumber > thisSource.entries.len
THEN
RETURN[$Failed, "There aren't that many"];
IF firstMessageNumber <= 0
THEN
RETURN[$Failed, "There aren't that few"];
};
ParseArguments:
PROC[
cmd: Commander.Handle, rangeDefaults: {none, all}←$none, dbOnly:
BOOL←
FALSE, sameDB:
BOOL ←
FALSE]
dbOnly -- Ignore message set name quantities, dummy up index entry bearing corresponding dbDesc.
sameDB -- source and dest must come from same db.
RETURNS[result: REF ANY ← NIL, msg: ROPE ← NIL] = {
Returns same as commandProc to clue in caller as to problems.
Problems include no such (registered) DB and nonexistent DB.
parsing: BOOL ← FALSE; {
ENABLE IO.EndOfStream => IF parsing THEN GOTO Failed ELSE CONTINUE;
s: IO.STREAM ← IO.RIS[cmd.commandLine];
arg: ROPE←NIL;
quoted: BOOL;
GetToken:
PROC
RETURNS[token:
ROPE, quoted:
BOOL←
FALSE] = {
ln: INT;
token ← IO.GetCedarTokenRope[s].token;
ln ← token.Length[];
IF ln<2 OR token.Fetch[0]#'" THEN RETURN;
quoted ← TRUE; token ← token.Substr[start: 1, len: ln-2];
};
ParseMsgSet:
PROC[msgSetName:
ROPE←
NIL]
RETURNS[msgSet: MsgSet] ~ {
dbName: ROPE ← "default";
parsing ← TRUE;
IF msgSetName=NIL THEN msgSetName ← GetToken[].token;
IF s.PeekChar[]='.
OR dbOnly
THEN {
dbName ← msgSetName;
msgSetName ← NIL;
IF dbOnly
THEN msgSetName ← "Active"
ELSE
DO
[] ← s.GetChar[];
msgSetName ← msgSetName.Concat[GetToken[].token];
IF s.PeekChar[]#'. THEN EXIT;
msgSetName ← msgSetName.Concat["."];
ENDLOOP;
};
[result, msg, msgSet] ← GetMsgSet[dbName, msgSetName];
parsing ← FALSE;
};
Implementation of "it", "them"
lastSource, lastDest: MsgSet;
lastSourceFilter: ROPE;
lastSourceNewFilter: NewFilter;
lastFirstMessageNumber, lastLastMessageNumber: INT;
lastSource ← thisSource; thisSource ← defaultSource;
lastDest ← thisDest; thisDest ← defaultDest;
lastSourceFilter ← thisSourceFilter; thisSourceFilter ← NIL;
lastSourceNewFilter ← thisSourceNewFilter; thisSourceNewFilter ← $none;
lastFirstMessageNumber𡤏irstMessageNumber; lastLastMessageNumber←lastMessageNumber;
firstMessageNumber ← lastMessageNumber ← -1;
WHILE result=
NIL
AND ([arg, quoted]←GetToken[]).token #
NIL
DO
c: CHAR ← IF arg.Length[]>=1 THEN arg.Fetch[0] ELSE '\000;
SELECT
TRUE
FROM
NOT quoted AND arg.Equal["unread", FALSE] => thisSourceNewFilter ← $unread;
NOT quoted AND arg.Equal["read", FALSE] => thisSourceNewFilter ← $read;
NOT quoted AND arg.Equal["from", FALSE] => thisSource ← ParseMsgSet[];
NOT quoted AND arg.Equal["to", FALSE] => thisDest ← ParseMsgSet[];
NOT quoted
AND arg.Equal["with",
FALSE] => {
parsing ← TRUE;
thisSourceFilter ← IO.GetRope[s];
IF thisSourceFilter.Length[]>1
THEN
thisSourceFilter ← thisSourceFilter.Substr[start: 1, len: thisSourceFilter.Length[]-2];
parsing ← FALSE;
};
NOT quoted
AND (arg.Equal["it",
FALSE]
OR arg.Equal["them",
FALSE]) => {
thisSource ← lastSource;
thisDest ← lastDest;
thisSourceFilter ← lastSourceFilter;
thisSourceNewFilter ← lastSourceNewFilter;
firstMessageNumber ← lastFirstMessageNumber; -- [sic]
lastMessageNumber ← lastLastMessageNumber; -- [mea culpa]
};
c = '[ => {
parsing ← TRUE;
arg ← GetToken[].token;
IF ~ (arg.Fetch[0] IN ['0..'9]) THEN RETURN[$Failed, "Non-number in message range"];
firstMessageNumber ← Convert.IntFromRope[arg];
arg ← GetToken[].token;
IF ~arg.Equal[".."] THEN RETURN[$Failed, "Missing ellipsis in message range"];
arg ← GetToken[].token;
IF ~ (arg.Fetch[0] IN ['0..'9]) THEN RETURN[$Failed, "Non-number in message range"];
lastMessageNumber ← Convert.IntFromRope[arg];
arg ← GetToken[].token;
IF ~arg.Equal["]"] THEN RETURN[$Failed, "Message range not properly terminated"];
parsing ← FALSE;
};
c
IN ['0..'9] => {
firstMessageNumber ← lastMessageNumber ← Convert.IntFromRope[arg];
};
c IN ['a..'z], c IN ['A..'Z] => thisSource ← ParseMsgSet[arg];
ENDCASE => RETURN[$Failed, "Unrecognized input"];
ENDLOOP;
EXITS
Failed => RETURN[$Failed, "Error while reading command"];
};
IF rangeDefaults = $all
THEN {
IF firstMessageNumber = -1 THEN firstMessageNumber ← 1;
IF lastMessageNumber = -1 THEN lastMessageNumber ← thisSource.entries.len;
};
IF sameDB AND thisSource.db#thisDest.db THEN RETURN[$Failed, "Source and destination message sets must be from same Walnut data base."];
};
GetMsgSet:
PROC[dbName, msgSetName:
ROPE]
RETURNS [result: REF ANY, msg: ROPE, msgSet: MsgSet←NIL] ~ {
key: ROPE ← Rope.Cat[dbName, ".", msgSetName];
db: DB;
msgSet ← NARROW[msgSets.Fetch[key].val];
IF msgSet#
NIL
THEN {
[]←SetHandle[msgSet.db];
RETURN;
};
db ← GetDBFromName[dbName];
IF db=
NIL
THEN {
result ← $Failed;
msg ← "DB Name not registered; use WalnutKeyboard command to register.";
RETURN;
};
[] ← SetHandle[db];
msgSet ← NEW[MsgSetBody ← [db, msgSetName]];
[] ← msgSets.Store[key, msgSet];
};
SetHandle:
PROC[db:
DB]
RETURNS[Handle] = {
rootFileName: ROPE ← db.dbFileName;
RETURN[db.handle ← WalnutOps.GetHandleForRootfile[rootFileName]];
};
GetTocEntry:
PROC[msgSet: MsgSet, i:
INT]
RETURNS[hasBeenRead: BOOL←FALSE, deleted: BOOL←FALSE, toc: ROPE←NIL]~{
entries: Entries ← msgSet.entries;
i ← i-1;
IF
NOT entries[i].tocValid
THEN {
[hasBeenRead, toc] ←
WalnutOps.GetDisplayProps[msgSet.db.handle, entries[i].msgID];
entries[i].tocValid ← TRUE;
entries[i].toc ← toc;
entries[i].hasBeenRead ← hasBeenRead;
}
ELSE {
toc ← entries[i].toc;
hasBeenRead ← entries[i].hasBeenRead;
deleted ← entries[i].deleted;
};
};
FullName:
PROC[msgSet: MsgSet]
RETURNS [fullName:
ROPE] ~ {
RETURN[
IO.PutFR["%g.%g", rope[msgSet.db.dbName], rope[msgSet.msgSetName]]];
};
FlushCmd: Commander.CommandProc = {
[cmd: Commander.Handle] RETURNS [result: REF ANY ← NIL, msg: ROPE ← NIL]
ENABLE RuntimeError.UNCAUGHT => GOTO Failed;
msgSets ← SymTab.Create[case: FALSE];
[result, msg, defaultSource] ← GetMsgSet["default", "Active"];
IF result=$Failed THEN RETURN;
defaultDest ← defaultSource;
cmd.out.PutF["Flushed message sets, default source and dest are default.Active\n"];
EXITS Failed => RETURN[$Failed, "*** Uncaught signal ***"]
};
WalnutKbdCmd: Commander.CommandProc = {
[cmd: Commander.Handle] RETURNS [result: REF ANY ← NIL, msg: ROPE ← NIL]
dbName: ROPE;
rootFile: ROPE;
dbName ← CommandTool.NextArgument[cmd];
rootFile ← CommandTool.NextArgument[cmd];
[result, msg, dbName, rootFile] ← WalnutKbdInit[dbName, rootFile];
IF result=$Failed THEN RETURN;
cmd.out.PutF["Registered %g: %g\n", rope[dbName], rope[rootFile]];
};
WalnutKbdInit:
PROC[dbNameIn, rootFileIn:
ROPE←
NIL]
RETURNS[result: REF ANY←NIL, msg: ROPE←NIL, dbName: ROPE←NIL, rootFile: ROPE←NIL] = {
[cmd: Commander.Handle] RETURNS [result: REF ANY ← NIL, msg: ROPE ← NIL]
ENABLE RuntimeError.UNCAUGHT => GOTO Failed;
db: DB;
dbName ← dbNameIn;
rootFile ← rootFileIn;
IF dbName =
NIL
THEN {
dbName ← "default";
rootFile ← UserProfile.Token["Walnut.WalnutRootFile"];
}
ELSE IF rootFile=NIL THEN RETURN[$Failed, "No root file name provided"];
db ← GetDBFromName[dbName];
IF db=
NIL
THEN {
db ← NEW[DBBody←[dbName, NIL]];
[]�s.Store[dbName, db];
};
db.dbFileName ← rootFile;
db.handle ← NIL;
IF defaultSource=
NIL
THEN
defaultSource ← defaultDest ← GetMsgSet[dbName, "Active"].msgSet;
EXITS Failed => RETURN[$Failed, "*** Uncaught signal ***"]
};
Commander.Register["WKDBs", ListDBsCmd, "List available Walnut data bases"];
Commander.Register["WKSets", ListMsgSetsCmd, "List Walnut message sets"];
Commander.Register["WKSelect", SelectMsgSetCmd, "Select working Walnut message set\n Usage: WKSelect <source>|<dest>"];
Commander.Register["WKListTOC", ListMsgsInMsgSetCmd, "List messages in message set, as specified by filters and message range.\n Usage: WKList <source>", $List];
Commander.Register["WKSameTOC", ListMsgsInMsgSetCmd, "List messages in message set, without consulting Walnut again.\n Usage: WKSame <source>", $Again];
Commander.Register["WKDisplay", PrintMsgInMsgSetCmd, "Display a message designated by number from a selected message set\n Usage: WKDisplay <msgNumber> <source>"];
Commander.Register["WKPoll", GetNewMailCmd, "Poll Mail services for new mail"];
Commander.Register["WKMove", MoveMsgCmd, "Move messages from source message set to destination message set.\n Usage: WKMove <source> <msgNumber> <destination>", $Move];
Commander.Register["WKCopy", MoveMsgCmd, "Copy messages from source message set to destination message set.\n Usage: WKCopy <source> <msgNumber> <destination>", $Copy];
Commander.Register["WKTransfer", XferMsgCmd, "Transfer messages from source message set in one database to destination message set in another.\n Usage: WKTransfer <source> <msgNumber> <destination>"];
Commander.Register["WKDelete", DeleteMsgCmd, "Delete messages from source message set.\n Usage: WKDelete <source> <msgNumber>"];
Commander.Register["WKFlush", FlushCmd, "Flush all cached message sets. Restore default to default.Active."];
Commander.Register["WalnutKeyboard", WalnutKbdCmd, "Usage: Walnutkeyboard <dbName> <rootFile>\nAdds mapping from <dbName> to <rootFile> to list of available Walnut databases\nDefault <dbName>='default'; default <rootFile> from user profile"];
dbs ← SymTab.Create[case: FALSE];
msgSets ← SymTab.Create[case: FALSE];
TRUSTED { Process.Detach[FORK Checker[]]; };
[]←WalnutKbdInit[NIL, NIL];