(FILECREATED "22-Aug-86 15:06:43" {ERIS}<LISPCORE>LIBRARY>CLMAIL.;9 18673
changes to: (FNS CLMAILMERGE CLMAILSEARCH CLMAILMSGHASH)
(VARS CLM.MENUFORMAT CLMAILCOMS)
previous date: "29-May-86 17:22:19" {ERIS}<LISPCORE>LIBRARY>CLMAIL.;6)
(* Copyright (c) 1986 by 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 (QUOTE INPUT)))
(SETQ CLM.HEADHASH (OPENHASHFILE CLM.HEADHASHNAME (QUOTE 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 (QUOTE FM.ITEMS))))
(SETQ CLM.WORD (for X in WP thereis (EQ (QUOTE THEWORD)
(FM.ITEMPROP X (QUOTE ID)))))
(SETQ CLM.HEADITEMS (for X on WP thereis (EQ (QUOTE LINE1)
(FM.ITEMPROP (CAR X)
(QUOTE ID)))))
(SETQ CLM.ABOVEITEM (for X in WP thereis (EQ (QUOTE ABOVEFIELD)
(FM.ITEMPROP X (QUOTE ID)))))
(SETQ CLM.BELOWITEM (for X in WP thereis (EQ (QUOTE BELOWFIELD)
(FM.ITEMPROP X (QUOTE ID))))))
(* * "Finally let user move the menu window (which will open it as a nice side effect)")
(MOVEW CLM.MENUWINDOW (GETBOXPOSITION (WINDOWPROP CLM.MENUWINDOW (QUOTE WIDTH))
(WINDOWPROP CLM.MENUWINDOW (QUOTE HEIGHT))
100 100 NIL "Specify the position of the menu window"))
(OPENW CLM.MENUWINDOW)))
(CLMAILDISPLAY
(LAMBDA (SLOT#) (* "Pavel" "29-May-86 15:53")
(LET ((MSG# (+ SLOT# CLM.HEAD#)))
(CL:UNLESS (> MSG# (ARRAYSIZE CLM.HEADARRAY))
(CLMAILDISPLAYMSG (CAR (ELT CLM.HEADARRAY MSG#)))))))
(CLMAILDISPLAYMSG
[LAMBDA (MSG) (* jrb: "28-May-86 21:55")
(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 (QUOTE LABEL)))))
(if MSGS
then (SETQ CLM.HEADARRAY (ARRAY (LENGTH MSGS)
(QUOTE 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: "22-Aug-86 12:32")
(if (SYMBOLP WORD)
then (GETHASHFILE WORD CLM.MSGHASH)
else (CL:ERROR "~S is not a word" WORD))))
(CLMAILMERGE
(LAMBDA (STRING) (* jrb: "22-Aug-86 15:01")
(LET ((STRINGSTREAM (MAKE-STRING-INPUT-STREAM STRING))
TERM TERMLIST (RESULT (QUOTE FIRSTTIME)))
(while (NOT (EOFP STRINGSTREAM))
do (TYPECASE (SETQ TERM (READ STRINGSTREAM))
(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 (QUOTE 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 (QUOTE SMALLEXPR)
70 4100))
(DF (OPENSTREAM DATAFILENAME (QUOTE 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:
"26-Mar-86 15:09")
(LET ((HF (CREATEHASHFILE HASHFILENAME (QUOTE EXPR)
80 23000))
(DF (OPENSTREAM DATAFILENAME (QUOTE INPUT)))
KEY VLIST NEXTITEM)
(SETQ KEY (READ DF))
(UNWIND-PROTECT (while (NOT (EOFP DF)) do (if (NUMBERP (SETQ NEXTITEM (READ DF)))
then (push VLIST NEXTITEM)
else (PUTHASHFILE KEY (NREVERSE VLIST)
HF)
(SETQ KEY NEXTITEM)
(SETQ VLIST NIL))
finally (PUTHASHFILE KEY (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 (QUOTE INPUT)))
(HDF (OPENSTREAM CLM.HEADDATANAME (QUOTE INPUT)))
(MHF (OPENHASHFILE CLM.MAILHASHNAME (QUOTE BOTH)))
(HHF (OPENHASHFILE CLM.HEADHASHNAME (QUOTE 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 ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1642 15697 (CLMAILSHOW 1652 . 3403) (CLMAILDISPLAY 3405 . 3689) (CLMAILDISPLAYMSG 3691
. 3953) (CLMAILSEARCH 3955 . 4578) (CLMAILMSGHASH 4580 . 4822) (CLMAILMERGE 4824 . 5826) (
CLMAILREDOMENU 5828 . 6483) (CLMAILHEADSTRING 6485 . 7432) (CLMAILFIRST 7434 . 7683) (CLMAILLAST 7685
. 8015) (CLMAILFWD 8017 . 8407) (CLMAILBKWD 8409 . 8690) (CLMAILQUIT 8692 . 8985) (MAKECMLHEADHASH
8987 . 9844) (MAKECMLMAILHASH 9846 . 10951) (UPDATEHASHFILES 10953 . 13435) (CMLMAIL1 13437 . 13661) (
CMLMAIL2 13663 . 13887) (CMLMAIL3 13889 . 14113) (CMLMAIL4 14115 . 14339) (CMLMAIL5 14341 . 14565) (
CMLMAIL6 14567 . 14791) (CMLMAIL7 14793 . 15017) (CMLMAIL8 15019 . 15243) (CMLMAIL9 15245 . 15469) (
CMLMAIL0 15471 . 15695)))))
STOP