(FILECREATED " 9-Oct-86 14:55:14" {ERIS}<LAFITE>SOURCES>LAFITESEND.;7 74914
changes to: (RECORDS SENDINGCOMMAND)
(FNS \SENDMESSAGE.RESTARTABLE)
(VARS LAFITESENDCOMS)
previous date: "28-May-86 17:19:15" {ERIS}<LAFITE>SOURCES>LAFITESEND.;5)
(* "
Copyright (c) 1984, 1985, 1986 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT LAFITESENDCOMS)
(RPAQQ LAFITESENDCOMS
((COMS (* ; "Sending mail")
(FNS DOLAFITESENDINGCOMMAND \SENDMESSAGE.INITIATE \SENDMESSAGE.PARSE
\LAFITE.PREPARE.SEND \LAFITE.PREPARE.ERROR \LAFITE.CHOOSE.MSG.FORMAT
\SENDMESSAGE.MENUPROMPT \SENDMESSAGEFAIL)
(FNS \SENDMESSAGE \SENDMESSAGE.RESTARTABLE \SENDMESSAGE.CLEANUP \SENDMESSAGE.MAKEWINDOW
MAKELAFITEDELIVERMENU \LAFITE.CLOSEMSG? \LAFITE.AFTER.DELIVER \LAFITE.UNSENT.ICON
\LAFITE.FETCH.SUBJECT LAFITE.SENDMESSAGE \SENDMESSAGE0 LA.ASSURE.PROMPT.WINDOW
\LAFITE.SEND.FAIL \LAFITE.INVALID.RECIPIENTS \SENDMESSAGE.ABORT))
(COMS (* ; "Outbox hacking")
(FNS \OUTBOX.CREATE \OUTBOX.RESET \OUTBOX.CLOSEFN \OUTBOX.REPAINTFN \OUTBOX.RESHAPEFN
\OUTBOX.SHADEITEM \OUTBOX.BUTTONFN \OUTBOX.DISPLAYLINE \OUTBOX.ADD.ITEM)
(INITVARS (LAFITEOUTBOXSIZE 2)
(\LAFITE.OUTBOX))
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS OUTBOXITEM)
(GLOBALVARS LAFITEOUTBOXSIZE)))
(COMS (* ; "Built-in message forms")
(FNS \LAFITE.MESSAGEFORM MAKELAFITESUPPORTFORM MAKELISPSUPPORTFORM MAKEXXXSUPPORTFORM
MAKENEWMESSAGEFORM MAKELAFITEPRIVATEFORMSITEMS \LAFITE.UNCACHE.MESSAGEFORM
\LAFITE.READ.FORM \LAFITE.FIND.TEMPLATE \LAFITE.SAVE.FORM))
(COMS (* ; "ANSWER")
(FNS \LAFITE.ANSWER \LAFITE.ANSWER.PROC MAKEANSWERFORM))
(COMS (* ; "FORWARD")
(FNS \LAFITE.FORWARD \LAFITE.FORWARD.PROC MAKEFORWARDFORM))
[COMS (VARS LAFITESENDINGMENUITEMS LAFITEFORMSMENUITEMS LAFITEFORMATMENUITEMS)
(ADDVARS (\SYSTEMCACHEVARS \LAFITE.REPORT.MACHINE)
(LAFITESPECIALFORMS ("Lisp Report" (FUNCTION MAKELISPSUPPORTFORM)
"A form to report a Lisp bug or suggestion")
("Lafite Report" (FUNCTION MAKELAFITESUPPORTFORM)
"A form to report a Lafite bug or suggestion")))
(INITVARS (\LAFITE.REPORT.MACHINE)
(LAFITEEDITORWINDOWS)
(LAFITECURRENTEDITORWINDOWS)
(LAFITEFORMFILES)
(LAFITEFORMSMENU)
(LAFITEFORMATMENU))
(INITVARS (LAFITEEDITORFONT LAFITEDISPLAYFONT)
(LAFITEFORM.EXT (QUOTE LAFITE-FORM))
(LAFITEFORMDIRECTORIES)
(LAFITEEDITORREGION (create REGION LEFT ← 485 BOTTOM ← 130 WIDTH ← 470 HEIGHT ←
470))
(LAFITEFORWARDSUBJECTSTR)
(LAFITESUPPORT)
(MESSAGESTR ">>Message<<")
(RECIPIENTSSTR ">>Recipients<<")
(SUBJECTSTR ">>Subject<<")
(LISPSUPPORT)
(LAFITEFORWARDSTRINGS (QUOTE (
">>CoveringMessage<<
----- Begin Forwarded Messages -----
" "
----- Next Message -----
" "
----- End Forwarded Messages -----"]
(COMS (* ; "ICON stuff")
(BITMAPS MSGUNSENTICON MSGUNSENTMASK)
(VARS MSGUNSENTREGION))
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS SENDINGCOMMAND)
(GLOBALVARS \LAFITE.REPORT.MACHINE LAFITECURRENTEDITORWINDOWS LAFITEEDITORFONT
LAFITEEDITORREGION LAFITEFORMATMENU LAFITEFORMSMENUITEMS LAFITEFORMATMENUITEMS
LAFITEFORWARDSTRINGS LAFITEFORWARDSUBJECTSTR LAFITESENDINGMENUITEMS
LAFITESPECIALFORMS LAFITESUPPORT LISPSUPPORT MAKESYSDATE MESSAGESTR
RECIPIENTSSTR SUBJECTSTR MSGUNSENTICON MSGUNSENTMASK MSGUNSENTREGION
LAFITEFORMDIRECTORIES)
(FILES (SOURCE)
LAFITEDECLS))))
(* ; "Sending mail")
(DEFINEQ
(DOLAFITESENDINGCOMMAND
[LAMBDA (ITEM MENU KEY) (* bvm: "31-Jul-84 15:03")
(* * this function is invoked by buttoning the menu on top of the "sending"
window * *)
(PROG ((WINDOW (WINDOWPROP (WFROMMENU MENU)
(QUOTE MAINWINDOW)))
PROC)
(AND (SETQ PROC (WINDOWPROP WINDOW (QUOTE PROCESS)))
(PROCESS.APPLY PROC (FUNCTION \SENDMESSAGE.INITIATE)
(LIST WINDOW MENU ITEM])
(\SENDMESSAGE.INITIATE
[LAMBDA (WINDOW MENU ITEM) (* bvm: "31-Jul-84 14:45")
(ERSETQ (RESETLST (PROG ((COMMAND (EXTRACTMENUCOMMAND ITEM))
TEXTSTREAM PARSE)
(RESETSAVE NIL (LIST [FUNCTION (LAMBDA (ITEM MENU)
(COND
(RESETSTATE
(SHADEITEM ITEM MENU WHITESHADE)
(replace (MENU WHENSELECTEDFN)
of MENU
with (FUNCTION
DOLAFITESENDINGCOMMAND]
ITEM MENU))
(SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE)
(* Now disable the menu)
(replace (MENU WHENSELECTEDFN) of MENU with (FUNCTION NILL))
(PROCESSPROP (THIS.PROCESS)
(QUOTE BEFOREEXIT)
(QUOTE DON'T)) (* Don't let anyone logout now!)
(SETQ TEXTSTREAM (WINDOWPROP WINDOW (QUOTE TEXTSTREAM)))
[COND
((EQ COMMAND (QUOTE ##SEND##))
(printout (GETPROMPTWINDOW WINDOW)
T "Parsing...")
(OR (SETQ PARSE (\SENDMESSAGE.PARSE TEXTSTREAM WINDOW))
(ERROR!]
(WINDOWADDPROP WINDOW (QUOTE CLOSEFN)
(QUOTE DON'T)) (* Keep TEDIT.QUIT from closing the
window)
(TEDIT.QUIT TEXTSTREAM
(create SENDINGCOMMAND
COMMAND ← COMMAND
ITEM ← ITEM
MENU ← MENU
MESSAGE ← TEXTSTREAM
MESSAGEPARSE ← PARSE])
(\SENDMESSAGE.PARSE
[LAMBDA (MSG EDITORWINDOW) (* bvm: "30-Jun-84 16:20")
(APPLY* (fetch SENDPARSER of \LAFITEMODE)
MSG EDITORWINDOW])
(\LAFITE.PREPARE.SEND
[LAMBDA (MSG EDITORWINDOW PARSETABLE) (* bvm: "13-Nov-84 12:50")
(* Does generic things to MSG, a textstream about to be sent as a message:
makes sure it ends in a CR, has no leading CRs, and parses it according to
PARSETABLE which defaults to \LAPARSE.FULL --
returns a parse, whose first element tries to be
(EOF end-of-header-position))
(PROG (MSGEOF HEADEREOF MSGFIELDS EOFINFO)
[COND
((NOT (TYPENAMEP MSG (QUOTE STREAM)))
(RETURN (LISPERROR "ILLEGAL ARG" MSG]
[COND
(EDITORWINDOW (* Scroll so that beginning of message
is visible)
(TEDIT.SETSEL MSG 1 0 (QUOTE LEFT))
(TEDIT.NORMALIZECARET MSG)
(first (SETFILEPTR MSG 0) until (NEQ (BIN MSG)
(CHARCODE EOL))
do (* hack to get rid of leading CRs *)
(TEDIT.DELETE MSG 1 1))
[SETFILEPTR MSG (SUB1 (SETQ MSGEOF (GETEOFPTR MSG]
(COND
((NEQ (BIN MSG)
(CHARCODE EOL)) (* Make sure message ends in eol)
(TEDIT.INSERT MSG LAFITEEOL (ADD1 MSGEOF)
NIL T]
(SETFILEINFO MSG (QUOTE ENDOFSTREAMOP)
(FUNCTION \LAFITE.EOF)) (* Avoid parsing failure if
header-only message)
(SETQ MSGFIELDS (LAFITE.PARSE.HEADER MSG (OR PARSETABLE \LAPARSE.FULL)
0
(SETQ MSGEOF (GETEOFPTR MSG))
NIL T))
(COND
((EQ (CAR (SETQ EOFINFO (CAR MSGFIELDS)))
(QUOTE EOF))
(SETQ HEADEREOF (CADR EOFINFO))
[COND
((CADDR EOFINFO) (* Error)
(RETURN (\LAFITE.PREPARE.ERROR MSG EDITORWINDOW HEADEREOF]
[COND
((IEQP HEADEREOF MSGEOF) (* Parse ended at eof, so message does
not end in double CR --
add another)
(SETFILEPTR MSG MSGEOF)
(BOUT MSG (CHARCODE CR]
(RPLACA (CDR EOFINFO)
(SETQ HEADEREOF (ADD1 HEADEREOF))) (* Add one for tedit fileptr one-based
nonsense)
))
(RETURN MSGFIELDS])
(\LAFITE.PREPARE.ERROR
[LAMBDA (MSG EDITORWINDOW HEADEREOF) (* bvm: "13-Nov-84 12:53")
(* * Called when header of MSG contained a line not conforming to spec.
Most likely cause is user deleted the blank line between header and message.
Print a suitable error message)
(PROG (LINE)
(SETFILEPTR MSG HEADEREOF)
(SETQ LINE (LAFITE.READ.TO.EOL MSG))
(SETFILEPTR MSG HEADEREOF)
(BOUT MSG (CHARCODE CR))
(\SENDMESSAGEFAIL EDITORWINDOW (CONCAT "Header not understood: %""
(COND
((IGREATERP (NCHARS LINE)
30)
(CONCAT (SUBSTRING LINE 1 30)
(QUOTE ...)))
(T LINE)))
"%". Assumed this was not part of header, and inserted blank line before it. If this is correct, press 'Deliver' again, else edit the message appropriately."
])
(\LAFITE.CHOOSE.MSG.FORMAT
[LAMBDA (TEXTSTREAM HEADEREOF EDITORWINDOW) (* bvm: "24-Feb-86 17:18")
(* Ask if user intends to retain
formatting info, and if so, send
formatted)
(LET ((FORMATTING (TEDIT.FORMATTEDFILEP TEXTSTREAM)))
(COND
((NULL FORMATTING)
(QUOTE TEXT))
(T (SELECTQ [COND
((OR (EQ FORMATTING (QUOTE IMAGEOBJ))
(NULL EDITORWINDOW))
(QUOTE TEDIT))
(T (\SENDMESSAGE.MENUPROMPT EDITORWINDOW (.LAFITEMENU. LAFITEFORMATMENU
LAFITEFORMATMENUITEMS
"Retain formatting information?"
)
(CONCAT "Message has " (SELECTQ FORMATTING
(CHARLOOKS "font information")
(PARALOOKS "paragraph formatting")
(NSCHARS "extended characters")
"unknown formatting"]
(TEXT (QUOTE TEXT))
(TEDIT (COND
((AND NIL HEADEREOF) (* No need to stick this in header)
(TEDIT.INSERT TEXTSTREAM "Format: TEdit
" HEADEREOF)))
(QUOTE TEDIT))
(ABORT NIL)
NIL])
(\SENDMESSAGE.MENUPROMPT
[LAMBDA (EDITWINDOW MENU PROMPT) (* bvm: "31-Jul-84 14:48")
(PROG ((PWINDOW (GETPROMPTWINDOW EDITWINDOW))
RESULT REG)
(SETQ REG (WINDOWPROP PWINDOW (QUOTE REGION)))
(CLEARW PWINDOW)
(printout PWINDOW PROMPT)
LP (\SETCURSORPOSITION (fetch (REGION LEFT) of REG)
(fetch (REGION TOP) of REG)) (* Drag cursor back to window if it
has been moved)
(COND
((SETQ RESULT (MENU MENU))
(CLEARW PWINDOW)
(RETURN RESULT)))
(GO LP])
(\SENDMESSAGEFAIL
[LAMBDA (EDITORWINDOW MESS1 MESS2) (* bvm: "24-Feb-85 18:41")
(PROG [(PWINDOW (COND
(EDITORWINDOW (LA.ASSURE.PROMPT.WINDOW EDITORWINDOW MESS1 MESS2))
(T PROMPTWINDOW]
(CLEARW PWINDOW)
(PRIN3 MESS1 PWINDOW)
(COND
(MESS2 (PRIN3 MESS2 PWINDOW)))
(RETFROM (QUOTE \SENDMESSAGE.PARSE])
)
(DEFINEQ
(\SENDMESSAGE
[LAMBDA (FORM TEDITPROPS FORMNAME) (* bvm: " 1-Nov-84 12:10")
(* * FORM can be a string, file, or stream -
The value of \SENDMESSAGE is T only if the message was actually sent * *)
(TEDIT.STREAMCHANGEDP FORM T) (* Clear the changed bit)
(TTY.PROCESS (THIS.PROCESS)) (* Take control of the keyboard *)
(\SENDMESSAGE.RESTARTABLE FORM TEDITPROPS NIL FORMNAME])
(\SENDMESSAGE.RESTARTABLE
[LAMBDA (FORM TEDITPROPS EDITORWINDOW FORMNAME) (* bvm: " 9-Oct-86 14:04")
(bind (CURRENTMESSAGE ← FORM)
(FIRSTTIME ← T)
EDITORRESULT DONE SENTOK PARSE
do (PROCESSPROP (THIS.PROCESS)
(QUOTE BEFOREEXIT)
NIL) (* ;
"Allow LOGOUT until delivery is attempted. Need to do this if we loop or restart")
(COND
([NULL (PROG1 EDITORWINDOW (SETQ EDITORWINDOW (\SENDMESSAGE.MAKEWINDOW CURRENTMESSAGE
NIL EDITORWINDOW]
(* ;
"First time thru. Fix it so that we can restart if aborted")
(PROCESSPROP (THIS.PROCESS)
(QUOTE RESTARTFORM)
(LIST (FUNCTION \SENDMESSAGE.RESTARTABLE)
(KWOTE FORM)
(KWOTE TEDITPROPS)
(KWOTE EDITORWINDOW))) (* ;
"If process is reset or aborted, this is how to resurrect")
(PROCESSPROP (THIS.PROCESS)
(QUOTE RESTARTABLE)
T)
(WINDOWPROP EDITORWINDOW (QUOTE LAFITEFORM)
FORMNAME)))
(COND
(FIRSTTIME (RESETSAVE NIL (LIST (FUNCTION \SENDMESSAGE.CLEANUP)
EDITORWINDOW))
(push LAFITECURRENTEDITORWINDOWS EDITORWINDOW)
(SETQ FIRSTTIME)))
[SETQ EDITORRESULT (TEDIT FORM EDITORWINDOW T (APPEND TEDITPROPS (LIST (QUOTE FONT)
LAFITEEDITORFONT]
(COND
((TTY.PROCESSP) (* ; "give back the keyboard")
(TTY.PROCESS T)))
(WINDOWDELPROP EDITORWINDOW (QUOTE CLOSEFN)
(QUOTE DON'T)) (* ; "let the window close")
(COND
((NOT (type? SENDINGCOMMAND EDITORRESULT))
(* ;
"get out anyway since the user used the TEDIT `quit' command instead of one of the sending commands")
(SETQ DONE T))
(T (* ;
"the user used the lafite menu to get out rather than the TEDIT menu so we have to do something")
(* ; "make sure CURRENTMESSAGE is always a string")
(SETQ CURRENTMESSAGE (fetch (SENDINGCOMMAND MESSAGE) of EDITORRESULT))
(SETQ DONE (SELECTQ (AND EDITORRESULT (fetch (SENDINGCOMMAND COMMAND) of EDITORRESULT
))
(##SEND## [SETQ SENTOK (\SENDMESSAGE0 CURRENTMESSAGE EDITORWINDOW
(SETQ PARSE (fetch (SENDINGCOMMAND
MESSAGEPARSE)
of EDITORRESULT])
(##SAVE## (CAR (NLSETQ (\LAFITE.SAVE.FORM CURRENTMESSAGE EDITORWINDOW)
)))
(SHOULDNT)))
(SHADEITEM (fetch (SENDINGCOMMAND ITEM) of EDITORRESULT)
(fetch (SENDINGCOMMAND MENU) of EDITORRESULT)
WHITESHADE) (* ;
"Unshade command. DOLAFITESENDINGCOMMAND shaded it to begin with")
))
(COND
(DONE (COND
(CURRENTMESSAGE (* ;
"Mark text unchanged now, so no trouble closing icon")
(TEDIT.STREAMCHANGEDP CURRENTMESSAGE T)))
(COND
((NULL SENTOK)
(CLOSEW EDITORWINDOW))
(T (* ; "shrink the window")
(DETACHALLWINDOWS EDITORWINDOW)
(\LAFITE.AFTER.DELIVER EDITORWINDOW CURRENTMESSAGE PARSE)))
(RETURN SENTOK))
(T (* ;
"Loop if deliver failed or \LAFITE.SAVE.FORM was aborted.")
])
(\SENDMESSAGE.CLEANUP
[LAMBDA (EDITORWINDOW) (* bvm: " 8-Nov-84 21:02")
(SETQ LAFITECURRENTEDITORWINDOWS (REMOVE EDITORWINDOW LAFITECURRENTEDITORWINDOWS))
(WINDOWPROP EDITORWINDOW (QUOTE MESSAGEFILE)
NIL])
(\SENDMESSAGE.MAKEWINDOW
[LAMBDA (MESSAGEFORM TITLE WINDOW) (* bvm: " 2-Mar-86 16:40")
(* * Editor for Mail system Lafite -- Handles the process mechanism right * *)
(* * Assumes that it's running in a separate process created above * *)
(PROG (EDITWINDOW EDITRESULT)
(SETQ TITLE (OR TITLE "Message Editor")) (* first locate a window --
creating one if necessary *)
[SETQ EDITWINDOW (COND
((WINDOWP WINDOW))
[(find WINDOW in LAFITEEDITORWINDOWS
suchthat (NOT (MEMB WINDOW LAFITECURRENTEDITORWINDOWS]
(T (* editing already in progress --
create a new window *)
(PROG1 (SETQ EDITWINDOW (CREATEMENUEDWINDOW (MAKELAFITEDELIVERMENU)
TITLE
(QUOTE TOP)
(AND (NULL LAFITEEDITORWINDOWS)
(type? REGION LAFITEEDITORREGION
)
LAFITEEDITORREGION)))
(SETQ LAFITEEDITORWINDOWS (NCONC1 LAFITEEDITORWINDOWS
EDITWINDOW))
(* Put at end of list so that windows
are taken in order of creation)
]
(OR (EQ WINDOW EDITWINDOW)
(CLEARW EDITWINDOW))
(WINDOWPROP EDITWINDOW (QUOTE TITLE)
TITLE)
(OR (ATTACHEDWINDOWS EDITWINDOW)
(ATTACHWINDOW (MENUWINDOW (MAKELAFITEDELIVERMENU))
EDITWINDOW
(QUOTE TOP)))
(GETPROMPTWINDOW EDITWINDOW 1 LAFITEEDITORFONT)
[COND
(NIL (* don't let TEDIT close the window *)
(WINDOWADDPROP EDITWINDOW (QUOTE CLOSEFN)
(QUOTE DON'T]
(PROGN (WINDOWDELPROP EDITWINDOW (QUOTE CLOSEFN)
(FUNCTION CLOSEATTACHEDWINDOWS)) (* On closing, get rid of attachments,
don't just close them)
(WINDOWADDPROP EDITWINDOW (QUOTE CLOSEFN)
(FUNCTION DETACHALLWINDOWS))
(WINDOWADDPROP EDITWINDOW (QUOTE CLOSEFN)
(FUNCTION \LAFITE.CLOSEMSG?)
T))
(PROGN (WINDOWPROP EDITWINDOW (QUOTE ICON)
NIL) (* Don't reuse silly old icon)
(WINDOWPROP EDITWINDOW (QUOTE ICONWINDOW)
NIL)
(WINDOWPROP EDITWINDOW (QUOTE ICONFN)
(FUNCTION \LAFITE.UNSENT.ICON)))
(WINDOWPROP EDITWINDOW (QUOTE MESSAGEFILE)
MESSAGEFORM)
(WINDOWPROP EDITWINDOW (QUOTE PROCESS)
(THIS.PROCESS)) (* Associate this process with the
edit window *)
(replace (MENU WHENSELECTEDFN) of (CAR (WINDOWPROP (CAR (ATTACHEDWINDOWS EDITWINDOW))
(QUOTE MENU))) with (FUNCTION
DOLAFITESENDINGCOMMAND))
(RETURN EDITWINDOW) (* Enable the menu)
])
(MAKELAFITEDELIVERMENU
[LAMBDA NIL (* bvm: "28-Mar-84 12:47")
(create MENU
ITEMS ← LAFITESENDINGMENUITEMS
CENTERFLG ← T
MENUFONT ← LAFITEMENUFONT
WHENSELECTEDFN ← (FUNCTION DOLAFITESENDINGCOMMAND])
(\LAFITE.CLOSEMSG?
[LAMBDA (WINDOW) (* bvm: "31-May-84 15:17")
(* This is the first CLOSEFN on a
message sending window.
If contents have changed, get
confirmation)
(PROG [(TEXTSTREAM (WINDOWPROP WINDOW (QUOTE TEXTSTREAM]
(RETURN (COND
((OR (NULL TEXTSTREAM)
(NOT (TEDIT.STREAMCHANGEDP TEXTSTREAM)))
NIL)
((MOUSECONFIRM "Message has been edited -- LEFT to flush anyway" T (
GETPROMPTWINDOW
WINDOW))
(TEDIT.STREAMCHANGEDP TEXTSTREAM T) (* Reset bit so question doesn't get
asked a second time)
NIL)
(T (QUOTE DON'T])
(\LAFITE.AFTER.DELIVER
[LAMBDA (EDITORWINDOW TEXTSTREAM PARSE) (* bvm: " 2-Mar-86 15:52")
(\OUTBOX.ADD.ITEM TEXTSTREAM (OR (CAR PARSE)
UNSUPPLIEDFIELDSTR))
(CLOSEW EDITORWINDOW])
(\LAFITE.UNSENT.ICON
[LAMBDA (WINDOW OLDICON) (* bvm: " 2-Mar-86 16:39")
(TITLEDICONW (create TITLEDICON
ICON ← MSGUNSENTICON
MASK ← MSGUNSENTMASK
TITLEREG ← MSGUNSENTREGION)
(\LAFITE.FETCH.SUBJECT (WINDOWPROP WINDOW (QUOTE TEXTSTREAM)))
LAFITEMSGICONFONT
(WINDOWPROP WINDOW (QUOTE ICONPOSITION))
T])
(\LAFITE.FETCH.SUBJECT
[LAMBDA (TEXTSTREAM) (* bvm: " 2-Mar-86 16:27")
(COND
(TEXTSTREAM (RESETLST [RESETSAVE NIL (LIST (FUNCTION SETFILEINFO)
TEXTSTREAM
(QUOTE ENDOFSTREAMOP)
(GETFILEINFO TEXTSTREAM (QUOTE ENDOFSTREAMOP]
(SETFILEINFO TEXTSTREAM (QUOTE ENDOFSTREAMOP)
(FUNCTION \LAFITE.EOF))
(LET ((STR (LAFITE.PARSE.HEADER TEXTSTREAM \LAPARSE.SUBJECTFIELD 0 NIL T)))
(COND
((STRING-EQUAL STR SUBJECTSTR)
UNSUPPLIEDFIELDSTR)
(T STR])
(LAFITE.SENDMESSAGE
[LAMBDA (MESSAGEFORM) (* bvm: "24-Feb-85 22:35")
(* * this is the external interface to sending a message * *)
(LET [(PARSE (\SENDMESSAGE.PARSE (SETQ MESSAGEFORM (OPENTEXTSTREAM MESSAGEFORM]
(AND PARSE (APPLY* (fetch SENDER of \LAFITEMODE)
MESSAGEFORM PARSE])
(\SENDMESSAGE0
[LAMBDA (TEXTSTREAM WINDOW PARSE) (* bvm: " 6-Nov-84 16:51")
(PROG ((PWINDOW (GETPROMPTWINDOW WINDOW))
MENUW OLDMENU ABORTMENU RESULT)
(for W in (ATTACHEDWINDOWS WINDOW) when [SETQ OLDMENU (CAR (WINDOWPROP W (QUOTE MENU]
do (SETQ MENUW W)
(DELETEMENU OLDMENU NIL MENUW) (* Remove Deliver menu, add Abort menu)
(ADDMENU (SETQ ABORTMENU (create MENU
ITEMS ← (QUOTE (("Abort" NIL
"Abort delivery of this message"
)))
WHENSELECTEDFN ← (FUNCTION \SENDMESSAGE.ABORT)
MENUFONT ← LAFITEMENUFONT
CENTERFLG ← T
ITEMWIDTH ← (fetch ITEMWIDTH of OLDMENU)))
MENUW
(QUOTE (0 . 0)))
(RETURN))
[SETQ RESULT (ERSETQ (RESETLST (APPLY* (fetch SENDER of \LAFITEMODE)
TEXTSTREAM PARSE WINDOW MENUW]
(COND
((NULL RESULT)
(printout PWINDOW "aborted."))
((SETQ RESULT (CAR RESULT))
(printout PWINDOW "done.")))
(RETURN (COND
(RESULT)
(T (* Restore Deliver menu)
(COND
((WINDOWPROP MENUW (QUOTE MENU))
(DELETEMENU ABORTMENU NIL MENUW)))
(ADDMENU OLDMENU MENUW (QUOTE (0 . 0))
NIL)
(WINDOWPROP MENUW (QUOTE ABORT)
NIL)
NIL])
(LA.ASSURE.PROMPT.WINDOW
[LAMBDA (MAINWINDOW MESS1 MESS2) (* bvm: "24-Feb-85 18:33")
(* * Returns prompt window for MAINWINDOW assuring that it is big enough to
print MESS1 and MESS2)
(LET ((PWINDOW (GETPROMPTWINDOW MAINWINDOW))
#LINES)
(COND
((IGREATERP [SETQ #LINES (IQUOTIENT (IPLUS (STRINGWIDTH MESS1 PWINDOW)
(COND
(MESS2 (STRINGWIDTH MESS2 PWINDOW))
(T 0)))
(WINDOWPROP PWINDOW (QUOTE WIDTH]
0) (* Make sure prompt window is big
enough)
(GETPROMPTWINDOW MAINWINDOW (ADD1 #LINES)))
(T PWINDOW])
(\LAFITE.SEND.FAIL
[LAMBDA (EDITORWINDOW ERRMSG) (* bvm: "24-Feb-85 18:38")
(* Print a message explaining why
delivery failed)
(LET ((FULLMSG (CONCAT "Delivery failed -- " ERRMSG))
PWINDOW)
[COND
[EDITORWINDOW (CLEARW (SETQ PWINDOW (LA.ASSURE.PROMPT.WINDOW EDITORWINDOW FULLMSG]
(T (TERPRI (SETQ PWINDOW PROMPTWINDOW]
(PRIN3 FULLMSG PWINDOW)
NIL])
(\LAFITE.INVALID.RECIPIENTS
[LAMBDA (NAMES) (* bvm: " 5-Nov-84 15:26")
(* * Returns an "invalid recipients" error string)
(PROG (NAME)
(SETQ NAME (for RECIPIENT in NAMES join (LIST ", " RECIPIENT)))
(RPLACA NAME ": ")
(COND
((CDR NAMES)
(push NAME "s")))
(RETURN (CONCATLIST (CONS "Invalid recipient" NAME])
(\SENDMESSAGE.ABORT
[LAMBDA (ITEM MENU KEY) (* bvm: " 1-Jun-84 12:21")
(* The WHENSELECTEDFN for the Abort
menu)
(PROG ((W (WFROMMENU MENU)))
(WINDOWPROP W (QUOTE ABORT)
T)
(SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE])
)
(* ; "Outbox hacking")
(DEFINEQ
(\OUTBOX.CREATE
[LAMBDA NIL (* bvm: "21-Dec-84 22:35")
(PROG (FONT NLINES W FONTHEIGHT)
(OR (AND LAFITESTATUSWINDOW (FIXP (SETQ NLINES LAFITEOUTBOXSIZE))
(IGREATERP NLINES 0))
(RETURN))
(SETQ FONTHEIGHT (FONTPROP (SETQ FONT LAFITEBROWSERFONT)
(QUOTE HEIGHT)))
(SETQ W (CREATEW (CREATEREGION 0 0 (WINDOWPROP LAFITESTATUSWINDOW (QUOTE WIDTH))
(HEIGHTIFWINDOW (ITIMES NLINES FONTHEIGHT)
T))
"Delivered Messages" NIL T))
(ATTACHWINDOW W LAFITESTATUSWINDOW (QUOTE BOTTOM)
(QUOTE JUSTIFY)
(QUOTE LOCALCLOSE))
(DSPFONT FONT W)
(WINDOWADDPROP W (QUOTE CLOSEFN)
(FUNCTION \OUTBOX.CLOSEFN))
(WINDOWPROP W (QUOTE REPAINTFN)
(FUNCTION \OUTBOX.REPAINTFN))
(WINDOWPROP W (QUOTE BUTTONEVENTFN)
(FUNCTION \OUTBOX.BUTTONFN))
(WINDOWPROP W (QUOTE RESHAPEFN)
(FUNCTION \OUTBOX.RESHAPEFN))
(WINDOWPROP W (QUOTE MINSIZE)
(CONS 0 (HEIGHTIFWINDOW FONTHEIGHT T)))
(RETURN (SETQ \LAFITE.OUTBOX
(\OUTBOX.RESET (create OUTBOX
OBWINDOW ← W
OBSIZE ← NLINES
OBHEIGHT ← FONTHEIGHT
OBDESCENT ← (FONTPROP FONT (QUOTE DESCENT])
(\OUTBOX.RESET
[LAMBDA (OUTBOX) (* bvm: " 9-Nov-84 16:29")
(PROG ((WINDOW (fetch OBWINDOW of OUTBOX)))
(CLEARW WINDOW)
(LINELENGTH MAX.SMALLP WINDOW)
(DSPRIGHTMARGIN MAX.SMALLP WINDOW)
(replace OBORIGIN of OUTBOX with (IPLUS (DSPYPOSITION NIL WINDOW)
(fetch OBHEIGHT of OUTBOX)))
(RETURN OUTBOX])
(\OUTBOX.CLOSEFN
[LAMBDA (WINDOW) (* bvm: " 8-Nov-84 16:02")
(SETQ \LAFITE.OUTBOX])
(\OUTBOX.REPAINTFN
[LAMBDA (WINDOW REGION) (* bvm: "13-Nov-84 10:57")
(PROG ((OUTBOX \LAFITE.OUTBOX))
(OR (EQ WINDOW (fetch OBWINDOW of OUTBOX))
(RETURN))
(MOVETO 0 (IDIFFERENCE (fetch OBORIGIN of OUTBOX)
(fetch OBHEIGHT of OUTBOX))
WINDOW)
(for ITEM in (fetch OBITEMS of OUTBOX) do (\OUTBOX.DISPLAYLINE OUTBOX ITEM)
(TERPRI WINDOW])
(\OUTBOX.RESHAPEFN
[LAMBDA (WINDOW OLDIMAGE IMAGEREGION OLDSCREENREGION) (* bvm: "13-Nov-84 10:57")
(COND
((EQ WINDOW (fetch OBWINDOW of \LAFITE.OUTBOX))
(PROG ((NLINES (IQUOTIENT (WINDOWPROP WINDOW (QUOTE HEIGHT))
(fetch OBHEIGHT of \LAFITE.OUTBOX)))
(OLDSIZE (fetch OBSIZE of \LAFITE.OUTBOX))
N ITEMS)
[COND
((NEQ NLINES OLDSIZE)
(replace OBSIZE of \LAFITE.OUTBOX with NLINES)
(COND
((AND (ILESSP NLINES OLDSIZE)
(IGREATERP (SETQ N (IDIFFERENCE (LENGTH (SETQ ITEMS (fetch OBITEMS
of \LAFITE.OUTBOX))
)
NLINES))
0))
(replace OBITEMS of \LAFITE.OUTBOX with (CDR (NTH ITEMS N]
(\OUTBOX.RESET \LAFITE.OUTBOX)
(REDISPLAYW WINDOW])
(\OUTBOX.SHADEITEM
[LAMBDA (OUTBOX ITEM N SHADE OPERATION) (* bvm: " 8-Nov-84 21:32")
(* * Shade the indicated ITEM in OUTBOX using texture SHADE blted with
OPERATION)
(PROG ((W (fetch OBWINDOW of OUTBOX))
HEIGHT)
(BITBLT NIL NIL NIL W 0 (IDIFFERENCE (fetch OBORIGIN of OUTBOX)
(IPLUS (ITIMES N (SETQ HEIGHT (fetch OBHEIGHT of OUTBOX)))
(fetch OBDESCENT of OUTBOX)))
NIL HEIGHT (QUOTE TEXTURE)
OPERATION SHADE)
(COND
((EQ OPERATION (QUOTE REPLACE))
(\OUTBOX.DISPLAYLINE OUTBOX ITEM N])
(\OUTBOX.BUTTONFN
[LAMBDA (WINDOW) (* bvm: "13-Nov-84 10:58")
(* * BUTTONEVENTFN for the outbox. If a message is selected, edit it)
(PROG ((SELECTIONREGION (DSPCLIPPINGREGION NIL WINDOW))
(OUTBOX \LAFITE.OUTBOX)
SELECTED SEL# NEWSEL# ITEMS HEIGHT ORIGIN DESCENT LASTX LASTY MAXITEM)
(COND
((OR (NOT (SETQ ITEMS (fetch OBITEMS of OUTBOX)))
(NEQ WINDOW (fetch OBWINDOW of OUTBOX))) (* Nothing to select)
(RETURN)))
(SETQ MAXITEM (LENGTH ITEMS))
(SETQ HEIGHT (fetch OBHEIGHT of OUTBOX))
(SETQ DESCENT (fetch OBDESCENT of OUTBOX))
(SETQ ORIGIN (fetch OBORIGIN of OUTBOX))
(* * keep looping until all mouse buttons are up * *)
(do (GETMOUSESTATE)
(COND
[(OR [NOT (INSIDEP SELECTIONREGION (SETQ LASTX (LASTMOUSEX WINDOW))
(SETQ LASTY (LASTMOUSEY WINDOW]
(IGREATERP (SETQ NEWSEL# (ADD1 (IQUOTIENT (IDIFFERENCE ORIGIN (IPLUS LASTY
DESCENT))
HEIGHT)))
MAXITEM))
(* I would like to just return here and let the next window take over, but
current mouse arrangement means I'll never get control back unless user lets up
on mouse)
[COND
(SELECTED (\OUTBOX.SHADEITEM OUTBOX SELECTED SEL# BLACKSHADE (QUOTE INVERT))
(SETQ SELECTED (SETQ SEL# NIL]
(COND
((LASTMOUSESTATE UP)
(RETURN))
(T (BLOCK]
((LASTMOUSESTATE UP) (* Let mouse up while over a
selection. Do it)
[COND
(SELECTED (\LAFITE.PROCESS [LIST (FUNCTION \SENDMESSAGE)
(KWOTE (COPYTEXTSTREAM (fetch OBITEXT
of SELECTED]
(QUOTE MESSAGESENDER)
T
(QUOTE NO))
(\OUTBOX.SHADEITEM OUTBOX SELECTED SEL# BLACKSHADE (QUOTE INVERT]
(RETURN))
((NEQ NEWSEL# SEL#)
[COND
(SELECTED (\OUTBOX.SHADEITEM OUTBOX SELECTED SEL# BLACKSHADE (QUOTE INVERT]
(\OUTBOX.SHADEITEM OUTBOX [SETQ SELECTED (CAR (NTH ITEMS (SETQ SEL# NEWSEL#]
SEL# BLACKSHADE (QUOTE INVERT])
(\OUTBOX.DISPLAYLINE
[LAMBDA (OUTBOX ITEM N) (* bvm: " 8-Nov-84 21:35")
(PROG ((W (fetch OBWINDOW of OUTBOX)))
(COND
(N (MOVETO 0 (IDIFFERENCE (fetch OBORIGIN of OUTBOX)
(ITIMES N (fetch OBHEIGHT of OUTBOX)))
W)))
(printout W (fetch OBIDATE of ITEM)
,,
(fetch OBISUBJECT of ITEM])
(\OUTBOX.ADD.ITEM
[LAMBDA (TEXTSTREAM SUBJECT) (* bvm: " 8-Nov-84 20:33")
(PROG ((OUTBOX (OR \LAFITE.OUTBOX (\OUTBOX.CREATE)))
W N ITEM BOTTOM HEIGHT ITEMS)
(OR OUTBOX (RETURN))
[COND
((IGEQ [SETQ N (LENGTH (SETQ ITEMS (fetch OBITEMS of OUTBOX]
(fetch OBSIZE of OUTBOX))
(replace OBITEMS of OUTBOX with (SETQ ITEMS (CDR ITEMS)))
(BITBLT (SETQ W (fetch OBWINDOW of OUTBOX))
0
[SETQ BOTTOM (IDIFFERENCE (fetch OBORIGIN of OUTBOX)
(IPLUS (ITIMES N (SETQ HEIGHT (fetch OBHEIGHT of OUTBOX)))
(fetch OBDESCENT of OUTBOX]
W 0 (IPLUS BOTTOM HEIGHT)
NIL
(ITIMES HEIGHT (SUB1 N))
(QUOTE INPUT)
(QUOTE REPLACE))
(BITBLT NIL NIL NIL W 0 BOTTOM NIL HEIGHT (QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE))
(T (SETQ N (ADD1 N]
[replace OBITEMS of OUTBOX with (NCONC1 ITEMS (SETQ ITEM
(create OUTBOXITEM
OBITEXT ← TEXTSTREAM
OBIDATE ← (DATE (DATEFORMAT NO.DATE
NO.SECONDS))
OBISUBJECT ← SUBJECT]
(\OUTBOX.DISPLAYLINE OUTBOX ITEM N])
)
(RPAQ? LAFITEOUTBOXSIZE 2)
(RPAQ? \LAFITE.OUTBOX )
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD OUTBOXITEM (OBITEXT OBIDATE OBISUBJECT OBIWINDOW))
]
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS LAFITEOUTBOXSIZE)
)
)
(* ; "Built-in message forms")
(DEFINEQ
(\LAFITE.MESSAGEFORM
[LAMBDA (ITEM MENU BUTTON) (* bvm: "22-Dec-84 15:36")
(COND
((NULL (OR \LAFITEMODE (\LAFITE.INFER.MODE)))
(printout PROMPTWINDOW T "Must set Lafite Mode before sending mail"))
(T (RESETLST (AND ITEM (LA.RESETSHADE ITEM MENU))
(PROG (FORM FORMNAME FULLNAME REALFORMNAME)
(COND
((EQ BUTTON (QUOTE LEFT))
(SETQ FORM (MAKENEWMESSAGEFORM)))
([NOT (SETQ FORM (MENU (.LAFITEMENU. LAFITEFORMSMENU (APPEND (
MAKELAFITEPRIVATEFORMSITEMS
"Use the form defined in this file."
)
LAFITESPECIALFORMS
LAFITEFORMSMENUITEMS
)
"Message Forms"]
(RETURN))
((EQ FORM (QUOTE ##ANOTHERFORM##)) (* user buttoned "Another Form" *)
(OR (SETQ FORMNAME (PROMPTFORFILENAME))
(RETURN)))
((DEFINEDP FORM)
(OR (SETQ FORM (APPLY FORM))
(RETURN)))
[(BOUNDP FORM)
(SETQ FORM (OR (EVALV FORM)
(MAKENEWMESSAGEFORM]
(T (* other private form)
(SETQ FORMNAME FORM)))
(COND
((NULL FORMNAME) (* Have form already)
)
([OR [SETQ REALFORMNAME (INFILEP (SETQ FULLNAME (LA.LONGFILENAME FORMNAME
LAFITEFORM.EXT]
(AND LAFITEFORMDIRECTORIES (COND
((SETQ REALFORMNAME
(FINDFILE (PACKFILENAME (QUOTE BODY)
FORMNAME
(QUOTE EXTENSION)
LAFITEFORM.EXT)
T LAFITEFORMDIRECTORIES))
(SETQ FORMNAME (SETQ FULLNAME
(PACKFILENAME
(QUOTE VERSION)
NIL
(QUOTE BODY)
REALFORMNAME)))
T]
(* read the form and return it *)
(COND
((NOT (MEMB FULLNAME LAFITEFORMFILES))
(push LAFITEFORMFILES FULLNAME)
(SETQ \LAFITEPROFILECHANGED T)
(SETQ LAFITEFORMSMENU)))
(SETQ FORM (\LAFITE.READ.FORM REALFORMNAME)))
(T (printout PROMPTWINDOW T FULLNAME " not found.")
(COND
((MEMB FULLNAME LAFITEFORMFILES)
(SETQ LAFITEFORMFILES (DREMOVE FULLNAME LAFITEFORMFILES))
(SETQ \LAFITEPROFILECHANGED T)
(SETQ LAFITEFORMSMENU)))
(RETURN)))
(ADD.PROCESS (LIST (FUNCTION \SENDMESSAGE)
(KWOTE FORM)
NIL
(KWOTE FORMNAME))
(QUOTE NAME)
(QUOTE MESSAGESENDER)
(QUOTE RESTARTABLE)
(QUOTE NO])
(MAKELAFITESUPPORTFORM
[LAMBDA NIL (* bvm: "12-Mar-85 00:39")
(MAKEXXXSUPPORTFORM "Lafite" LAFITESUPPORT LAFITESYSTEMDATE])
(MAKELISPSUPPORTFORM
[LAMBDA NIL (* bvm: "12-Mar-85 00:39")
(MAKEXXXSUPPORTFORM "Lisp" LISPSUPPORT])
(MAKEXXXSUPPORTFORM
[LAMBDA (SYSTEMNAME ADDRESS SYSTEMDATE) (* bvm: "12-Mar-85 00:39")
(PROG ((SUBJFIELD ">>Terse summary of problem<<")
(UCODEVERSION (MICROCODEVERSION))
OUTSTREAM SELECTPOSITION)
[COND
((LISTP ADDRESS) (* Mode-dependent address)
(SETQ ADDRESS (CADR (ASSOC (CAR \LAFITEMODE)
ADDRESS]
(COND
((NOT ADDRESS)
(printout PROMPTWINDOW T "Can't -- no address known for " SYSTEMNAME " report.")
(RETURN)))
(SETQ OUTSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (LIST (QUOTE FONT)
LAFITEEDITORFONT)))
(printout OUTSTREAM "Subject: " SYSTEMNAME ": ")
(SETQ SELECTPOSITION (ADD1 (GETFILEPTR OUTSTREAM)))
(printout OUTSTREAM SUBJFIELD T)
(printout OUTSTREAM "To: " ADDRESS T)
(printout OUTSTREAM "cc: " (FULLUSERNAME)
T T)
(COND
(SYSTEMDATE (printout OUTSTREAM SYSTEMNAME " System Date: " SYSTEMDATE T)))
(printout OUTSTREAM "Lisp System Date: " MAKESYSDATE T)
(printout OUTSTREAM "Machine: " (OR \LAFITE.REPORT.MACHINE
(PROGN (SETQ \LAFITE.REPORT.MACHINE (L-CASE (
MACHINETYPE
)
T))
[COND
((EQ \PUP.READY T)
(SETQ \LAFITE.REPORT.MACHINE
(CONCAT \LAFITE.REPORT.MACHINE " ("
(ETHERHOSTNAME NIL T)
")"]
\LAFITE.REPORT.MACHINE))
T)
(printout OUTSTREAM "Microcode version: " .I1.8 (fetch HIBYTE of UCODEVERSION)
"," .I1.8 (fetch LOBYTE of UCODEVERSION)
T)
(printout OUTSTREAM "Memory size: " .I4.8 (REALMEMORYSIZE)
T)
(printout OUTSTREAM "Frequency: >> Always, Intermittent, Once <<
Impact: >> Fatal, Serious, Moderate, Annoying, Minor <<" T T)
(printout OUTSTREAM ">>detailed problem description<<" T)
(TEDIT.SETSEL OUTSTREAM SELECTPOSITION (NCHARS SUBJFIELD)
(QUOTE RIGHT)
T)
(RETURN OUTSTREAM])
(MAKENEWMESSAGEFORM
[LAMBDA NIL (* M.Yonke " 4-OCT-83 15:09")
(PROG (OUTSTREAM SELECTPOSITION)
(SETQ OUTSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (LIST (QUOTE FONT)
LAFITEEDITORFONT)))
(printout OUTSTREAM "Subject: ")
(SETQ SELECTPOSITION (ADD1 (GETFILEPTR OUTSTREAM)))
(printout OUTSTREAM SUBJECTSTR T)
(printout OUTSTREAM "To: " RECIPIENTSSTR T)
(printout OUTSTREAM "cc: " (FULLUSERNAME)
T T)
(printout OUTSTREAM MESSAGESTR T)
(TEDIT.SETSEL OUTSTREAM SELECTPOSITION (NCHARS SUBJECTSTR)
(QUOTE RIGHT)
T)
(RETURN OUTSTREAM])
(MAKELAFITEPRIVATEFORMSITEMS
[LAMBDA (HELPSTR) (* bvm: "21-Feb-84 14:45")
(for FORMFILE in (SORT LAFITEFORMFILES) when FORMFILE collect (LIST (L-CASE (LA.SHORTFILENAME
FORMFILE
LAFITEFORM.EXT))
(KWOTE FORMFILE)
HELPSTR])
(\LAFITE.UNCACHE.MESSAGEFORM
[LAMBDA (ITEM MENU) (* bvm: " 5-Mar-84 15:28")
(PROG (FORM)
(COND
((NULL LAFITEFORMFILES)
(printout PROMPTWINDOW T "You have no private message forms"))
((SETQ FORM (MENU (\LAFITE.CREATE.MENU (MAKELAFITEPRIVATEFORMSITEMS
"Forget about this message form")
"Private Forms")))
(SETQ LAFITEFORMFILES (DREMOVE FORM LAFITEFORMFILES))
(SETQ \LAFITEPROFILECHANGED T)
(SETQ LAFITEFORMSMENU)
(printout PROMPTWINDOW T FORM " forgotten."])
(\LAFITE.READ.FORM
[LAMBDA (FILE) (* bvm: "11-Mar-85 23:38")
(* * copies the messaage form in the FILE into a text stream * *)
(PROG (TEXTSTREAM NAME CH)
(SETQ TEXTSTREAM (OPENTEXTSTREAM (COPYFILE FILE (QUOTE {NODIRCORE}))
NIL NIL NIL (LIST (QUOTE FONT)
LAFITEEDITORFONT)))
(COND
([PROGN (SETFILEPTR TEXTSTREAM 0)
(OR (EQ (SETQ CH (BIN TEXTSTREAM))
(CHARCODE %"))
(AND (EQ CH (CHARCODE CR))
(EQ (BIN TEXTSTREAM)
(CHARCODE %"] (* Old-style form, get rid of
surrounding double quotes)
(TEDIT.DELETE TEXTSTREAM 1 (ADD1 (GETFILEPTR TEXTSTREAM)))
(TEDIT.DELETE TEXTSTREAM (GETEOFPTR TEXTSTREAM)
1)))
[bind [OPENMARKER ← (CONSTANT (ALLOCSTRING 1 (CHARCODE ↑A]
J
(I ← 1) while (SETQ I (TEDIT.FIND TEXTSTREAM OPENMARKER I))
do (* Change Laurel forms into Lafite
forms)
(COND
((AND (SETQ J (TEDIT.FIND TEXTSTREAM (CONSTANT (ALLOCSTRING 1 (CHARCODE ↑B)))
(ADD1 I)
(IPLUS I 70)))
(NOT (TEDIT.FIND TEXTSTREAM OPENMARKER (ADD1 I)
J)))
(TEDIT.DELETE TEXTSTREAM J 1)
(TEDIT.INSERT TEXTSTREAM "<<" J)
(TEDIT.DELETE TEXTSTREAM I 1)
(TEDIT.INSERT TEXTSTREAM ">>" I)
(SETQ I J))
(T (RETURN]
(bind (I ← 1) while (SETQ I (TEDIT.FIND TEXTSTREAM ">>Self<<" I))
do (* Replace ">>Self<<" with user name)
(OR NAME (SETQ NAME (FULLUSERNAME)))
(TEDIT.DELETE TEXTSTREAM I 8)
(TEDIT.INSERT TEXTSTREAM NAME I)
(SETFILEPTR TEXTSTREAM I) (* Patch around tedit bug...))
(\LAFITE.FIND.TEMPLATE TEXTSTREAM)
(RETURN TEXTSTREAM])
(\LAFITE.FIND.TEMPLATE
[LAMBDA (TEXTSTREAM) (* bvm: "22-Apr-84 23:59")
(PROG (SELECTSTART)
(RETURN (COND
((SETQ SELECTSTART (TEDIT.FIND TEXTSTREAM ">>*<<" 1 NIL T))
(* Wait until TEDIT.FIND gets fixed)
(* highlight the first "blank" to fill
in)
[COND
((LISTP SELECTSTART)
(SETQ SELECTSTART (CAR SELECTSTART]
(TEDIT.SETSEL TEXTSTREAM SELECTSTART (IPLUS 2 (IDIFFERENCE (TEDIT.FIND
TEXTSTREAM
"<<"
SELECTSTART)
SELECTSTART))
(QUOTE RIGHT)
T)
T)
(T (TEDIT.SETSEL TEXTSTREAM 1 0 (QUOTE LEFT])
(\LAFITE.SAVE.FORM
[LAMBDA (MSG WINDOW) (* bvm: " 6-Nov-84 12:37")
(PROG ((PROMPT "Save form under name: ")
(FORMNAME (WINDOWPROP WINDOW (QUOTE LAFITEFORM)))
PWINDOW FORMFILE)
[COND
(FORMNAME (SETQ FORMNAME (LA.SHORTFILENAME FORMNAME LAFITEFORM.EXT]
(SETQ PWINDOW (LA.ASSURE.PROMPT.WINDOW WINDOW PROMPT (OR FORMNAME "XXX")))
(* Kludge to keep it small)
(COND
((SETQ FORMFILE (PROMPTFORFILENAME PWINDOW FORMNAME PROMPT))
(SETQ FORMFILE (OPENSTREAM (SETQ FORMNAME (LA.LONGFILENAME (U-CASE FORMFILE)
LAFITEFORM.EXT))
(QUOTE BOTH)
(QUOTE NEW)))
(printout PWINDOW T "Saving " (FULLNAME FORMFILE))
(COND
((TEDIT.FORMATTEDFILEP MSG)
(COERCETEXTOBJ MSG (QUOTE FILE)
FORMFILE))
(T (COPYBYTES MSG FORMFILE 0 -1)))
(AND (OPENP FORMFILE)
(CLOSEF FORMFILE)) (* Early version of Tedit erroneously
closed FORMFILE)
(printout PWINDOW " .. done.")
(COND
((NOT (MEMB FORMNAME LAFITEFORMFILES))
(SETQ LAFITEFORMFILES (APPEND LAFITEFORMFILES (LIST FORMNAME)))
(SETQ \LAFITEPROFILECHANGED T)
(SETQ LAFITEFORMSMENU)))
(RETURN FORMFILE])
)
(* ; "ANSWER")
(DEFINEQ
(\LAFITE.ANSWER
[LAMBDA (WINDOW FOLDERDATA ITEM MENU) (* bvm: " 1-Feb-84 15:08")
(ADD.PROCESS (LIST (FUNCTION \LAFITE.ANSWER.PROC)
(KWOTE WINDOW)
(KWOTE FOLDERDATA)
(KWOTE ITEM)
(KWOTE MENU))
(QUOTE NAME)
(QUOTE MESSAGEANSWERER)
(QUOTE RESTARTABLE)
(QUOTE NO])
(\LAFITE.ANSWER.PROC
[LAMBDA (WINDOW MAILFOLDER ITEM MENU) (* bvm: "29-May-84 15:59")
(PROG (MSGDESCRIPTOR FORM)
[SETQ FORM (RESETLST (LA.RESETSHADE ITEM MENU)
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER)
(COND
((NOT (LAB.ASSURE.SELECTIONS MAILFOLDER))
(MAKEANSWERFORM (SETQ MSGDESCRIPTOR
(find MSGDESCRIPTOR selectedin MAILFOLDER
suchthat T))
MAILFOLDER]
(COND
((AND FORM (\SENDMESSAGE FORM))
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(PROG ((MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER)))
(COND
([AND MESSAGES (EQ MSGDESCRIPTOR (NTHMESSAGE MESSAGES
(fetch (LAFITEMSG #)
of MSGDESCRIPTOR]
(* If message got expunged since we
constructed the answer form, we can't
do anything)
(MARKMESSAGE MSGDESCRIPTOR MAILFOLDER ANSWERMARK])
(MAKEANSWERFORM
[LAMBDA (MSGDESCRIPTORS MAILFOLDER) (* bvm: "31-Jul-84 17:09")
(APPLY* (fetch ANSWERER of \LAFITEMODE)
MSGDESCRIPTORS MAILFOLDER])
)
(* ; "FORWARD")
(DEFINEQ
(\LAFITE.FORWARD
[LAMBDA (WINDOW MAILFOLDER ITEM MENU) (* bvm: " 1-Feb-84 15:05")
(ADD.PROCESS (LIST (FUNCTION \LAFITE.FORWARD.PROC)
(KWOTE WINDOW)
(KWOTE MAILFOLDER)
(KWOTE ITEM)
(KWOTE MENU))
(QUOTE NAME)
(QUOTE MESSAGEFORWARDER)
(QUOTE RESTARTABLE)
(QUOTE NO])
(\LAFITE.FORWARD.PROC
[LAMBDA (WINDOW MAILFOLDER ITEM MENU) (* bvm: "29-May-84 15:57")
(PROG (FORWARDEDMSGS FORM)
(* the reason to get the MSG#S first is that they may have changed by the time
\SENDMESSAGE finishes and then we would have marked the wrong ones *)
[WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(RESETLST (LA.RESETSHADE ITEM MENU)
(\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER)
(COND
((NOT (LAB.ASSURE.SELECTIONS MAILFOLDER))
(SETQ FORM (MAKEFORWARDFORM WINDOW MAILFOLDER
(SETQ FORWARDEDMSGS (for MSG selectedin MAILFOLDER
collect MSG]
(COND
((AND FORM (\SENDMESSAGE FORM))
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(PROG ((MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER)))
(COND
(MESSAGES (* Make sure folder hasn't been closed
since)
(for MSG in FORWARDEDMSGS
when (EQ MSG (NTHMESSAGE MESSAGES (fetch (LAFITEMSG #)
of MSG)))
do (* If message got expunged since we
constructed the forward form, we can't
do anything)
(MARKMESSAGE MSG MAILFOLDER FORWARDMARK])
(MAKEFORWARDFORM
[LAMBDA (WINDOW FOLDERDATA MESSAGELIST) (* bvm: "31-Jul-84 15:10")
(PROG ((FOLDER (\LAFITE.OPEN.FOLDER FOLDERDATA (QUOTE INPUT)))
(OUTSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (LIST (QUOTE FONT)
LAFITEEDITORFONT)))
(CURMSG (CAR MESSAGELIST))
SUBJECT SELECTPOSITION SELECTLEN)
(OR (fetch (LAFITEMSG PARSED?) of CURMSG)
(LAFITE.PARSE.MSG.FOR.TOC CURMSG FOLDERDATA))
(LINELENGTH MAX.SMALLP OUTSTREAM)
(printout OUTSTREAM "Subject: ")
(COND
([OR LAFITEFORWARDSUBJECTSTR (NULL (SETQ SUBJECT (fetch (LAFITEMSG SUBJECT) of CURMSG]
(SETQ SELECTPOSITION (ADD1 (GETFILEPTR OUTSTREAM)))
[SETQ SELECTLEN (NCHARS (SETQ SUBJECT (OR LAFITEFORWARDSUBJECTSTR SUBJECTSTR]
(printout OUTSTREAM SUBJECT))
(T (printout OUTSTREAM "[" (fetch (LAFITEMSG FROM) of CURMSG)
": " SUBJECT "]")))
(printout OUTSTREAM T "To: ")
[COND
((NOT SELECTPOSITION)
(SETQ SELECTPOSITION (ADD1 (GETFILEPTR OUTSTREAM)))
(SETQ SELECTLEN (NCHARS RECIPIENTSSTR]
(printout OUTSTREAM RECIPIENTSSTR T)
(printout OUTSTREAM "cc: " (FULLUSERNAME)
T)
(printout OUTSTREAM T (CAR LAFITEFORWARDSTRINGS)
T)
(for MSGDESCRIPTOR in MESSAGELIST bind NTHTIME do (COND
(NTHTIME (printout OUTSTREAM
(CADR
LAFITEFORWARDSTRINGS
)
T))
(T (SETQ NTHTIME T)))
(TEDIT.SETSEL OUTSTREAM
(ADD1 (GETEOFPTR OUTSTREAM))
0
(QUOTE RIGHT))
(* make sure we're pointing at the end
-- TEDIT.INCLUDE leaves it at the left
*)
(TEDIT.INCLUDE (TEXTOBJ OUTSTREAM)
FOLDER
(fetch (LAFITEMSG START)
of MSGDESCRIPTOR)
(fetch (LAFITEMSG END)
of MSGDESCRIPTOR))
(printout OUTSTREAM T))
(TEDIT.INSERT OUTSTREAM (CADDR LAFITEFORWARDSTRINGS)
T)
(TEDIT.SETSEL OUTSTREAM SELECTPOSITION SELECTLEN (QUOTE RIGHT)
T)
(RETURN OUTSTREAM])
)
(RPAQQ LAFITESENDINGMENUITEMS (("Deliver" (QUOTE ##SEND##)
"Send the message in the edit window")
("Save Form" (QUOTE ##SAVE##)
"Save the message in a file for later use as a private form")))
(RPAQQ LAFITEFORMSMENUITEMS (("Saved Form" (QUOTE ##ANOTHERFORM##)
"You will be asked to specify a filename for the form")
("Standard Form" (FUNCTION MAKENEWMESSAGEFORM)
"A clean message form")))
(RPAQQ LAFITEFORMATMENUITEMS (("Send Formatted Message" (QUOTE TEDIT))
("Send Plain Text" (QUOTE TEXT))
("Abort" (QUOTE ABORT))))
(ADDTOVAR \SYSTEMCACHEVARS \LAFITE.REPORT.MACHINE)
(ADDTOVAR LAFITESPECIALFORMS ("Lisp Report" (FUNCTION MAKELISPSUPPORTFORM)
"A form to report a Lisp bug or suggestion")
("Lafite Report" (FUNCTION MAKELAFITESUPPORTFORM)
"A form to report a Lafite bug or suggestion"))
(RPAQ? \LAFITE.REPORT.MACHINE )
(RPAQ? LAFITEEDITORWINDOWS )
(RPAQ? LAFITECURRENTEDITORWINDOWS )
(RPAQ? LAFITEFORMFILES )
(RPAQ? LAFITEFORMSMENU )
(RPAQ? LAFITEFORMATMENU )
(RPAQ? LAFITEEDITORFONT LAFITEDISPLAYFONT)
(RPAQ? LAFITEFORM.EXT (QUOTE LAFITE-FORM))
(RPAQ? LAFITEFORMDIRECTORIES )
(RPAQ? LAFITEEDITORREGION (create REGION LEFT ← 485 BOTTOM ← 130 WIDTH ← 470 HEIGHT ← 470))
(RPAQ? LAFITEFORWARDSUBJECTSTR )
(RPAQ? LAFITESUPPORT )
(RPAQ? MESSAGESTR ">>Message<<")
(RPAQ? RECIPIENTSSTR ">>Recipients<<")
(RPAQ? SUBJECTSTR ">>Subject<<")
(RPAQ? LISPSUPPORT )
(RPAQ? LAFITEFORWARDSTRINGS (QUOTE (">>CoveringMessage<<
----- Begin Forwarded Messages -----
" "
----- Next Message -----
" "
----- End Forwarded Messages -----")))
(* ; "ICON stuff")
(RPAQ MSGUNSENTICON (READBITMAP))
(82 72
"@@@@@@@@@GO@@@@@@@@@@@@@"
"@@@@@@@@AOOL@@@@@@@@@@@@"
"@@@@@@@@GH@O@@@@@@@@@@@@"
"@@@@@@@CN@@CL@@@@@@@@@@@"
"@@@@@@@OH@@@OH@@@@@@@@@@"
"@@@@@@CL@@@@CN@@@@@@@@@@"
"@@@@@@O@@@@@@GH@@@@@@@@@"
"@@@@@CL@@@@@@AN@@@@@@@@@"
"@@@@AO@@@@@@@@GL@@@@@@@@"
"@@@@GL@@@@@@@@AO@@@@@@@@"
"@@@AN@@@@@@@@@@CL@@@@@@@"
"@@@GH@@@@@@@@@@@O@@@@@@@"
"@@CN@@@@@@@@@@@@CL@@@@@@"
"@@OH@@@@@@@@@@@@@OH@@@@@"
"@CL@@@@@@@@@@@@@@CN@@@@@"
"@O@@@@@@@@@@@@@@@@GH@@@@"
"CL@@@@@@@@@@@@@@@@AN@@@@"
"O@@@@@@@@@@@@@@@@@@GH@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"O@@@@@@@@@@@@@@@@@@GL@@@"
"ML@@@@@@@@@@@@@@@@ALL@@@"
"LN@@@@@@@@@@@@@@@@CHL@@@"
"LCH@@@@@@@@@@@@@@@N@L@@@"
"LAL@@@@@@@@@@@@@@CL@L@@@"
"L@G@@@@@@@@@@@@@@G@@L@@@"
"L@CL@@@@@@@@@@@@AL@@L@@@"
"L@@N@@@@@@@@@@@@CH@@L@@@"
"L@@CH@@@@@@@@@@@N@@@L@@@"
"L@@AL@@@@@@@@@@AL@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@L@@@"
"L@@N@@@@@@@@@@@@CH@@L@@@"
"L@CL@@@@@@@@@@@@AL@@L@@@"
"L@G@@@@@@@@@@@@@@G@@L@@@"
"LAL@@@@@@@@@@@@@@CL@L@@@"
"LCH@@@@@@@@@@@@@@@N@L@@@"
"LN@@@@@@@@@@@@@@@@CHL@@@"
"ML@@@@@@@@@@@@@@@@ALL@@@"
"O@@@@@@@@@@@@@@@@@@GL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@")
(RPAQ MSGUNSENTMASK (READBITMAP))
(82 72
"@@@@@@@@@GO@@@@@@@@@@@@@"
"@@@@@@@@AOOL@@@@@@@@@@@@"
"@@@@@@@@GOOO@@@@@@@@@@@@"
"@@@@@@@COOOOL@@@@@@@@@@@"
"@@@@@@@OOOOOOH@@@@@@@@@@"
"@@@@@@COOOOOON@@@@@@@@@@"
"@@@@@@OOOOOOOOH@@@@@@@@@"
"@@@@@COOOOOOOON@@@@@@@@@"
"@@@@AOOOOOOOOOOL@@@@@@@@"
"@@@@GOOOOOOOOOOO@@@@@@@@"
"@@@AOOOOOOOOOOOOL@@@@@@@"
"@@@GOOOOOOOOOOOOO@@@@@@@"
"@@COOOOOOOOOOOOOOL@@@@@@"
"@@OOOOOOOOOOOOOOOOH@@@@@"
"@COOOOOOOOOOOOOOOON@@@@@"
"@OOOOOOOOOOOOOOOOOOH@@@@"
"COOOOOOOOOOOOOOOOOON@@@@"
"OOOOOOOOOOOOOOOOOOOOH@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOL@@@")
(RPAQQ MSGUNSENTREGION (8 8 64 36))
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD SENDINGCOMMAND (COMMAND ITEM MENU MESSAGE MESSAGEPARSE)
[TYPE? (AND (LISTP DATUM)
(FMEMB (fetch COMMAND of DATUM)
(QUOTE (##SEND## ##SAVE## ##FORGETIT##])
]
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \LAFITE.REPORT.MACHINE LAFITECURRENTEDITORWINDOWS LAFITEEDITORFONT LAFITEEDITORREGION
LAFITEFORMATMENU LAFITEFORMSMENUITEMS LAFITEFORMATMENUITEMS LAFITEFORWARDSTRINGS
LAFITEFORWARDSUBJECTSTR LAFITESENDINGMENUITEMS LAFITESPECIALFORMS LAFITESUPPORT LISPSUPPORT
MAKESYSDATE MESSAGESTR RECIPIENTSSTR SUBJECTSTR MSGUNSENTICON MSGUNSENTMASK MSGUNSENTREGION
LAFITEFORMDIRECTORIES)
)
(FILESLOAD (SOURCE)
LAFITEDECLS)
)
(PUTPROPS LAFITESEND COPYRIGHT ("Xerox Corporation" 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4440 15041 (DOLAFITESENDINGCOMMAND 4450 . 4992) (\SENDMESSAGE.INITIATE 4994 . 7534) (
\SENDMESSAGE.PARSE 7536 . 7739) (\LAFITE.PREPARE.SEND 7741 . 10743) (\LAFITE.PREPARE.ERROR 10745 .
11965) (\LAFITE.CHOOSE.MSG.FORMAT 11967 . 13880) (\SENDMESSAGE.MENUPROMPT 13882 . 14595) (
\SENDMESSAGEFAIL 14597 . 15039)) (15042 33015 (\SENDMESSAGE 15052 . 15580) (\SENDMESSAGE.RESTARTABLE
15582 . 20426) (\SENDMESSAGE.CLEANUP 20428 . 20702) (\SENDMESSAGE.MAKEWINDOW 20704 . 24890) (
MAKELAFITEDELIVERMENU 24892 . 25202) (\LAFITE.CLOSEMSG? 25204 . 26454) (\LAFITE.AFTER.DELIVER 26456 .
26716) (\LAFITE.UNSENT.ICON 26718 . 27194) (\LAFITE.FETCH.SUBJECT 27196 . 28061) (LAFITE.SENDMESSAGE
28063 . 28471) (\SENDMESSAGE0 28473 . 30519) (LA.ASSURE.PROMPT.WINDOW 30521 . 31504) (
\LAFITE.SEND.FAIL 31506 . 32096) (\LAFITE.INVALID.RECIPIENTS 32098 . 32575) (\SENDMESSAGE.ABORT 32577
. 33013)) (33047 43192 (\OUTBOX.CREATE 33057 . 34702) (\OUTBOX.RESET 34704 . 35188) (\OUTBOX.CLOSEFN
35190 . 35333) (\OUTBOX.REPAINTFN 35335 . 35909) (\OUTBOX.RESHAPEFN 35911 . 37096) (\OUTBOX.SHADEITEM
37098 . 37878) (\OUTBOX.BUTTONFN 37880 . 40892) (\OUTBOX.DISPLAYLINE 40894 . 41390) (\OUTBOX.ADD.ITEM
41392 . 43190)) (43486 59482 (\LAFITE.MESSAGEFORM 43496 . 48533) (MAKELAFITESUPPORTFORM 48535 . 48727)
(MAKELISPSUPPORTFORM 48729 . 48898) (MAKEXXXSUPPORTFORM 48900 . 51796) (MAKENEWMESSAGEFORM 51798 .
52587) (MAKELAFITEPRIVATEFORMSITEMS 52589 . 53191) (\LAFITE.UNCACHE.MESSAGEFORM 53193 . 53914) (
\LAFITE.READ.FORM 53916 . 56458) (\LAFITE.FIND.TEMPLATE 56460 . 57768) (\LAFITE.SAVE.FORM 57770 .
59480)) (59506 61904 (\LAFITE.ANSWER 59516 . 59951) (\LAFITE.ANSWER.PROC 59953 . 61694) (
MAKEANSWERFORM 61696 . 61902)) (61929 67931 (\LAFITE.FORWARD 61939 . 62377) (\LAFITE.FORWARD.PROC
62379 . 64382) (MAKEFORWARDFORM 64384 . 67929)))))
STOP