(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "12-Sep-88 15:02:24" {POOH/N}<POOH>LAFITE>SOURCES>LAFITESEND;4 49016
changes to%: (FNS \SENDMESSAGE.PARSE \SENDMESSAGE \SENDMESSAGE.RESTARTABLE LAFITE.SENDMESSAGE \SENDMESSAGE0)
previous date%: "31-Aug-88 19:13:27" {POOH/N}<POOH>VANMELLE>ERIS>LAFITE>SOURCES>LAFITESEND;2)
(* "
Copyright (c) 1984, 1985, 1986, 1987, 1988 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 LAFITE.MAKE.PLAIN.TEXTSTREAM \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 LA.PRINT.COMMA.LIST LAFITE.FILL.IN.ANSWER.FORM)) (COMS (* ; "FORWARD") (FNS \LAFITE.FORWARD \LAFITE.FORWARD.PROC MAKEFORWARDFORM)) (COMS (VARS LAFITESENDINGMENUITEMS LAFITEFORMSMENUITEMS LAFITEFORMATMENUITEMS LAFITEFORWARDSTRINGS) (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")) (LAFITEMENUVARS LAFITEFORMSMENU LAFITEFORMATMENU)) (INITVARS (\LAFITE.REPORT.MACHINE) (LAFITECURRENTEDITORWINDOWS) (LAFITEFORMFILES) (LAFITEFORMSMENU) (LAFITEFORMATMENU)) (INITVARS (LAFITEEDITORFONT LAFITEDISPLAYFONT) (LAFITEFORM.EXT (QUOTE LAFITE-FORM)) (LAFITEFORMDIRECTORIES NIL) (LAFITE.EDITOR.SIZE (QUOTE (470 . 300))) (LAFITE.EDITOR.LAYOUTS NIL) (LAFITEFORWARDSUBJECTSTR NIL) (LAFITESUPPORT NIL) (LISPSUPPORT NIL) (MESSAGESTR ">>Message<<") (RECIPIENTSSTR ">>Recipients<<") (SUBJECTSTR ">>Subject<<") (LAFITE.SEND.FORMATTED (QUOTE ((NSCHARS :ASK) (CHARLOOKS :ASK) (PARALOOKS :ASK) (IMAGEOBJ T)))))) (COMS (* ; "Obsolete") (INITVARS (LAFITEEDITORREGION NIL))) (COMS (* ; "ICON stuff") (VARS LAFITE.MSG.ICON)) (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 LAFITE.MSG.ICON LAFITEFORMDIRECTORIES LAFITE.SEND.FORMATTED) (FILES (SOURCE) LAFITEDECLS) (LOCALVARS . T))))
(* ; "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) (* ; "Edited 3-Jun-88 17:27 by bvm") (ERSETQ (RESETLST (PROG ((COMMAND (EXTRACTMENUCOMMAND ITEM)) TEXTSTREAM PARSE) (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (ITEM MENU) (COND (RESETSTATE (* ; "In case of error/abort, set menu & proc back to normal") (SHADEITEM ITEM MENU WHITESHADE) (replace (MENU WHENSELECTEDFN) of MENU with (FUNCTION DOLAFITESENDINGCOMMAND)) (PROCESSPROP (THIS.PROCESS) (QUOTE BEFOREEXIT) NIL))))) 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)) (LA.DETACH.TEDIT TEXTSTREAM)))))
)
(\SENDMESSAGE.PARSE
(LAMBDA (MSG EDITORWINDOW) (* ; "Edited 12-Sep-88 14:05 by bvm") (* ;; "Parse MSG in the current mode, returning a parse structure that the corresponding sender will be happy with") (LET ((*LAFITE-MODE-DATA* (\LAFITE.GET.USER.DATA (TEXTPROP MSG (QUOTE LAFITEMODE))))) (CL:FUNCALL (fetch (LAFITEMODEDATA SENDPARSER) of *LAFITE-MODE-DATA*) 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 ((= 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 ((> (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) (* ; "Edited 30-Aug-88 14:40 by bvm") (* ;; "Ask if user intends to retain formatting info, and if so, send formatted") (LET ((FORMATTING (TEDIT.FORMATTEDFILEP TEXTSTREAM)) TMP) (COND ((NULL FORMATTING) (* ; "It's just plain text") (QUOTE TEXT)) ((AND (TEXTSTREAMP TEXTSTREAM) (TEXTPROP TEXTSTREAM (QUOTE LAFITEFORMAT)))) ((NULL EDITORWINDOW) (* ; "Nobody to interact with") (QUOTE TEDIT)) (T (SELECTQ (COND ((NLISTP LAFITE.SEND.FORMATTED) LAFITE.SEND.FORMATTED) ((SETQ TMP (ASSOC FORMATTING LAFITE.SEND.FORMATTED)) (CADR TMP)) (T :ASK)) (T (* ; "Send formatted") (QUOTE TEDIT)) (NIL (* ; "Send unformatted") (QUOTE TEXT)) (SELECTQ (SETQ TMP (\SENDMESSAGE.MENUPROMPT EDITORWINDOW (OR LAFITEFORMATMENU (SETQ LAFITEFORMATMENU (\LAFITE.CREATE.MENU LAFITEFORMATMENUITEMS "Retain formatting information?" T))) (CONCAT "Message " (SELECTQ FORMATTING (CHARLOOKS "has font information") (PARALOOKS "has paragraph formatting") (NSCHARS "uses extended character set") (IMAGEOBJ "contains images") "has unknown formatting") "."))) (ABORT NIL) TMP))))))
)
(LAFITE.MAKE.PLAIN.TEXTSTREAM
(LAMBDA (TEXTSTREAM START) (* ; "Edited 24-Sep-87 16:48 by bvm:") (* ;; "Coerces TEXTSTREAM to a %"plain text%" stream, returning the new stream. If START is specified, only copies from that file pointer onward.") (LET ((PLAIN (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH)))) (SETFILEPTR TEXTSTREAM (OR START (SETQ START 0))) (* ;; "TEXT streams return character codes on BIN, so we have to translate to bytes on output side to handle fat chars correctly and avoid image objects") (to (- (GETEOFPTR TEXTSTREAM) START) do (\OUTCHAR PLAIN (OR (FIXP (BIN TEXTSTREAM)) (CHARCODE *)))) (* ; "Reopen to avoid core bug") (OPENSTREAM (CLOSEF PLAIN) (QUOTE INPUT))))
)
(\SENDMESSAGE.MENUPROMPT
(LAMBDA (EDITWINDOW MENU PROMPT) (* ; "Edited 13-Oct-87 14:32 by bvm:") (LET* ((PWINDOW (GETPROMPTWINDOW EDITWINDOW)) (REG (WINDOWPROP PWINDOW (QUOTE REGION))) RESULT) (CLEARW PWINDOW) (printout PWINDOW PROMPT) (SETQ RESULT (MENU MENU (create POSITION XCOORD ← (fetch (REGION LEFT) of REG) YCOORD ← (fetch (REGION TOP) of REG)) T)) (CLEARW PWINDOW) RESULT))
)
(\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) (* ; "Edited 12-Sep-88 14:08 by bvm") (* ;;; "FORM can be a string, file, or stream --- The value of \SENDMESSAGE is T only if the message was actually sent") (OR (TEXTSTREAMP FORM) (SETQ FORM (OPENTEXTSTREAM FORM NIL NIL NIL TEDITPROPS))) (TEDIT.STREAMCHANGEDP FORM T) (* ; "Clear the changed bit") (if (NOT (LISTGET TEDITPROPS (QUOTE LEAVETTY))) then (* ; "Take control of the keyboard") (TTY.PROCESS (THIS.PROCESS))) (\SENDMESSAGE.RESTARTABLE FORM TEDITPROPS NIL FORMNAME))
)
(\SENDMESSAGE.RESTARTABLE
(LAMBDA (FORM TEDITPROPS EDITORWINDOW FORMNAME) (* ; "Edited 12-Sep-88 14:04 by bvm") (bind (CURRENTMESSAGE ← FORM) (FIRSTTIME ← T) (MODE ← (OR (LISTGET TEDITPROPS (QUOTE LAFITEMODE)) (TEXTPROP FORM (QUOTE LAFITEMODE)) (fetch LAFITEMODE of \LAFITEMODE))) 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 MODE)))) (* ; "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) (TEXTPROP CURRENTMESSAGE (QUOTE LAFITEMODE) MODE))) (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 (* ; "Message successfully dispatched") (PROCESSPROP (THIS.PROCESS) (QUOTE RESTARTABLE) NIL) (* ; "Don't try to restart if there's any sort of error now") (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) (* ; "Edited 6-Oct-87 15:58 by bvm:") (SETQ LAFITECURRENTEDITORWINDOWS (REMOVE EDITORWINDOW LAFITECURRENTEDITORWINDOWS)))
)
(\SENDMESSAGE.MAKEWINDOW
(LAMBDA (MESSAGEFORM TITLE WINDOW MODE) (* ; "Edited 18-Jul-88 11:28 by bvm") (* ;;; "Editor for Mail system Lafite -- Handles the process mechanism right") (* ;;; "Assumes that it's running in a separate process created above") (PROG (EDITWINDOW LAYOUT REGION) (COND ((NOT TITLE) (SETQ TITLE "Message Editor") (if (AND MODE (LAFITE.SHOW.MODE.P)) then (SETQ TITLE (CONCAT TITLE " (" MODE ")"))))) (COND ((WINDOWP (SETQ EDITWINDOW WINDOW)) (WINDOWPROP EDITWINDOW (QUOTE TITLE) TITLE)) (T (SETQ REGION (if (for old LAYOUT in LAFITE.EDITOR.LAYOUTS unless (for WINDOW in LAFITECURRENTEDITORWINDOWS thereis (EQ (WINDOWPROP WINDOW (QUOTE LAFITE.LAYOUT)) LAYOUT)) do (* ; "Use first layout not already in use") (RETURN (CAR LAYOUT))) elseif (AND (NULL LAFITECURRENTEDITORWINDOWS) (type? REGION LAFITEEDITORREGION)) then (* ; "Old way of doing this for a single window") LAFITEEDITORREGION elseif LAFITE.EDITOR.SIZE then (* ; "Get window of appropriate size") (GETBOXREGION (CAR LAFITE.EDITOR.SIZE) (CDR LAFITE.EDITOR.SIZE)) else (GETREGION))) (SETQ EDITWINDOW (CREATEMENUEDWINDOW (MAKELAFITEDELIVERMENU) TITLE (QUOTE TOP) (create REGION using REGION HEIGHT ← (- (fetch (REGION HEIGHT) of REGION) (HEIGHTIFWINDOW (FONTPROP LAFITEEDITORFONT (QUOTE HEIGHT))))))) (if LAYOUT then (WINDOWPROP EDITWINDOW (QUOTE LAFITE.LAYOUT) LAYOUT) (WINDOWPROP EDITWINDOW (QUOTE ICONPOSITION) (CADR LAYOUT))))) (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)) (WINDOWPROP EDITWINDOW (QUOTE ICONFN) (FUNCTION \LAFITE.UNSENT.ICON)) (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) (* ; "Edited 3-Sep-87 17:21 by bvm:") (* ;; "This is the first CLOSEFN on a message sending window. If contents have changed, get confirmation") (LET ((TEXTSTREAM (WINDOWPROP WINDOW (QUOTE TEXTSTREAM)))) (COND ((OR (NULL TEXTSTREAM) (NOT (TEDIT.STREAMCHANGEDP TEXTSTREAM))) (* ; "TEXTSTREAM is null once TEdit's gotten thru with it.") 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) (* ; "Edited 24-Sep-87 16:58 by bvm:") (TITLEDICONW LAFITE.MSG.ICON (\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) (* ; "Edited 12-Sep-88 14:07 by bvm") (* ;;; "this is the external interface to sending a message") (SETQ MESSAGEFORM (OPENTEXTSTREAM MESSAGEFORM)) (LET* ((MODE (TEXTPROP MESSAGEFORM (QUOTE LAFITEMODE))) (*LAFITE-MODE-DATA* (\LAFITE.GET.USER.DATA MODE)) PARSE) (AND *LAFITE-MODE-DATA* (SETQ PARSE (CL:FUNCALL (fetch (LAFITEMODEDATA SENDPARSER) of *LAFITE-MODE-DATA*) MESSAGEFORM)) (CL:FUNCALL (fetch (LAFITEMODEDATA SENDER) of *LAFITE-MODE-DATA*) MESSAGEFORM PARSE))))
)
(\SENDMESSAGE0
(LAMBDA (TEXTSTREAM WINDOW PARSE) (* ; "Edited 12-Sep-88 14:04 by bvm") (PROG ((PWINDOW (GETPROMPTWINDOW WINDOW)) *LAFITE-MODE-DATA* 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)) (if (NULL (SETQ *LAFITE-MODE-DATA* (\LAFITE.GET.USER.DATA (TEXTPROP TEXTSTREAM (QUOTE LAFITEMODE))))) then (printout PWINDOW "Failed to authenticate user.") else (SETQ RESULT (ERSETQ (RESETLST (CL:FUNCALL (fetch (LAFITEMODEDATA SENDER) of *LAFITE-MODE-DATA*) TEXTSTREAM PARSE WINDOW MENUW)))) (COND ((NULL RESULT) (printout PWINDOW "aborted.")) ((SETQ RESULT (CAR RESULT)) (printout PWINDOW "done.")))) (RETURN (COND (RESULT (* ; "Success") (CLOSEF TEXTSTREAM) (* ; "Explicit Close here after successful delivery so that TEdit can close any files it might have open") 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 ((> (SETQ %#LINES (QUOTIENT (+ (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) (* ; "Edited 3-Sep-87 17:24 by bvm:") (* ;;; "Shade the indicated ITEM in OUTBOX using texture SHADE blted with OPERATION") (PROG ((W (fetch OBWINDOW of OUTBOX)) HEIGHT) (BLTSHADE SHADE W 0 (- (fetch OBORIGIN of OUTBOX) (+ (ITIMES N (SETQ HEIGHT (fetch OBHEIGHT of OUTBOX))) (fetch OBDESCENT of OUTBOX))) NIL HEIGHT OPERATION) (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)))) (> (SETQ NEWSEL# (ADD1 (QUOTIENT (- ORIGIN (+ 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) (* ; "Edited 3-Sep-87 18:08 by bvm:") (PROG ((OUTBOX (OR \LAFITE.OUTBOX (\OUTBOX.CREATE))) W N ITEM BOTTOM HEIGHT ITEMS) (OR OUTBOX (RETURN)) (COND ((>= (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 (- (fetch OBORIGIN of OUTBOX) (+ (ITIMES N (SETQ HEIGHT (fetch OBHEIGHT of OUTBOX))) (fetch OBDESCENT of OUTBOX)))) W 0 (+ BOTTOM HEIGHT) NIL (ITIMES HEIGHT (SUB1 N)) (QUOTE INPUT) (QUOTE REPLACE)) (BLTSHADE WHITESHADE W 0 BOTTOM NIL HEIGHT (QUOTE REPLACE))) (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) (* ; "Edited 18-Jul-88 12:12 by bvm") (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.STRING (QUOTE BODY) FORMNAME (QUOTE EXTENSION) LAFITEFORM.EXT) T LAFITEFORMDIRECTORIES)) (SETQ FORMNAME (SETQ FULLNAME (PACKFILENAME.STRING (QUOTE VERSION) NIL (QUOTE BODY) REALFORMNAME))) T)))) (* ; "read the form and return it") (COND ((NOT (CL:MEMBER FULLNAME LAFITEFORMFILES :TEST (QUOTE STRING-EQUAL))) (push LAFITEFORMFILES FULLNAME) (SETQ \LAFITEPROFILECHANGED T) (SETQ LAFITEFORMSMENU))) (SETQ FORM (\LAFITE.READ.FORM REALFORMNAME))) (T (printout PROMPTWINDOW T FULLNAME " not found.") (RETURN))) (ADD.PROCESS (LIST (FUNCTION \SENDMESSAGE) (KWOTE FORM) NIL (KWOTE FORMNAME)) (QUOTE NAME) (QUOTE MESSAGESENDER) (QUOTE RESTARTABLE) (QUOTE NO)) (* ; "Finally, start authenticating if we haven't yet.") (\LAFITE.GET.USER.DATA))))))
)
(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) (* ; "Edited 22-Aug-88 18:14 by bvm") (PROG ((SUBJFIELD ">>Terse summary of problem<<") (UCODEVERSION (MICROCODEVERSION)) (SCRATCH (OPENSTREAM "{nodircore}" (QUOTE BOTH))) TEXTSTREAM 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 TEXTSTREAM (OPENTEXTSTREAM (CONCAT "Subject: " SYSTEMNAME ": ") NIL NIL NIL (LIST (QUOTE FONT) LAFITEEDITORFONT))) (SETQ SELECTPOSITION (ADD1 (GETEOFPTR TEXTSTREAM))) (PROGN (* ; "Now write the main stuff to a scratch stream. faster than bouting a byte at a time to tedit") (printout SCRATCH SUBJFIELD T) (printout SCRATCH "To: " ADDRESS T) (printout SCRATCH "cc: " (FULLUSERNAME) T T) (COND (SYSTEMDATE (printout SCRATCH SYSTEMNAME " System Date: " SYSTEMDATE T))) (printout SCRATCH "Lisp System Date: " MAKESYSDATE " (" (L-CASE (MKSTRING MAKESYSNAME) T) ")" T) (printout SCRATCH "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 SCRATCH "Microcode version: " |.I1.8| (fetch HIBYTE of UCODEVERSION) "," |.I1.8| (fetch LOBYTE of UCODEVERSION) T) (printout SCRATCH "Memory size: " |.I4.8| (REALMEMORYSIZE) T) (printout SCRATCH "Frequency: >> Always, Intermittent, Once <<
Impact: >> Fatal, Serious, Moderate, Annoying, Minor <<" T T) (printout SCRATCH ">>detailed problem description<<" T)) (TEDIT.SETSEL TEXTSTREAM SELECTPOSITION 0 (QUOTE RIGHT)) (TEDIT.INCLUDE TEXTSTREAM SCRATCH) (TEDIT.SETSEL TEXTSTREAM SELECTPOSITION (NCHARS SUBJFIELD) (QUOTE RIGHT) T) (RETURN TEXTSTREAM)))
)
(MAKENEWMESSAGEFORM
(LAMBDA NIL (* ; "Edited 6-Jun-88 12:22 by bvm") (LET ((OUTSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (LIST (QUOTE FONT) LAFITEEDITORFONT))) SELECTPOSITION) (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) (if LAFITE.SIGNATURE then (* ; "Pre-sign it") (PRIN3 LAFITE.SIGNATURE OUTSTREAM)) (TEDIT.SETSEL OUTSTREAM SELECTPOSITION (NCHARS SUBJECTSTR) (QUOTE RIGHT) T) OUTSTREAM))
)
(MAKELAFITEPRIVATEFORMSITEMS
(LAMBDA (HELPSTR) (* ; "Edited 8-Sep-87 16:48 by bvm:") (for FORMFILE in (SORT LAFITEFORMFILES) when FORMFILE collect (BQUOTE ((\, (CL:STRING-CAPITALIZE (LA.SHORTFILENAME FORMFILE LAFITEFORM.EXT))) (QUOTE (\, 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") (LET (SELECTSTART) (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 (+ 2 (- (TEDIT.FIND TEXTSTREAM "<<" SELECTSTART) SELECTSTART)) (QUOTE RIGHT) T) T) (T (TEDIT.SETSEL TEXTSTREAM 1 0 (QUOTE LEFT))))))
)
(\LAFITE.SAVE.FORM
(LAMBDA (MSG WINDOW) (* ; "Edited 13-Jun-88 11:36 by bvm") (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") (CLEARW PWINDOW) (COND ((SETQ FORMFILE (PROMPTFORFILENAME PWINDOW FORMNAME PROMPT)) (TEDIT.PUT MSG (SETQ FORMNAME (LA.LONGFILENAME FORMFILE LAFITEFORM.EXT)) NIL (if (EQ (TEDIT.FORMATTEDFILEP MSG) (QUOTE NSCHARS)) then (* ; "Force no formatting--TEdit defaultly saves formatting even if only ns chars") T)) (COND ((NOT (CL:MEMBER FORMNAME LAFITEFORMFILES :TEST (QUOTE STRING-EQUAL))) (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) (* ; "Edited 9-May-88 18:34 by bvm") (LET* ((FIRSTMSG (if (LISTP MSGDESCRIPTORS) then (CAR MSGDESCRIPTORS) else MSGDESCRIPTORS)) (MODEBITS (fetch (LAFITEMSG MODEBITS) of FIRSTMSG)) (MODE (CL:NTH MODEBITS *LAFITE-WELL-KNOWN-MODES*))) (if (NULL MODE) then (if (OR (NEQ MODEBITS 0) (NULL (SETQ MODE (\LAFITE.GUESS.MODE FIRSTMSG)))) then (LAB.PROMPTPRINT MAILFOLDER (if (EQ MODEBITS 0) then "Message of unknown protocol." else "Warning: This message was retrieved under a protocol not currently enabled.")) (LAB.PROMPTPRINT MAILFOLDER "Will answer in " (SETQ MODE (fetch (LAFITEOPS LAFITEMODE) of \LAFITEMODE)) " mode; this may not work. "))) (* ;; "Currently we only pay attention to the first message. If we ever do otherwise, we'll want to notice whether the other messages are in the same mode") (LET* ((*LAFITE-MODE-DATA* (\LAFITE.GET.USER.DATA MODE)) (MSG (CL:FUNCALL (fetch (LAFITEMODEDATA ANSWERER) of *LAFITE-MODE-DATA*) MSGDESCRIPTORS MAILFOLDER))) (* ;; "Before returning the form, tag it with a mail mode") (if (TEXTSTREAMP MSG) then (TEXTPROP MSG (QUOTE LAFITEMODE) MODE) MSG else (OPENTEXTSTREAM MSG NIL NIL NIL (BQUOTE (LAFITEMODE (\, MODE))))))))
)
(LA.PRINT.COMMA.LIST
(LAMBDA (STRINGS STREAM) (* ; "Edited 6-Jun-88 12:50 by bvm") (for STR in STRINGS bind NTHTIME when STR do (COND (NTHTIME (PRIN3 ", " STREAM)) (T (SETQ NTHTIME T))) (PRIN3 STR STREAM)))
)
(LAFITE.FILL.IN.ANSWER.FORM
(LAMBDA (SUBJECT FROM DATE TO CC ADDRESSPRINTFN) (* ; "Edited 10-Jun-88 17:19 by bvm") (* ;; "Construct an answer form replying to a message from FROM on DATE with specified SUBJECT. Reply should go to the lists of names TO and CC. ADDRESSPRINTFN is a function that prints a list of names suitably for the protocol in question.") (LET ((OUTSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (LIST (QUOTE FONT) LAFITEEDITORFONT))) SELECTPOSITION) (LINELENGTH MAX.SMALLP OUTSTREAM) (* ; "Sigh, apparently text streams have linelength") (PROGN (printout OUTSTREAM "Subject: ") (if SUBJECT then (COND ((NOT (STRING-EQUAL (SUBSTRING SUBJECT 1 3) "Re:")) (printout OUTSTREAM "Re: "))) (printout OUTSTREAM SUBJECT) else (printout OUTSTREAM "(reply to message)"))) (PROGN (printout OUTSTREAM T "In-reply-to: ") (if (NULL FROM) then (printout OUTSTREAM "your") else (printout OUTSTREAM FROM "'s")) (printout OUTSTREAM " message of " DATE T)) (PROGN (printout OUTSTREAM "To: ") (if TO then (CL:FUNCALL ADDRESSPRINTFN TO OUTSTREAM) else (* ; "No to, so ask to fill in") (printout OUTSTREAM RECIPIENTSSTR T)) (TERPRI OUTSTREAM)) (COND (CC (printout OUTSTREAM "cc: ") (CL:FUNCALL ADDRESSPRINTFN CC OUTSTREAM) (TERPRI OUTSTREAM))) (TERPRI OUTSTREAM) (SETQ SELECTPOSITION (ADD1 (GETFILEPTR OUTSTREAM))) (printout OUTSTREAM MESSAGESTR T) (if LAFITE.SIGNATURE then (* ; "Pre-sign it") (PRIN3 LAFITE.SIGNATURE OUTSTREAM)) (TEDIT.SETSEL OUTSTREAM SELECTPOSITION (NCHARS MESSAGESTR) (QUOTE RIGHT) T) OUTSTREAM))
)
)
(* ; "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) (* ; "Edited 14-Oct-87 16:20 by bvm:") (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") (RESETLST (OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER) NIL T) (LA.RESETSHADE ITEM MENU) (\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER) (COND ((NOT (LAB.ASSURE.SELECTIONS MAILFOLDER)) (SETQ FORM (MAKEFORWARDFORM WINDOW MAILFOLDER (SETQ FORWARDEDMSGS (LAB.SELECTED.MESSAGES MAILFOLDER))))))) (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 FOLDER MESSAGELIST) (* ; "Edited 23-Aug-88 12:50 by bvm") (* ;; "Make a message form that forwards each of the messages in MESSAGELIST") (PROG ((FOLDERSTREAM (\LAFITE.OPEN.FOLDER FOLDER (QUOTE INPUT) :ABORT)) (TEXTSTREAM (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 FOLDER)) (LINELENGTH MAX.SMALLP TEXTSTREAM) (PRIN3 "Subject: " TEXTSTREAM) (COND ((OR LAFITEFORWARDSUBJECTSTR (NULL (SETQ SUBJECT (fetch (LAFITEMSG SUBJECT) of CURMSG)))) (SETQ SELECTPOSITION (ADD1 (GETFILEPTR TEXTSTREAM))) (SETQ SELECTLEN (NCHARS (SETQ SUBJECT (OR LAFITEFORWARDSUBJECTSTR SUBJECTSTR)))) (PRIN3 SUBJECT TEXTSTREAM)) (T (CL:FORMAT TEXTSTREAM "[~A: ~A]" (fetch (LAFITEMSG FROM) of CURMSG) SUBJECT))) (TERPRI TEXTSTREAM) (PRIN3 "To: " TEXTSTREAM) (COND ((NOT SELECTPOSITION) (SETQ SELECTPOSITION (ADD1 (GETFILEPTR TEXTSTREAM))) (SETQ SELECTLEN (NCHARS RECIPIENTSSTR)))) (CL:FORMAT TEXTSTREAM "~A
cc: ~A
~A
" RECIPIENTSSTR (FULLUSERNAME) (CAR LAFITEFORWARDSTRINGS)) (if LAFITE.SIGNATURE then (* ; "Sign it up here, after the user's inserted comments, if any") (PRIN3 LAFITE.SIGNATURE TEXTSTREAM) (TERPRI TEXTSTREAM)) (for MSGDESCRIPTOR in MESSAGELIST bind NTHTIME do (PRIN3 (COND (NTHTIME (* ; "%"Next message%"") (CADDR LAFITEFORWARDSTRINGS)) (T (* ; "%"Begin forwarded messages%"") (SETQ NTHTIME T) (CADR LAFITEFORWARDSTRINGS))) TEXTSTREAM) (TERPRI TEXTSTREAM) (\LAFITE.APPEND.MESSAGE.BODY TEXTSTREAM FOLDERSTREAM MSGDESCRIPTOR \LAPARSE.DONT.FORWARD.HEADERS) (TERPRI TEXTSTREAM) (TEDIT.CARETLOOKS TEXTSTREAM LAFITEEDITORFONT)) (PRIN3 (CADDDR LAFITEFORWARDSTRINGS) TEXTSTREAM) (TERPRI TEXTSTREAM) (TEDIT.SETSEL TEXTSTREAM SELECTPOSITION SELECTLEN (QUOTE RIGHT) T) (RETURN TEXTSTREAM)))
)
)
(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))))
(RPAQQ LAFITEFORWARDSTRINGS (">>CoveringMessage<<" "
----- Begin Forwarded Messages -----
" "
----- Next Message -----
" "
----- End Forwarded Messages -----"))
(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"))
(ADDTOVAR LAFITEMENUVARS LAFITEFORMSMENU LAFITEFORMATMENU)
(RPAQ? \LAFITE.REPORT.MACHINE)
(RPAQ? LAFITECURRENTEDITORWINDOWS)
(RPAQ? LAFITEFORMFILES)
(RPAQ? LAFITEFORMSMENU)
(RPAQ? LAFITEFORMATMENU)
(RPAQ? LAFITEEDITORFONT LAFITEDISPLAYFONT)
(RPAQ? LAFITEFORM.EXT (QUOTE LAFITE-FORM))
(RPAQ? LAFITEFORMDIRECTORIES NIL)
(RPAQ? LAFITE.EDITOR.SIZE (QUOTE (470 . 300)))
(RPAQ? LAFITE.EDITOR.LAYOUTS NIL)
(RPAQ? LAFITEFORWARDSUBJECTSTR NIL)
(RPAQ? LAFITESUPPORT NIL)
(RPAQ? LISPSUPPORT NIL)
(RPAQ? MESSAGESTR ">>Message<<")
(RPAQ? RECIPIENTSSTR ">>Recipients<<")
(RPAQ? SUBJECTSTR ">>Subject<<")
(RPAQ? LAFITE.SEND.FORMATTED (QUOTE ((NSCHARS :ASK) (CHARLOOKS :ASK) (PARALOOKS :ASK) (IMAGEOBJ T))))
(* ; "Obsolete")
(RPAQ? LAFITEEDITORREGION NIL)
(* ; "ICON stuff")
(RPAQQ LAFITE.MSG.ICON (#*(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@@@
#*(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@@@ (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 LAFITE.MSG.ICON LAFITEFORMDIRECTORIES LAFITE.SEND.FORMATTED)
)
(FILESLOAD (SOURCE) LAFITEDECLS)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
)
(PUTPROPS LAFITESEND COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3462 10337 (DOLAFITESENDINGCOMMAND 3472 . 3846) (\SENDMESSAGE.INITIATE 3848 . 5043) (
\SENDMESSAGE.PARSE 5045 . 5428) (\LAFITE.PREPARE.SEND 5430 . 7092) (\LAFITE.PREPARE.ERROR 7094 . 7819)
(\LAFITE.CHOOSE.MSG.FORMAT 7821 . 8939) (LAFITE.MAKE.PLAIN.TEXTSTREAM 8941 . 9634) (
\SENDMESSAGE.MENUPROMPT 9636 . 10024) (\SENDMESSAGEFAIL 10026 . 10335)) (10338 21324 (\SENDMESSAGE
10348 . 10879) (\SENDMESSAGE.RESTARTABLE 10881 . 13757) (\SENDMESSAGE.CLEANUP 13759 . 13932) (
\SENDMESSAGE.MAKEWINDOW 13934 . 16274) (MAKELAFITEDELIVERMENU 16276 . 16481) (\LAFITE.CLOSEMSG? 16483
. 17083) (\LAFITE.AFTER.DELIVER 17085 . 17270) (\LAFITE.UNSENT.ICON 17272 . 17517) (
\LAFITE.FETCH.SUBJECT 17519 . 17967) (LAFITE.SENDMESSAGE 17969 . 18485) (\SENDMESSAGE0 18487 . 19892)
(LA.ASSURE.PROMPT.WINDOW 19894 . 20403) (\LAFITE.SEND.FAIL 20405 . 20770) (\LAFITE.INVALID.RECIPIENTS
20772 . 21093) (\SENDMESSAGE.ABORT 21095 . 21322)) (21356 27136 (\OUTBOX.CREATE 21366 . 22372) (
\OUTBOX.RESET 22374 . 22678) (\OUTBOX.CLOSEFN 22680 . 22769) (\OUTBOX.REPAINTFN 22771 . 23113) (
\OUTBOX.RESHAPEFN 23115 . 23757) (\OUTBOX.SHADEITEM 23759 . 24229) (\OUTBOX.BUTTONFN 24231 . 25943) (
\OUTBOX.DISPLAYLINE 25945 . 26235) (\OUTBOX.ADD.ITEM 26237 . 27134)) (27423 35543 (\LAFITE.MESSAGEFORM
27433 . 29262) (MAKELAFITESUPPORTFORM 29264 . 29393) (MAKELISPSUPPORTFORM 29395 . 29501) (
MAKEXXXSUPPORTFORM 29503 . 31387) (MAKENEWMESSAGEFORM 31389 . 31981) (MAKELAFITEPRIVATEFORMSITEMS
31983 . 32255) (\LAFITE.UNCACHE.MESSAGEFORM 32257 . 32723) (\LAFITE.READ.FORM 32725 . 34150) (
\LAFITE.FIND.TEMPLATE 34152 . 34638) (\LAFITE.SAVE.FORM 34640 . 35541)) (35567 39646 (\LAFITE.ANSWER
35577 . 35845) (\LAFITE.ANSWER.PROC 35847 . 36692) (MAKEANSWERFORM 36694 . 37913) (LA.PRINT.COMMA.LIST
37915 . 38128) (LAFITE.FILL.IN.ANSWER.FORM 38130 . 39644)) (39671 42885 (\LAFITE.FORWARD 39681 .
39952) (\LAFITE.FORWARD.PROC 39954 . 41015) (MAKEFORWARDFORM 41017 . 42883)))))
STOP