(FILECREATED "12-Mar-85 00:51:52" {ERIS}<LAFITE>LAFITESEND.;28 56336
changes to: (FNS MAKELAFITESUPPORTFORM MAKELISPSUPPORTFORM MAKEXXXSUPPORTFORM
\LAFITE.READ.FORM)
previous date: "24-Feb-85 23:17:48" {ERIS}<LAFITE>LAFITESEND.;26)
(* Copyright (c) 1984, 1985 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.SENDER.ICON 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 OUTBOX OUTBOXITEM)
(GLOBALVARS LAFITEOUTBOXSIZE \LAFITE.OUTBOX)))
(COMS (* 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)
(LAFITE.WORDBOUND.READTABLE)
(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 MSGSENTICON MSGSENTMASK)
(INITVARS MSGSENTTEMPLATE))
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS SENDINGCOMMAND)
(GLOBALVARS LAFITE.WORDBOUND.READTABLE TEDIT.WORDBOUND.READTABLE
\LAFITE.REPORT.MACHINE LAFITECURRENTEDITORWINDOWS LAFITEEDITORFONT
LAFITEEDITORREGION LAFITEFORMATMENU LAFITEFORMSMENUITEMS
LAFITEFORMATMENUITEMS LAFITEFORWARDSTRINGS LAFITEFORWARDSUBJECTSTR
LAFITESENDINGMENUITEMS LAFITESPECIALFORMS LAFITESUPPORT LISPSUPPORT
MAKESYSDATE MESSAGESTR RECIPIENTSSTR SUBJECTSTR MSGSENTTEMPLATE
LAFITEFORMDIRECTORIES))))
(* 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-85 18:40")
(* Ask if user intends to retain formatting info, and
if so, send formatted)
(PROG ((FORMATTING (TEDIT.FORMATTEDFILEP TEXTSTREAM)))
[COND
((NULL FORMATTING)
(RETURN (QUOTE TEXT]
(RETURN (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")
(IMAGEOBJ "image objects")
"unknown formatting"]
(TEXT (QUOTE TEXT))
(TEDIT (AND HEADEREOF (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: " 8-Nov-84 21:41")
(bind (CURRENTMESSAGE ← FORM)
(FIRSTTIME ← T)
EDITORRESULT DONE SENTOK PARSE
do (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)))
(COND
((NULL LAFITE.WORDBOUND.READTABLE) (* Make < and > be alphabetic, so that >>Message<< etc
work.)
(SETQ LAFITE.WORDBOUND.READTABLE (COPYREADTABLE TEDIT.WORDBOUND.READTABLE))
(TEDIT.WORDSET (CHARCODE <)
(QUOTE TEXT)
LAFITE.WORDBOUND.READTABLE)
(TEDIT.WORDSET (CHARCODE >)
(QUOTE TEXT)
LAFITE.WORDBOUND.READTABLE)))
[SETQ EDITORRESULT (TEDIT FORM EDITORWINDOW T (APPEND TEDITPROPS (LIST (QUOTE FONT)
LAFITEEDITORFONT
(QUOTE BOUNDTABLE)
LAFITE.WORDBOUND.READTABLE]
(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: " 8-Nov-84 20:35")
(* * 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.SENDER.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: " 8-Nov-84 17:10")
(COND
(NIL (WINDOWPROP EDITORWINDOW (QUOTE TITLE)
(CONCAT "Message delivered at " (DATE)))
(WINDOWPROP EDITORWINDOW (QUOTE ICONFN)
NIL)
(SHRINKW EDITORWINDOW (\LAFITE.SENDER.ICON EDITORWINDOW NIL "Delivered")))
(T (\OUTBOX.ADD.ITEM TEXTSTREAM (CAR PARSE))
(CLOSEW EDITORWINDOW])
(\LAFITE.SENDER.ICON
[LAMBDA (WINDOW OLDICON TITLE) (* bvm: "31-Jul-84 17:37")
(OR OLDICON
(PROG [(REGION (WINDOWPROP WINDOW (QUOTE REGION]
(RETURN (TITLEDICONW [OR MSGSENTTEMPLATE
(SETQ MSGSENTTEMPLATE
(create TITLEDICON
ICON ← MSGSENTICON
MASK ← MSGSENTMASK
TITLEREG ←(create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← 75
HEIGHT ← 30]
(OR TITLE "unsent")
LAFITEMENUFONT
[OR (WINDOWPROP WINDOW (QUOTE ICONPOSITION))
(create POSITION
XCOORD ←(IDIFFERENCE (fetch (REGION RIGHT)
of REGION)
(BITMAPWIDTH MSGSENTICON))
YCOORD ←(IPLUS (IDIFFERENCE (fetch (REGION TOP)
of REGION)
(BITMAPHEIGHT MSGSENTICON))
(HEIGHTIFWINDOW (FONTHEIGHT
LAFITEMENUFONT]
T])
(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 OUTBOX (OBWINDOW OBSIZE OBHEIGHT OBDESCENT OBORIGIN OBITEMS))
(RECORD OUTBOXITEM (OBITEXT OBIDATE OBISUBJECT OBIWINDOW))
]
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS LAFITEOUTBOXSIZE \LAFITE.OUTBOX)
)
)
(* 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? LAFITE.WORDBOUND.READTABLE )
(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 MSGSENTICON (READBITMAP))
(75 40
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"L@@@@@@@@@@@@@@@@@F@"
"MKFNKL@@@@@@@CN@GOF@"
"LMKEDK@@@@@@FDAFDAF@"
"L@@@@@@@@@@@AILIMOF@"
"MGMMJ@@@@@@@@H@HEAF@"
"MNOFM@@@@@@@FNGFEMF@"
"L@@@@@@@@@@@AIHILEF@"
"MGMNKD@@@@@@@H@HEMF@"
"MMGENL@@@@@@FFGFDAF@"
"L@@@@@@@@@@@AJEIOOF@"
"L@@@@@@@@@@@@EJ@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@")
(RPAQ MSGSENTMASK (READBITMAP))
(75 40
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@")
(RPAQ? MSGSENTTEMPLATE NIL)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD SENDINGCOMMAND (COMMAND ITEM MENU MESSAGE MESSAGEPARSE)
[TYPE? (FMEMB (fetch COMMAND of DATUM)
(QUOTE (##SEND## ##SAVE## ##FORGETIT##])
]
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS LAFITE.WORDBOUND.READTABLE TEDIT.WORDBOUND.READTABLE \LAFITE.REPORT.MACHINE
LAFITECURRENTEDITORWINDOWS LAFITEEDITORFONT LAFITEEDITORREGION LAFITEFORMATMENU
LAFITEFORMSMENUITEMS LAFITEFORMATMENUITEMS LAFITEFORWARDSTRINGS LAFITEFORWARDSUBJECTSTR
LAFITESENDINGMENUITEMS LAFITESPECIALFORMS LAFITESUPPORT LISPSUPPORT MAKESYSDATE
MESSAGESTR RECIPIENTSSTR SUBJECTSTR MSGSENTTEMPLATE LAFITEFORMDIRECTORIES)
)
)
(PUTPROPS LAFITESEND COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3562 11196 (DOLAFITESENDINGCOMMAND 3572 . 4043) (\SENDMESSAGE.INITIATE 4045 . 5451) (
\SENDMESSAGE.PARSE 5453 . 5646) (\LAFITE.PREPARE.SEND 5648 . 8020) (\LAFITE.PREPARE.ERROR 8022 . 8988)
(\LAFITE.CHOOSE.MSG.FORMAT 8990 . 10161) (\SENDMESSAGE.MENUPROMPT 10163 . 10760) (\SENDMESSAGEFAIL
10762 . 11194)) (11197 25725 (\SENDMESSAGE 11207 . 11727) (\SENDMESSAGE.RESTARTABLE 11729 . 15819) (
\SENDMESSAGE.CLEANUP 15821 . 16098) (\SENDMESSAGE.MAKEWINDOW 16100 . 19287) (MAKELAFITEDELIVERMENU
19289 . 19570) (\LAFITE.CLOSEMSG? 19572 . 20318) (\LAFITE.AFTER.DELIVER 20320 . 20809) (
\LAFITE.SENDER.ICON 20811 . 21756) (LAFITE.SENDMESSAGE 21758 . 22143) (\SENDMESSAGE0 22145 . 23641) (
LA.ASSURE.PROMPT.WINDOW 23643 . 24361) (\LAFITE.SEND.FAIL 24363 . 24877) (\LAFITE.INVALID.RECIPIENTS
24879 . 25364) (\SENDMESSAGE.ABORT 25366 . 25723)) (25755 34233 (\OUTBOX.CREATE 25765 . 27229) (
\OUTBOX.RESET 27231 . 27697) (\OUTBOX.CLOSEFN 27699 . 27842) (\OUTBOX.REPAINTFN 27844 . 28356) (
\OUTBOX.RESHAPEFN 28358 . 29247) (\OUTBOX.SHADEITEM 29249 . 29938) (\OUTBOX.BUTTONFN 29940 . 32364) (
\OUTBOX.DISPLAYLINE 32366 . 32815) (\OUTBOX.ADD.ITEM 32817 . 34231)) (34596 46111 (\LAFITE.MESSAGEFORM
34606 . 37446) (MAKELAFITESUPPORTFORM 37448 . 37636) (MAKELISPSUPPORTFORM 37638 . 37803) (
MAKEXXXSUPPORTFORM 37805 . 40057) (MAKENEWMESSAGEFORM 40059 . 40776) (MAKELAFITEPRIVATEFORMSITEMS
40778 . 41112) (\LAFITE.UNCACHE.MESSAGEFORM 41114 . 41709) (\LAFITE.READ.FORM 41711 . 43822) (
\LAFITE.FIND.TEMPLATE 43824 . 44642) (\LAFITE.SAVE.FORM 44644 . 46109)) (46131 47875 (\LAFITE.ANSWER
46141 . 46484) (\LAFITE.ANSWER.PROC 46486 . 47675) (MAKEANSWERFORM 47677 . 47873)) (47896 51752 (
\LAFITE.FORWARD 47906 . 48252) (\LAFITE.FORWARD.PROC 48254 . 49634) (MAKEFORWARDFORM 49636 . 51750))))
)
STOP