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

(FILECREATED "14-Jun-90 20:54:42" {DSK}<usr>local>lde>lispcore>internal>library>CLMAIL.;2
 17296  

      changes to%:  (VARS CLMAILCOMS)
                    (FNS CLMAILSHOW CLMAILDISPLAY CLMAILDISPLAYMSG CLMAILSEARCH CLMAILMSGHASH 
                         CLMAILMERGE CLMAILREDOMENU CLMAILHEADSTRING CLMAILFIRST CLMAILLAST CLMAILFWD
                         CLMAILBKWD CLMAILQUIT MAKECMLHEADHASH MAKECMLMAILHASH UPDATEHASHFILES 
                         CMLMAIL1 CMLMAIL2 CMLMAIL3 CMLMAIL4 CMLMAIL5 CMLMAIL6 CMLMAIL7 CMLMAIL8 
                         CMLMAIL9 CMLMAIL0)

      previous date%: "23-Jan-87 16:37:36" {DSK}<usr>local>lde>lispcore>internal>library>CLMAIL.;1)


(* ; "
Copyright (c) 1986, 1987, 1990 by Venue & Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT CLMAILCOMS)

(RPAQQ CLMAILCOMS

       ((FNS CLMAILSHOW CLMAILDISPLAY CLMAILDISPLAYMSG CLMAILSEARCH CLMAILMSGHASH CLMAILMERGE 
             CLMAILREDOMENU CLMAILHEADSTRING CLMAILFIRST CLMAILLAST CLMAILFWD CLMAILBKWD CLMAILQUIT 
             MAKECMLHEADHASH MAKECMLMAILHASH UPDATEHASHFILES CMLMAIL1 CMLMAIL2 CMLMAIL3 CMLMAIL4 
             CMLMAIL5 CMLMAIL6 CMLMAIL7 CMLMAIL8 CMLMAIL9 CMLMAIL0)
        (VARS CLM.MENUFORMAT (* "Format list for Free Menu")
              CLM.MAILHASHNAME CLM.HEADHASHNAME (* "Names of hashfiles")
              CLM.MAILDATANAME CLM.HEADDATANAME (* "Names of unhashed data files")
              CLM.VAXCDIR CLM.MSGDIR (* "Names of magic directories"))
        (GLOBALVARS CLM.HEADITEMS (* 
                    "A pointer to the first message menu item in CLM.MENUFORMAT for easy referencing"
                                     )
               CLM.ABOVEITEM CLM.BELOWITEM CLM.WORD (* "Points at Above:, Below:, and THEWORD fields"
                                                       )
               CLM.MSGHASH CLM.HEADHASH (* "Streams for message and head line hash files")
               CLM.MENUWINDOW
               (* "The menu window")
               CLM.HEADARRAY CLM.HEAD# (* "Array of head lines for menu and an index into it"))))
(DEFINEQ

(CLMAILSHOW

  [LAMBDA NIL
                                            (* "Pavel" "29-May-86 15:52")


         (* * "First, open the the hash files")


    (SETQ CLM.MSGHASH (OPENHASHFILE CLM.MAILHASHNAME 'INPUT))
    (SETQ CLM.HEADHASH (OPENHASHFILE CLM.HEADHASHNAME 'INPUT))

         (* * "Then create the menu window")


    (SETQ CLM.MENUWINDOW (FREEMENU CLM.MENUFORMAT))

         (* * 

    "Set various pointers into the FM.ITEMS list so we can find the first message menu item easily")


    [LET [(WP (WINDOWPROP CLM.MENUWINDOW 'FM.ITEMS]
         [SETQ CLM.WORD (for
 X in
 WP thereis
 (EQ 'THEWORD (FM.ITEMPROP X 'ID]
         [SETQ CLM.HEADITEMS (for
 X on
 WP thereis
 (EQ 'LINE1 (FM.ITEMPROP (CAR X)
                                                                                'ID]
         [SETQ CLM.ABOVEITEM (for
 X in
 WP thereis
 (EQ 'ABOVEFIELD (FM.ITEMPROP
                                                                               X
                                                                               'ID]
         (SETQ CLM.BELOWITEM (for
 X in
 WP thereis
 (EQ 'BELOWFIELD (FM.ITEMPROP
                                                                               X
                                                                               'ID]

         (* * "Finally let user move the menu window (which will open it as a nice side effect)")


    (MOVEW CLM.MENUWINDOW (GETBOXPOSITION (WINDOWPROP CLM.MENUWINDOW 'WIDTH)
                                 (WINDOWPROP CLM.MENUWINDOW 'HEIGHT)
                                 100 100 NIL "Specify the position of the menu window"))
    (OPENW CLM.MENUWINDOW])

(CLMAILDISPLAY

  [LAMBDA (SLOT#)
                                        (* jrb%: "29-Oct-86 12:39")

    (LET ((MSG# (+ SLOT# CLM.HEAD#)))
         (CL:UNLESS (> MSG# (ARRAYSIZE CLM.HEADARRAY))
             (CLMAILDISPLAYMSG
 (CAR (ELT CLM.HEADARRAY MSG#))))])

(CLMAILDISPLAYMSG

  [LAMBDA (MSG)
                                          (* jrb%: "29-Oct-86 12:39")

    (if
 (NUMBERP MSG)
        then
 (TEDIT (MKATOM (CONCAT CLM.MSGDIR MSG)))
      else
 (ERROR "This isn't a CL message number" MSG])

(CLMAILSEARCH

  [LAMBDA NIL
                                            (* jrb%: "22-Aug-86 14:24")

    (LET [(MSGS (CLMAILMERGE
 (FM.ITEMPROP CLM.WORD 'LABEL]
         (if
 MSGS
             then
 (SETQ CLM.HEADARRAY (ARRAY (LENGTH MSGS)
                                                 'POINTER))
                   (for
 I from
 1 to
 (ARRAYSIZE CLM.HEADARRAY)
                      do
 (SETA CLM.HEADARRAY I (pop
 MSGS)))
                   (SETQ CLM.HEAD# 1)
                   (CLMAILLAST
)
           else
 (FM.CHANGELABEL CLM.WORD "Sorry, that word isn't indexed" CLM.MENUWINDOW])

(CLMAILMSGHASH

  [LAMBDA (WORD)
                                         (* jrb%: "29-Oct-86 12:38")

    (if
 (CL:SYMBOLP WORD)
        then
 (GETHASHFILE WORD CLM.MSGHASH)
      else
 (CL:ERROR "~S is not a word" WORD])

(CLMAILMERGE

  [LAMBDA (STRING)
                                       (* ; "Edited 23-Jan-87 16:37 by jrb:")

    (LET ((STRINGSTREAM (CL:MAKE-STRING-INPUT-STREAM STRING))
          TERM TERMLIST (RESULT 'FIRSTTIME))
         (while
 (NOT (EOFP STRINGSTREAM))
            do
 (CL:TYPECASE (SETQ TERM (READ STRINGSTREAM))
                       (CL:SYMBOL (SETQ TERMLIST (CLMAILMSGHASH
 TERM)))
                       (LIST 
                          (SETQ TERMLIST NIL)
                          (for
 TR in
 TERM do
 (SETQ TERMLIST (UNION (CLMAILMSGHASH

                                                                                TR)
                                                                               TERMLIST))))
                       (T (CL:ERROR "~S is not a word or list of words" TERM)))
                  (SETQ RESULT (if
 (EQ RESULT 'FIRSTTIME)
                                   then
 TERMLIST
                                 else
 (INTERSECTION TERMLIST RESULT)))
                  (if
 (NULL RESULT)
                      then
 (RETURN NIL)))
         RESULT])

(CLMAILREDOMENU

  [LAMBDA NIL
                                            (* jrb%: "17-May-86 00:21")

    (FM.CHANGELABEL CLM.ABOVEITEM (SUB1 CLM.HEAD#)
           CLM.MENUWINDOW)
    (FM.CHANGELABEL CLM.BELOWITEM (MAX 0 (IDIFFERENCE (ARRAYSIZE CLM.HEADARRAY)
                                                (IPLUS CLM.HEAD# 9)))
           CLM.MENUWINDOW)
    (for
 ITM in
 CLM.HEADITEMS bind
 (APTR _ CLM.HEAD#) do
 (FM.CHANGELABEL ITM
                                                                                (CLMAILHEADSTRING

                                                                                 APTR)
                                                                                CLM.MENUWINDOW)
                                                                        (SETQ APTR (ADD1 APTR])

(CLMAILHEADSTRING

  [LAMBDA (HEAD#)
                                        (* jrb%: "31-Mar-86 21:19")


         (* * If the index is outside the array, return a null string to blank out that 

       slot in the menu)


         (* * If the array element is a number, it hasn't been fetched from the hashfile 

       yet; do so)


         (* * Otherwise just return it)


    (COND
       ((GREATERP HEAD# (ARRAYSIZE CLM.HEADARRAY))
        "")
       ((NUMBERP (ELT CLM.HEADARRAY HEAD#))
        (SETA CLM.HEADARRAY HEAD# (CONS (ELT CLM.HEADARRAY HEAD#)
                                        (GETHASHFILE (ELT CLM.HEADARRAY HEAD#)
                                               CLM.HEADHASH)))
        (CDR (ELT CLM.HEADARRAY HEAD#)))
       (T (CDR (ELT CLM.HEADARRAY HEAD#])

(CLMAILFIRST

  [LAMBDA NIL
                                            (* jrb%: "31-Mar-86 19:50")

    (SETQ CLM.HEAD# 1)
    (CLMAILREDOMENU
])

(CLMAILLAST

  [LAMBDA NIL
                                            (* jrb%: "31-Mar-86 21:58")

    (SETQ CLM.HEAD# (MAX 1 (IDIFFERENCE (ARRAYSIZE CLM.HEADARRAY)
                                  9)))
    (CLMAILREDOMENU
])

(CLMAILFWD

  [LAMBDA NIL
                                            (* jrb%: "31-Mar-86 22:05")

    [SETQ CLM.HEAD# (MAX 1 (MIN (IPLUS CLM.HEAD# 10)
                                (IDIFFERENCE (ARRAYSIZE CLM.HEADARRAY)
                                       9]
    (CLMAILREDOMENU
])

(CLMAILBKWD

  [LAMBDA NIL
                                            (* jrb%: "31-Mar-86 22:05")

    (SETQ CLM.HEAD# (MAX 1 (IDIFFERENCE CLM.HEAD# 10)))
    (CLMAILREDOMENU
])

(CLMAILQUIT

  [LAMBDA NIL
                                            (* jrb%: "31-Mar-86 19:52")

    (CLOSEHASHFILE CLM.MSGHASH)
    (CLOSEHASHFILE CLM.HEADHASH)
    (CLOSEW CLM.MENUWINDOW])

(MAKECMLHEADHASH

  [LAMBDA (DATAFILENAME HASHFILENAME)
                    (* jrb%: "26-Mar-86 10:19")

    (LET ((HF (CREATEHASHFILE HASHFILENAME 'SMALLEXPR 70 4100))
          (DF (OPENSTREAM DATAFILENAME 'INPUT))
          KEY SUBJECT SENDER DATE)
         (while
 (NOT (EOFP DF)) do
 (SETQ KEY (READ DF))
                                          (SETQ SUBJECT (READ DF))
                                          (SETQ SENDER (READ DF))
                                          (SETQ DATE (READ DF))
                                          (PUTHASHFILE KEY (CONCAT SUBJECT " " SENDER " " DATE)
                                                 HF) finally
 (CLOSEHASHFILE HF)
                                                           (CLOSEF DF])

(MAKECMLMAILHASH

  [LAMBDA (DATAFILENAME HASHFILENAME)
                    (* jrb%: "29-Oct-86 12:43")

    (LET ((HF (CREATEHASHFILE HASHFILENAME 'EXPR 80 23000))
          (DF (OPENSTREAM DATAFILENAME 'INPUT))
          KEY VLIST NEXTITEM)
         (SETQ KEY (READ DF))
         (CL:UNWIND-PROTECT
             (while
 (NOT (EOFP DF)) do
 (if
 (NUMBERP (SETQ NEXTITEM (READ DF)))
                                                   then
 (push
 VLIST NEXTITEM)
                                                 else
 (PUTHASHFILE KEY (CL:NREVERSE VLIST)
                                                                 HF)
                                                       (SETQ KEY NEXTITEM)
                                                       (SETQ VLIST NIL))
                finally
 (PUTHASHFILE KEY (CL:NREVERSE VLIST)
                                   HF))
             (CLOSEHASHFILE HF)
             (CLOSEF DF))])

(UPDATEHASHFILES

  [LAMBDA NIL
                                            (* jrb%: "28-May-86 13:32")


         (* * First open all the files)


    (LET [(MDF (OPENSTREAM CLM.MAILDATANAME 'INPUT))
          (HDF (OPENSTREAM CLM.HEADDATANAME 'INPUT))
          (MHF (OPENHASHFILE CLM.MAILHASHNAME 'BOTH))
          (HHF (OPENHASHFILE CLM.HEADHASHNAME 'BOTH]

         (* * Then hash out all the new header lines)


         (while
 (READP HDF) bind
 KEY SUBJECT VAXCFILE do
 (SETQ KEY (READ HDF))
                                                                    (SETQ SUBJECT (READ HDF))
                                                                    (PUTHASHFILE KEY SUBJECT HHF)
                                                                    (COPYFILE (SETQ VAXCFILE
                                                                               (CONCAT CLM.VAXCDIR 
                                                                                      KEY))
                                                                           (CONCAT CLM.MSGDIR KEY))
                                                                    (DELFILE VAXCFILE)
                                                                    (PRINTOUT T KEY %,)
            finally
 (CLOSEHASHFILE HHF)
                  (CLOSEF HDF)
                  (TERPRI))

         (* * And then update the message hash file)


         (while
 (READP MDF) bind
 (KEY _ (READ MDF))
                                      NEXTITEM VLIST
            do
 (if
 (NUMBERP (SETQ NEXTITEM (READ MDF)))
                       then
 (push
 VLIST NEXTITEM)
                     else
 (PUTHASHFILE KEY (NCONC (GETHASHFILE KEY MHF)
                                                      (DREVERSE VLIST))
                                     MHF)
                           (PRINTOUT T KEY %,)
                           (SETQ KEY NEXTITEM)
                           (SETQ VLIST NIL)) finally
 (PUTHASHFILE KEY (NCONC (GETHASHFILE KEY MHF
                                                                                        )
                                                                                 (DREVERSE VLIST))
                                                                MHF)
                                                   (CLOSEF MDF)
                                                   (CLOSEHASHFILE MHF)
                                                   (PRINTOUT T T "DONE!" T])

(CMLMAIL1

  [LAMBDA NIL
                                            (* jrb%: "31-Mar-86 21:47")

    (CLMAILDISPLAY
 1])

(CMLMAIL2

  [LAMBDA NIL
                                            (* jrb%: "31-Mar-86 21:47")

    (CLMAILDISPLAY
 2])

(CMLMAIL3

  [LAMBDA NIL
                                            (* jrb%: "31-Mar-86 21:50")

    (CLMAILDISPLAY
 3])

(CMLMAIL4

  [LAMBDA NIL
                                            (* jrb%: "31-Mar-86 21:50")

    (CLMAILDISPLAY
 4])

(CMLMAIL5

  [LAMBDA NIL
                                            (* jrb%: "31-Mar-86 21:50")

    (CLMAILDISPLAY
 5])

(CMLMAIL6

  [LAMBDA NIL
                                            (* jrb%: "31-Mar-86 21:50")

    (CLMAILDISPLAY
 6])

(CMLMAIL7

  [LAMBDA NIL
                                            (* jrb%: "31-Mar-86 21:50")

    (CLMAILDISPLAY
 7])

(CMLMAIL8

  [LAMBDA NIL
                                            (* jrb%: "31-Mar-86 21:52")

    (CLMAILDISPLAY
 8])

(CMLMAIL9

  [LAMBDA NIL
                                            (* jrb%: "31-Mar-86 21:52")

    (CLMAILDISPLAY
 9])

(CMLMAIL0

  [LAMBDA NIL
                                            (* jrb%: " 1-Apr-86 09:35")

    (CLMAILDISPLAY
 0])
)

(RPAQQ CLM.MENUFORMAT

       ((PROPS FORMAT ROW)
        ((TYPE DISPLAY LABEL "Common Lisp Mailing List Index" FONT (MODERN 10 BOLD)
               HJUSTIFY CENTER))
        ((TYPE EDITSTART LABEL "Word (implicit AND):" LINKS (EDIT THEWORD)
               FONT
               (MODERN 10 BOLD))
         (TYPE EDIT ID THEWORD LABEL ""))
        ((TYPE DISPLAY LABEL "Above:" FONT (MODERN 10 BOLD))
         (TYPE DISPLAY ID ABOVEFIELD LABEL "        ")
         (TYPE DISPLAY LABEL "Below:" FONT (MODERN 10 BOLD))
         (TYPE DISPLAY ID BELOWFIELD LABEL "        "))
        ((TYPE MOMENTARY LABEL "Search!" FONT (MODERN 10 BOLD)
               SELECTEDFN CLMAILSEARCH)
         (TYPE MOMENTARY LABEL "First!" FONT (MODERN 10 BOLD)
               SELECTEDFN CLMAILFIRST)
         (TYPE MOMENTARY LABEL "Last!" FONT (MODERN 10 BOLD)
               SELECTEDFN CLMAILLAST)
         (TYPE MOMENTARY LABEL "Forwards!" FONT (MODERN 10 BOLD)
               SELECTEDFN CLMAILFWD)
         (TYPE MOMENTARY LABEL "Backwards!" FONT (MODERN 10 BOLD)
               SELECTEDFN CLMAILBKWD)
         (TYPE MOMENTARY LABEL "Quit!" FONT (MODERN 10 BOLD)
               SELECTEDFN CLMAILQUIT))
        ((TYPE MOMENTARY LABEL 
               "                                                                                " ID
               LINE1 SELECTEDFN CMLMAIL0))
        ((TYPE MOMENTARY LABEL "" SELECTEDFN CMLMAIL1))
        ((TYPE MOMENTARY LABEL "" SELECTEDFN CMLMAIL2))
        ((TYPE MOMENTARY LABEL "" SELECTEDFN CMLMAIL3))
        ((TYPE MOMENTARY LABEL "" SELECTEDFN CMLMAIL4))
        ((TYPE MOMENTARY LABEL "" SELECTEDFN CMLMAIL5))
        ((TYPE MOMENTARY LABEL "" SELECTEDFN CMLMAIL6))
        ((TYPE MOMENTARY LABEL "" SELECTEDFN CMLMAIL7))
        ((TYPE MOMENTARY LABEL "" SELECTEDFN CMLMAIL8))
        ((TYPE MOMENTARY LABEL "" SELECTEDFN CMLMAIL9))))

(RPAQQ CLM.MAILHASHNAME
 {ERIS}<COMMONLISP>CLMAIL>MSGHASH)

(RPAQQ CLM.HEADHASHNAME
 {ERIS}<COMMONLISP>CLMAIL>HEADHASH)

(RPAQQ CLM.MAILDATANAME
 {VAXC}/user/xais/bane/clmail/newwords)

(RPAQQ CLM.HEADDATANAME
 {VAXC}/user/xais/bane/clmail/newheads)

(RPAQQ CLM.VAXCDIR
 {VAXC}/user/xais/bane/clmail/)

(RPAQQ CLM.MSGDIR
 {ERIS}<COMMONLISP>CLMAIL>)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS CLM.HEADITEMS CLM.ABOVEITEM CLM.BELOWITEM CLM.WORD CLM.MSGHASH CLM.HEADHASH 
       CLM.MENUWINDOW CLM.HEADARRAY CLM.HEAD#)
)
(PUTPROPS CLMAIL COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (2142 14793 (CLMAILSHOW 2152 . 3870) (CLMAILDISPLAY 3872 . 4146) (CLMAILDISPLAYMSG 4148
 . 4407) (CLMAILSEARCH 4409 . 5038) (CLMAILMSGHASH 5040 . 5280) (CLMAILMERGE 5282 . 6419) (
CLMAILREDOMENU 6421 . 7262) (CLMAILHEADSTRING 7264 . 8073) (CLMAILFIRST 8075 . 8233) (CLMAILLAST 8235
 . 8474) (CLMAILFWD 8476 . 8775) (CLMAILBKWD 8777 . 8967) (CLMAILQUIT 8969 . 9171) (MAKECMLHEADHASH 
9173 . 9946) (MAKECMLMAILHASH 9948 . 10911) (UPDATEHASHFILES 10913 . 13441) (CMLMAIL1 13443 . 13576) (
CMLMAIL2 13578 . 13711) (CMLMAIL3 13713 . 13846) (CMLMAIL4 13848 . 13981) (CMLMAIL5 13983 . 14116) (
CMLMAIL6 14118 . 14251) (CMLMAIL7 14253 . 14386) (CMLMAIL8 14388 . 14521) (CMLMAIL9 14523 . 14656) (
CMLMAIL0 14658 . 14791)))))
STOP