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
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];
};
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 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"];
};