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


(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-FIND.;2
 14652  

      :EDIT-BY rmk

      :CHANGES-TO (VARS LAFITE-FINDCOMS)

      :PREVIOUS-DATE "23-Feb-2024 22:11:33" {WMEDLEY}<library>lafite>LAFITE-FIND.;1)


(PRETTYCOMPRINT LAFITE-FINDCOMS)

(RPAQQ LAFITE-FINDCOMS

       ((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)
                      LAFITE-DECLS)
               (LOCALVARS . T))
        (INITVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)
        (VARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS)
        (ADDVARS [LAFITEEXTRAMENUITEMS ("Find" '\LAFITE.FIND "Search mail for something")
                        ["Find Related" '\LAFITE.FIND.RELATED 
                               "Find all messages from here on in reply to this message"
                               (SUBITEMS ("Find Related Forward" '\LAFITE.FIND.RELATED)
                                      ("Find Related Backward" '\LAFITE.FIND.RELATED.BACKWARD]
                        ("Find Again" '\LAFITE.FIND.AGAIN "Repeat previous search")
                        ("Go to #" '\LAFITE.GO.TO.INTERACTIVE 
                               "Scroll to and select a specific message by number."
                               (SUBITEMS ("Go to First" '\LAFITE.GO.TO.FIRST 
                                                "Scroll to and select first message.")
                                      ("Go to Last" '\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)
                                   (* ; "Edited 15-Jun-90 16:03 by jds")

    (LET ((LASTSEARCH \LAFITE.LAST.SEARCH))
         (COND
            (LASTSEARCH (\LAFITE.DO.FIND
 MAILFOLDER (fetch
 (SEARCHSTATE SEARCHDIRECTION)
                                                           of
 LASTSEARCH)
                               (fetch
 (SEARCHSTATE SEARCHAREA) of
 LASTSEARCH)
                               (fetch
 (SEARCHSTATE SEARCHSTRING) of
 LASTSEARCH)))
            (T (\LAFITE.FIND
 MAILFOLDER])

(\LAFITE.FIND.PROMPT

  [LAMBDA (MAILFOLDER SEARCHAREA)
                        (* ; "Edited 15-Jun-90 16:03 by jds")


(* ;;; "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 'PROCESS NIL]
                                  WINDOW))
             (COND
                ([COND
                    ((EQ SEARCHAREA '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
 (SEARCHSTATE 
                                                                                        SEARCHREPLYTO
                                                                                        )
                                                                         of
 LASTSEARCH))
                                                      (EQ SEARCHAREA (fetch
 (SEARCHSTATE 
                                                                                       SEARCHAREA)
                                                                        of
 LASTSEARCH))
                                                      (fetch
 (SEARCHSTATE 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)
       LAFITE-DECLS)

(DECLARE%: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
)

(RPAQ? LAFITEFINDTYPEMENU
 NIL)

(RPAQ? LAFITEFINDAREAMENU
 NIL)

(RPAQQ LAFITEFINDAREAMENUITEMS

       ((From 'From "Search From: field for string (or To: if from self)")
        (Subject 'Subject "Search Subject: field for string")
        (Body 'Body "Search message bodies for string")
        (Mark 'Mark "Search for messages with specified mark character")
        (Related 'Related "Search for a message with same Subject, modulo Re:")))

(RPAQQ LAFITEFINDTYPEMENUITEMS

       (("Find Next One" '(FORWARD ONE)
               "Search forward from selected message")
        ("Find Next All" '(FORWARD ALL)
               "Search forward from selected message")
        ("Find Previous One" '(BACKWARD ONE)
               "Search backward from selected message")
        ("Find Previous All" '(BACKWARD ALL)
               "Search backward from selected message")))

(ADDTOVAR LAFITEEXTRAMENUITEMS

          ("Find" '\LAFITE.FIND "Search mail for something")
          ["Find Related" '\LAFITE.FIND.RELATED 
                 "Find all messages from here on in reply to this message" (SUBITEMS
                                                                            ("Find Related Forward"
                                                                             '\LAFITE.FIND.RELATED)
                                                                            ("Find Related Backward"
                                                                             
                                                                             '
                                                                        \LAFITE.FIND.RELATED.BACKWARD
                                                                             ]
          ("Find Again" '\LAFITE.FIND.AGAIN "Repeat previous search")
          ("Go to #" '\LAFITE.GO.TO.INTERACTIVE "Scroll to and select a specific message by number."
                 (SUBITEMS ("Go to First" '\LAFITE.GO.TO.FIRST "Scroll to and select first message.")
                        ("Go to Last" '\LAFITE.GO.TO.LAST "Scroll to and select last message."))))

(ADDTOVAR LAFITEMENUVARS
 LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)

(RPAQQ \LAFITE.LAST.SEARCH
 NIL)
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (2180 11952 (\LAFITE.FIND 2190 . 3222) (\LAFITE.FIND.RELATED 3224 . 3889) (
\LAFITE.FIND.RELATED.BACKWARD 3891 . 4027) (\LAFITE.GO.TO.FIRST 4029 . 4196) (
\LAFITE.GO.TO.INTERACTIVE 4198 . 4810) (\LAFITE.GO.TO.LAST 4812 . 5020) (\LAFITE.FIND.AGAIN 5022 . 
5604) (\LAFITE.FIND.PROMPT 5606 . 7728) (\LAFITE.DO.FIND 7730 . 10881) (\LAFITE.FIND.START 10883 . 
11950)))))
STOP