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, January 13, 1986 3:11:46 pm PST
Eric Nickell, April 3, 1986 12:25:38 pm PST
Willie-Sue, July 12, 1985 11:16:15 am PDT
Rick Beach, May 9, 1986 2:56:43 pm 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, Find, Length, ROPE, Substr],
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, newMsgSet:
ROPE, removeFromOld, checkOnlyTitle:
BOOLEAN ←
FALSE]
RETURNS [msgsMoved:
LIST
OF
ROPE ←
NIL] ~ {
Note that pattern and fromMsgSets are Regular Expressions.
CreateFromRope:
PROC [pattern:
ROPE, ignoreCase:
BOOL]
RETURNS [ref: ACFind.Ref] ~ {
CheckSpecialCases:
PROC [in:
ROPE]
RETURNS [out:
ROPE] ~ {
RETURN [IF Rope.Equal[in, "*"] THEN "" ELSE in];
};
loc: INT;
list: LIST OF ROPE ← NIL;
WHILE (loc ← Rope.Find[s1: pattern, s2: "|"]) # -1
DO
list ← CONS[CheckSpecialCases[Rope.Substr[base: pattern, len: loc]], list];
pattern ← Rope.Substr[base: pattern, start: loc+1];
ENDLOOP;
list ← CONS[CheckSpecialCases[pattern], list];
ref ← ACFind.Create[keys: list, caseSensitive: ~ignoreCase];
};
patternRE: ACFind.Ref ~ CreateFromRope[pattern: pattern, ignoreCase: TRUE];
fromMsgSetsRE: ACFind.Ref ~ CreateFromRope[pattern: fromMsgSets, ignoreCase: TRUE];
msgSets: LIST OF ROPE;
count: INT ← 0;
CMSProc:
PROC
RETURNS[doReset:
BOOL] = {
WalnutOps.CreateMsgSet[newMsgSet, WalnutOps.MsgSetsInfo[].version];
RETURN[TRUE];
};
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+1 - 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] ;
ENDLOOP;
[] ← WalnutWindow.QueueCall[CMSProc];
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."];
};
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: LoadSortDefs <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: DumpSortDefs <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] <regular expression to match> [<message set(s) to sample> [<new message set name>]].";
ResortCmd: Commander.CommandProc ~ {
arg: LIST OF ROPE ← CommandTool.ParseToList[cmd].list;
pattern, from, 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 THEN GOTO NoPattern;
pattern ← arg.first;
from ← IF arg.rest#NIL THEN arg.rest.first ELSE "#*";
to ← IF arg.rest#NIL AND arg.rest.rest#NIL THEN arg.rest.rest.first ELSE "Temp";
[] ← ReSort[pattern, from, to, deleteFromOld, checkOnlyTitle];
EXITS
NoPattern => RETURN [msg: resortMsg];
};
TriggerCmd: Commander.CommandProc ~ {
tokens: LIST OF ROPE ← CommandTool.ParseToList[cmd].list;
priority: INT ← 10;
usageMessage: ROPE ~ "Usage: Trigger [-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: DeleteTrigger 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", TriggerCmd, "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.