(FILECREATED "29-May-86 17:22:19" {ERIS}<LISPCORE>LIBRARY>CLMAIL.;6 17420
changes to: (FNS CLMAILSHOW CLMAILDISPLAY CLMAILSEARCH)
(VARS CLMAILCOMS CLM.MENUFORMAT)
previous date: "28-May-86 22:00:53" {ERIS}<LISPCORE>LIBRARY>CLMAIL.;5)
(* 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 (* "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 (* "Pavel" "29-May-86 17:18")
(LET ((MSGS (GETHASHFILE (MKATOM (FM.ITEMPROP CLM.WORD (QUOTE LABEL)))
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 "Sorry, that word isn't indexed" CLM.MENUWINDOW)))))
(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:" 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 (1615 14465 (CLMAILSHOW 1625 . 3376) (CLMAILDISPLAY 3378 . 3662) (CLMAILDISPLAYMSG 3664
. 3926) (CLMAILSEARCH 3928 . 4594) (CLMAILREDOMENU 4596 . 5251) (CLMAILHEADSTRING 5253 . 6200) (
CLMAILFIRST 6202 . 6451) (CLMAILLAST 6453 . 6783) (CLMAILFWD 6785 . 7175) (CLMAILBKWD 7177 . 7458) (
CLMAILQUIT 7460 . 7753) (MAKECMLHEADHASH 7755 . 8612) (MAKECMLMAILHASH 8614 . 9719) (UPDATEHASHFILES
9721 . 12203) (CMLMAIL1 12205 . 12429) (CMLMAIL2 12431 . 12655) (CMLMAIL3 12657 . 12881) (CMLMAIL4
12883 . 13107) (CMLMAIL5 13109 . 13333) (CMLMAIL6 13335 . 13559) (CMLMAIL7 13561 . 13785) (CMLMAIL8
13787 . 14011) (CMLMAIL9 14013 . 14237) (CMLMAIL0 14239 . 14463)))))
STOP