WalnutSortMailImpl.mesa
Copyright © 1984, 1985, 1986 by Xerox Corporation. All rights reserved.
Created December 18, 1984 4:36:42 pm PST by Dave Rumph
Dave Rumph, June 23, 1986 5:56:23 pm PDT
Eric Nickell, June 25, 1986 3:57:00 pm PDT
Willie-Sue, July 12, 1985 11:16:15 am PDT
Donahue, May 12, 1986 7:53:15 am PDT
DIRECTORY
ACFind USING [ActionProc, Create, Find, Ref],
Basics USING [CompareCard],
Commander USING [CommandProc, Register],
CommandTool USING [ParseToList],
Convert USING [IntFromRope, RopeFromInt],
FS USING [Error],
MBQueue USING [Create, Queue],
MessageWindow USING [Append, Blink],
Process USING [Detach],
Rope USING [Cat, Equal, Fetch, Length, Match, ROPE],
SymTab USING [Create, EachPairAction, Fetch, Insert, Pairs, Ref],
UserCredentials USING [Get],
UserProfile USING [Boolean, ListOfTokens],
ViewerTools USING [TiogaContents],
WalnutOps USING [AddMsg, CreateMsgSet, GetDisplayProps, GetMsg, MsgSetNames, MsgSetsInfo, MsgsInSetEnumeration, MoveMsg],
WalnutSortDB,
WalnutWindow USING [QueueCall, SelectMsgSetsFromMSNames],
WalnutWindowInternal USING [Report],
WalnutRegistry USING [EventProc, MsgProc, ProcSet, Register],
WalnutSortMail;
WalnutSortMailImpl:
CEDAR
MONITOR
IMPORTS ACFind, Basics, Commander, CommandTool, Convert, FS, MBQueue, MessageWindow, Process, Rope, SymTab, UserCredentials, UserProfile, WalnutOps, WalnutRegistry, WalnutSortDB, WalnutWindow, WalnutWindowInternal
EXPORTS WalnutSortMail
= BEGIN
ROPE: TYPE ~ Rope.ROPE;
TriggerSet: TYPE ~ WalnutSortDB.TriggerSet;
Trigger: TYPE ~ WalnutSortDB.Trigger;
Error: PUBLIC ERROR [info: ROPE] = CODE;
EachMsg: WalnutRegistry.MsgProc ~ {
PROC[msgName: Rope.ROPE, event: MsgEvent, clientData: REF ANY];
IF sortEnabled AND event=firstRead THEN SortMsg[IF UserProfile.Boolean[key: "WalnutSort.SelectOnTOC"] THEN WalnutOps.GetDisplayProps[msg: msgName].TOCentry ELSE WalnutOps.GetMsg[msgName].contents.contents];
};
SortMsg:
PUBLIC
PROC [msg:
ROPE] ~ {
EachKeyword: ACFind.ActionProc ~ {
trig: REF Trigger ← NARROW[SymTab.Fetch[ts.mapping, keyFound].val];
SELECT Basics.CompareCard[trig.priority, highestPriorityFound]
FROM
less => RETURN;
greater => {
highestPriorityFound ← trig.priority;
msNamesToActivate ← SymTab.Create[];
};
ENDCASE => NULL;
FOR each:
LIST
OF
ROPE ← trig.msNames, each.rest
UNTIL each=
NIL
DO
[] ← SymTab.Insert[msNamesToActivate, each.first, NIL];
ENDLOOP;
};
EachMSName: SymTab.EachPairAction = {
[key: SymTab.Key, val: SymTab.Val] RETURNS [quit: BOOL]
msNamesToActivateList ← CONS[key, msNamesToActivateList];
RETURN[FALSE];
};
highestPriorityFound: CARDINAL ← 0;
msNamesToActivate: SymTab.Ref;
msNamesToActivateList: LIST OF ROPE ← NIL;
finder: ACFind.Ref ← NIL;
ts: TriggerSet ← GetTriggerSet[];
Don't catch WalnutSortMail.Error here because retries are attempted below its generation and Walnut has successfully established communication with the server. Something else must be wrong. Let the debugger help figure it out.
finder ← NARROW[ts.clientData];
IF ACFind.Find[finder, msg, EachKeyword]
THEN
[] ← SymTab.Pairs[msNamesToActivate, EachMSName]
ELSE
Here, no trigger was found - look for a default action in User Profile
msNamesToActivateList ← UserProfile.ListOfTokens["WalnutSort.DefaultSelections"];
IF msNamesToActivateList # NIL THEN [] ← WalnutWindow.SelectMsgSetsFromMSNames[msNamesToActivateList];
};
ReSort:
PUBLIC
PROC [pattern, fromMsgSets:
LIST
OF
ROPE, newMsgSet:
ROPE, removeFromOld, checkOnlyTitle:
BOOLEAN ←
FALSE]
RETURNS [msgsMoved:
LIST
OF
ROPE ←
NIL] ~ {
Note that pattern and fromMsgSets are LIST OF ROPE, and pattern may be "".
patternRE: ACFind.Ref ~ ACFind.Create[keys: pattern, caseSensitive: FALSE];
fromMsgSetsRE: ACFind.Ref ~ ACFind.Create[keys: fromMsgSets, caseSensitive: FALSE];
msgSets: LIST OF ROPE ← NIL;
count: INT ← 0;
CMSProc:
PROC[]
RETURNS[doReset:
BOOL] = {
doReset ← TRUE;
WalnutOps.CreateMsgSet[newMsgSet, WalnutOps.MsgSetsInfo[].version];
Add to msgSets any names matching the fromMsgSets pattern.
FOR mss:
LIST
OF
ROPE ← WalnutOps.MsgSetNames[].mL, mss.rest
UNTIL mss=
NIL
DO
FindMsgSetName: ACFind.ActionProc = {
[position: INT, keyFound: ROPE] RETURNS [quit: BOOL ← FALSE]
pos ← position - Rope.Length[keyFound];
RETURN [TRUE]
};
pos: INT ← INT.LAST;
IF ACFind.Find[fromMsgSetsRE, mss.first, FindMsgSetName] AND pos=0 THEN msgSets ← CONS[mss.first, msgSets] ;
FOR each:
LIST
OF
ROPE ← fromMsgSets, each.rest
UNTIL each=
NIL
DO
IF Rope.Match[pattern: each.first, object: mss.first, case:
FALSE]
THEN {
msgSets ← CONS[mss.first, msgSets];
EXIT;
};
ENDLOOP;
ENDLOOP;
Scan the messages in each message set.
WalnutWindowInternal.Report["Messages moved:"];
FOR mss:
LIST
OF
ROPE ← msgSets, mss.rest
UNTIL mss=
NIL
DO
ms: ROPE ~ mss.first;
FOR msgs:
LIST
OF
ROPE ← WalnutOps.MsgsInSetEnumeration[ms].mL, msgs.rest
UNTIL msgs=
NIL
DO
FindKeyInText: ACFind.ActionProc = {
[position: INT, keyFound: ROPE] RETURNS [quit: BOOL ← FALSE]
RETURN [TRUE]
};
herald, text: ROPE;
herald ← text ← WalnutOps.GetDisplayProps[msgs.first].TOCentry;
IF ~checkOnlyTitle
THEN {
text ← WalnutOps.GetMsg[msgs.first].contents.contents;
};
IF ACFind.Find[self: patternRE, text: text, action: FindKeyInText]
THEN {
count ← count+1;
msgsMoved ← CONS[msgs.first, msgsMoved];
WalnutWindowInternal.Report[" ", herald];
IF removeFromOld THEN [] ← WalnutOps.MoveMsg[msgs.first, [ms], [newMsgSet]]
ELSE [] ← WalnutOps.AddMsg[msgs.first, [ms], [newMsgSet]];
};
ENDLOOP;
ENDLOOP;
WalnutWindowInternal.Report[Convert.RopeFromInt[from: count], " messages moved."];
};
[] ← WalnutWindow.QueueCall[CMSProc] };
WatchWalnut: WalnutRegistry.EventProc = {
[event: WalnutRegistry.Event, clientData: REF ANY]
SELECT event
FROM
stopped => WalnutSortDisable[];
started => IF Rope.Equal[user, UserCredentials.Get[].name, FALSE] THEN WalnutSortEnable[];
ENDCASE => NULL;
};
user: ROPE ← NIL;
sortEnabled: BOOLEAN ← FALSE;
queue: MBQueue.Queue ~ MBQueue.Create[];
procSet: WalnutRegistry.ProcSet ~ [
eventProc: WatchWalnut,
msgProc: EachMsg
];
WalnutSortEnable:
PUBLIC
ENTRY
PROC ~ {
ENABLE UNWIND => NULL;
Activates the WalnutSort facility.
IF
NOT sortEnabled
THEN {
currentUser: ROPE ← UserCredentials.Get[].name;
IF
NOT Rope.Equal[currentUser, user,
FALSE]
THEN {
user ← currentUser;
WalnutSortDB.DeclareSegment[user];
};
sortEnabled ← TRUE;
TRUSTED {Process.Detach[FORK MakeWalnutSortGetTriggerSet[]];}
};
};
WalnutSortDisable:
PUBLIC
ENTRY
PROC ~ {
ENABLE UNWIND => NULL;
Disables the WalnutSort facility.
WalnutSortDB.Close[];
sortEnabled ← FALSE;
};
LoadDefinitions: Commander.CommandProc ~ {
tokens: LIST OF ROPE ~ CommandTool.ParseToList[cmd].list;
usageMessage: ROPE ~ "Usage: WSLoad <filename>.\n";
SELECT
TRUE
FROM
tokens=NIL => msg ← usageMessage;
ENDCASE => WalnutSortDB.LoadFromFile[tokens.first !
FS.Error => {msg ← error.explanation; GOTO Complain};
ANY => {msg ← "Failed.\n"; GOTO Complain}
];
EXITS
Complain => {RETURN [$Failure, msg]};
};
DumpDefinitions: Commander.CommandProc ~ {
tokens: LIST OF ROPE ~ CommandTool.ParseToList[cmd].list;
usageMessage: ROPE ~ "Usage: WSDump <filename>.\n";
SELECT
TRUE
FROM
tokens=NIL => msg ← usageMessage;
ENDCASE => WalnutSortDB.DumpToFile[tokens.first !
FS.Error => {msg ← error.explanation; GOTO Complain};
ANY => {msg ← "Failed.\n"; GOTO Complain}
];
EXITS
Complain => {RETURN [$Failure, msg]};
};
MakeFinder:
PROC [mapping: SymTab.Ref]
RETURNS [finder: ACFind.Ref] ~ {
BuildKeyList: SymTab.EachPairAction = {
[key: SymTab.Key, val: SymTab.Val] RETURNS [quit: BOOL]
keyList ← CONS[key, keyList];
RETURN[FALSE];
};
keyList: LIST OF ROPE ← NIL;
[] ← SymTab.Pairs[x: mapping, action: BuildKeyList];
finder ← ACFind.Create[keyList];
};
GetTriggerSet:
PROC
RETURNS [ts: TriggerSet] ~ {
ts ← WalnutSortDB.GetTriggerSetFromDB[];
IF ts.clientData = NIL THEN ts.clientData ← MakeFinder[ts.mapping];
};
MakeWalnutSortGetTriggerSet:
PROC ~ {
[] ← GetTriggerSet[ ! Error => {
MessageWindow.Append[info, TRUE];
MessageWindow.Blink[];
CONTINUE
}];
};
WalnutSort: Commander.CommandProc ~ {
tokens: LIST OF ROPE ~ CommandTool.ParseToList[cmd].list;
usageMessage: ROPE ~ "Usage: WalnutSort on|off.\n";
SELECT
TRUE
FROM
tokens=NIL OR
Rope.Equal[tokens.first, "on",
FALSE] => {
WalnutSortEnable[];
msg ← "Sort enabled.\n";
};
Rope.Equal[tokens.first, "off", FALSE] => {WalnutSortDisable[]; msg ← "Sort disabled.\n"};
ENDCASE => msg ← usageMessage;
};
resortMsg: ROPE ~ "WSResort [-[m][t]] <new message set name> ← <keyword(s) or '*> IN <message set(s) to sample>.";
ResortCmd: Commander.CommandProc ~ {
arg: LIST OF ROPE ← CommandTool.ParseToList[cmd].list;
pattern: LIST OF ROPE ← NIL;
to: ROPE;
deleteFromOld, checkOnlyTitle: BOOL ← FALSE;
IF arg = NIL THEN GOTO NoPattern;
IF Rope.Fetch[arg.first]='-
THEN {
FOR k:
NAT
IN [0..
NAT[Rope.Length[arg.first]])
DO
SELECT Rope.Fetch[arg.first, k]
FROM
'm => deleteFromOld ← TRUE;
't => checkOnlyTitle ← TRUE;
ENDCASE;
ENDLOOP;
arg ← arg.rest;
};
IF arg = NIL OR arg.rest = NIL OR NOT Rope.Equal[arg.rest.first, "←"] THEN GOTO NoPattern;
to ← arg.first;
arg ← arg.rest.rest;
IF Rope.Equal[s1: arg.first, s2: "*"]
THEN {
pattern ← LIST[""];
arg ← arg.rest;
}
ELSE
UNTIL arg=
NIL
OR Rope.Equal[s1: arg.first, s2: "IN"]
DO
pattern ← CONS[arg.first, pattern];
arg ← arg.rest;
ENDLOOP;
IF arg = NIL OR arg.rest = NIL OR NOT Rope.Equal[s1: arg.first, s2: "IN"] THEN GOTO NoPattern;
from ← arg;
[] ← ReSort[pattern, arg.rest --from--, to, deleteFromOld, checkOnlyTitle];
EXITS
NoPattern => RETURN [msg: resortMsg];
};
SetTrigger: Commander.CommandProc ~ {
tokens: LIST OF ROPE ← CommandTool.ParseToList[cmd].list;
priority: INT ← 10;
usageMessage: ROPE ~ "Usage: WSSetTrigger [-priority] keyword messageSetName.\n";
SELECT
TRUE
FROM
tokens=NIL => RETURN [msg: usageMessage];
Rope.Fetch[tokens.first]='- => {
priority ← -Convert.IntFromRope[tokens.first];
tokens ← tokens.rest;
};
ENDCASE;
IF tokens=NIL OR tokens.rest=NIL THEN RETURN [msg: usageMessage];
WalnutSortDB.DeleteTrigger[tokens.rest.first, tokens.first];
WalnutSortDB.AddTrigger[tokens.rest.first, tokens.first, priority];
};
DeleteTrigger: Commander.CommandProc ~ {
tokens: LIST OF ROPE ~ CommandTool.ParseToList[cmd].list;
usageMessage: ROPE ~ "Usage: WSDeleteTrigger keyword messageSetName.\n";
IF tokens=NIL OR tokens.rest=NIL THEN RETURN [msg: usageMessage];
WalnutSortDB.DeleteTrigger[tokens.rest.first, tokens.first];
};
ListTriggers: Commander.CommandProc ~ {
WalnutSortDB.DumpToStream[cmd.out];
};
Init:
PROC ~ {
OPEN Commander;
Register["WalnutSort", WalnutSort, "WalnutSort on|off --Enable/disable auto message set button selection"];
Register["WSDump", DumpDefinitions, "Dump the Walnut Sort Definitions (WSDump filename)."];
Register["WSLoad", LoadDefinitions, "Load the Walnut Sort Definitions (WSLoad filename)."];
Register["WSSetTrigger", SetTrigger, "Create a keyword trigger (WSSetTrigger [-priority] keyword messageSetName)."];
Register["WSDeleteTrigger", DeleteTrigger, "Remove a keyword trigger (WSDeleteTrigger keyword messageSetName)."];
Register["WSListTriggers", ListTriggers, "List current triggers."];
Register["WSResort", ResortCmd, Rope.Cat["Resort Walnut messages into another message set. (", resortMsg, ")."]];
[] ← WalnutRegistry.Register[procSet: procSet, queue: queue];
};
Init[];
END.