(FILECREATED "10-Apr-85 11:13:03" {ERIS}<SPEECH>MAILREADER>CALLTEXT>PROSE-LAFITE.;9 42787
changes to: (FNS PREPARE.DL)
previous date: " 4-Apr-85 09:55:02" {ERIS}<SPEECH>MAILREADER>CALLTEXT>PROSE-LAFITE.;8)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT PROSE-LAFITECOMS)
(RPAQQ PROSE-LAFITECOMS ((FNS BROWSER.FROM.FILE P.AUTHENTICATE P.QUIT.OR.READ.OLD.MAIL
PROSE.LAFITE.PREPARE.BROWSER P.BYE P.CLOSE.BROWSER
P.FILES.IN.ACTIVE.BROWSERS P.FIND.MSG.BODY P.LAFITE.START.NEW.USER
P.OPEN.FOLDER.AND.GET.NEW.MAIL P.SURVEY.MSGS P.GETMAIL P.GETNEWMAIL
P.LAFITE.BROWSE P.MAILFILE P.OPEN.BROWSER.ON.FILE P.PREPARE.HEADER
P.READ.OLD.MAIL P.SAY.MSG? P.SAY.QUERY P.SEARCH.FOR.MAILFILE
P.SELECT.AND.SAY.MSG P.SELECT.MSG MSG.IN.RANGE PREPARE.ADDRESSES
PREPARE.DL PREPARE.NAME PREPARE.REGISTRY PREPARE.SINGLE.ADDRESS
PREPARE.SITE \PROSE.LAFITE.PREPARE.BROWSER)
(INITVARS P.READING.MAIL)
(VARS (FOLDER.OPEN NIL)
(P.NEW.MAIL.RETRIEVED NIL)
(NO.NEW.MAIL NIL)
(NEW.MAIL NIL)
(HEARDMSGS NIL)
(P.MESSAGE.QUERY? NIL)
ONEMINUTE)
(CONSTANTS ONEMINUTE)
(GLOBALVARS P.PASSWORDS P.MAILFILES P.USERS)
(RECORDS LAFITEMSG MAILFOLDER)))
(DEFINEQ
(BROWSER.FROM.FILE
[LAMBDA (MAILFILE) (* pkh: "10-Nov-84 17:30")
(for BROWSER in \ACTIVELAFITEFOLDERS until (EQUAL MAILFILE (fetch (MAILFOLDER
VERSIONLESSFOLDERNAME)
of BROWSER))
do NIL finally (RETURN BROWSER])
(P.AUTHENTICATE
[LAMBDA NIL (* mmw: " 1-Nov-84 19:49")
(WITH.MONITOR \LAFITE.MAILSERVERLOCK (\LAFITE.GET.USER.DATA])
(P.QUIT.OR.READ.OLD.MAIL
[LAMBDA (ITEM) (* pkh: "25-Feb-85 18:08")
(COND
((EQ ITEM (QUOTE #)) (* We don't want to quit right now)
(* Read old mail)
(REPLACE (STATE STATEINFO QUIT) OF STATE WITH NIL)
(REPLACE (STATE STATEINFO READINGOLDMAIL) OF STATE WITH T)
(P.CONTROLLER))
(T (* Call for help when the input is not what we expect)
(P.HELP (QUOTE WRONG.INPUT.WHILE.P.QUIT])
(PROSE.LAFITE.PREPARE.BROWSER
[LAMBDA (FOLDERNAME) (* pkh: "18-Jan-85 18:30")
(* Automatic confirm of folder creation and return of
MAILFOLDERNAME)
(WITH.MONITOR
\LAFITE.BROWSELOCK
(PROGN (PROG (MAILFOLDER BROWSERWINDOW)
(RETURN (COND
((NULL (SETQ MAILFOLDER (\LAFITE.GETMAILFOLDER FOLDERNAME)))
(* Error occurred)
NIL)
((SETQ BROWSERWINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER))
(replace (STATE MAILFOLDER) of STATE with MAILFOLDER)
(COND
((OPENWP BROWSERWINDOW)
(TOTOPW BROWSERWINDOW))
(T (* Make sure the EXPANDFN runs)
(EXPANDW BROWSERWINDOW)))
NIL)
(T (PROG ((STREAM (fetch (MAILFOLDER FOLDERSTREAM) of MAILFOLDER))
ERRN)
(COND
(STREAM (* Already have folder open, e.g., from MOVETO, but no
browser yet)
(SETFILEINFO STREAM (QUOTE BUFFERS)
LAFITEBUFFERSIZE))
(T [COND
([NULL (SETQ STREAM (CAR (NLSETQ (\LAFITE.OPENSTREAM
FOLDERNAME
(QUOTE INPUT)
(QUOTE OLD)
T]
(COND
((OR (NEQ (CAR (SETQ ERRN (ERRORN)))
(PROG1 23
(* File not found)))
(NEQ (CADR ERRN)
FOLDERNAME))
(printout PROMPTWINDOW T "Could not open "
FOLDERNAME)
(RETURN))
(T (* Automatic confirm for over the phone)
(SETQ STREAM (\LAFITE.OPENSTREAM FOLDERNAME
(QUOTE BOTH)
(QUOTE NEW)
T)))
(T (FORGETMAILFILE FOLDERNAME)
(RETURN]
(replace (MAILFOLDER FULLFOLDERNAME) of MAILFOLDER
with (FULLNAME STREAM))
(replace (MAILFOLDER FOLDERSTREAM) of MAILFOLDER
with STREAM)))
(SETQ BROWSERWINDOW (LAB.CREATEWINDOW MAILFOLDER))
(replace (STATE MAILFOLDER) of STATE with MAILFOLDER)
(RETURN MAILFOLDER])
(P.BYE
[LAMBDA NIL (* BBB " 4-Apr-85 09:50")
(IGNORETIMER T)
(P.RESET.TIMER)
(SPEAK " You are logged out. Goodbye!↑[[i")
(READ.TTS) (* Wait for the response.)
(SETQ P.HELP.FLG T)
(P.CLOSE.BROWSER (fetch (STATE MAILFOLDER) of STATE))
(P.CONTROLLER.RESET)
(P.SPEED 160)
(BREAKCONNECTION (QUOTE PHYLUM))
(BREAKCONNECTION (QUOTE ERIS))
(BREAKCONNECTION (QUOTE INDIGO))
(BREAKCONNECTION (QUOTE IVY))
(SPEAK PHONE.HANGUP) (* Hang up the phone)
(READ.PHONECONTROL) (* Read the response.)
(FLUSH.ESC.SEQ)
(SETQ OFF.THE.HOOK NIL)
(WAKE.PROCESS \PROSE.OPERATOR.PROCESS])
(P.CLOSE.BROWSER
[LAMBDA (MAILFOLDER) (* pkh: " 7-Dec-84 16:41")
(* Based on a LAFITE function which closes browsers)
(RESETLST (OBTAIN.MONITORLOCK \LAFITE.BROWSELOCK NIL T)
(OBTAIN.MONITORLOCK \LAFITE.MAINLOCK NIL T)
(COND
(\LAFITE.ACTIVE [for FOLDER in (APPEND \ACTIVELAFITEFOLDERS) bind BROWSERWINDOW
do (COND
((NOT (SETQ BROWSERWINDOW (fetch (MAILFOLDER BROWSERWINDOW)
of FOLDER)))
(\LAFITE.CLOSE.FOLDER FOLDER T))
((OR (fetch (MAILFOLDER HARDCOPYSTREAM) of FOLDER)
(fetch (MAILFOLDER FOLDERNEEDSUPDATE) of FOLDER)
(fetch (MAILFOLDER FOLDERNEEDSEXPUNGE) of FOLDER))
(\LAFITE.EXPUNGE.PROC BROWSERWINDOW FOLDER (QUOTE CLOSE)
NIL NIL))
(T (\LAFITE.CLOSE.FOLDER FOLDER T)
(CLOSEW (LAB.FLUSHWINDOW BROWSERWINDOW FOLDER]
(SETQ \ACTIVELAFITEFOLDERS)
(PROGN [for WINDOW in LAFITEEDITORWINDOWS
do (* now close the edit and display windows *)
(COND
((WINDOWP WINDOW)
(COND
((OPENWP WINDOW)
(CLOSEW WINDOW))
([WINDOWP (SETQ WINDOW (WINDOWPROP WINDOW
(QUOTE
ICONWINDOW]
(CLOSEW WINDOW]
(SETQ LAFITEEDITORWINDOWS NIL))
(COND
(\LAFITEPROFILECHANGED (\LAFITE.WRITE.PROFILE)))
(LAFITECLEARCACHE)
(PROGN (for FILE in \LAFITE.TEMPFILES
do (* delete any temp files laying around *)
(CLOSEF? FILE)
(DELFILE FILE))
(SETQ \LAFITE.TEMPFILES))
(SETQ \LAFITE.LAST.STATUS (SETQ LAFITELASTMESSAGE (SETQ
LAFITEPRIMARYDISPLAYWINDOW (SETQ \LAFITEDEFAULTHOST&DIR NIL])
(P.FILES.IN.ACTIVE.BROWSERS
[LAMBDA NIL (* pkh: "10-Nov-84 17:17")
(for BROWSER in \ACTIVELAFITEFOLDERS collect (fetch (MAILFOLDER VERSIONLESSFOLDERNAME)
of BROWSER])
(P.FIND.MSG.BODY
[LAMBDA (TEXTSTREAM) (* pkh: "30-Oct-84 13:35")
(for A while [AND (NOT (EOFP TEXTSTREAM))
(NOT (AND (EQ A 13)
(EQ A (BIN TEXTSTREAM]
do (SETQ A (BIN TEXTSTREAM)) finally (RETURN (GETFILEPTR TEXTSTREAM])
(P.LAFITE.START.NEW.USER
[LAMBDA NIL (* BBB "21-Feb-85 15:11")
(* Executed when new user has been successfully logged
in; starts or restarts LAFITE)
(USEDFREE \LAFITE.ACTIVE \LAFITE.LAST.STATUS \LAFITE.READY \LAFITE.AUTHENTICATION.FAILURE)
(SETQ LAFITEDEFAULTHOST&DIR NIL)
(COND
((EQ T \LAFITE.ACTIVE) (* LAFITE is on so Let LAFITE take notice of new user
and (password; and forget old state))
(SETQ \LAFITE.LAST.STATUS NIL)
(\LAFITE.AFTERLOGIN NIL (fetch (STATE USERINFO USER) of STATE)))
((NOT \LAFITE.ACTIVE) (* Lafite is off, so turn it on)
(SETQ \LAFITE.READY NIL)
(SETQ \LAFITE.LAST.STATUS NIL)
(SETQ \LAFITE.AUTHENTICATION.FAILURE NIL)
(LAFITE (QUOTE ON)
NIL))) (* Wait for mail polling etc. to happen)
(while (OR (NOT \LAFITE.LAST.STATUS)
(OR (EQ \LAFITE.LAST.STATUS (QUOTE Initializing))
(EQUAL \LAFITE.LAST.STATUS "Initializing")))
do (BLOCK 250)) (* No mail test)
(COND
((EQ \LAFITE.LAST.STATUS (QUOTE NO.MAIL))
(replace (STATE STATEINFO QUIT) of STATE with T)
(replace (STATE LAFITEINFO NONEWMAIL) of STATE with T)
(P.CHUNK " There is no new mail. ")
(P.CHUNK " Push asterisk to quit, or, push sharp sign to read old mail. "))
((EQ \LAFITE.LAST.STATUS (QUOTE NEW.MAIL))
(replace (STATE LAFITEINFO NEWMAIL) of STATE with T)
(P.CONTROLLER))
((EQ \LAFITE.LAST.STATUS (QUOTE NO.MAILSERVERS))
(replace (STATE STATEINFO QUIT) of STATE with T)
(P.CHUNK " No mail servers are available. ")
(P.HELP (QUOTE NO.MAILSERVERS)))
((EQ \LAFITE.LAST.STATUS (QUOTE SOME.UP))
(P.CHUNK " Some mail servers are down. I can not find out whether you have any new mail. ")
(replace (STATE STATEINFO QUIT) of STATE with T)
(replace (STATE LAFITEINFO NONEWMAIL) of STATE with T)
(P.HELP (QUOTE NO.NEW.MAIL)))
(T (SHOULDNT])
(P.OPEN.FOLDER.AND.GET.NEW.MAIL
[LAMBDA (USER) (* BBB "18-Feb-85 17:49")
(* Happens when we start and there is new mail)
(PROG (FIRSTNEW LASTNEW MAILFOLDER RESULT MAILFILE)
(P.CHUNK " You have new mail, which is being retrieved")
(if [NOT (NLSETQ (P.OPEN.BROWSER.ON.FILE (SETQ MAILFILE (P.MAILFILE USER]
then (P.HELP (QUOTE FILE.SERVER.DOWN.OR.MAIL.FILE.BUSY))
(RETURN)) (* Want to know where to open other file if this one
fails)
(SETQ MAILFOLDER (fetch (STATE MAILFOLDER) of STATE))
(* The first new message is
(1 + the number of messages in the old file))
(SETQ FIRSTNEW (ADD1 (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER)))
(if (NOT (NLSETQ (P.GETMAIL USER MAILFOLDER)))
then (RETURN))
(replace (STATE STATEINFO READINGNEWMAIL) of STATE with T)
(SETQ LASTNEW (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER))
(replace (STATE STATEINFO MSGS NEWMSGS FIRSTNEW) of STATE with FIRSTNEW)
(replace (STATE STATEINFO MSGS NEWMSGS LASTNEW) of STATE with LASTNEW)
(if (NOT (EQ FIRSTNEW LASTNEW))
then (P.CHUNK (CONCAT FIRSTNEW " is the first new message. " LASTNEW
" is the last message. "))
else (P.CHUNK (CONCAT "The new message is number " FIRSTNEW ". ")))
(P.HELP (QUOTE NEW.MAIL])
(P.SURVEY.MSGS
[LAMBDA (FIRSTMSGNO LASTMSGNO MAILFOLDER) (* pkh: "17-Nov-84 14:05")
(replace (STATE STATEINFO MSGSURVEY) of STATE with T)
(for MSG from FIRSTMSGNO to LASTMSGNO first (SETQ MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS)
of MAILFOLDER))
do (P.CHUNK (P.PREPARE.HEADER (NTHMESSAGE MESSAGES MSG)
MSG)))
(replace (STATE STATEINFO MSGSURVEY) of STATE with NIL])
(P.GETMAIL
[LAMBDA (USER MAILFOLDER) (* lfg: "25-Feb-85 19:21")
(* Starts LAFITE if necessary and gets mail for USER)
(* Turn on LAFITE if it isn't already;
but don't get a particular mail-file)
(PROG NIL
(forDuration (ITIMES 3 ONEMINUTE) until (fetch (MAILFOLDER BROWSERREADY) of MAILFOLDER)
do (DISMISS 500)
finally (if (NOT (fetch (MAILFOLDER BROWSERREADY) of MAILFOLDER))
then (P.HELP (QUOTE CANT.WRITE.MAIL.FILE)))
(RETURN))
(if [NULL (NLSETQ (\LAFITE.GETNEWMAIL MAILFOLDER (fetch (MAILFOLDER BROWSERWINDOW)
of MAILFOLDER]
then (P.HELP (QUOTE CANT.WRITE.MAIL.FILE))
(RETFROM (QUOTE P.CONTROLLER)))
(until (fetch (MAILFOLDER BROWSERREADY) of MAILFOLDER) do (BLOCK 1000))
(P.CHUNK " Your mail has been retrieved. "])
(P.GETNEWMAIL
[LAMBDA (MAILFOLDER) (* pkh: "16-Jan-85 19:01")
(COND
([NULL (NLSETQ (\LAFITE.GETNEWMAIL MAILFOLDER (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER]
(P.CHUNK
"Could not open your mail file. The mail file is in use on some other machine. Please log out by pushing asterisk. "
)
(RETFROM (QUOTE P.CONTROLLER])
(P.LAFITE.BROWSE
[LAMBDA (FILE) (* pkh: "27-Oct-84 16:30")
(\LAFITE.BROWSE (QUOTE ##BROWSE##)
LAFITEMAINMENU FILE])
(P.MAILFILE
[LAMBDA (USER OLDMAILONLY?) (* bbb: " 1-Mar-85 17:52")
(* Associates mail files to be used by the mail reader
with users)
(PROG ((USER.LOGININFO (GET.LOGININFO USER (fetch (STATE USERINFO TOUCHTONES) of STATE)))
MAILFILE UNKNOWN HOST NEW.LOGININFO)
(P.CHUNK " Looking for your mail file. ")
(SETQ MAILFILE (OR (INFILEP (fetch (LOGININFO MAILFILE) of USER.LOGININFO))
(P.SEARCH.FOR.MAILFILE USER)))
(if MAILFILE
then [P.CHUNK (CONCAT "Found the mail file on " (UNPACKFILENAME MAILFILE (QUOTE HOST]
(if (NEQ MAILFILE (fetch (LOGININFO MAILFILE) of USER.LOGININFO))
then (CHANGE.MAILFILE USER (fetch (STATE USERINFO TOUCHTONES) of STATE)
MAILFILE))
(RETURN MAILFILE)
else (* Didn't find ACTIVE.MAIL)
[SETQ HOST (COND
([NLSETQ (DELFILE (CLOSEF (OPENFILE (PACKFILENAME (QUOTE HOST)
(QUOTE PHYLUM)
(QUOTE DIRECTORY)
USER
(QUOTE NAME)
(GENSYM (QUOTE F)))
(QUOTE BOTH]
(SETQ HOST (QUOTE PHYLUM)))
([NLSETQ (DELFILE (CLOSEF (OPENFILE (PACKFILENAME (QUOTE HOST)
(QUOTE ERIS)
(QUOTE DIRECTORY)
USER
(QUOTE NAME)
(GENSYM (QUOTE F))
(QUOTE BOTH]
(SETQ HOST (QUOTE ERIS)))
([NLSETQ (DELFILE (CLOSEF (OPENFILE (PACKFILENAME (QUOTE HOST)
(QUOTE IVY)
(QUOTE DIRECTORY)
USER
(QUOTE NAME)
(GENSYM (QUOTE F))
(QUOTE BOTH]
(SETQ HOST (QUOTE IVY]
[COND
(HOST (SETQ MAILFILE (PACKFILENAME (QUOTE HOST)
HOST
(QUOTE DIRECTORY)
USER
(QUOTE NAME)
(QUOTE MAILREADER)
(QUOTE EXTENSION)
(QUOTE MAIL]
(COND
((AND MAILFILE (NOT OLDMAILONLY?)
(NOT UNKNOWN))
(P.CHUNK " Could not find a mail file called active dot mail for you. ")
(P.CHUNK (CONCAT " Your mail will be put in the file " HOST " " USER
" mailreader dot mail . "))
(\LAFITE.BROWSE NIL NIL NIL MAILFILE)
(RETURN MAILFILE))
((AND (NOT UNKNOWN)
(INFILEP MAILFILE)
(NEQ (GETFILEINFO MAILFILE (QUOTE LENGTH))
0)) (* We are reading old mail, so the user should be
known, there should be a MAILREADER.MAIL file and it
should be non-empty)
(P.CHUNK (CONCAT
" Could not find a mail file called active dot mail for you. We will read the mail in "
MAILFILE "."))
(RETURN MAILFILE))
(T (P.CHUNK
" Could not find a mail file called active dot mail for you. Please logout. ")
(RETURN NIL])
(P.OPEN.BROWSER.ON.FILE
[LAMBDA (MAILFILE) (* BBB " 7-Mar-85 09:52")
(* Opens a browser on the users mailfile)
(* Flush info about old mailfolder)
(PROG (FILESINUSE (P.FILES.IN.ACTIVE.BROWSERS))
(COND
((NULL MAILFILE)
(RETURN)))
(COND
((MEMBER MAILFILE FILESINUSE)
(replace (STATE MAILFOLDER) of STATE with (BROWSER.FROM.FILE MAILFILE))
(RETURN T))
((NULL (fetch (STATE MAILFOLDER) of STATE)) (* Open browser)
(P.HELP (QUOTE OPENING.FOLDER))
(\LAFITE.BROWSE NIL NIL NIL MAILFILE) (* Wait until P.MAILFOLDER is rebound by our special
\LAFITE.PREPARE.BROWSER)
[forDuration (ITIMES 3 ONEMINUTE) until (AND (fetch (STATE MAILFOLDER) of STATE)
(fetch (MAILFOLDER BROWSERREADY)
of (fetch (STATE MAILFOLDER)
of STATE)))
do (DISMISS 250) finally (COND
((AND (fetch (STATE MAILFOLDER) of STATE)
(fetch (MAILFOLDER BROWSERREADY)
of (fetch (STATE MAILFOLDER) of STATE)))
(replace (STATE LAFITEINFO FOLDEROPEN) of STATE
with T))
(T (P.HELP (QUOTE CANT.READ.MAIL.FILE))
(ERROR]
(RETURN T])
(P.PREPARE.HEADER
[LAMBDA (MSGDESCRIPTOR MSG#) (* BBB " 8-Mar-85 09:52")
(* Makes up a string which describes the message)
(PROG ((DATE (fetch (LAFITEMSG DATE) of MSGDESCRIPTOR))
(SUBJECT (fetch (LAFITEMSG SUBJECT) of MSGDESCRIPTOR))
(RECIPIENT (LAFITE.FETCH.TO.FIELD MSGDESCRIPTOR MAILFOLDER))
(SENDER (fetch (LAFITEMSG FROM) of MSGDESCRIPTOR))
(LENGTH (fetch (LAFITEMSG MESSAGELENGTH) of MSGDESCRIPTOR))
MINUTELENGTH)
(SETQ MINUTELENGTH (MSG.LEN.TO.TIME LENGTH))
(* CONCAT (COND ((OR MSG# (SETQ MSG# (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of (fetch (STATE MAILFOLDER) of STATE)
))) (CONCAT "Message number " (MKSTRING MSG#) ", ")) (T "")) (COND (DATE (CONCAT " dated " DATE ". "))
(T "")) (COND (SENDER (CONCAT "This message is from " SENDER ". ")) (T "")) (COND (RECIPIENT
(CONCAT "The message is to: " RECIPIENT ". ")) (T "")) (COND (SUBJECT (CONCAT "The subject is: " SUBJECT ". "))
(T "")) (COND (MINUTELENGTH (CONCAT "The length of the message is: " MINUTELENGTH ". ")) (T "")))
(RETURN (CONCAT (COND
([OR MSG# (SETQ MSG# (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE)
of (fetch (STATE MAILFOLDER) of STATE]
(CONCAT "Message " (MKSTRING MSG#)
". "))
(T ""))
(COND
[SENDER (CONCAT " from " (PREPARE.ADDRESSES (U-CASE SENDER]
(T ""))
(COND
(DATE (CONCAT " on " DATE ".. "))
(T ""))
(COND
(RECIPIENT (CONCAT " Addressed to: " (PREPARE.ADDRESSES (U-CASE RECIPIENT)
)
". "))
(T ""))
(COND
(SUBJECT (CONCAT " Subject: " SUBJECT ". "))
(T ""))
(COND
(MINUTELENGTH (CONCAT " Length: " MINUTELENGTH ". "))
(T ""])
(P.READ.OLD.MAIL
[LAMBDA (MAILFILE) (* lfg: "25-Feb-85 19:21")
(PROG (NO.MSGS MAILFOLDER)
(COND
((NOT (NLSETQ (P.OPEN.BROWSER.ON.FILE MAILFILE)))
(P.HELP (QUOTE FILE.SERVER.DOWN.OR.MAIL.FILE.BUSY))
(RETURN)))
(replace (STATE STATEINFO READINGOLDMAIL) of STATE with T)
(SETQ MAILFOLDER (fetch (STATE MAILFOLDER) of STATE))
[forDuration (ITIMES 3 ONEMINUTE) until (fetch (MAILFOLDER BROWSERREADY) of MAILFOLDER)
do (DISMISS 250) finally (COND
((NOT (fetch (MAILFOLDER BROWSERREADY) of MAILFOLDER))
(P.HELP (QUOTE CANT.READ.MAIL.FILE))
(RETURN]
(SETQ NO.MSGS (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER))
(replace (STATE STATEINFO MSGS NOOFMSGS) of STATE with NO.MSGS)
(P.CHUNK (CONCAT " There " (COND
((PLURAL? NO.MSGS " is " " are ")))
(MKSTRING NO.MSGS)
(COND
((PLURAL? NO.MSGS " message " " messages ")))
" in your mail file. ")) (* Select the first message)
(P.SELECT.MSG MAILFOLDER 1)
(P.HELP (QUOTE PLAYING.MESSAGE.INFO])
(P.SAY.MSG?
[LAMBDA (PARSEDMSG) (* pkh: "14-Dec-84 19:25")
(P.CHUNK (fetch (STATE PROSEINPUT HEADER) of STATE)) (* It should maybe be the message number rather than
the message descriptor which we list as heard)
(replace (STATE STATEINFO HEARDMSGS EXAMINED) of STATE
with (CONS (fetch (STATE PROSEINPUT MSGNO) of STATE)
(fetch (STATE STATEINFO HEARDMSGS EXAMINED) of STATE)))
(P.CHUNK
" Push sharp sign if you want to hear the message. Push asterisk if you don't want to hear it. "])
(P.SAY.QUERY
[LAMBDA (HEADER BODY)
NIL])
(P.SEARCH.FOR.MAILFILE
[LAMBDA (USER) (* bbb: " 1-Mar-85 19:25")
(* * Searches for a mail file using the following path: {PHYLUM}<USER>*ACTIVE.MAIL {ERIS}<USER>*ACTIVE.MAIL
{IVY}<USER>*ACTIVE.MAIL)
(OR (CAR (DIRECTORY (LIST (PACK* (QUOTE {PHYLUM})
(QUOTE <)
USER
(QUOTE >)
(QUOTE ACTIVE.MAIL;))
(QUOTE +)
(PACK* (QUOTE {PHYLUM})
(QUOTE <)
USER
(QUOTE >)
(QUOTE *>ACTIVE.MAIL;)))
(QUOTE COLLECT)))
(CAR (DIRECTORY (LIST (PACK* (QUOTE {ERIS})
(QUOTE <)
USER
(QUOTE >)
(QUOTE ACTIVE.MAIL;))
(QUOTE +)
(PACK* (QUOTE {ERIS})
(QUOTE <)
USER
(QUOTE >)
(QUOTE *>ACTIVE.MAIL;)))
(QUOTE COLLECT)))
(CAR (DIRECTORY (LIST (PACK* (QUOTE {IVY})
(QUOTE <)
USER
(QUOTE >)
(QUOTE ACTIVE.MAIL;))
(QUOTE +)
(PACK* (QUOTE {IVY})
(QUOTE <)
USER
(QUOTE >)
(QUOTE *>ACTIVE.MAIL;)))
(QUOTE COLLECT])
(P.SELECT.AND.SAY.MSG
[LAMBDA (MSG) (* pkh: " 4-Jan-85 17:40")
(* Selects a message; if a MSG argument is given, we check that it is in the range of messages in the folder;
it it is we pass the message to P.PREPARE.TO.SAY.MSG; if no MSGno argument is supplied we go back into this function
supplying a MSGno argument which is the number of the message after the one which is currently selected)
(PROG (FIRSTSELECTEDMESSAGE (NO.OF.MSGS (fetch (MAILFOLDER #OFMESSAGES)
of (fetch (STATE MAILFOLDER) of STATE)))
(MAILFOLDER (fetch (STATE MAILFOLDER) of STATE)))
[COND
((NOT (OR (NULL MSG)
(NUMBERP MSG)))
(RETURN (P.CHUNK " Please renter the number of the message again. "]
(COND
(MSG (* A message number has been explicitly supplied by the
user; select the message and say it)
(P.SELECT.MSG MAILFOLDER MSG) (* The MSGDESCRIPTOR and MSGNO fields of PROSEINPUT are
set by P.SELECT.MSG)
[COND
((fetch (STATE HEADER) of STATE)
(P.MESSAGE.QUERY (fetch (STATE PROSEINPUT MSGDESCRIPTOR) of STATE)
(fetch (STATE PROSEINPUT MSGNO) of STATE]
(* The header and body fields of PROSEINPUT are set by
P.PARSEMSG)
)
(T (* The user has pushed #, no message number has been
specified, we are reading old mail, so we just get the
next message)
(COND
[(MEMBER (SETQ FIRSTSELECTEDMESSAGE (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE)
of MAILFOLDER))
(fetch (STATE STATEINFO HEARDMSGS EXAMINED) of STATE))
(P.SELECT.MSG MAILFOLDER (ADD1 (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE)
of MAILFOLDER)))
(COND
((fetch (STATE HEADER) of STATE)
(P.MESSAGE.QUERY (fetch (STATE MSGDESCRIPTOR) of STATE)
(fetch (STATE MSGNO) of STATE]
(T (P.SELECT.MSG MAILFOLDER FIRSTSELECTEDMESSAGE)
(* Update of MSGNO is done inside of P.SELECT.MSG, but
we don't call that here, we probably should for
uniformity !!!!)
(COND
((fetch (STATE HEADER) of STATE)
(P.MESSAGE.QUERY (fetch (STATE MSGDESCRIPTOR) of STATE)
FIRSTSELECTEDMESSAGE])
(P.SELECT.MSG
[LAMBDA (MAILFOLDER MSG#) (* pkh: "18-Jan-85 11:41")
(* Selects a message)
(PROG [(NO.OF.MSGS (fetch (MAILFOLDER #OFMESSAGES) of (fetch MAILFOLDER of STATE]
[COND
((NOT MSG#)
(SETQ MSG# (OR (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of (fetch (STATE MAILFOLDER)
of STATE))
1]
[COND
((MSG.IN.RANGE MSG# NO.OF.MSGS))
(T (* The MSG wasn't in the folder)
(RETURN (PROGN (P.CHUNK (CONCAT " You asked for message " (MKSTRING MSG#)
", but the number of messages in the file is only "
(MKSTRING NO.OF.MSGS)
"."))
(P.HELP (QUOTE SPECIFY.ANOTHER.MSG))
(* Make sure we have empty PROSEINPUT because
P.CONTROLLER will poll it)
(replace (STATE PROSEINPUT HEADER) of STATE with NIL]
(replace (STATE PROSEINPUT MSGDESCRIPTOR) of STATE with (NTHMESSAGE (fetch (MAILFOLDER
MESSAGEDESCRIPTORS)
of MAILFOLDER)
MSG#))
(replace (STATE HEADER) of STATE with (P.PREPARE.HEADER (fetch (STATE MSGDESCRIPTOR)
of STATE)
MSG#))
(replace (STATE PROSEINPUT MSGNO) of STATE with MSG#)
(replace (MAILFOLDER FIRSTSELECTEDMESSAGE) of MAILFOLDER with MSG#)
(replace (MAILFOLDER LASTSELECTEDMESSAGE) of MAILFOLDER with MSG#])
(MSG.IN.RANGE
[LAMBDA (MSG NO.OF.MSG) (* Checks that a message number is within the range of
messages in the file)
(COND
((NULL MSG)
T)
((AND (IGEQ MSG 1)
(ILEQ MSG NO.OF.MSG))
MSG)
(T NIL])
(PREPARE.ADDRESSES
[LAMBDA (RECIPIENTS) (* bbb: "27-Feb-85 15:25")
(* * Each recipient in the string RECIPIENTS will be parsed and uttered.)
(CONCATLIST (for NAME in (\GV.PARSERECIPIENTS RECIPIENTS) collect (CONCAT (PREPARE.SINGLE.ADDRESS
NAME)
","])
(PREPARE.DL
[LAMBDA (DLNAME) (* BBB "10-Apr-85 11:08")
(* * The dl name is prepared)
(if DLNAME
then (CONCAT (OR [CADR (SASSOC DLNAME (QUOTE (("COMPUTERRESEARCH" "COMPUTER RESEARCH")
("ISL" "EYE ESS EL")
("FORUMSATPARC" "FORUMS AT PARC")
("AISBU-PA" "AI EYE ESS BEE YOU")
("EXERCISECLASSINFO" "EXERCISE CLASS INFO"]
(if (MEMBER DLNAME (QUOTE ("ALLPA" "ALLWBST" "ALLDLOS" "ALLES" "ALLSV")))
then "ALL")
DLNAME)
" dl"])
(PREPARE.NAME
[LAMBDA (NAME) (* bbb: "27-Feb-85 11:41")
(* * For now the name will simply be returned without looking up its pronunciation)
(CONCAT " " NAME])
(PREPARE.REGISTRY
[LAMBDA (REGISTRY) (* BBB "15-Mar-85 14:41")
(* * REGISTRY is a string which will be interpreted and said if not the same as the default registry)
(if [AND REGISTRY (NOT (STREQUAL REGISTRY (MKSTRING DEFAULTREGISTRY]
then (CONCAT " in " (OR [CADR (SASSOC REGISTRY (QUOTE (("PA" "PALO ALTO")
("ES" "EL SEGUNDO")
("WBST" "WEBSTER")
("PASA" "PASADENA")
("HENR" "HENRIETTA")
("OSBUNORTH" "OSB YOU NORTH")
("DLOS" "DALLAS")
("SV" "VERSATEC"]
REGISTRY))
else " "])
(PREPARE.SINGLE.ADDRESS
[LAMBDA (ADDRESS) (* BBB " 8-Mar-85 11:00")
(* * Addresses are assumed in one of the following forms: xeroxdl↑ (.registry), name ((.registry) {@ %%}site
(.other information)), or externalmailinglist:{spaces};)
(* * What is returned: Xeroxdl "dl" ("in" registry) "." or Name ("in" registry) ("at" site) "."
The registry part will not be returned if the registry is the same as DEFAULTREGISTRY. Note: for now the
externalmailinglist name will be treated just like a name)
(PROG (NAME REGISTRY SITE TEMPSTRING NAME.END.POS REGISTRY.END.POS SITE.END.POS ADDRESS.STRING)
(if (NULL ADDRESS)
then (RETURN " unrecognized address "))
(SETQ TEMPSTRING (CONCAT ADDRESS))
(SETQ NAME.END.POS 0) (* Get the name or the external mailing list name)
(while [AND (SETQ CHAR (GNC TEMPSTRING))
(NOT (FMEMB CHAR (QUOTE (%% %. @ :]
do (SETQ NAME.END.POS (ADD1 NAME.END.POS)))
[COND
((NOT CHAR)
(SETQ NAME ADDRESS))
((EQ CHAR (QUOTE :))
(SETQ NAME (SUBSTRING ADDRESS 1 NAME.END.POS)))
(T (SETQ NAME (SUBSTRING ADDRESS 1 NAME.END.POS))
(* Get the registry name)
[if (EQ CHAR (QUOTE %.))
then (SETQ REGISTRY.END.POS (ADD1 NAME.END.POS))
(while [AND (SETQ CHAR (GNC TEMPSTRING))
(NOT (FMEMB CHAR (QUOTE (%% @]
do (SETQ REGISTRY.END.POS (ADD1 REGISTRY.END.POS)))
(if CHAR
then (SETQ REGISTRY (SUBSTRING ADDRESS (PLUS 2 NAME.END.POS)
REGISTRY.END.POS))
else (SETQ REGISTRY (SUBSTRING ADDRESS (PLUS 2 NAME.END.POS]
(SETQ SITE.END.POS (ADD1 (OR REGISTRY.END.POS NAME.END.POS)))
(while [AND (SETQ CHAR (GNC TEMPSTRING))
(NOT (FMEMB CHAR (QUOTE (%% @ %.]
do (SETQ SITE.END.POS (ADD1 SITE.END.POS)))
(if CHAR
then (SETQ SITE (SUBSTRING ADDRESS (PLUS 2 (OR REGISTRY.END.POS NAME.END.POS))
SITE.END.POS))
else (SETQ SITE (SUBSTRING ADDRESS (PLUS 2 (OR REGISTRY.END.POS NAME.END.POS]
(* Get the site)
(* Check to see if we have a dl)
[if (STREQUAL "↑" (SUBSTRING NAME NAME.END.POS NAME.END.POS))
then [SETQ ADDRESS.STRING (PREPARE.DL (SUBSTRING NAME 1 (SUB1 NAME.END.POS]
else (SETQ ADDRESS.STRING (if (AND (EQ (PACK* NAME)
USERNAME)
(NOT SITE)
(OR (NULL REGISTRY)
(EQ (PACK* REGISTRY)
DEFAULTREGISTRY)))
then " you"
else (PREPARE.NAME NAME]
(SETQ ADDRESS.STRING (CONCAT ADDRESS.STRING (PREPARE.REGISTRY REGISTRY)
(PREPARE.SITE SITE)))
(RETURN ADDRESS.STRING])
(PREPARE.SITE
[LAMBDA (SITE) (* bbb: "27-Feb-85 11:39")
(* * SITE is a string which will be interpreted and said)
(if SITE
then (CONCAT " at " (OR (CADR (SASSOC SITE NIL))
SITE))
else " "])
(\PROSE.LAFITE.PREPARE.BROWSER
[LAMBDA (FOLDERNAME) (* pkh: "18-Jan-85 11:33")
(* Automatic confirm of folder creation and return of
MAILFOLDERNAME)
(WITH.MONITOR
\LAFITE.BROWSELOCK
(PROGN
[replace (STATE MAILFOLDER) of STATE
with (PROG (MAILFOLDER BROWSERWINDOW)
(RETURN (COND
((NULL (SETQ MAILFOLDER (\LAFITE.GETMAILFOLDER FOLDERNAME)))
(* Error occurred)
NIL)
((SETQ BROWSERWINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER))
(COND
((OPENWP BROWSERWINDOW)
(TOTOPW BROWSERWINDOW))
(T (* Make sure the EXPANDFN runs)
(EXPANDW BROWSERWINDOW)))
NIL)
(T (PROG ((STREAM (fetch (MAILFOLDER FOLDERSTREAM) of MAILFOLDER))
ERRN)
(COND
(STREAM (* Already have folder open, e.g., from MOVETO, but no
browser yet)
(SETFILEINFO STREAM (QUOTE BUFFERS)
LAFITEBUFFERSIZE))
(T [COND
([NULL (SETQ STREAM
(CAR (NLSETQ (\LAFITE.OPENSTREAM
FOLDERNAME
(QUOTE INPUT)
(QUOTE OLD)
T]
(COND
((OR (NEQ (CAR (SETQ ERRN (ERRORN)))
(PROG1 23
(* File not found)))
(NEQ (CADR ERRN)
FOLDERNAME))
(printout PROMPTWINDOW T "Could not open "
FOLDERNAME)
(RETURN))
(T (* Automatic confirm for over the phone)
(SETQ STREAM (\LAFITE.OPENSTREAM FOLDERNAME
(QUOTE BOTH)
(QUOTE NEW)
T)))
(T (FORGETMAILFILE FOLDERNAME)
(RETURN]
(replace (MAILFOLDER FULLFOLDERNAME) of MAILFOLDER
with (FULLNAME STREAM))
(replace (MAILFOLDER FOLDERSTREAM) of MAILFOLDER
with STREAM)))
(SETQ BROWSERWINDOW (LAB.CREATEWINDOW MAILFOLDER))
(RETURN MAILFOLDER]
(fetch (STATE MAILFOLDER) of STATE])
)
(RPAQ? P.READING.MAIL NIL)
(RPAQQ FOLDER.OPEN NIL)
(RPAQQ P.NEW.MAIL.RETRIEVED NIL)
(RPAQQ NO.NEW.MAIL NIL)
(RPAQQ NEW.MAIL NIL)
(RPAQQ HEARDMSGS NIL)
(RPAQQ P.MESSAGE.QUERY? NIL)
(RPAQQ ONEMINUTE 60000)
(DECLARE: EVAL@COMPILE
(RPAQQ ONEMINUTE 60000)
(CONSTANTS ONEMINUTE)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS P.PASSWORDS P.MAILFILES P.USERS)
)
[DECLARE: EVAL@COMPILE
(DATATYPE LAFITEMSG ((PARSED? FLAG)
(DELETED? FLAG)
(SEEN? FLAG)
(FORMATTED? FLAG)
(NIL FLAG)
(NIL FLAG)
(NIL FLAG)
(NIL FLAG)
(BEGIN POINTER)
(MARKCHAR BYTE)
(MESSAGELENGTH POINTER)
(# WORD)
(STAMPLENGTH WORD)
(TOCLENGTH WORD)
(NIL WORD)
(MESSAGELENGTHCHANGED? FLAG)
(MARKSCHANGED? FLAG)
(SELECTED? FLAG)
(MSGFROMMECHECKED? FLAG)
(MSGFROMMETRUTH FLAG)
(NIL FLAG)
(NIL FLAG)
(NIL FLAG)
(DATE POINTER)
(FROM POINTER)
(SUBJECT POINTER)
(TO POINTER)) (* BEGIN is the only absolute pointer into the message
file -- all other positions are relative to BEGIN --
see the ACCESSFNS *)
(BLOCKRECORD LAFITEMSG ((PARSED&DELETED&SEENBITS BITS 3)
(NIL BITS 5)
(NIL POINTER)))
(BLOCKRECORD LAFITEMSG ((MSGFLAGBITS BITS 8)
(NIL POINTER)))
[ACCESSFNS LAFITEMSG ((END (IPLUS (fetch (LAFITEMSG MESSAGELENGTH) of DATUM)
(fetch (LAFITEMSG BEGIN) of DATUM)))
(START (IPLUS (fetch (LAFITEMSG BEGIN) of DATUM)
(fetch (LAFITEMSG STAMPLENGTH) of DATUM)))
(SEENFILEPTR (IPLUS (fetch (LAFITEMSG BEGIN) of DATUM)
LAFITESEENPOSITION))
(MARKFILEPTR (IPLUS (fetch (LAFITEMSG BEGIN) of DATUM)
LAFITEMARKPOSITION))
(DELETEFILEPTR (IPLUS (fetch (LAFITEMSG BEGIN) of DATUM)
LAFITEDELETEPOSITION))
(MSGFROMMEP (COND
((fetch (LAFITEMSG MSGFROMMECHECKED?) of DATUM)
(fetch (LAFITEMSG MSGFROMMETRUTH) of DATUM))
(T (LA.MSGFROMMEP DATUM)))
(PROG1 (replace (LAFITEMSG MSGFROMMETRUTH) of DATUM
with NEWVALUE)
(replace (LAFITEMSG MSGFROMMECHECKED?)
of DATUM with T])
(DATATYPE MAILFOLDER ((BROWSERPROMPTDIRTY FLAG)
(BROWSERREADY FLAG)
(FOLDERNEEDSUPDATE FLAG)
(FOLDERNEEDSEXPUNGE FLAG)
(FOLDERBEINGUPDATED FLAG)
(HARDCOPYPENDING FLAG)
(NIL FLAG)
(FULLFOLDERNAME POINTER)
(VERSIONLESSFOLDERNAME POINTER)
(SHORTFOLDERNAME POINTER)
(FOLDERSTREAM POINTER)
(MESSAGEDESCRIPTORS POINTER)
(FOLDERLOCK POINTER)
(#OFMESSAGES WORD)
(TOCLASTMESSAGE# WORD)
(BROWSERFONTHEIGHT WORD)
(BROWSERFONTASCENT WORD)
(BROWSERFONTDESCENT WORD)
(BROWSERMAXXPOS WORD)
(ORDINALXPOS WORD)
(DATEXPOS WORD)
(FROMXPOS WORD)
(FROMMAXXPOS WORD)
(SUBJECTXPOS WORD)
(BROWSERDIGITWIDTH WORD)
(FIRSTSELECTEDMESSAGE WORD)
(LASTSELECTEDMESSAGE WORD)
(FIRSTCHANGEDMESSAGE WORD)
(CURRENTEOMLENGTH WORD)
(CURRENTDISPLAYEDSTREAM POINTER)
(BROWSEREXTENT POINTER)
(BROWSERORIGIN POINTER)
(BROWSERSELECTIONREGION POINTER)
(BROWSERWINDOW POINTER)
(BROWSERMENU POINTER)
(BROWSERMENUWINDOW POINTER)
(BROWSERPROMPTWINDOW POINTER)
(ORIGINALBROWSERTITLE POINTER)
(FOLDERDISPLAYWINDOWS POINTER)
(FOLDEREOFPTR POINTER)
(DEFAULTMOVETOFILE POINTER)
(CURRENTDISPLAYEDMESSAGE POINTER)
(BROWSERUPDATEFROMHERE POINTER)
(EXTRAFIELD POINTER)
(FOLDERCREATIONDATE POINTER)
(HARDCOPYMESSAGES POINTER)
(HARDCOPYSTREAM POINTER)))
]
(/DECLAREDATATYPE (QUOTE LAFITEMSG)
(QUOTE (FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER BYTE POINTER WORD WORD WORD
WORD FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER POINTER POINTER
POINTER)))
(/DECLAREDATATYPE (QUOTE MAILFOLDER)
(QUOTE (FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER POINTER POINTER POINTER POINTER
POINTER WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER)))
(PUTPROPS PROSE-LAFITE COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1304 38063 (BROWSER.FROM.FILE 1314 . 1646) (P.AUTHENTICATE 1648 . 1829) (
P.QUIT.OR.READ.OLD.MAIL 1831 . 2486) (PROSE.LAFITE.PREPARE.BROWSER 2488 . 4982) (P.BYE 4984 . 5893) (
P.CLOSE.BROWSER 5895 . 7922) (P.FILES.IN.ACTIVE.BROWSERS 7924 . 8181) (P.FIND.MSG.BODY 8183 . 8541) (
P.LAFITE.START.NEW.USER 8543 . 10912) (P.OPEN.FOLDER.AND.GET.NEW.MAIL 10914 . 12692) (P.SURVEY.MSGS
12694 . 13198) (P.GETMAIL 13200 . 14338) (P.GETNEWMAIL 14340 . 14764) (P.LAFITE.BROWSE 14766 . 14953)
(P.MAILFILE 14955 . 18324) (P.OPEN.BROWSER.ON.FILE 18326 . 19898) (P.PREPARE.HEADER 19900 . 21931) (
P.READ.OLD.MAIL 21933 . 23275) (P.SAY.MSG? 23277 . 23908) (P.SAY.QUERY 23910 . 23960) (
P.SEARCH.FOR.MAILFILE 23962 . 25285) (P.SELECT.AND.SAY.MSG 25287 . 28007) (P.SELECT.MSG 28009 . 29800)
(MSG.IN.RANGE 29802 . 30103) (PREPARE.ADDRESSES 30105 . 30477) (PREPARE.DL 30479 . 31089) (
PREPARE.NAME 31091 . 31328) (PREPARE.REGISTRY 31330 . 31991) (PREPARE.SINGLE.ADDRESS 31993 . 35321) (
PREPARE.SITE 35323 . 35626) (\PROSE.LAFITE.PREPARE.BROWSER 35628 . 38061)))))
STOP