(FILECREATED " 7-Oct-86 18:41:35" {ERIS}<LAFITE>SOURCES>LAFITEFIND.;6 19168
changes to: (VARS LAFITEFINDCOMS LAFITEEXTRAMENUITEMS)
previous date: "25-Feb-86 14:52:09" {ERIS}<LAFITE>SOURCES>LAFITEFIND.;5)
(* "
Copyright (c) 1984, 1985, 1986 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT LAFITEFINDCOMS)
(RPAQQ LAFITEFINDCOMS ((FNS \LAFITE.FIND \LAFITE.FIND.RELATED \LAFITE.FIND.RELATED.BACKWARD
\LAFITE.FIND.AGAIN \LAFITE.FIND.PROMPT \LAFITE.DO.FIND \LAFITE.FIND.START
LAFITEEXTRABROWSERCOMMANDFN)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS SEARCHSTATE)
(GLOBALVARS LAFITEFINDAREAMENUITEMS LAFITEEXTRAMENUITEMS
LAFITEFINDTYPEMENUITEMS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU
LAFITEEXTRAMENU LAFITEEXTRAMENUFLG \LAFITE.LAST.SEARCH)
(FILES (SOURCE)
LAFITEDECLS))
(INITVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU LAFITEEXTRAMENU)
(VARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS LAFITEEXTRAMENUITEMS)
(VARS (LAFITEEXTRAMENUFLG T)
(\LAFITE.LAST.SEARCH))))
(DEFINEQ
(\LAFITE.FIND
[LAMBDA (MAILFOLDER) (* bvm: "25-Feb-86 14:29")
(* Invoked by Find command)
(PROG (SEARCHDIRECTION SEARCHAREA SEARCHSTRING)
(OR [SETQ SEARCHDIRECTION
(MENU (OR LAFITEFINDTYPEMENU
(SETQ LAFITEFINDTYPEMENU
(create MENU
ITEMS ← LAFITEFINDTYPEMENUITEMS
MENUFONT ← LAFITEMENUFONT
CENTERFLG ← T]
(RETURN))
(OR [SETQ SEARCHAREA
(MENU (OR LAFITEFINDAREAMENU
(SETQ LAFITEFINDAREAMENU
(create MENU
ITEMS ← LAFITEFINDAREAMENUITEMS
MENUFONT ← LAFITEMENUFONT
CENTERFLG ← T]
(RETURN))
(COND
((EQ SEARCHAREA (QUOTE Related))
[SETQ SEARCHSTRING (fetch (LAFITEMSG SUBJECT) of (NTHMESSAGE (fetch MESSAGEDESCRIPTORS
of MAILFOLDER)
(fetch LASTSELECTEDMESSAGE
of MAILFOLDER]
[COND
((STRING-EQUAL (SUBSTRING SEARCHSTRING 1 4)
"Re: ")
(SETQ SEARCHSTRING (SUBSTRING SEARCHSTRING 5]
(SETQ SEARCHAREA (QUOTE Subject)))
((SETQ SEARCHSTRING (\LAFITE.FIND.PROMPT MAILFOLDER SEARCHAREA)))
(T (RETURN)))
(\LAFITE.DO.FIND MAILFOLDER (CAR SEARCHDIRECTION)
SEARCHAREA SEARCHSTRING NIL (EQ (CADR SEARCHDIRECTION)
(QUOTE ALL])
(\LAFITE.FIND.RELATED
[LAMBDA (MAILFOLDER DIRECTION) (* bvm: "25-Feb-86 12:42")
(* * Find message that shares subject with this one.)
(OR DIRECTION (SETQQ DIRECTION FORWARD))
(LET* [(FROM# (\LAFITE.FIND.START MAILFOLDER DIRECTION))
(SEARCHSTRING (fetch (LAFITEMSG SUBJECT) of (NTHMESSAGE (fetch MESSAGEDESCRIPTORS
of MAILFOLDER)
FROM#]
(COND
((OR (NULL SEARCHSTRING)
(EQ (NCHARS SEARCHSTRING)
0))
(LAB.PROMPTPRINT MAILFOLDER " can't--message has no Subject"))
(T [COND
((STRING-EQUAL (SUBSTRING SEARCHSTRING 1 4)
"Re: ")
(SETQ SEARCHSTRING (SUBSTRING SEARCHSTRING 5]
(\LAFITE.DO.FIND MAILFOLDER DIRECTION (QUOTE Subject)
SEARCHSTRING FROM# T T])
(\LAFITE.FIND.RELATED.BACKWARD
[LAMBDA (MAILFOLDER) (* bvm: " 5-Mar-84 17:28")
(\LAFITE.FIND.RELATED MAILFOLDER (QUOTE BACKWARD])
(\LAFITE.FIND.AGAIN
[LAMBDA (MAILFOLDER) (* bvm: "25-Feb-86 12:42")
(LET ((LASTSEARCH \LAFITE.LAST.SEARCH))
(COND
(LASTSEARCH (\LAFITE.DO.FIND MAILFOLDER (fetch SEARCHDIRECTION of LASTSEARCH)
(fetch SEARCHAREA of LASTSEARCH)
(fetch SEARCHSTRING of LASTSEARCH)))
(T (\LAFITE.FIND MAILFOLDER])
(\LAFITE.FIND.PROMPT
[LAMBDA (MAILFOLDER SEARCHAREA) (* bvm: "25-Feb-86 14:36")
(* * prompt for search string for a search of the indicated area.
Return NIL if aborted.)
(RESETLST (LET ((WINDOW (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER))
(LASTSEARCH \LAFITE.LAST.SEARCH)
RESULT)
(CLEARW WINDOW)
(RESETSAVE NIL (LIST [FUNCTION (LAMBDA (W)
(COND
(RESETSTATE (printout W "...aborted"]
WINDOW))
(RESETSAVE NIL (LIST (FUNCTION WINDOWPROP)
WINDOW
(QUOTE PROCESS)
NIL))
(COND
([COND
((EQ SEARCHAREA (QUOTE Mark))
(LAB.PROMPTPRINT MAILFOLDER T "Find message marked: ")
(RESETSAVE (TTYDISPLAYSTREAM WINDOW))
(LESSP (SETQ RESULT (\GETKEY))
(CHARCODE SPACE)))
(T (NULL (SETQ RESULT (PROMPTFORWORD (CONCAT "Find " SEARCHAREA " string: "
)
(AND LASTSEARCH (NOT (fetch SEARCHREPLYTO
of LASTSEARCH))
(EQ SEARCHAREA (fetch SEARCHAREA
of LASTSEARCH))
(fetch SEARCHSTRING of LASTSEARCH))
NIL WINDOW NIL NIL (CHARCODE (CR ESC]
(ERROR!)))
RESULT])
(\LAFITE.DO.FIND
[LAMBDA (MAILFOLDER DIRECTION AREA SEARCHSTRING FROM# ALLFLG REPLYTO?)
(* bvm: "25-Feb-86 14:41")
(PROG ((MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))
(LASTMSG# (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER))
MSG MSG# ADDFLG #FOUND FIRSTFOUND# INSTREAM CURRENT LASTSEL MARK)
(SELECTQ AREA
(Body (ALLOW.BUTTON.EVENTS) (* Could take a while)
(SETQ INSTREAM (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE INPUT))))
(Mark (SETQ SEARCHSTRING (UCASECODE SEARCHSTRING)))
NIL)
[COND
((NOT FROM#)
(SETQ FROM# (\LAFITE.FIND.START MAILFOLDER DIRECTION]
(SETQ MSG# (COND
(ALLFLG (* Be sure to include starting
message, assuming it matches)
(SELECTQ DIRECTION
(FORWARD (SUB1 FROM#))
(ADD1 FROM#)))
(T FROM#)))
LP [until (SELECTQ DIRECTION
(FORWARD (IGREATERP (add MSG# 1)
LASTMSG#))
(ILEQ (add MSG# -1)
0))
do (SETQ MSG (NTHMESSAGE MESSAGES MSG#))
(COND
((SELECTQ AREA
(From (* Include the To: field in messages
from self)
(OR (STRPOS SEARCHSTRING (fetch (LAFITEMSG FROM) of MSG)
1 NIL NIL NIL UPPERCASEARRAY)
(AND (fetch (LAFITEMSG MSGFROMMEP) of MSG)
(STRPOS SEARCHSTRING (fetch (LAFITEMSG TO) of MSG)
1 NIL NIL NIL UPPERCASEARRAY))))
(Subject (STRPOS SEARCHSTRING (fetch (LAFITEMSG SUBJECT) of MSG)
1 NIL NIL NIL UPPERCASEARRAY))
(Body (FILEPOS SEARCHSTRING INSTREAM (fetch (LAFITEMSG START) of MSG)
(fetch (LAFITEMSG END) of MSG)
NIL NIL UPPERCASEARRAY))
(Mark (OR (EQ (SETQ MARK (fetch (LAFITEMSG MARKCHAR) of MSG))
SEARCHSTRING)
(EQ (UCASECODE MARK)
SEARCHSTRING)))
(SHOULDNT))
(COND
((NOT ADDFLG)
(UNSELECTALLMESSAGES MAILFOLDER)
(SETQ ADDFLG T)))
(LA.SELECTRANGE MAILFOLDER MSG# MSG# T)
(LA.SHOW.SELECTION MAILFOLDER MSG (QUOTE REPLACE))
(COND
((NOT #FOUND)
(SETQ #FOUND 1)
(COND
((NOT ALLFLG)
(LAB.PROMPTPRINT MAILFOLDER "Found in message " MSG#)
(LAB.EXPOSEMESSAGE MAILFOLDER MSG)
(RETURN)))
(SETQ FIRSTFOUND# MSG#))
(T (add #FOUND 1]
[COND
[(OR (NULL #FOUND)
(AND (EQ #FOUND 1)
(EQ FIRSTFOUND# FROM#))) (* Didn't find it, or found it only in
the starting message
(in the case of ALLFLG))
(COND
(REPLYTO? (LAB.PROMPTPRINT MAILFOLDER "No related message found"))
(T (LAB.PROMPTPRINT MAILFOLDER "%"" (COND
((FIXP SEARCHSTRING)
(CHARACTER SEARCHSTRING))
(T SEARCHSTRING))
"%" not found"]
(ALLFLG (* Multiple find)
(LAB.PROMPTPRINT MAILFOLDER "Found in " #FOUND " messages")
(LAB.EXPOSEMESSAGE MAILFOLDER
(NTHMESSAGE MESSAGES (COND
[(AND (SETQ CURRENT (fetch (MAILFOLDER
CURRENTDISPLAYEDMESSAGE
) of MAILFOLDER)
)
(fetch (LAFITEMSG SELECTED?) of CURRENT))
(* Scroll to message that would be
displayed if user clicked "Display"
now)
(COND
((EQ (fetch (LAFITEMSG #) of CURRENT)
(SETQ LASTSEL (fetch (MAILFOLDER
LASTSELECTEDMESSAGE
)
of MAILFOLDER)))
(* Currently displaying the last one,
so cycle back to first)
(fetch (MAILFOLDER FIRSTSELECTEDMESSAGE)
of MAILFOLDER))
(T (LAB.FIND.SELECTED.MSG
MAILFOLDER
(ADD1 (fetch (LAFITEMSG #) of CURRENT))
LASTSEL]
(T (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE)
of MAILFOLDER]
(SETQ \LAFITE.LAST.SEARCH
(create SEARCHSTATE
SEARCHSTRING ← SEARCHSTRING
SEARCHDIRECTION ← DIRECTION
SEARCHAREA ← AREA
SEARCHREPLYTO ← REPLYTO?])
(\LAFITE.FIND.START
[LAMBDA (MAILFOLDER DIRECTION) (* bvm: "25-Feb-86 12:33")
(* Return the message to start searching from.
Forward searches start from last selected message, backward from first.
However, if that message is not visible, but some other message is, start from
the visible message and print warning)
(LET ((LAST# (fetch LASTSELECTEDMESSAGE of MAILFOLDER))
(FIRST# (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER))
VIS)
(LAB.PROMPTPRINT MAILFOLDER T "Searching")
(COND
([AND (NEQ LAST# FIRST#)
(SELECTQ DIRECTION
(BACKWARD (LESSP (SETQ LAST# FIRST#)
(SETQ VIS (FIRSTVISIBLEMESSAGE MAILFOLDER))))
(GREATERP LAST# (SETQ VIS (LASTVISIBLEMESSAGE MAILFOLDER]
(* Extreme selected message not
visible, so tell user where search
will start)
(COND
((SETQ VIS (SELECTQ DIRECTION
(BACKWARD (LAB.FIND.SELECTED.MSG MAILFOLDER VIS (LASTVISIBLEMESSAGE
MAILFOLDER)))
(LAB.REV.FIND.SELECTED.MSG MAILFOLDER (FIRSTVISIBLEMESSAGE MAILFOLDER)
VIS)))
(SETQ LAST# VIS)))
(LAB.PROMPTPRINT MAILFOLDER " from msg " LAST#)))
(LAB.PROMPTPRINT MAILFOLDER (QUOTE ...))
LAST#])
(LAFITEEXTRABROWSERCOMMANDFN
[LAMBDA (WINDOW MAILFOLDER) (* bvm: " 5-Mar-84 15:39")
(PROG [(FN (MENU (.LAFITEMENU. LAFITEEXTRAMENU LAFITEEXTRAMENUITEMS]
(COND
(FN (APPLY* FN MAILFOLDER])
)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD SEARCHSTATE (SEARCHSTRING SEARCHDIRECTION SEARCHAREA SEARCHREPLYTO))
]
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS LAFITEFINDAREAMENUITEMS LAFITEEXTRAMENUITEMS LAFITEFINDTYPEMENUITEMS LAFITEFINDTYPEMENU
LAFITEFINDAREAMENU LAFITEEXTRAMENU LAFITEEXTRAMENUFLG \LAFITE.LAST.SEARCH)
)
(FILESLOAD (SOURCE)
LAFITEDECLS)
)
(RPAQ? LAFITEFINDTYPEMENU NIL)
(RPAQ? LAFITEFINDAREAMENU NIL)
(RPAQ? LAFITEEXTRAMENU NIL)
(RPAQQ LAFITEFINDAREAMENUITEMS ((From (QUOTE From)
"Search From: field for string (or To: if from self)")
(Subject (QUOTE Subject)
"Search Subject: field for string")
(Body (QUOTE Body)
"Search message bodies for string")
(Mark (QUOTE Mark)
"Search for messages with specified mark character")
(Related (QUOTE Related)
"Search for a message with same Subject, modulo Re:")))
(RPAQQ LAFITEFINDTYPEMENUITEMS (("Find Next One" (QUOTE (FORWARD ONE))
"Search forward from selected message")
("Find Next All" (QUOTE (FORWARD ALL))
"Search forward from selected message")
("Find Previous One" (QUOTE (BACKWARD ONE))
"Search backward from selected message")
("Find Previous All" (QUOTE (BACKWARD ALL))
"Search backward from selected message")))
(RPAQQ LAFITEEXTRAMENUITEMS (("Find" (QUOTE \LAFITE.FIND)
"Search mail for something")
["Find Related" (QUOTE \LAFITE.FIND.RELATED)
"Find all messages from here on in reply to this message"
(SUBITEMS ("Find Related Forward" (QUOTE \LAFITE.FIND.RELATED))
("Find Related Backward" (QUOTE
\LAFITE.FIND.RELATED.BACKWARD
]
("Find Again" (QUOTE \LAFITE.FIND.AGAIN)
"Repeat previous search")))
(RPAQQ LAFITEEXTRAMENUFLG T)
(RPAQQ \LAFITE.LAST.SEARCH NIL)
(PUTPROPS LAFITEFIND COPYRIGHT ("Xerox Corporation" 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1351 16392 (\LAFITE.FIND 1361 . 3352) (\LAFITE.FIND.RELATED 3354 . 4437) (
\LAFITE.FIND.RELATED.BACKWARD 4439 . 4628) (\LAFITE.FIND.AGAIN 4630 . 5104) (\LAFITE.FIND.PROMPT 5106
. 7233) (\LAFITE.DO.FIND 7235 . 14338) (\LAFITE.FIND.START 14340 . 16130) (
LAFITEEXTRABROWSERCOMMANDFN 16132 . 16390)))))
STOP