(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

(FILECREATED "23-Aug-88 18:58:15" {ERIS}<LAFITE>SOURCES>LAFITEFIND.;13
 12215  

      changes to%:  (VARS LAFITEFINDCOMS) (FNS \LAFITE.GO.TO.LAST \LAFITE.GO.TO.FIRST \LAFITE.GO.TO.INTERACTIVE)

      previous date%: "29-Jul-88 11:59:44" {ERIS}<LAFITE>SOURCES>LAFITEFIND.;12)


(* "
Copyright (c) 1984, 1985, 1986, 1987, 1988 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT LAFITEFINDCOMS)

(RPAQQ LAFITEFINDCOMS ((FNS \LAFITE.FIND \LAFITE.FIND.RELATED \LAFITE.FIND.RELATED.BACKWARD \LAFITE.GO.TO.FIRST \LAFITE.GO.TO.INTERACTIVE \LAFITE.GO.TO.LAST \LAFITE.FIND.AGAIN \LAFITE.FIND.PROMPT \LAFITE.DO.FIND \LAFITE.FIND.START) (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS SEARCHSTATE) (GLOBALVARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU LAFITEEXTRAMENU LAFITEEXTRAMENUFLG \LAFITE.LAST.SEARCH) (FILES (SOURCE) LAFITEDECLS) (LOCALVARS . T)) (INITVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU) (VARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS) (ADDVARS (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") ("Go to #" (QUOTE \LAFITE.GO.TO.INTERACTIVE) "Scroll to and select a specific message by number." (SUBITEMS ("Go to First" (QUOTE \LAFITE.GO.TO.FIRST) "Scroll to and select first message.") ("Go to Last" (QUOTE \LAFITE.GO.TO.LAST) "Scroll to and select last message.")))) (LAFITEMENUVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)) (VARS (\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.GO.TO.FIRST

(LAMBDA (FOLDER) (* ; "Edited 23-Aug-88 18:35 by bvm") (AND (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER) (LAB.GO.TO.MESSAGE FOLDER 1)))
)

(\LAFITE.GO.TO.INTERACTIVE

(LAMBDA (FOLDER) (* ; "Edited 23-Aug-88 18:35 by bvm") (* ;; "Called from title menu to go to some user specified message.") (ALLOW.BUTTON.EVENTS) (LET ((N (PROGN (TTY.PROCESS (THIS.PROCESS)) (LAB.PROMPTPRINT FOLDER "Type or select number of message.") (PROG1 (RNUMBER "Message#" NIL NIL NIL T NIL T T) (TTY.PROCESS T)))) MAX) (if (AND N (> N 0)) then (if (> N (SETQ MAX (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER))) then (LAB.FORMAT FOLDER T "There are only ~D messages in this folder." MAX) (SETQ N MAX) else (\LAFITE.MAYBE.CLEAR.PROMPT FOLDER)) (LAB.GO.TO.MESSAGE FOLDER N))))
)

(\LAFITE.GO.TO.LAST

(LAMBDA (FOLDER) (* ; "Edited 23-Aug-88 18:35 by bvm") (AND (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER) (LAB.GO.TO.MESSAGE FOLDER (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER))))
)

(\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) (* ; "Edited 14-Jun-88 11:15 by bvm") (* ;;; "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"))) (WINDOWPROP W (QUOTE PROCESS) NIL))) WINDOW)) (COND ((COND ((EQ SEARCHAREA (QUOTE Mark)) (LAB.PROMPTPRINT MAILFOLDER T "Find message marked: ") (RESETSAVE (TTYDISPLAYSTREAM WINDOW)) (< (SETQ RESULT (\GETKEY)) (CHARCODE SPACE))) (T (NULL (SETQ RESULT (TTYINPROMPTFORWORD (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))))))) (ERROR!))) RESULT)))
)

(\LAFITE.DO.FIND

(LAMBDA (MAILFOLDER DIRECTION AREA SEARCHSTRING FROM# ALLFLG REPLYTO?) (* ; "Edited 23-Sep-87 18:35 by bvm:") (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) :ABORT))) (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 (> (add MSG# 1) LASTMSG#)) (<= (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 (< (SETQ LAST# FIRST#) (SETQ VIS (FIRSTVISIBLEMESSAGE MAILFOLDER)))) (> 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#))
)
)
(DECLARE%: EVAL@COMPILE DONTCOPY 
(DECLARE%: EVAL@COMPILE

(RECORD SEARCHSTATE
 (SEARCHSTRING SEARCHDIRECTION SEARCHAREA SEARCHREPLYTO))
)

(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU LAFITEEXTRAMENU LAFITEEXTRAMENUFLG \LAFITE.LAST.SEARCH)
)


(FILESLOAD (SOURCE) LAFITEDECLS)

(DECLARE%: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
)

(RPAQ? LAFITEFINDTYPEMENU NIL)

(RPAQ? LAFITEFINDAREAMENU 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")))

(ADDTOVAR 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") ("Go to #" (QUOTE \LAFITE.GO.TO.INTERACTIVE) "Scroll to and select a specific message by number." (SUBITEMS ("Go to First" (QUOTE \LAFITE.GO.TO.FIRST) "Scroll to and select first message.") ("Go to Last" (QUOTE \LAFITE.GO.TO.LAST) "Scroll to and select last message."))))

(ADDTOVAR LAFITEMENUVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)

(RPAQQ \LAFITE.LAST.SEARCH NIL)
(PUTPROPS LAFITEFIND COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1823 10123 (\LAFITE.FIND 1833 . 2865) (\LAFITE.FIND.RELATED 2867 . 3532) (
\LAFITE.FIND.RELATED.BACKWARD 3534 . 3670) (\LAFITE.GO.TO.FIRST 3672 . 3839) (
\LAFITE.GO.TO.INTERACTIVE 3841 . 4453) (\LAFITE.GO.TO.LAST 4455 . 4663) (\LAFITE.FIND.AGAIN 4665 . 
4966) (\LAFITE.FIND.PROMPT 4968 . 5899) (\LAFITE.DO.FIND 5901 . 9052) (\LAFITE.FIND.START 9054 . 10121
)))))
STOP