WalnutFilterImpl.mesa
Copyright Ó 1991, 1992 by Xerox Corporation. All rights reserved.
Doug Terry, October 22, 1992 11:21 am PDT
Willie-s, April 30, 1992 11:22 am PDT
Implements operations for filtering and sorting mail messages. These are used in menus and message set displayers. Filtering is also called "appraising" since this is more accurate, and also serves to avoid confusion with the filtering done by the Tapestry clipping service.
DIRECTORY
Ascii USING [Lower],
Atom USING [GetPName],
BasicTime USING [GMT, Period],
IO,
LoganBerryEntry USING [GetAllAttrs, I2V, V2I],
LoganQuery USING [ParseBooleanQuery, ParseTree, SyntaxError],
MailUtils USING [Credentials, GetUserCredentials],
Menus USING [CreateEntry, MenuEntry, MenuEntryAppend, MenuProc],
PopUpSelection USING [Request],
Process USING [Detach],
RedBlackTree USING [Compare],
RefText USING [MaxLen, New, TrustTextAsRope],
Rope,
SimpleMailer USING [SendMessage],
SystemNames USING [UserName],
TapFilter USING [AddFilter, Agent, Annotation, CreateAgent, DeleteFilter, Error, FilterInfo, GetAnnotations, IsAgentIdle, LookupAllFilters, LookupFilter, MonitorAgent, MonitorProc, ParseMsgIntoFields, TerminateAgent, WakeupAgent, msgID, seqNum],
TapMsgQueue USING [Create, Msg, MsgQueue, Put],
TextEdit USING [PutCharProp],
TiogaOps USING [--CallWithLocks,-- FindText, GetSelection, Location, Ref, SelectPoint, StepForward, ViewerDoc],
UserProfile USING [Boolean, CallWhenProfileChanges, ListOfTokens, ProfileChangedProc, Number, Token],
ViewerClasses USING [Column, Viewer],
ViewerOps USING [FetchProp, PaintViewer],
ViewerTools USING [EnableUserEdits, GetSelectionContents, InhibitUserEdits],
WalnutDB USING [GetMsgText],
WalnutInternal USING [QDisplayMsgSet],
WalnutFilter,
WalnutLog USING [GetRefTextFromLog],
WalnutOps USING [WalnutOpsHandle],
WalnutWindow USING [GetHandleList, Report, ReportFormat, ReportRope],
WalnutWindowPrivate USING [MsgAndHandle, MsgSetButton, MsgSetFieldHandle, MsgInfo, MsgSetInfo, WalnutHandle, WalnutHandleRec];
WalnutFilterImpl: CEDAR PROGRAM
IMPORTS Ascii, Atom, BasicTime, IO, LoganBerryEntry, LoganQuery, MailUtils, Menus, PopUpSelection, Process, RefText, Rope, SimpleMailer, SystemNames, TapFilter, TapMsgQueue, TextEdit, TiogaOps, UserProfile, ViewerOps, ViewerTools, WalnutDB, WalnutInternal, WalnutLog, WalnutWindow
EXPORTS WalnutFilter, WalnutWindow
= BEGIN
Types
Viewer: TYPE = ViewerClasses.Viewer;
ROPE: TYPE = Rope.ROPE;
WalnutHandle: TYPE = WalnutWindowPrivate.WalnutHandle;
WalnutHandleRec: PUBLIC TYPE = WalnutWindowPrivate.WalnutHandleRec;
WalnutOpsHandle: TYPE = WalnutOps.WalnutOpsHandle;
MsgSetInfo: TYPE = WalnutWindowPrivate.MsgSetInfo;
MsgSetFieldHandle: TYPE = WalnutWindowPrivate.MsgSetFieldHandle;
MsgInfo: TYPE = WalnutWindowPrivate.MsgInfo;
Variables
userWantsPriority: BOOL¬FALSE;
annotationDBName: ROPE ¬ NIL;
defaultILevel: INT ¬ 50;
A filtering agent is maintained for the re-filter operation(s) that is separate from the agent used for new mail.
refilterAgent: TapFilter.Agent ¬ NIL;
refilterFeeder: TapMsgQueue.MsgQueue;
feederSeqNum: INT ¬ 0;
Message priority/interest levels
MessageTOC: PUBLIC PROC[toc: ROPE, msgInfo: MsgInfo] RETURNS [new: ROPE] ~ {
Might change the format of the message's "table of contents", e.g. to include its priority.
IF userWantsPriority
THEN new ¬ IO.PutFR["%3g> %g", IO.int[msgInfo.ilevel], IO.rope[toc]]
ELSE new ¬ toc;
};
MsgInterestLevel: PUBLIC PROC [msg: ROPE] RETURNS [ilevel: INT] ~ {
Lookup the msg's ilevel in the annotation database. The default ilevel is used if a database entry is not found for this message. If the message is annotated with several ilevels then the highest one is used.
ENABLE TapFilter.Error => {
wH: WalnutHandle ¬ WalnutWindow.GetHandleList[].first;
IF wH # NIL THEN
WalnutWindow.ReportFormat[wH, "Problem with annotation database: %g - %g.\n", IO.atom[ec], IO.rope[explanation]];
CONTINUE;
};
Max: PROC [values: LIST OF ROPE] RETURNS [max: INT] ~ {
max ¬ -1;
FOR rL: LIST OF ROPE ¬ values, rL.rest WHILE rL # NIL DO
i: INT ¬ LoganBerryEntry.V2I[rL.first];
IF i > max THEN
max ¬ i;
ENDLOOP;
};
ilevel ¬ -1;
IF annotationDBName # NIL THEN BEGIN
annot: TapFilter.Annotation;
annot ¬ TapFilter.GetAnnotations[annotDB: annotationDBName, msgID: msg];
ilevel ¬ Max[LoganBerryEntry.GetAllAttrs[entry: annot, type: $Level]];
ilevel ¬ MAX[ilevel, Max[LoganBerryEntry.GetAllAttrs[entry: annot, type: $level]]];
END;
IF ilevel = -1 THEN
ilevel ¬ defaultILevel;
};
Sorting orders for messages within sets
sortChoices: LIST OF ROPE = LIST[
"Date",
"Priority",
"Unread",
"Unread then Priority",
"Subject",
"Sender"
];
sortDocs: LIST OF ROPE = LIST[
"Sort messages in this set by date",
"Sort messages in this set by priority",
"Sort messages so that unread ones are at the end",
"Sort messages by priority within read/unread classes",
"Sort messages in this set by subject",
"Sort messages in this set by sender"
];
sortAtoms: LIST OF ATOM = LIST[
$date,
$priority,
$unread,
$unreadpriority,
$subject,
$sender
];
InitialSortOrder: PUBLIC PROC [msName: ROPE] RETURNS [order: ATOM] ~ {
default: ATOM ¬ $date;
plist: LIST OF ROPE;
order ¬ NIL;
plist ¬ UserProfile.ListOfTokens[key: "WallTapestry.SortByPriority", default: NIL];
FOR l: LIST OF ROPE ¬ plist, l.rest WHILE l # NIL DO
SELECT TRUE FROM
Rope.Equal[l.first, msName] => {
order ¬ $priority;
EXIT;
};
Rope.Equal[l.first, "*"] => default ¬ $priority;
ENDCASE => NULL;
ENDLOOP;
IF order # NIL THEN RETURN;
plist ¬ UserProfile.ListOfTokens[key: "WallTapestry.SortByDate", default: NIL];
FOR l: LIST OF ROPE ¬ plist, l.rest WHILE l # NIL DO
SELECT TRUE FROM
Rope.Equal[l.first, msName] => {
order ¬ $date;
EXIT;
};
Rope.Equal[l.first, "*"] => default ¬ $date;
ENDCASE => NULL;
ENDLOOP;
IF order = NIL THEN order ¬ default;
};
SortCompareProc: PUBLIC PROC [order: ATOM ¬ $date] RETURNS [proc: RedBlackTree.Compare] ~ {
Returns a comparison procedure for the given sort order.
SELECT order FROM
$date => proc ¬ CompareDateThenMsg;
$priority => proc ¬ ComparePriorityThenDateThenMsg;
$unread => proc ¬ CompareUnreadThenDate;
$unreadpriority => proc ¬ CompareUnreadThenPriorityThenDate;
$subject => proc ¬ CompareSubjectThenDate;
$sender => proc ¬ CompareSenderThenDate;
ENDCASE => proc ¬ CompareDateThenMsg;
};
CompareDateThenMsg: RedBlackTree.Compare ~ {
key1: MsgSetFieldHandle ¬ NARROW[k];
key2: MsgSetFieldHandle ¬ NARROW[data];
RETURN[
SELECT BasicTime.Period[from: key1.msgInfo.date, to: key2.msgInfo.date] FROM
<0 => greater,
>0 => less,
ENDCASE => Rope.Compare[key1.msgInfo.msg, key2.msgInfo.msg]];
};
ComparePriorityThenDateThenMsg: RedBlackTree.Compare ~ {
key1: MsgSetFieldHandle ¬ NARROW[k];
key2: MsgSetFieldHandle ¬ NARROW[data];
RETURN[
SELECT TRUE FROM
key1.msgInfo.ilevel < key2.msgInfo.ilevel => greater,
key1.msgInfo.ilevel > key2.msgInfo.ilevel => less,
ENDCASE => CompareDateThenMsg[k, data]];
};
CompareUnreadThenDate: RedBlackTree.Compare ~ {
key1: MsgSetFieldHandle ¬ NARROW[k];
key2: MsgSetFieldHandle ¬ NARROW[data];
RETURN[
SELECT TRUE FROM
NOT key1.msgInfo.hasBeenRead AND key2.msgInfo.hasBeenRead => greater,
key1.msgInfo.hasBeenRead AND NOT key2.msgInfo.hasBeenRead => less,
ENDCASE => CompareDateThenMsg[k, data]];
};
CompareUnreadThenPriorityThenDate: RedBlackTree.Compare ~ {
key1: MsgSetFieldHandle ¬ NARROW[k];
key2: MsgSetFieldHandle ¬ NARROW[data];
RETURN[
SELECT TRUE FROM
NOT key1.msgInfo.hasBeenRead AND key2.msgInfo.hasBeenRead => greater,
key1.msgInfo.hasBeenRead AND NOT key2.msgInfo.hasBeenRead => less,
ENDCASE => ComparePriorityThenDateThenMsg[k, data]];
};
CompareSubjectThenDate: RedBlackTree.Compare ~ {
GetSubjectWithoutRe: PROC [toc: ROPE, startOfSubject: INT] RETURNS [subject: ROPE] ~ {
Strips initial blanks and "re:" from subject.
loc: INT ¬ startOfSubject;
DO
loc ¬ Rope.SkipOver[s: toc, pos: loc, skip: " \t\n\l\r"];
subject ¬ Rope.Substr[base: toc, start: loc];
IF NOT Rope.IsPrefix[prefix: "re:", subject: subject, case: FALSE] THEN EXIT;
loc ¬ loc + 3;
ENDLOOP;
RETURN[subject];
};
key1: MsgSetFieldHandle ¬ NARROW[k];
key2: MsgSetFieldHandle ¬ NARROW[data];
subject1: ROPE ¬ GetSubjectWithoutRe[key1.msgInfo.tocName, key1.msgInfo.startOfSubject];
subject2: ROPE ¬ GetSubjectWithoutRe[key2.msgInfo.tocName, key2.msgInfo.startOfSubject];
RETURN[
SELECT Rope.Compare[subject1, subject2, FALSE] FROM
greater => greater,
less => less,
ENDCASE => CompareDateThenMsg[k, data]];
};
CompareSenderThenDate: RedBlackTree.Compare ~ {
key1: MsgSetFieldHandle ¬ NARROW[k];
key2: MsgSetFieldHandle ¬ NARROW[data];
Note: sender is in the TOC between the date and the subject.
sender1: ROPE ¬ Rope.Substr[base: key1.msgInfo.tocName, start: 10, len: key1.msgInfo.startOfSubject - 10];
sender2: ROPE ¬ Rope.Substr[base: key2.msgInfo.tocName, start: 10, len: key2.msgInfo.startOfSubject - 10];
RETURN[
SELECT Rope.Compare[sender1, sender2, FALSE] FROM
greater => greater,
less => less,
ENDCASE => CompareDateThenMsg[k, data]];
};
Filtering messages
TapRef: TYPE = REF TapFilterRep;
TapFilterRep: TYPE = RECORD[wH: WalnutHandle, annotations: INT ¬ 0];
ReportProgress: TapFilter.MonitorProc = {
[msgID: ROPE, msg: TapMsgQueue.Msg, filterID: ROPE, annot: TapFilter.Annotation] RETURNS [doIt: BOOLEAN ← TRUE]
tR: TapRef ¬ NARROW[clientData];
WalnutWindow.ReportRope[tR.wH, "@"];
tR.annotations ¬ tR.annotations + 1;
};
GetMsgText: PROC [opsH: WalnutOpsHandle, msg: ROPE] RETURNS [ROPE] = {
Adapted from WalnutOpsImpl.GetMsgText.
textStart, textLen: INT;
contents: REF TEXT;
[textStart, textLen, ] ¬ WalnutDB.GetMsgText[opsH, msg];
IF textStart = 0 THEN RETURN[NIL];
IF textLen > RefText.MaxLen-8 THEN textLen ¬ RefText.MaxLen-8;
contents ¬ RefText.New[textLen];
WalnutLog.GetRefTextFromLog[opsH, textStart, textLen, contents];
RETURN[RefText.TrustTextAsRope[contents]];
};
FilterMessages: PROC[wH: WalnutHandle, msgIDs: LIST OF ROPE]
RETURNS [annotations: INT ¬ 0] ~ {
ENABLE TapFilter.Error => {
WalnutWindow.ReportFormat[wH, "Problem with filtering agent: %g - %g.\n", IO.atom[ec], IO.rope[explanation]];
CONTINUE;
};
Get user profile info.
filterDBName: ROPE ¬ UserProfile.Token[key: "WallTapestry.FilterDB", default: NIL];
annotationDBName: ROPE ¬ UserProfile.Token[key: "WallTapestry.AnnotationDB", default: NIL];
tR: TapRef;
IF filterDBName = NIL OR annotationDBName = NIL THEN {
WalnutWindow.Report[wH, "You need to set your WallTapestry.FilterDB and WallTapestry.AnnotationDB user profile entries."];
RETURN[0];
};
Create filtering agent if necessary.
IF refilterAgent = NIL THEN {
refilterFeeder ¬ TapMsgQueue.Create[];
refilterAgent ¬ TapFilter.CreateAgent[feeder: refilterFeeder, filterDB: filterDBName, user: NIL, annotDB: annotationDBName];
IF refilterAgent = NIL THEN RETURN[0];
};
Parse msgs and place on filter queue.
WalnutWindow.ReportRope[wH, "\nAnnotating messages: "];
tR ¬ NEW[TapFilterRep ¬ [wH, 0]];
TapFilter.MonitorAgent[agent: refilterAgent, proc: ReportProgress, clientData: tR];
FOR mL: LIST OF ROPE ¬ msgIDs, mL.rest WHILE mL#NIL DO
msg: ROPE = mL.first;
parsedMsg: TapMsgQueue.Msg;
contents: ROPE ¬ GetMsgText[wH.opsH, msg];
parsedMsg ¬ TapFilter.ParseMsgIntoFields[contents];
feederSeqNum ¬ feederSeqNum + 1;
parsedMsg ¬ CONS[[TapFilter.seqNum, LoganBerryEntry.I2V[feederSeqNum]], parsedMsg];
parsedMsg ¬ CONS[[TapFilter.msgID, msg], parsedMsg];
TapMsgQueue.Put[parsedMsg, refilterFeeder];
ENDLOOP;
Wakeup agent to filter messages and wait until it is finished.
TapFilter.WakeupAgent[refilterAgent];
[] ¬ TapFilter.IsAgentIdle[agent: refilterAgent, wait: TRUE];
WalnutWindow.ReportRope[wH, " done.\n"];
TapFilter.MonitorAgent[agent: refilterAgent, proc: NIL, clientData: NIL];
RETURN[IF tR # NIL THEN tR.annotations ELSE 0];
};
Extra menu procedures
MenuExtras: PUBLIC PROC[menu: ATOM] RETURNS [ops: Menus.MenuEntry] ~ {
Returns a list of operations that can be added to the specified WallTapestry menu. Valid menus include: $main, $msgset, $msgsetops, $msg, and $msgops. A variety of operations might be returned such as ones for creating filters, sorting message sets, highlighting messages, etc. Also returns descriptions for the operations and procedures associated with the operations.
SELECT menu FROM
$main => RETURN[MainExtras[]];
$msgset => RETURN[MsgSetExtras[]];
$msgsetops => RETURN[MsgSetOpsExtras[]];
$msg => RETURN[MsgExtras[]];
$msgops => RETURN[MsgOpsExtras[]];
ENDCASE => RETURN[NIL];
};
Additions to the main menu in a message displayer
MsgExtras: PROC [] RETURNS [ops: Menus.MenuEntry] ~ {
ops ¬ NIL;
ops ¬ Menus.MenuEntryAppend[Menus.CreateEntry[
name: "LikeIt", proc: LikeItProc,
documentation: "Marks the displayed message as interesting"],
ops];
ops ¬ Menus.MenuEntryAppend[Menus.CreateEntry[
name: "HateIt", proc: HateItProc,
documentation: "Marks the displayed message as terribly uninteresting"],
ops];
};
LikeItProc: Menus.MenuProc ~ {
self: Viewer = NARROW[parent];
msgAndwH: WalnutWindowPrivate.MsgAndHandle = NARROW[ViewerOps.FetchProp[self, $WalnutMsgName]];
msg: ROPE = msgAndwH.msg;
wH: WalnutHandle = msgAndwH.wH;
messageID: ROPE = GetMessageID[wH, msg];
anonymous: BOOLEAN ¬ IF mouseButton = blue THEN TRUE ELSE FALSE;
howmuch: INT ¬ SELECT TRUE FROM
shift => 5,
control => 1,
ENDCASE => 3;
IF messageID = NIL THEN {
WalnutWindow.Report[wH, "Cannot find a Message-ID field in the displayed message.\n"];
RETURN;
};
Process.Detach[FORK SendAnnotation[wH, messageID, TRUE, howmuch, anonymous]];
WalnutWindow.ReportFormat[wH, "Like message %g %g\n", [rope[msg]], [rope[messageID]]];
};
HateItProc: Menus.MenuProc ~ {
self: Viewer = NARROW[parent];
msgAndwH: WalnutWindowPrivate.MsgAndHandle = NARROW[ViewerOps.FetchProp[self, $WalnutMsgName]];
msg: ROPE = msgAndwH.msg;
wH: WalnutHandle = msgAndwH.wH;
messageID: ROPE = GetMessageID[wH, msg];
anonymous: BOOLEAN ¬ IF mouseButton = blue THEN TRUE ELSE FALSE;
howmuch: INT ¬ SELECT TRUE FROM
shift => 5,
control => 1,
ENDCASE => 3;
IF messageID = NIL THEN {
WalnutWindow.Report[wH, "Cannot find a Message-ID field in the displayed message.\n"];
RETURN;
};
Process.Detach[FORK SendAnnotation[wH, messageID, FALSE, howmuch, anonymous]];
WalnutWindow.ReportFormat[wH, "Hate message %g %g\n", [rope[msg]], [rope[messageID]]];
};
GetMessageID: PROC [wH: WalnutHandle, msg: ROPE] RETURNS [messageID: ROPE] ~ {
start, end: INT;
contents, header: ROPE;
contents ¬ GetMsgText[wH.opsH, msg];
start ¬ Rope.Find[s1: contents, s2: "Message-ID:", case: FALSE];
IF start < 0 THEN RETURN[NIL];
end ¬ Rope.SkipTo[s: contents, pos: start, skip: "\n\r\l"];
header ¬ Rope.Substr[base: contents, start: start, len: end-start];
start ¬ Rope.Find[s1: header, s2: "<"];
end ¬ Rope.Find[s1: header, s2: ">"];
IF start < 0 OR end < 0 THEN RETURN[NIL];
messageID ¬ Rope.Substr[base: header, start: start, len: end-start+1];
};
SendAnnotation: PROC [wH: WalnutHandle, messageID: ROPE, likeit: BOOLEAN ¬ TRUE, howmuch: INTEGER ¬ 3, anonymous: BOOLEAN ¬ FALSE] RETURNS [] ~ {
contents: ROPE;
sent: BOOL ¬ FALSE;
failureReason: ROPE ¬ "user's identity cannot be determined";
from: ROPE ¬ NIL;
userWantsReplies: BOOL ¬ UserProfile.Boolean[key: "WallTapestry.WantReplyToAnnotation", default: FALSE];
contents ¬ IO.PutFR["Annotate\nmessage-ID: %s\nclass: %s\ncomments(optional): \nwhy(optional): \nhowmuch(optional): %s\n", [rope[messageID]], [rope[IF likeit THEN "likeit" ELSE "hateit"]], [integer[howmuch]]];
IF anonymous OR NOT userWantsReplies THEN
contents ¬ Rope.Concat["NoReply\n", contents];
IF NOT anonymous THEN {
credentials: LIST OF MailUtils.Credentials ¬ MailUtils.GetUserCredentials[];
IF credentials # NIL THEN
from ¬ credentials.first.rName.name;
};
[sent, failureReason] ¬ SimpleMailer.SendMessage[from: from, to: LIST[[ns: $xns, name: "TapestryServer:PARC:Xerox"]], subject: "Annotation from WallTapestry", body: contents];
IF NOT sent THEN
WalnutWindow.ReportFormat[wH, "Annotation NOT sent to TapestryServer because %g\n", [rope[failureReason]]];
};
Additions to the MsgOps menu in a message displayer
MsgOpsExtras: PROC [] RETURNS [ops: Menus.MenuEntry] ~ {
ops ¬ NIL;
ops ¬ Menus.MenuEntryAppend[Menus.CreateEntry[
name: "Explain Msg's Priority", proc: ExplainMsgProc,
documentation: "Which appraisers assigned priorities to the selected msg(s)?"],
ops];
ops ¬ Menus.MenuEntryAppend[Menus.CreateEntry[
name: "Highlight Msg's Priority", proc: HighlightMsgProc,
documentation: "Highlight those portions of the message that contributed to its priority"],
ops];
ops ¬ Menus.MenuEntryAppend[Menus.CreateEntry[
name: "Highlight Keywords", proc: HighlightKeywordsProc,
documentation: "Highlight selected keywords in the displayed message"],
ops];
};
ExplainMsgProc: Menus.MenuProc ~ {
self: Viewer = NARROW[parent];
msgAndwH: WalnutWindowPrivate.MsgAndHandle = NARROW[ViewerOps.FetchProp[self, $WalnutMsgName]];
msg: ROPE = msgAndwH.msg;
wH: WalnutHandle = msgAndwH.wH;
ReportAnnotations[wH, msg];
};
HighlightMsgProc: Menus.MenuProc ~ {
self: Viewer = NARROW[parent];
msgAndwH: WalnutWindowPrivate.MsgAndHandle = NARROW[ViewerOps.FetchProp[self, $WalnutMsgName]];
msg: ROPE = msgAndwH.msg;
wH: WalnutHandle = msgAndwH.wH;
filterDBName: ROPE ¬ UserProfile.Token[key: "WallTapestry.FilterDB", default: NIL];
note: TapFilter.Annotation;
fids: LIST OF ROPE;
highlights: LIST OF ROPE;
note ¬ TapFilter.GetAnnotations[annotDB: annotationDBName, msgID: msg];
IF note = NIL THEN {
WalnutWindow.ReportFormat[wH, "\nNo annotations for message %g\n", [rope[msg]]];
RETURN;
};
fids ¬ LoganBerryEntry.GetAllAttrs[note, $FID];
highlights ¬ NIL;
FOR l: LIST OF ROPE ¬ fids, l.rest WHILE l # NIL DO
fid: ROPE ¬ l.first;
query: ROPE ¬ TapFilter.LookupFilter[filterDB: filterDBName, filterID: fid].query;
highlights ¬ GetQueryKeywords[query, highlights, wH];
ENDLOOP;
ViewerTools.EnableUserEdits[self];
HighlightTioga[self, highlights];
ViewerTools.InhibitUserEdits[self];
};
HighlightKeywordsProc: Menus.MenuProc ~ {
self: Viewer = NARROW[parent];
msgAndwH: WalnutWindowPrivate.MsgAndHandle = NARROW[ViewerOps.FetchProp[self, $WalnutMsgName]];
msg: ROPE = msgAndwH.msg;
wH: WalnutHandle = msgAndwH.wH;
highlights: LIST OF ROPE;
selection: ROPE ¬ ViewerTools.GetSelectionContents[];
IF Rope.Length[selection] < 1 THEN {
WalnutWindow.ReportRope[wH, "\nPlease select some words to highlight.\n"];
RETURN;
};
highlights ¬ GetKeywords[selection, NIL];
ViewerTools.EnableUserEdits[self];
HighlightTioga[self, highlights];
ViewerTools.InhibitUserEdits[self];
};
GetQueryKeywords: PROC [rope: ROPE, list: LIST OF ROPE, wH: WalnutHandle] RETURNS [new: LIST OF ROPE] ~ {
GetNodeKeywords: PROC [node: LoganQuery.ParseTree, list: LIST OF ROPE] RETURNS [new: LIST OF ROPE] ~ {
new ¬ list;
IF node.tag = $ap THEN {
new ¬ CONS[Rope.Concat[Atom.GetPName[node.ap.attr.type], ":"], new];
new ¬ GetKeywords[node.ap.attr.value, new];
RETURN[new];
};
IF node.child1 # NIL THEN
new ¬ GetNodeKeywords[node.child1, new];
IF node.child2 # NIL THEN
new ¬ GetNodeKeywords[node.child1, new];
RETURN[new];
};
s: IO.STREAM ¬ IO.RIS[rope];
parseTree: LoganQuery.ParseTree ¬ NIL;
parseTree ¬ LoganQuery.ParseBooleanQuery[s ! LoganQuery.SyntaxError => CONTINUE];
IF parseTree = NIL THEN {
WalnutWindow.ReportFormat[wH, "\nNot a valid query: %g\n", [rope[rope]]];
RETURN[NIL];
};
new ¬ GetNodeKeywords[parseTree, list];
};
GetKeywords: PROC [rope: ROPE, list: LIST OF ROPE] RETURNS [new: LIST OF ROPE] ~ {
Alphanumerics: IO.BreakProc ~ {
RETURN[SELECT char FROM
IN ['A..'Z], IN ['a..'z], IN ['0..'9] => other,
ENDCASE => sepr];
};
s: IO.STREAM ¬ IO.RIS[rope];
word: ROPE ¬ NIL;
new ¬ list;
WHILE NOT IO.EndOf[s] DO
word ¬ IO.GetTokenRope[s, Alphanumerics ! IO.EndOfStream => CONTINUE].token;
IF word = NIL THEN EXIT;
IF Rope.Length[word] > 1 THEN
new ¬ CONS[word, new];
ENDLOOP;
};
HighlightTioga: PROC [viewer: Viewer, highlights: LIST OF ROPE] RETURNS [] ~ {
root: TiogaOps.Ref = TiogaOps.ViewerDoc[viewer];
highlightProp: ROPE = "10 pt backgroundAscent 4 pt backgroundDescent 1 outlineBoxBearoff \"xerox/research/distinct/yellow\" backgroundNamedColor";
highlightProp: ROPE = "10 pt backgroundAscent 4 pt backgroundDescent 0.95 backgroundBrightness .95 backgroundSaturation .175 backgroundHue 1 outlineBoxBearoff";
HT: PROC [root: TiogaOps.Ref] ~ {
FOR hList: LIST OF ROPE ¬ highlights, hList.rest WHILE hList#NIL DO
word: ROPE = hList.first;
found: BOOLEAN ¬ TRUE;
TiogaOps.SelectPoint[viewer: viewer, caret: [node: TiogaOps.StepForward[root], where: 0], which: $feedback];
WHILE found DO
found ¬ TiogaOps.FindText[viewer: viewer, rope: word, case: FALSE, which: $feedback];
IF found THEN {
This assumes that the selection does not extend across nodes.
start, end: TiogaOps.Location;
start ¬ TiogaOps.GetSelection[which: $feedback].start;
end ¬ TiogaOps.GetSelection[which: $feedback].end;
TextEdit.PutCharProp[node: start.node, index: start.where, nChars: end.where-start.where+1, root: root, name: $Postfix, value: highlightProp];
};
ENDLOOP;
ENDLOOP;
ViewerOps.PaintViewer[viewer: viewer, hint: $client]; -- so new char props are seen
};
TiogaOps.CallWithLocks[proc: HT, root: root]; -- causes lock up?
HT[root];
};
Additions to the main menu in a message set displayer
MsgSetExtras: PROC [] RETURNS [ops: Menus.MenuEntry] ~ {
ops ¬ Menus.CreateEntry[
name: "SortBy", proc: SortProc,
documentation: "Sort messages within this message set in the chosen order"];
};
SortProc: Menus.MenuProc = {
viewer: Viewer = NARROW[parent];
msI: MsgSetInfo = NARROW[ViewerOps.FetchProp[viewer, $MsgSetInfo]];
wH: WalnutHandle = msI.button.wH;
desiredOrder: ATOM ¬ NIL;
which: INT =
PopUpSelection.Request[
header: "SortBy",
choice: sortChoices,
choiceDoc: sortDocs,
default: 1];
possibleOrders: LIST OF ATOM ¬ sortAtoms;
i: INT ¬ 1;
WHILE possibleOrders # NIL DO
IF i = which THEN {
desiredOrder ¬ possibleOrders.first;
EXIT;
};
i ¬ i + 1;
possibleOrders ¬ possibleOrders.rest;
ENDLOOP;
IF desiredOrder # NIL THEN {
msI.sortby ¬ desiredOrder;
msI.button.msgSet.version ¬ msI.button.msgSet.version + 1;
msI.container ¬ WalnutInternal.QDisplayMsgSet[wH: wH, msb: msI.button, oldV: msI.container, shift: FALSE];
};
};
Additions to the MsgOps menu in a message set displayer
MsgSetOpsExtras: PROC [] RETURNS [ops: Menus.MenuEntry] ~ {
ops ¬ NIL;
ops ¬ Menus.MenuEntryAppend[Menus.CreateEntry[
name: "Explain Msg's Priority", proc: ExplainProc,
documentation: "Which appraisers assigned priorities to the selected msg(s)?"],
ops];
ops ¬ Menus.MenuEntryAppend[Menus.CreateEntry[
name: "Reappraise Selected Msg(s)", proc: RefilterSelectedProc,
documentation: "Apply appraisers to the selected message(s) and then redisplay message set"],
ops];
ops ¬ Menus.MenuEntryAppend[Menus.CreateEntry[
name: "Reappraise MsgSet", proc: RefilterMsgSetProc,
documentation: "Apply appraisers to all message(s) in this message set and then redisplay it"],
ops];
};
ExplainProc: Menus.MenuProc ~ {
viewer: Viewer = NARROW[parent];
msI: MsgSetInfo = NARROW[ViewerOps.FetchProp[viewer, $MsgSetInfo]];
wH: WalnutHandle = msI.button.wH;
IF msI = NIL OR msI.selected = NIL THEN { WalnutWindow.Report[wH, "No selected messages"]; RETURN };
FOR selList: LIST OF MsgSetFieldHandle ¬ msI.selected, selList.rest
WHILE selList#NIL DO
selected: MsgSetFieldHandle ¬ selList.first;
ReportAnnotations[wH, selected.msgInfo.msg];
ENDLOOP;
};
ReportAnnotations: PROC [wH: WalnutHandle, msg: ROPE] ~ {
note: TapFilter.Annotation;
note ¬ TapFilter.GetAnnotations[annotDB: annotationDBName, msgID: msg];
IF note = NIL
THEN WalnutWindow.ReportFormat[wH, "\nNo annotations for message %g\n", [rope[msg]]]
ELSE {
WalnutWindow.ReportFormat[wH, "\nAnnotations for message %g:\n", [rope[msg]]];
FOR l: TapFilter.Annotation ¬ note.rest, l.rest WHILE l # NIL DO
SELECT l.first.type FROM
$FID => WalnutWindow.ReportFormat[wH, " appraiser %g => ", [rope[l.first.value]]];
$Level, $level => WalnutWindow.ReportFormat[wH, "priority %g\n", [rope[l.first.value]]];
ENDCASE => NULL;
ENDLOOP;
};
};
RefilterSelectedProc: Menus.MenuProc ~ {
viewer: Viewer = NARROW[parent];
msI: MsgSetInfo = NARROW[ViewerOps.FetchProp[viewer, $MsgSetInfo]];
wH: WalnutHandle = msI.button.wH;
msgIDs: LIST OF ROPE ¬ NIL;
IF msI = NIL OR msI.selected = NIL THEN { WalnutWindow.Report[wH, "No selected messages"]; RETURN };
FOR selList: LIST OF MsgSetFieldHandle ¬ msI.selected, selList.rest WHILE selList#NIL DO
msgIDs ¬ CONS[selList.first.msgInfo.msg, msgIDs];
ENDLOOP;
Note: Should really clear the existing annotations before refiltering the messages.
[] ¬ FilterMessages[wH, msgIDs];
msI.button.msgSet.version ¬ msI.button.msgSet.version + 1;
msI.container ¬ WalnutInternal.QDisplayMsgSet[wH: wH, msb: msI.button, oldV: msI.container, shift: FALSE];
};
RefilterMsgSetProc: Menus.MenuProc ~ {
viewer: Viewer = NARROW[parent];
msI: MsgSetInfo = NARROW[ViewerOps.FetchProp[viewer, $MsgSetInfo]];
wH: WalnutHandle = msI.button.wH;
msgIDs: LIST OF ROPE ¬ NIL;
mfh: MsgSetFieldHandle ¬ msI.lastMFH;
WHILE mfh#NIL DO
msgIDs ¬ CONS[mfh.msgInfo.msg, msgIDs];
mfh ¬ mfh.prev;
ENDLOOP;
Note: Should really clear the existing annotations before refiltering the messages.
[] ¬ FilterMessages[wH, msgIDs];
msI.button.msgSet.version ¬ msI.button.msgSet.version + 1;
msI.container ¬ WalnutInternal.QDisplayMsgSet[wH: wH, msb: msI.button, oldV: msI.container, shift: FALSE];
};
Additions to Walnut's main menu
MainExtras: PROC [] RETURNS [ops: Menus.MenuEntry] ~ {
ops ¬ Menus.CreateEntry[
name: "Appraisers", proc: FiltersProc,
documentation: "Operations for creating and manipulating appraisers"];
};
FiltersProc: Menus.MenuProc = {
wH: WalnutHandle = NARROW[clientData];
filterDBName: ROPE ¬ UserProfile.Token[key: "WallTapestry.FilterDB", default: NIL];
which: INT =
PopUpSelection.Request[
header: "Filter operations",
choice: LIST[
"Add Appraiser",
"List Appraisers",
"Show Appraiser",
"Delete Appraiser",
"Re-read Appraiser Database"],
choiceDoc: LIST[
"Add appraiser where query is based on current selection",
"List all appraisers whose query includes the current selection",
"Print information about the appraiser named in the current selection",
"Delete the appraiser named in the current selection",
"Restart the appraiser agent after new appraisers have been added to the database"],
default: 1
];
IF filterDBName = NIL THEN {
WalnutWindow.Report[wH, "No WallTapestry.FilterDB user profile entry."];
RETURN;
};
BEGIN
ENABLE TapFilter.Error => {
WalnutWindow.ReportFormat[wH, "Problem with filter database: %g - %g.\n", IO.atom[ec], IO.rope[explanation]];
CONTINUE;
};
SELECT which FROM
1 => AddFilterProc[wH, filterDBName];
2 => ListFiltersProc[wH, filterDBName];
3 => FilterInfoProc[wH, filterDBName];
4 => DeleteFilterProc[wH, filterDBName];
5 => RestartFilterAgentProc[wH, filterDBName];
ENDCASE => NULL;
END;
};
AddFilterProc: PROC[wH: WalnutHandle, filterDBName: ROPE] = {
ReplaceBlanks: Rope.TranslatorType = {
[old: CHAR] RETURNS [new: CHAR]
RETURN[SELECT old FROM
' , '\t => '←,
ENDCASE => old];
};
Lower: Rope.TranslatorType = {
[old: CHAR] RETURNS [new: CHAR]
RETURN [Ascii.Lower[old]];
};
ListNth: PROC [list: LIST OF ROPE, itemNum: CARD] RETURNS [nth: ROPE ¬ NIL] ~ {
i: CARD ¬ 0;
FOR l: LIST OF ROPE ¬ list, l.rest WHILE l # NIL DO
i ¬ i + 1;
IF i = itemNum THEN RETURN[l.first];
ENDLOOP;
};
levelChoices: LIST OF ROPE ¬ LIST["5", "10", "15", "20", "25", "30", "35", "40", "45", "50", "55", "60", "65", "70", "75", "80", "85", "90", "95"];
text: ROPE ¬ ViewerTools.GetSelectionContents[];
query, name, user: ROPE;
level: INT;
annot: TapFilter.Annotation;
pos, start: INT;
pos ¬ Rope.Find[text, ":"];
IF pos < 0 THEN {
WalnutWindow.Report[wH, "Current selection must be of the form: \"field: value\"."];
RETURN;
};
start ¬ Rope.SkipOver[s: text, pos: pos+1, skip: " \t*"];
query ¬ Rope.Translate[base: Rope.Substr[base: text, len: pos], translator: Lower];
query ¬ Rope.Cat[query, "(wildcard): \"*", Rope.Substr[base: text, start: start, len: Rope.Length[text]-start], "*\""];
name ¬ Rope.Replace[base: text, start: pos+1, len: start-pos-1, with: NIL];
name ¬ Rope.Translate[base: name, translator: ReplaceBlanks];
user ¬ SystemNames.UserName[];
level ¬ PopUpSelection.Request[header: "Select priority level", choice: levelChoices];
IF level <= 0 THEN {
WalnutWindow.ReportFormat[wH, "No priority level selected so appraiser not added.\n"];
RETURN;
};
annot ¬ LIST[[$Level, ListNth[levelChoices, level]]];
[] ¬ TapFilter.AddFilter[filterDB: filterDBName, user: user, filterName: name, query: query, annot: annot, agent: wH.opsH.filterAgent];
IF refilterAgent # NIL THEN { -- terminate refiltering agent
TapFilter.TerminateAgent[agent: refilterAgent];
refilterAgent ¬ NIL;
};
WalnutWindow.ReportRope[wH, "\nAdded "];
PrintFilterInfo[wH, name, user, query, annot];
};
ListFiltersProc: PROC[wH: WalnutHandle, filterDBName: ROPE] = {
text: ROPE ¬ ViewerTools.GetSelectionContents[];
filters: LIST OF TapFilter.FilterInfo;
WalnutWindow.ReportFormat[wH, "Appraisers that mention \"%g\": ", [rope[text]]];
filters ¬ TapFilter.LookupAllFilters[filterDBName];
FOR l: LIST OF TapFilter.FilterInfo ¬ filters, l.rest WHILE l # NIL DO
IF Rope.Find[s1: l.first.query, s2: text, case: FALSE] >= 0 THEN
WalnutWindow.ReportFormat[wH, "%g$%g ", [rope[l.first.user]], [rope[l.first.filterName]]];
ENDLOOP;
WalnutWindow.Report[wH, "."];
};
FilterInfoProc: PROC[wH: WalnutHandle, filterDBName: ROPE] = {
filter: ROPE ¬ ViewerTools.GetSelectionContents[];
name, user, query: ROPE;
annot: TapFilter.Annotation;
[name, user, query, annot] ¬ TapFilter.LookupFilter[filterDB: filterDBName, filterID: filter];
IF name = NIL THEN {
WalnutWindow.ReportFormat[wH, "No appraiser named %g.\n", [rope[filter]]];
RETURN;
};
WalnutWindow.Report[wH, ""];
PrintFilterInfo[wH, name, user, query, annot];
};
DeleteFilterProc: PROC[wH: WalnutHandle, filterDBName: ROPE] = {
filter: ROPE ¬ ViewerTools.GetSelectionContents[];
TapFilter.DeleteFilter[filterDB: filterDBName, filterID: filter, agent: wH.opsH.filterAgent];
IF refilterAgent # NIL THEN { -- terminate refiltering agent
TapFilter.TerminateAgent[agent: refilterAgent];
refilterAgent ¬ NIL;
};
WalnutWindow.ReportFormat[wH, "Deleted appraiser %g.\n", [rope[filter]]];
};
RestartFilterAgentProc: PROC[wH: WalnutHandle, filterDBName: ROPE] = {
annotationDBName: ROPE ¬ UserProfile.Token[key: "WallTapestry.AnnotationDB", default: NIL];
IF refilterAgent # NIL THEN { -- terminate refiltering agent
TapFilter.TerminateAgent[agent: refilterAgent];
refilterAgent ¬ NIL;
};
TapFilter.TerminateAgent[agent: wH.opsH.filterAgent];
IF NOT TapFilter.IsAgentIdle[agent: wH.opsH.filterAgent, wait: FALSE] THEN {
Must wait for old filter agent to stop since we re-use the feeder
WalnutWindow.ReportRope[wH, "Appraiser agent is currently busy. Waiting for it to finish...\n"];
[] ¬ TapFilter.IsAgentIdle[agent: wH.opsH.filterAgent, wait: TRUE];
};
wH.opsH.filterAgent ¬ TapFilter.CreateAgent[feeder: wH.opsH.filterFeeder, filterDB: filterDBName, user: NIL, annotDB: annotationDBName];
WalnutWindow.ReportRope[wH, "Restarted appraiser agent.\n"];
};
PrintFilterInfo: PROC [wH: WalnutHandle, name, user, query: ROPE, annot: TapFilter.Annotation] ~ {
WalnutWindow.ReportFormat[wH, "Appraiser: %g$%g\n", [rope[user]], [rope[name]]];
WalnutWindow.ReportFormat[wH, " query: %g\n", [rope[query]]];
WalnutWindow.ReportRope[wH, " annotations: "];
FOR l: TapFilter.Annotation ¬ annot, l.rest WHILE l # NIL DO
WalnutWindow.ReportRope[wH, IO.PutFR["%g: \"%g\" ", IO.rope[Atom.GetPName[l.first.type]], IO.rope[l.first.value]]];
ENDLOOP;
WalnutWindow.Report[wH, "\n"];
};
User profile entries
WhenProfileChanges: UserProfile.ProfileChangedProc = {
userWantsPriority ¬ UserProfile.Boolean[key: "WallTapestry.DisplayPriority", default: FALSE];
annotationDBName ¬ UserProfile.Token[key: "WallTapestry.AnnotationDB", default: NIL];
defaultILevel ¬ UserProfile.Number[key: "WallTapestry.DefaultPriority", default: 50];
};
Initializations
UserProfile.CallWhenProfileChanges[WhenProfileChanges];
END.