(FILECREATED "28-May-86 22:00:53" {ERIS}<LISPCORE>LIBRARY>CLMAIL.;5 17448
changes to: (VARS CLMAILCOMS CLM.MENUFORMAT)
(FNS UPDATEHASHFILES CLMAILDISPLAYMSG CLMAILSHOW CLMAILREDOMENU)
previous date: "17-May-86 00:35:17" {ERIS}<LISPCORE>LIBRARY>CLMAIL.;2)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT CLMAILCOMS)
(RPAQQ CLMAILCOMS
((FNS CLMAILSHOW CLMAILDISPLAY CLMAILDISPLAYMSG CLMAILSEARCH 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 (* jrb: "17-May-86 00:26")
(* * 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#) (* jrb:
" 1-Apr-86 09:26")
(LET ((MSG# (IPLUS SLOT# CLM.HEAD#)))
(if (NOT (GREATERP MSG# (ARRAYSIZE CLM.HEADARRAY)))
then (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: " 1-Apr-86 21:03")
(LET ((MSGS (GETHASHFILE (MKATOM (LISTGET (FM.READSTATE CLM.MENUWINDOW)
(QUOTE THEWORD)))
CLM.MSGHASH)))
(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 CLM.MENUWINDOW "Sorry, that word isn't indexed"])
(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)
((LABEL "Common Lisp Mailing List Index" FONT (MODERN 10 BOLD)
HJUSTIFY CENTER))
((TYPE EDITSTART LABEL Word: FONT (MODERN 10 BOLD)
LINK THEWORD)
(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 (1541 14555 (CLMAILSHOW 1551 . 3309) (CLMAILDISPLAY 3311 . 3695) (CLMAILDISPLAYMSG 3697
. 3959) (CLMAILSEARCH 3961 . 4684) (CLMAILREDOMENU 4686 . 5341) (CLMAILHEADSTRING 5343 . 6290) (
CLMAILFIRST 6292 . 6541) (CLMAILLAST 6543 . 6873) (CLMAILFWD 6875 . 7265) (CLMAILBKWD 7267 . 7548) (
CLMAILQUIT 7550 . 7843) (MAKECMLHEADHASH 7845 . 8702) (MAKECMLMAILHASH 8704 . 9809) (UPDATEHASHFILES
9811 . 12293) (CMLMAIL1 12295 . 12519) (CMLMAIL2 12521 . 12745) (CMLMAIL3 12747 . 12971) (CMLMAIL4
12973 . 13197) (CMLMAIL5 13199 . 13423) (CMLMAIL6 13425 . 13649) (CMLMAIL7 13651 . 13875) (CMLMAIL8
13877 . 14101) (CMLMAIL9 14103 . 14327) (CMLMAIL0 14329 . 14553)))))
STOP