(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "24-Oct-88 18:22:03" {POOH/N}<POOH>LAFITE>SOURCES>LAFITE;8 90859
changes to%: (FNS \LAFITE.MAKE.FOLDER.MENU)
previous date%: "13-Sep-88 18:46:57" {POOH/N}<POOH>LAFITE>SOURCES>LAFITE;7)
(* "
Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988 by
Xerox Corporation and Bolt Beranek and Newman Inc.. All rights reserved.
")
(PRETTYCOMPRINT LAFITECOMS)
(RPAQQ LAFITECOMS ((COMS (E (SETQ LAFITESYSTEMDATE (DATE))) (VARS LAFITEVERSION# LAFITESYSTEMDATE)) (COMS (FNS LAFITE LAFITE.ON.FROM.BACKGROUND \LAFITE.OFF \LAFITE.START.PROC LAFITE.COMPUTE.CACHED.VARS \LAFITE.PROCESS \LAFITE.START.ABORT \LAFITE.QUIT \LAFITE.RESTART \LAFITE.SUBQUIT \LAFITE.QUIT.PROC \LAFITEDEFAULTHOST&DIR LAFITEDEFAULTHOST&DIR MAKELAFITECOMMANDWINDOW EXTRACTMENUCOMMAND DOMAINLAFITECOMMAND) (PROP ARGNAMES LAFITE) (FNS LAFITEMODE \LAFITE.INFER.MODE \LAFITE.SHOW.MODE \LAFITE.MODE.TITLE LAFITE.SHOW.MODE.P LAFITE.ALL.MODES.P SET.LAFITE.MODE.INTERACTIVELY \LAFITE.COMPUTE.MODE.COMMANDS) (PROP VARTYPE LAFITEMODELST) (ADDVARS (LAFITEMODELST)) (INITVARS (\LAFITEMODE) (\LAFITE.AUTHENTICATION.FAILURE) (LAFITE.BACKGROUND.ITEM (QUOTE ("Mail" (QUOTE (\LAFITE.MESSAGEFORM NIL NIL (QUOTE LEFT))) "Send an ordinary message. See subcommands for other operations." (SUBITEMS ("Turn Lafite on" (QUOTE (LAFITE.ON.FROM.BACKGROUND)) "Turn on Lafite, bringing up status window and browsing default folder.") ("Send Mail" (QUOTE (\LAFITE.MESSAGEFORM)) "Send a message. Prompts for type of message.") ("Set Lafite Mode" (QUOTE (SET.LAFITE.MODE.INTERACTIVELY)) "Set or change Lafite's mail protocol mode.")))))) (FNS \LAFITE.LOGIN \LAFITE.LOGIN.NORESTART LAFITE.PROMPT.FOR.LOGIN \LAFITE.REAUTHENTICATE)) (INITVARS * LAFITEPROFILEVARS) (INITVARS * LAFITERANDOMGLOBALS) (VARS * LAFITEMARKS) (VARS LAFITECOMMANDMENUITEMS LAFITEUPDATEMENUITEMS LAFITESUBQUITMENUITEMS ANOTHERFOLDERMENUITEM) (INITVARS (LAFITESTATUSWINDOW) (\ACTIVELAFITEFOLDERS) (\LAFITEPROFILECHANGED) (\LAFITE.TEMPFILES) (LAFITEMAILFOLDERS) (LAFITEFOLDERSMENU) (LAFITEMULTIPLEFOLDERSMENU) (\LAFITE.MODE.CHOICES) (LAFITESUBQUITMENU)) (ADDVARS (LAFITEMENUVARS LAFITESUBQUITMENU LAFITEFOLDERSMENU LAFITEMULTIPLEFOLDERSMENU)) (COMS (* ; "misc utilities") (FNS LA.RESETSHADE LA.MENU.ITEM NTHMESSAGE \LAFITE.MAKE.MSGARRAY \LAFITE.ADDMESSAGES.TO.ARRAY \MAILFOLDER.DEFPRINT)) (COMS (* ; "Display aids") (CURSORS LA.CROSSCURSOR)) (COMS (INITVARS (\LAFITE.ACTIVE) (\LAFITE.READY) (\LAFITEDEFAULTHOST&DIR) (\LAFITE.ACTIVE.MODES) (\LAFITE.CURRENT.USER) (LAFITE.USER.INFO) (*LAFITE-WELL-KNOWN-MODES*) (*LAFITE-LOGGING-IN*)) (ADDVARS (\SYSTEMCACHEVARS \LAFITE.READY \LAFITE.ACTIVE.MODES) (LAFITE.PERSONAL.VARS LAFITEDEFAULTHOST&DIR LAFITE.SIGNATURE)) (FNS LAFITE.AROUNDEXIT \LAFITE.MARK.FOLDERS.OBSOLETE \LAFITE.CHECK.FOLDERS \LAFITE.ASSURE.FOLDER.READY \LAFITE.AFTERLOGIN)) (COMS (* ; "The profile") (FNS \LAFITE.READ.PROFILE \LAFITE.PROCESS.PROFILE \LAFITE.WRITE.PROFILE \LAFITE.MERGE.NAMELISTS \LAFITE.READ.OLD.PROFILE \LAFITE.MERGE.FOLDERS \LAFITE.REPACK.FOLDERS) (INITVARS (\LAFITEPROFILEDATE)) (ADDVARS (LAFITE.PROFILE.VARS (*LA.ABBREVS.IN.PROFILE*) (LAFITEMAILFOLDERS \LAFITE.MERGE.FOLDERS) (LAFITEFORMFILES \LAFITE.MERGE.NAMELISTS)))) (COMS (* ; "Name mashing") (FNS LA.LONGFILENAME LA.SHORTFILENAME TOCFILENAME FORGETMAILFILE \LAFITE.FOLDER.NAME.CHANGED \LAFITE.RECOMPUTE.FOLDER.NAMES \LAFITE.NEW.SHORT.NAME \LAFITE.NOTICE.FILE \LAFITE.UNCACHE.FOLDER) (INITVARS LAFITE.HOST.ABBREVS \LAFITE.PSEUDO.DEVICES) (* ; "Prompting for folders") (FNS \LAFITE.PROMPTFORFOLDER PROMPTFORFILENAME MAKELAFITEMAILFOLDERSMENU \LAFITE.ARRANGE.MENU \LAFITE.MAKE.FOLDER.MENU LAFITE.SELECT.FOLDERS \LAFITE.HANDLE.MULTIPLE.SELECTION COLLECT.SHADED.ITEMS)) (COMS (* ; "Low level file functions") (FNS DELETEMAILFOLDER \LAFITE.OPEN.FOLDER \LAFITE.REPORT.FILE.WONT.OPEN \LAFITE.FOLDER.CHANGED \LAFITE.REBROWSE.FOLDER \LAFITE.FOLDER.CHANGED.MENU \LAFITE.SET.FOLDER.STREAM \LAFITE.OPENSTREAM \LAFITE.CREATE.MENU \LAFITE.EOF \LAFITE.CLOSE.FOLDER MAILFOLDERBUSY) (FNS COPY7BITFILE \LAFITE.BROWSE.LAURELFILE \LAFITE.NOTICE.FOLDERS \LAFITE.MAKE.RANDOM.DISPLAY \LAFITE.GC.FOLDERS \LAFITE.GC.FOLDERS.CONFIRM \LAFITE.SET.NEW.FOLDERS \LAFITE.RENAME.FOLDER \LAFITE.DESCRIBE.FOLDER \LAFITE.FIX.LAUREL.FOLDER)) (COMS (* ; "Make is easy to load new versions of Lafite") (FNS LOAD-LAFITE) (VARS LAFITEFILES)) (DECLARE%: DOEVAL@COMPILE DONTCOPY (FILES (SOURCE) LAFITEDECLS) (LOCALVARS . T) (GLOBALVARS MENUFONT TEDIT.DEFAULT.MENU) (P (CL:PROCLAIM (QUOTE (CL:SPECIAL *LAFITE-LOGGING-IN* *LA.ABBREVS.IN.PROFILE*)))) (ADDVARS (DONTCOMPILEFNS RELEASE.LAFITE)) DONTEVAL@COMPILE (FNS RELEASE.LAFITE)) (INITRECORDS MAILFOLDER LAFITEMSG) (SYSRECORDS MAILFOLDER LAFITEMSG) (COMS (FNS \LAFITE.GLOBAL.INIT) (DECLARE%: DONTEVAL@LOAD DOCOPY (FILES LAFITEBROWSE LAFITECOMMANDS LAFITESEND LAFITEMAIL TEDIT LAFITETEDIT LAFITEFIND ATTACHEDWINDOW) (P * (PROGN LAFITE.PROCLAMATIONS)) (* ; "Proclaim user interface variables. Value is on LAFITEDECLS") (P (\LAFITE.GLOBAL.INIT) (COND ((EQ MAKESYSNAME :LYRIC) (FILESLOAD (SYSLOAD) NSCHARPATCH) (* ; "Patch to horrid Lyric NS chars bug") (MOVD? (QUOTE PROMPTFORWORD) (QUOTE TTYINPROMPTFORWORD) NIL T)))))) (DECLARE%: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA LAFITE)))))
(RPAQQ LAFITEVERSION# 9)
(RPAQQ LAFITESYSTEMDATE "24-Oct-88 18:22:05")
(DEFINEQ
(LAFITE
(LAMBDA X (* ; "Edited 13-Jun-88 10:47 by bvm") (* ;;; "The first argument should be :ON or :OFF. The second argument, if supplied, is the name of the mailfile Lafite should browse unless the second argument is NIL in which case no mailfile will be browsed. If there is no second argument then default to DEFAULTMAILFOLDERNAME mailfile -- currently ACTIVE") (PROG ((CMD (COND ((< X 1) (* ; "Lafite called with no args") :ON) (T (ARG X 1)))) OPTIONS) RETRY (RETURN (CASE CMD ((:ON ON) (COND (\LAFITE.ACTIVE (* ; "Already on!") (TOTOPW LAFITESTATUSWINDOW) :ON) (T (\LAFITE.PROCESS (BQUOTE ((\, (FUNCTION \LAFITE.START.PROC)) (QUOTE (\, (COND ((OR (<= X 1) (EQ (ARG X 2) T)) DEFAULTMAILFOLDERNAME) (T (ARG X 2))))) (QUOTE (\, (for I from 3 to X collect (LET ((OP (ARG X I))) (if (CL:KEYWORDP OP) then OP elseif (CL:SYMBOLP OP) then (* ; "Old interface wasn't with keywords, so help out") (CL:INTERN (CL:SYMBOL-NAME OP) *KEYWORD-PACKAGE*) else (\ILLEGAL.ARG OP)))))))) (QUOTE LAFITE)) (QUOTE :ON)))) ((:OFF OFF RESTART) (if (\LAFITE.OFF) then (* ; "Successfully turned Lafite off") (COND ((EQ CMD (QUOTE RESTART)) (APPLY (FUNCTION LAFITE) (CONS :ON (for I from 2 to X collect (ARG X I))))) (T :OFF)))) (T (if (NEQ CMD (SETQ CMD (U-CASE CMD))) then (GO RETRY) else (LISPERROR "ILLEGAL ARG" CMD)))))))
)
(LAFITE.ON.FROM.BACKGROUND
(LAMBDA NIL (* ; "Edited 13-Jun-88 11:18 by bvm") (* ;; "Called from background menu to turn lafite on.") (COND (\LAFITE.ACTIVE (* ; "Already on!") (TOTOPW LAFITESTATUSWINDOW) (PROMPTPRINT "Lafite is already on.")) (T (\LAFITE.PROCESS (BQUOTE ((\, (FUNCTION \LAFITE.START.PROC)) (QUOTE (\, DEFAULTMAILFOLDERNAME)) NIL)) (QUOTE LAFITE)))))
)
(\LAFITE.OFF
(LAMBDA NIL (* ; "Edited 6-Jun-88 19:53 by bvm") (* ;; "If Lafite is on, turn it off. Returns T if successfully off") (OR (NULL \LAFITE.ACTIVE) (PROGN (* ; "Lafite was on") (COND ((EQ \LAFITE.ACTIVE (QUOTE INIT)) (* ; "Zap the initializer") (DEL.PROCESS (QUOTE LAFITE)))) (\LAFITE.QUIT.PROC (LA.MENU.ITEM (FUNCTION \LAFITE.QUIT) LAFITEMAINMENU) LAFITEMAINMENU))))
)
(\LAFITE.START.PROC
(LAMBDA (MAILFILE OPTIONS) (* ; "Edited 13-Jun-88 10:49 by bvm") (RESETSAVE NIL (LIST (FUNCTION \LAFITE.START.ABORT))) (SETQ \LAFITE.ACTIVE (QUOTE INIT)) (COND ((NOT (WINDOWP LAFITESTATUSWINDOW)) (MAKELAFITECOMMANDWINDOW))) (\LAFITE.REINITIALIZING T) (\LAFITEDEFAULTHOST&DIR (OR LAFITEDEFAULTHOST&DIR LOGINHOST/DIR)) (SETQ \LAFITE.BROWSELOCK (CREATE.MONITORLOCK "Lafite Browser Control")) (* ; "Used by anyone creating browsers or otherwise concerned with changes to \ACTIVELAFITEFOLDERS") (SETQ \LAFITE.MAINLOCK (CREATE.MONITORLOCK "Lafite Main")) (* ; "Used by \LAFITE.CLOSE.OTHER.FOLDERS or anyone who needs access to multiple arbitrary folders") (SETQ \LAFITE.PROFILELOCK (CREATE.MONITORLOCK "Lafite Profile")) (SETQ \LAFITE.HARDCOPYLOCK (CREATE.MONITORLOCK "Lafite hardcopy")) (* ; "Used by anyone reading or writing the Lafite profile") (SETQ LAFITEMAILFOLDERS (SETQ LAFITEFORMFILES NIL)) (\LAFITE.READ.PROFILE) (LA.CREATE.UPDATE.MENU.ARRAY) (LAFITE.COMPUTE.CACHED.VARS) (SETQ \LAFITE.READY T) (pushnew \AFTERLOGINFNS (FUNCTION \LAFITE.AFTERLOGIN)) (pushnew AROUNDEXITFNS (FUNCTION LAFITE.AROUNDEXIT)) (SETQ \LAFITE.ACTIVE T) (if NIL then (* ;; "Authenticate user first, so that MSGFROMMEP works. NLSETQ so that errors and/or ↑ from break do not leave Lafite in inconsistent state") (NLSETQ (\LAFITE.GET.USER.DATA))) (ADD.PROCESS (CONSTANT (LIST (FUNCTION LAFITEMAILWATCH))) (QUOTE RESTARTABLE) (QUOTE HARDRESET) (QUOTE AFTEREXIT) (QUOTE SUSPEND)) (* ; "Finally, enable menu") (replace (MENU WHENSELECTEDFN) of LAFITEMAINMENU with (FUNCTION DOMAINLAFITECOMMAND)) (COND ((OR MAILFILE (AND (MEMB :SHRINK OPTIONS) (SETQ MAILFILE DEFAULTMAILFOLDERNAME))) (\LAFITE.BROWSE.PROC (LA.MENU.ITEM (FUNCTION \LAFITE.BROWSE) LAFITEMAINMENU) LAFITEMAINMENU MAILFILE (if (AND MAILFILE (NLISTP MAILFILE)) then (* ; "Make it the %"active%" folder as well") (CONS :ACTIVE (MKLIST OPTIONS)) else OPTIONS)))))
)
(LAFITE.COMPUTE.CACHED.VARS
(LAMBDA NIL (* ; "Edited 12-Sep-88 17:08 by bvm") (* ;; "Clears or recomputes all cached information that is based on some possibly user-settable variable.") (SETQ \LAFITE.DISPLAY.COMMANDS (APPEND (for CMD in (fetch (MENU ITEMS) of TEDIT.DEFAULT.MENU) when (CL:MEMBER (if (LISTP CMD) then (CAR CMD) else CMD) (QUOTE ("put" "find" "Expanded Menu")) :TEST (QUOTE STRING-EQUAL)) collect CMD) (for CMD in LAFITE.EXTRA.DISPLAY.COMMANDS collect (if (STRING-EQUAL (CAR CMD) "looks") then (* ; "Add subcommands, so user can easily add more functions to do Looks.") (LIST (CAR CMD) (CADR CMD) (CADDR CMD) (CONS (QUOTE SUBITEMS) (APPEND (CDR (CADDDR CMD)) LAFITE.LOOKS.SUBCOMMANDS))) else CMD)))) (for USERVAR in (QUOTE (LAFITE.DONT.DISPLAY.HEADERS LAFITE.DONT.FORWARD.HEADERS LAFITE.DONT.HARDCOPY.HEADERS)) as IVAR in (QUOTE (\LAPARSE.DONT.DISPLAY.HEADERS \LAPARSE.DONT.FORWARD.HEADERS \LAPARSE.DONT.HARDCOPY.HEADERS)) do (* ; "Make parse tables out of user vars that list fields to omit from headers") (SET IVAR (AND (EVALV USERVAR) (LAFITE.MAKE.PARSE.TABLE (for FIELD in (EVALV USERVAR) collect (LIST FIELD (FUNCTION LAFITE.EAT.UNDESIRABLE.FIELD))))))) (for VAR in LAFITEMENUVARS do (* ; "Clear cached menus") (SET VAR NIL)) (for FOLDER in \ACTIVELAFITEFOLDERS do (for W in (fetch (MAILFOLDER FOLDERDISPLAYWINDOWS) of FOLDER) when (WINDOWP W) do (WINDOWPROP W (QUOTE TEDIT.MENU.COMMANDS) \LAFITE.DISPLAY.COMMANDS) (WINDOWPROP W (QUOTE TEDIT.MENU) NIL))) (LET ((OLDABBREVS \LAFITE.PSEUDO.DEVICES) (NEWABBREVS (DREMOVE NIL (for PAIR in LAFITE.HOST.ABBREVS bind FIELDS NAMES collect (if (AND (for STR in (SETQ NAMES (if (LISTP (SETQ NAMES (CAR PAIR))) then (APPEND NAMES) else (LIST NAMES))) always (AND (STRINGP STR) (EQ (NTHCHARCODE STR -1) (CHARCODE ":")))) (for TAIL on (SETQ FIELDS (UNPACKFILENAME.STRING (CADR PAIR))) by (CDDR TAIL) always (FMEMB (CAR TAIL) (QUOTE (HOST DIRECTORY DEVICE))))) then (* ; "CAR is list of pseudo-devices (must be strings ending in colon), CDR is unpacked fields") (CONS NAMES FIELDS) else (PRINTOUT PROMPTWINDOW T "Bad host abbreviation: " PAIR) NIL))))) (if (NOT (PROG1 (EQUAL (CDR \LAFITE.PSEUDO.DEVICES) NEWABBREVS) (SETQ \LAFITE.PSEUDO.DEVICES (AND NEWABBREVS (CONS (CONS NIL (fetch UNPACKEDHOST&DIR of \LAFITEDEFAULTHOST&DIR)) NEWABBREVS))))) then (\LAFITE.RECOMPUTE.FOLDER.NAMES OLDABBREVS))) (* ;; "Finally, reauthenticate user, in case there is any mode-specific caching we care about.") (LAFITECLEARCACHE))
)
(\LAFITE.PROCESS
(LAMBDA (FORM NAME ALLOWLOGOUT RESTARTABLE) (* bvm%: "25-Mar-84 17:16") (* ;;; "Creates a process running FORM which by default is not restartable and will not permit LOGOUT while it is running") (ADD.PROCESS FORM (QUOTE NAME) NAME (QUOTE RESTARTABLE) (OR RESTARTABLE (QUOTE NO)) (QUOTE BEFOREEXIT) (COND (ALLOWLOGOUT NIL) (T (QUOTE DON'T)))))
)
(\LAFITE.START.ABORT
(LAMBDA NIL (* bvm%: "25-Mar-84 16:44") (COND ((AND RESETSTATE (NEQ \LAFITE.ACTIVE T)) (CLOSEW LAFITESTATUSWINDOW) (SETQ LAFITESTATUSWINDOW (SETQ \LAFITE.ACTIVE)))))
)
(\LAFITE.QUIT
(LAMBDA (ITEM MENU BUTTON) (* bvm%: " 7-Nov-84 11:48") (COND ((EQ BUTTON (QUOTE MIDDLE)) (\LAFITE.SUBQUIT ITEM MENU)) (T (\LAFITE.PROCESS (LIST (FUNCTION \LAFITE.QUIT.PROC) (KWOTE ITEM) (KWOTE MENU)) (QUOTE LAFITEQUIT)))))
)
(\LAFITE.RESTART
(LAMBDA (ITEM MENU) (* ; "Edited 8-Jun-88 12:08 by bvm") (COND ((\LAFITE.QUIT.PROC ITEM MENU) (LAFITE :ON))))
)
(\LAFITE.SUBQUIT
(LAMBDA (ITEM MENU) (* ; "Edited 13-Jun-88 10:49 by bvm") (PROG ((MODES (\LAFITE.COMPUTE.MODE.COMMANDS)) (ITEMS LAFITESUBQUITMENUITEMS) COMMAND LOGINS LOGINITEM) (COND ((OR (NOT (EQUAL \LAFITE.MODE.CHOICES (SETQ \LAFITE.MODE.CHOICES MODES))) (NULL LAFITESUBQUITMENU)) (* ; "Recompute menu") (if (CDR MODES) then (* ; "Only include modes if there's more than one--boring otherwise") (SETQ ITEMS (APPEND ITEMS MODES))) (if (AND (SETQ LOGINITEM (LA.MENU.ITEM (FUNCTION \LAFITE.LOGIN) ITEMS)) (SETQ LOGINS (for MODE in LAFITEMODELST bind FN when (AND (LISTP (CDR MODE)) (SETQ FN (fetch (LAFITEOPS LOGIN) of MODE))) collect (BQUOTE ((\, (CONCAT (CAR MODE) " Login")) (QUOTE (\, FN)) (\, (CONCAT "Change the name and/or password for " (CAR MODE) " operation."))))))) then (* ; "Add subitems for logging in for specific modes.") (SETQ ITEMS (DSUBST (LIST (CAR LOGINITEM) (CADR LOGINITEM) (CADDR LOGINITEM) (APPEND (CADDDR LOGINITEM) LOGINS)) LOGINITEM ITEMS))) (SETQ LAFITESUBQUITMENU (\LAFITE.CREATE.MENU ITEMS "Mode Change")))) (COND ((LISTP (SETQ COMMAND (MENU LAFITESUBQUITMENU))) (* ; "Change mode command") (LAFITEMODE (CAR COMMAND))) (COMMAND (* ; "Arbitrary other command") (\LAFITE.PROCESS (BQUOTE ((\, COMMAND) (QUOTE (\, ITEM)) (QUOTE (\, MENU)))) (QUOTE LAFITEQUIT))))))
)
(\LAFITE.QUIT.PROC
(LAMBDA (ITEM MENU) (* ; "Edited 30-Aug-88 14:41 by bvm") (RESETLST (LA.RESETSHADE ITEM MENU) (OBTAIN.MONITORLOCK \LAFITE.BROWSELOCK NIL T) (OBTAIN.MONITORLOCK \LAFITE.MAINLOCK NIL T) (PROG ((HOW? 0) MENUREG) (OR \LAFITE.ACTIVE (RETURN T)) (COND ((for WINDOW in LAFITECURRENTEDITORWINDOWS do (COND ((OPENWP WINDOW) (SETQ $$VAL (TOTOPW WINDOW))) ((WINDOWP (SETQ WINDOW (WINDOWPROP WINDOW (QUOTE ICONWINDOW)))) (SETQ $$VAL (EXPANDW WINDOW))))) (printout PROMPTWINDOW T "There are open/undelivered message composition windows -- can't quit") (RETURN))) (for FOLDER in \ACTIVELAFITEFOLDERS when (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER) do (SETQ HOW? (LOGOR HOW? (LAB.UPDATE.NEEDED? FOLDER)))) (COND ((EQ HOW? 0) (* ; "Nothing to do but close them") (SETQ HOW? (FUNCTION \LAFITE.FINISH.UPDATE))) (T (* ;; "Determine what to do with open browsers. Essentially same as the CLOSEFN for a browser, but we offer a single menu that offers all the choices that the most particular window might need") (SETQ HOW? (CL:AREF LAFITE.UPDATE.MENU.ARRAY (LOGOR HOW? \CLOSE.MENU.BIT))) (SETQ HOW? (\LAFITE.CREATE.MENU (APPEND (OR (LISTP HOW?) (fetch (MENU ITEMS) of HOW?)) (QUOTE (("Don't Quit" NIL "Abort the Quit command")))) "How should browsers be closed?" T)) (SETQ MENUREG (WINDOWPROP (WFROMMENU MENU) (QUOTE REGION))) (SETQ HOW? (OR (MENU HOW? (create POSITION XCOORD ← (- (fetch (REGION RIGHT) of MENUREG) (fetch (MENU IMAGEWIDTH) of HOW?)) YCOORD ← (- (fetch (REGION BOTTOM) of MENUREG) (fetch (MENU IMAGEHEIGHT) of HOW?))) T) (RETURN NIL))))) (for FOLDER in (APPEND \ACTIVELAFITEFOLDERS) bind BROWSERWINDOW do (COND ((NOT (SETQ BROWSERWINDOW (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER))) (\LAFITE.CLOSE.FOLDER FOLDER T)) (T (CL:FUNCALL HOW? BROWSERWINDOW FOLDER :EXIT)))) (SETQ \ACTIVELAFITEFOLDERS) (AND \LAFITE.OUTBOX (CLOSEW (fetch OBWINDOW of \LAFITE.OUTBOX))) (COND (\LAFITEPROFILECHANGED (\LAFITE.WRITE.PROFILE))) (SETQ AROUNDEXITFNS (REMOVE (FUNCTION LAFITE.AROUNDEXIT) AROUNDEXITFNS)) (if NIL then (* ; "Currently these are all on {SCRATCH}, so gc gets them") (for FILE in \LAFITE.TEMPFILES do (* ; "delete any temp files laying around") (CLOSEF? FILE) (DELFILE FILE)) (SETQ \LAFITE.TEMPFILES)) (SETQ \LAFITE.ACTIVE NIL) (DEL.PROCESS (FUNCTION LAFITEMAILWATCH)) (* (* ; "Don't remove this, since it continues to look at login changes") (SETQ \AFTERLOGINFNS (REMOVE (QUOTE \LAFITE.AFTERLOGIN) \AFTERLOGINFNS)) (LAFITECLEARCACHE)) (COND ((OPENWP LAFITESTATUSWINDOW) (CLOSEW LAFITESTATUSWINDOW))) (SETQ \LAFITE.MODE.CHOICES (SETQ LAFITEFORMFILES (SETQ \LAFITE.LAST.STATUS (SETQ \LAFITEDEFAULTHOST&DIR (SETQ LAFITE.UPDATE.MENU.ARRAY (SETQ LAFITEMAINMENU (SETQ LAFITESTATUSWINDOW NIL))))))) (for VAR in LAFITEMENUVARS do (* ; "Clear cached menus") (SET VAR NIL)) (RETURN T))))
)
(\LAFITEDEFAULTHOST&DIR
(LAMBDA (HOST&DIR) (* ; "Edited 29-Aug-88 17:12 by bvm") (PROG ((OLDHOST&DIR (fetch PACKEDHOST&DIR of \LAFITEDEFAULTHOST&DIR)) UNPACKED) (COND ((OR (NULL HOST&DIR) (STRING-EQUAL OLDHOST&DIR HOST&DIR)) (* ; "User wants the value, or there is no change") (RETURN HOST&DIR))) (* ; "now make sure its a legitimate HOST&DIR") (COND ((NOT (HOSTNAMEP HOST&DIR)) (printout PROMPTWINDOW T "Warning: " HOST&DIR " not a recognized directory"))) (* ; "set both the visible and invisble variables") (SETQ UNPACKED (UNPACKFILENAME.STRING HOST&DIR)) (SETQ \LAFITEDEFAULTHOST&DIR (create DEFAULTHOST&DIR PACKEDHOST&DIR ← (PACKFILENAME.STRING UNPACKED) UNPACKEDHOST&DIR ← UNPACKED)) (RETURN OLDHOST&DIR)))
)
(LAFITEDEFAULTHOST&DIR
(LAMBDA (HOST&DIR) (* bvm%: "22-Feb-84 16:27") (* ;;; "Temporary definition until we can do it right") (SETQ LAFITEDEFAULTHOST&DIR HOST&DIR))
)
(MAKELAFITECOMMANDWINDOW
(LAMBDA NIL (* bvm%: " 5-May-86 16:23") (PROG ((FONTHEIGHT (FONTPROP LAFITEMENUFONT (QUOTE HEIGHT))) MENUW MENUWREGION POSITION HEIGHT WIDTH STATUSWINDOW) (SETQ MENUW (MENUWINDOW (SETQ LAFITEMAINMENU (create MENU ITEMS ← LAFITECOMMANDMENUITEMS WHENSELECTEDFN ← (FUNCTION NILL) CENTERFLG ← T TITLE ← (OR (\LAFITE.MODE.TITLE) "L a f i t e") MENUFONT ← LAFITEMENUFONT MENUTITLEFONT ← LAFITETITLEFONT)))) (SETQ WIDTH (IMAX (fetch (REGION WIDTH) of (SETQ MENUWREGION (WINDOWPROP MENUW (QUOTE REGION)))) LAFITESTATUSWINDOWMINWIDTH)) (SETQ HEIGHT (HEIGHTIFWINDOW (FIX (FTIMES FONTHEIGHT 1.5)))) (SETQ POSITION (OR LAFITESTATUSWINDOWPOSITION (GETBOXPOSITION WIDTH (IPLUS HEIGHT (fetch (REGION HEIGHT) of MENUWREGION)) NIL NIL NIL "Specify position of the Lafite Command Menu."))) (SETQ STATUSWINDOW (CREATEW (MAKEWITHINREGION (create REGION LEFT ← (fetch (POSITION XCOORD) of POSITION) BOTTOM ← (IPLUS (fetch (POSITION YCOORD) of POSITION) (fetch (REGION HEIGHT) of MENUWREGION)) WIDTH ← WIDTH HEIGHT ← HEIGHT)))) (DSPFONT LAFITEMENUFONT STATUSWINDOW) (ATTACHWINDOW MENUW STATUSWINDOW (QUOTE BOTTOM)) (WINDOWPROP STATUSWINDOW (QUOTE BUTTONEVENTFN) (FUNCTION (LAMBDA (WINDOW) (COND ((LASTMOUSESTATE (NOT UP)) (SETQ \LAFITE.LAST.STATUS) (\LAFITE.WAKE.WATCHER)))))) (WINDOWPROP STATUSWINDOW (QUOTE MAINWINDOWMINSIZE) (CONS 0 HEIGHT)) (WINDOWPROP STATUSWINDOW (QUOTE MAINWINDOWMAXSIZE) (CONS MAX.SMALLP HEIGHT)) (OPENW STATUSWINDOW) (CLEARW STATUSWINDOW) (WINDOWPROP STATUSWINDOW (QUOTE YPOS) (IDIFFERENCE (DSPYPOSITION NIL STATUSWINDOW) (FIXR (FTIMES FONTHEIGHT 0.2)))) (RETURN (SETQ LAFITESTATUSWINDOW STATUSWINDOW))))
)
(EXTRACTMENUCOMMAND
(LAMBDA (ITEM) (* ; "Edited 3-Sep-87 15:28 by bvm:") (* ;; "Extract the %"command%" from a menu item. ITEM is in form (label form helpstring)") (COND ((NLISTP ITEM) ITEM) ((CADR ITEM) (EVAL (CADR ITEM))) (T (CAR ITEM))))
)
(DOMAINLAFITECOMMAND
(LAMBDA (ITEM MENU BUTTON) (* ; "Edited 3-Sep-87 18:00 by bvm:") (CL:FUNCALL (EXTRACTMENUCOMMAND ITEM) ITEM MENU BUTTON))
)
)
(PUTPROPS LAFITE ARGNAMES (NIL (ON/OFF MAILFILE . OPTIONS) . U))
(DEFINEQ
(LAFITEMODE
(LAMBDA (MODE) (* ; "Edited 9-May-88 15:53 by bvm") (PROG1 (fetch LAFITEMODE of \LAFITEMODE) (COND (MODE (while (LITATOM (CDR (SETQ MODE (OR (ASSOC MODE LAFITEMODELST) (\ILLEGAL.ARG MODE))))) do (SETQ MODE (CDR MODE))) (COND ((NEQ (fetch LAFITEMODE of \LAFITEMODE) (fetch LAFITEMODE of (SETQ \LAFITEMODE MODE))) (* ; "Mode changed, kick mailwatcher") (COND (\LAFITE.ACTIVE (\LAFITE.SHOW.MODE) (WITH.MONITOR \LAFITE.MAILSERVERLOCK (\LAFITE.WAKE.WATCHER))))))))))
)
(\LAFITE.INFER.MODE
(LAMBDA NIL (* bvm%: "21-Dec-84 22:43") (COND ((SETQ \LAFITEMODE (OR (AND LAFITEMODEDEFAULT (ASSOC LAFITEMODEDEFAULT LAFITEMODELST)) (PROG ((CHOICES (for X in LAFITEMODELST collect X when (LISTP (CDR X))))) (RETURN (AND CHOICES (NULL (CDR CHOICES)) (CAR CHOICES)))))) (AND LAFITESTATUSWINDOW (\LAFITE.SHOW.MODE)) \LAFITEMODE)))
)
(\LAFITE.SHOW.MODE
(LAMBDA NIL (* bvm%: "30-Oct-84 16:53") (PROG ((TITLE (\LAFITE.MODE.TITLE)) (MENU LAFITEMAINMENU)) (COND (TITLE (replace (MENU TITLE) of MENU with TITLE) (UPDATE/MENU/IMAGE MENU) (REDISPLAYW (WFROMMENU MENU))))))
)
(\LAFITE.MODE.TITLE
(LAMBDA NIL (* ; "Edited 5-May-88 12:24 by bvm") (* ;;; "If user wants mode shown in Lafite status window, this returns a suitable title for that window") (AND \LAFITEMODE (LAFITE.SHOW.MODE.P) (CONCAT "L a f i t e (" (fetch LAFITEMODE of \LAFITEMODE) ")")))
)
(LAFITE.SHOW.MODE.P
(LAMBDA NIL (* ; "Edited 5-May-88 12:02 by bvm") (* ;; "True if the current mode should be displayed.") (SELECTQ LAFITESHOWMODEFLG (ALWAYS T) (NIL NIL) (> (for X in LAFITEMODELST count (LISTP (CDR (LISTP X)))) 1)))
)
(LAFITE.ALL.MODES.P
(LAMBDA (OP) (* ; "Edited 9-May-88 17:15 by bvm") (* ;; "True if we should use all modes for the operation designated by OP. Currently known ops are :POLL, :GETMAIL, :ANSWER.") (if (LISTP LAFITE.USE.ALL.MODES) then (FMEMB OP LAFITE.USE.ALL.MODES) else (OR (EQ LAFITE.USE.ALL.MODES T) (EQ LAFITE.USE.ALL.MODES OP))))
)
(SET.LAFITE.MODE.INTERACTIVELY
(LAMBDA NIL (* ; "Edited 13-Jun-88 10:36 by bvm") (* ;; "Called from background menu to set Lafite's mode.") (LET ((*PRINT-CASE* :UPCASE) CHOICE) (CL:FORMAT PROMPTWINDOW "~2%%Lafite's current mode is ~A.
Use menu to specify the new mode.~@[
Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITEMODE then (fetch (LAFITEOPS LAFITEMODE) of \LAFITEMODE) else "not set") (EQ LAFITE.USE.ALL.MODES T)) (AND (SETQ CHOICE (MENU (\LAFITE.CREATE.MENU (\LAFITE.COMPUTE.MODE.COMMANDS) "Mode choices"))) (LAFITEMODE (CAR CHOICE)))))
)
(\LAFITE.COMPUTE.MODE.COMMANDS
(LAMBDA NIL (* ; "Edited 13-Jun-88 10:27 by bvm") (* ;; "Returns a list of menu items %"xx Mode%" for changing Lafite's mode. The result of calling MENU on this is a list whose car is the desired mode.") (for MODE in LAFITEMODELST when (LISTP (CDR MODE)) collect (BQUOTE ((\, (CONCAT (CAR MODE) " Mode")) (QUOTE ((\, (CAR MODE)))) "Change to this mode of mail sending/retrieving"))))
)
)
(PUTPROPS LAFITEMODELST VARTYPE ALIST)
(ADDTOVAR LAFITEMODELST)
(RPAQ? \LAFITEMODE)
(RPAQ? \LAFITE.AUTHENTICATION.FAILURE)
(RPAQ? LAFITE.BACKGROUND.ITEM (QUOTE ("Mail" (QUOTE (\LAFITE.MESSAGEFORM NIL NIL (QUOTE LEFT))) "Send an ordinary message. See subcommands for other operations." (SUBITEMS ("Turn Lafite on" (QUOTE (LAFITE.ON.FROM.BACKGROUND)) "Turn on Lafite, bringing up status window and browsing default folder.") ("Send Mail" (QUOTE (\LAFITE.MESSAGEFORM)) "Send a message. Prompts for type of message.") ("Set Lafite Mode" (QUOTE (SET.LAFITE.MODE.INTERACTIVELY)) "Set or change Lafite's mail protocol mode.")))))
(DEFINEQ
(\LAFITE.LOGIN
(LAMBDA NIL (* ; "Edited 8-Jun-88 12:50 by bvm") (if (AND (\LAFITE.OFF) (LAFITE.PROMPT.FOR.LOGIN NIL (FUNCTION (LAMBDA NIL (SETQ LAFITEDEFAULTHOST&DIR (TTYINPROMPTFORWORD "Host&dir for mail files: " (OR LAFITEDEFAULTHOST&DIR LOGINHOST/DIR) "Specify, in form {host}<dir> the location of the mail files for the user you just logged in.")))))) then (LAFITE :ON)))
)
(\LAFITE.LOGIN.NORESTART
(LAMBDA NIL (* ; "Edited 7-Jun-88 19:33 by bvm") (LAFITE.PROMPT.FOR.LOGIN)))
(LAFITE.PROMPT.FOR.LOGIN
(LAMBDA (HOST AFTERLOGINFN) (* ; "Edited 8-Jun-88 12:42 by bvm") (* ;; "Prompt for login to HOST in a little window near the status window. If login is successful, then apply AFTERLOGINFN to HOST while the ttydisplaystream is still in the interaction window.") (RESETLST (LET* ((TOPLEFT (OR LAFITESTATUSWINDOWPOSITION (CURSORPOSITION))) (HEIGHT (HEIGHTIFWINDOW (TIMES 5 (FONTPROP DEFAULTFONT (QUOTE HEIGHT))) NIL 8)) (W (CREATEW (MAKEWITHINREGION (create REGION LEFT ← (fetch XCOORD of TOPLEFT) BOTTOM ← (- (fetch YCOORD of TOPLEFT) HEIGHT) WIDTH ← 400 HEIGHT ← HEIGHT)) NIL 8))) (RESETSAVE NIL (LIST (QUOTE CLOSEW) W)) (RESETSAVE (TTYDISPLAYSTREAM W)) (WINDOWADDPROP W (QUOTE CLOSEFN) (FUNCTION (LAMBDA (WINDOW) (\CARET.DOWN) (LET ((P (WINDOWPROP WINDOW (QUOTE PROCESS)))) (if (AND P (NEQ P (THIS.PROCESS))) then (* ; "user explicit close--kill the process") (DEL.PROCESS P))))))) (RESETSAVE (TTY.PROCESS T)) (AND (LOGIN HOST) (OR (NULL AFTERLOGINFN) (CL:FUNCALL AFTERLOGINFN HOST)))))
)
(\LAFITE.REAUTHENTICATE
(LAMBDA (ITEM MENU) (DECLARE (IGNORE ITEM MENU)) (* ; "Edited 18-Jul-88 12:25 by bvm") (* ;; "Reauthenticate using the current login, rather than prompting for anything new.") (\LAFITE.AFTERLOGIN NIL))
)
)
(RPAQQ LAFITEPROFILEVARS ((LAFITEDEFAULTHOST&DIR NIL) (LAFITE.SIGNATURE NIL) (LAFITEBUFFERSIZE 20) (LAFITEIFFROMMETHENSEENFLG T) (LAFITEMENUFONT (FONTCREATE (QUOTE (HELVETICA 10 BOLD)))) (LAFITETITLEFONT (FONTCREATE (QUOTE (HELVETICA 12 BOLD)))) (LAFITEDISPLAYFONT (FONTCREATE (QUOTE (TIMESROMAN 10)))) (LAFITEFIXEDWIDTHFONT (COND ((EQ (CHARWIDTH (CHARCODE "i") DEFAULTFONT) (CHARWIDTH (CHARCODE "W") DEFAULTFONT)) (* ; "Yes, user has not changed default to a variable width font") DEFAULTFONT) (T (FONTCREATE (QUOTE (GACHA 10)))))) (LAFITEHARDCOPYFONT LAFITEDISPLAYFONT) (LAFITEBROWSERFONT (FONTCREATE (QUOTE (GACHA 10)))) (LAFITEMSGICONFONT (FONTCREATE (QUOTE (HELVETICA 8)))) (LAFITE.FOLDER.MENU.FONT NIL) (LAFITEINFO.NAME "Lafite.info") (DEFAULTMAILFOLDERNAME "Active.mail") (LAFITEMAIL.EXT "mail") (LAFITESTATUSWINDOWMINWIDTH 200) (LAFITESTATUSWINDOWPOSITION (QUOTE (735 . 650))) (LAFITE.DONT.DISPLAY.HEADERS NIL) (LAFITE.DONT.FORWARD.HEADERS NIL) (LAFITE.DONT.HARDCOPY.HEADERS NIL) (LAFITEDEBUGFLG NIL) (LAFITEMODEDEFAULT NIL) (LAFITESHOWMODEFLG T) (LAFITE.USE.ALL.MODES T)))
(RPAQ? LAFITEDEFAULTHOST&DIR NIL)
(RPAQ? LAFITE.SIGNATURE NIL)
(RPAQ? LAFITEBUFFERSIZE 20)
(RPAQ? LAFITEIFFROMMETHENSEENFLG T)
(RPAQ? LAFITEMENUFONT (FONTCREATE (QUOTE (HELVETICA 10 BOLD))))
(RPAQ? LAFITETITLEFONT (FONTCREATE (QUOTE (HELVETICA 12 BOLD))))
(RPAQ? LAFITEDISPLAYFONT (FONTCREATE (QUOTE (TIMESROMAN 10))))
(RPAQ? LAFITEFIXEDWIDTHFONT (COND ((EQ (CHARWIDTH (CHARCODE "i") DEFAULTFONT) (CHARWIDTH (CHARCODE "W") DEFAULTFONT)) (* ; "Yes, user has not changed default to a variable width font") DEFAULTFONT) (T (FONTCREATE (QUOTE (GACHA 10))))))
(RPAQ? LAFITEHARDCOPYFONT LAFITEDISPLAYFONT)
(RPAQ? LAFITEBROWSERFONT (FONTCREATE (QUOTE (GACHA 10))))
(RPAQ? LAFITEMSGICONFONT (FONTCREATE (QUOTE (HELVETICA 8))))
(RPAQ? LAFITE.FOLDER.MENU.FONT NIL)
(RPAQ? LAFITEINFO.NAME "Lafite.info")
(RPAQ? DEFAULTMAILFOLDERNAME "Active.mail")
(RPAQ? LAFITEMAIL.EXT "mail")
(RPAQ? LAFITESTATUSWINDOWMINWIDTH 200)
(RPAQ? LAFITESTATUSWINDOWPOSITION (QUOTE (735 . 650)))
(RPAQ? LAFITE.DONT.DISPLAY.HEADERS NIL)
(RPAQ? LAFITE.DONT.FORWARD.HEADERS NIL)
(RPAQ? LAFITE.DONT.HARDCOPY.HEADERS NIL)
(RPAQ? LAFITEDEBUGFLG NIL)
(RPAQ? LAFITEMODEDEFAULT NIL)
(RPAQ? LAFITESHOWMODEFLG T)
(RPAQ? LAFITE.USE.ALL.MODES T)
(RPAQQ LAFITERANDOMGLOBALS ((UNSUPPLIEDFIELDSTR "---") (LAFITEBUSYWAITTIME 1000) (LAFITEITEMBUSYSHADE 43605) (LAFITEEOL "
")))
(RPAQ? UNSUPPLIEDFIELDSTR "---")
(RPAQ? LAFITEBUSYWAITTIME 1000)
(RPAQ? LAFITEITEMBUSYSHADE 43605)
(RPAQ? LAFITEEOL "
")
(RPAQQ LAFITEMARKS ((SEENMARK (CHARCODE SP)) (UNSEENMARK (CHARCODE ?)) (MOVETOMARK (CHARCODE m)) (FORWARDMARK (CHARCODE f)) (ANSWERMARK (CHARCODE a)) (HARDCOPYBATCHMARK (CHARCODE H)) (HARDCOPYMARK (CHARCODE h)) (HEARDMARK (CHARCODE @))))
(RPAQ SEENMARK (CHARCODE SP))
(RPAQ UNSEENMARK (CHARCODE ?))
(RPAQ MOVETOMARK (CHARCODE m))
(RPAQ FORWARDMARK (CHARCODE f))
(RPAQ ANSWERMARK (CHARCODE a))
(RPAQ HARDCOPYBATCHMARK (CHARCODE H))
(RPAQ HARDCOPYMARK (CHARCODE h))
(RPAQ HEARDMARK (CHARCODE @))
(RPAQQ LAFITECOMMANDMENUITEMS (("Browse" (QUOTE \LAFITE.BROWSE) "Browse a mail file; MIDDLE for subcommands") ("Send Mail" (QUOTE \LAFITE.MESSAGEFORM) "Open a message composition window; MIDDLE for choice of forms") ("Quit" (QUOTE \LAFITE.QUIT) "Update and close all mail files and stop Lafite")))
(RPAQQ LAFITEUPDATEMENUITEMS (("Do Hardcopy Only" (QUOTE \LAFITE.HARDCOPYONLY.PROC) "Will print batched hardcopy but not update file") ("Write out changes only" (QUOTE \LAFITE.UPDATE.PROC) "Will update physical file to reflect new marks and deletions") ("Update table of contents only" (FUNCTION \LAFITE.UPDATE.PROC) "Write table of contents file to speed next browse of this folder") ("Expunge deleted messages" (QUOTE \LAFITE.EXPUNGE.PROC) "Will rewrite mail file, expunging all deleted messages")))
(RPAQQ LAFITESUBQUITMENUITEMS (("Quit" (QUOTE \LAFITE.QUIT) "Turn Lafite off") ("Restart" (QUOTE \LAFITE.RESTART) "Turn Lafite off then back on") ("Login" (QUOTE \LAFITE.LOGIN) "Change the global username/password and restart Lafite with the new user." (SUBITEMS ("Just re-authenticate" (QUOTE \LAFITE.REAUTHENTICATE) "Re-authenticate currently logged-in user.") ("Login without restarting" (QUOTE \LAFITE.LOGIN.NORESTART) "Change the global login but don't restart Lafite (keep the same folders open, etc)"))) ("Recache" (QUOTE LAFITE.COMPUTE.CACHED.VARS) "Make Lafite recompute cached information based on current variable settings")))
(RPAQQ ANOTHERFOLDERMENUITEM ("** Other Folder **" (QUOTE %##ANOTHERFILE##) "You will be asked to specify another mail filename"))
(RPAQ? LAFITESTATUSWINDOW)
(RPAQ? \ACTIVELAFITEFOLDERS)
(RPAQ? \LAFITEPROFILECHANGED)
(RPAQ? \LAFITE.TEMPFILES)
(RPAQ? LAFITEMAILFOLDERS)
(RPAQ? LAFITEFOLDERSMENU)
(RPAQ? LAFITEMULTIPLEFOLDERSMENU)
(RPAQ? \LAFITE.MODE.CHOICES)
(RPAQ? LAFITESUBQUITMENU)
(ADDTOVAR LAFITEMENUVARS LAFITESUBQUITMENU LAFITEFOLDERSMENU LAFITEMULTIPLEFOLDERSMENU)
(* ; "misc utilities")
(DEFINEQ
(LA.RESETSHADE
(LAMBDA (ITEM MENU OLDSHADE) (* ; "Edited 23-Aug-88 12:40 by bvm") (* ;;; "Shades ITEM in MENU to indicate Lafite is busy, leaves something on resetlst to unshade it") (if ITEM then (* ; "Don't do when some program calls without an item") (RESETSAVE (SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE) (LIST (FUNCTION SHADEITEM) ITEM MENU (OR OLDSHADE WHITESHADE)))))
)
(LA.MENU.ITEM
(LAMBDA (FN MENU) (* ; "Edited 7-Jun-88 19:15 by bvm") (* ;; "Returns the menu item executed by FN in MENU. This beats searching by the label because someone might want to change the label. Menu items are assumed to be of the form (label 'fn --). MENU can also be just a list of items.") (find ITEM in (OR (LISTP MENU) (fetch (MENU ITEMS) of MENU)) suchthat (EQ FN (CADR (LISTP (CADR ITEM))))))
)
(NTHMESSAGE
(LAMBDA (MESSAGES N) (* bvm%: " 3-Jan-84 12:11") (ELT MESSAGES N)))
(\LAFITE.MAKE.MSGARRAY
(LAMBDA (SIZE OLDARRAY OLDSIZE) (* bvm%: " 3-Jan-84 11:07") (* ;;; "Creates an array at least large enough to hold SIZE message descriptors. If OLDARRAY is given, its elements up to OLDSIZE are copied into the new array") (PROG ((NEWARRAY (ARRAY (IMAX (+ SIZE 32) (CEIL SIZE 64)) (QUOTE POINTER)))) (COND (OLDARRAY (for I from 1 to OLDSIZE do (SETA NEWARRAY I (ELT OLDARRAY I))))) (RETURN NEWARRAY)))
)
(\LAFITE.ADDMESSAGES.TO.ARRAY
(LAMBDA (MSGARRAY MESSAGELIST FIRSTMSG# LASTMSG#) (* bvm%: " 3-Jan-84 11:26") (* ;;; "Adds to MSGARRAY the messages from MESSAGELIST, which should be numbered FIRSTMSG# thru LASTMSG# --- returns a new array if MSGARRAY wasn't large enough") (COND ((OR (NULL MSGARRAY) (> LASTMSG# (ARRAYSIZE MSGARRAY))) (SETQ MSGARRAY (\LAFITE.MAKE.MSGARRAY LASTMSG# MSGARRAY (SUB1 FIRSTMSG#))))) (COND ((NEQ (fetch (LAFITEMSG %#) of (CAR MESSAGELIST)) FIRSTMSG#) (SHOULDNT))) (for MSG in MESSAGELIST as MSG# from FIRSTMSG# do (SETA MSGARRAY MSG# MSG)) MSGARRAY)
)
(\MAILFOLDER.DEFPRINT
(LAMBDA (FOLDER STREAM) (* ; "Edited 11-Dec-87 17:22 by bvm:") (\DEFPRINT.BY.NAME FOLDER STREAM (OR (fetch (MAILFOLDER SHORTFOLDERNAME) of FOLDER) (fetch (MAILFOLDER VERSIONLESSFOLDERNAME) of FOLDER)) "Mail Folder on"))
)
)
(* ; "Display aids")
(RPAQ LA.CROSSCURSOR (CURSORCREATE (QUOTE #*(16 16)L@@CN@@GG@@NCHALALCH@NG@@GN@@CL@@CL@@GN@@NG@ALCHCHALG@@NN@@GL@@C
) (QUOTE NIL) 8 8))
(RPAQ? \LAFITE.ACTIVE)
(RPAQ? \LAFITE.READY)
(RPAQ? \LAFITEDEFAULTHOST&DIR)
(RPAQ? \LAFITE.ACTIVE.MODES)
(RPAQ? \LAFITE.CURRENT.USER)
(RPAQ? LAFITE.USER.INFO)
(RPAQ? *LAFITE-WELL-KNOWN-MODES*)
(RPAQ? *LAFITE-LOGGING-IN*)
(ADDTOVAR \SYSTEMCACHEVARS \LAFITE.READY \LAFITE.ACTIVE.MODES)
(ADDTOVAR LAFITE.PERSONAL.VARS LAFITEDEFAULTHOST&DIR LAFITE.SIGNATURE)
(DEFINEQ
(LAFITE.AROUNDEXIT
(LAMBDA (EVENT) (* ; "Edited 9-May-88 15:57 by bvm") (SELECTQ EVENT ((BEFORELOGOUT) (RESETLST (for FOLDER in \ACTIVELAFITEFOLDERS when (OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of FOLDER) T T) do (\LAFITE.CLOSE.FOLDER FOLDER T))) (SETQ \LAFITE.ACTIVE.MODES NIL)) ((AFTERLOGOUT AFTERSAVEVM AFTERSYSOUT AFTERMAKESYS) (COND ((EQ \LAFITE.ACTIVE T) (\LAFITE.REINITIALIZING) (\LAFITE.AFTERLOGIN) (* ; "Check for changed user") (RESTART.PROCESS (QUOTE LAFITEMAILWATCH)) (\LAFITE.MARK.FOLDERS.OBSOLETE)))) NIL))
)
(\LAFITE.MARK.FOLDERS.OBSOLETE
(LAMBDA NIL (* ; "Edited 7-Jun-88 16:14 by bvm") (* ;;; "On returning from LOGOUT check to see that all the mailfiles are in a consistence state -- the user might have run Laurel and screwed up Lafite's data, or run Lafite from another machine") (COND ((AND \ACTIVELAFITEFOLDERS (NOT \LAFITE.READY)) (WITH.MONITOR \LAFITE.BROWSELOCK (COND ((NOT \LAFITE.READY) (SETQ \ACTIVELAFITEFOLDERS (for FOLDER in \ACTIVELAFITEFOLDERS when (COND ((NULL (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER)) (\LAFITE.CLOSE.FOLDER FOLDER T) (* ; "Not really active, forget it") NIL) (T (* ; "Mark all folders as needing checking") (if (EQ (fetch (MAILFOLDER BROWSERSTATUS) of FOLDER) LAS.READY) then (replace (MAILFOLDER BROWSERSTATUS) of FOLDER with LAS.LOGGED.OUT)) T)) collect FOLDER)) (\LAFITE.PROCESS (LIST (FUNCTION \LAFITE.CHECK.FOLDERS)) (QUOTE LAFITE.CHECK) T T)))) (SETQ \LAFITE.READY T))))
)
(\LAFITE.CHECK.FOLDERS
(LAMBDA NIL (* ; "Edited 15-Dec-87 17:48 by bvm:") (* ;; "Background task that goes around checking that everyone's ok.") (\LAFITE.READ.PROFILE T) (* ; "Get any changes to profile that happened while logged out.") (for FOLDER in \ACTIVELAFITEFOLDERS when (EQ (fetch (MAILFOLDER BROWSERSTATUS) of FOLDER) LAS.LOGGED.OUT) do (ERSETQ (\LAFITE.ASSURE.FOLDER.READY FOLDER))))
)
(\LAFITE.ASSURE.FOLDER.READY
(LAMBDA (FOLDER) (* ; "Edited 15-Oct-87 14:57 by bvm:") (WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of FOLDER) (if (EQ (fetch (MAILFOLDER BROWSERSTATUS) of FOLDER) LAS.LOGGED.OUT) then (* ; "Open and close the file. The opening code will take care of interesting conditions.") (PROG1 (\LAFITE.OPEN.FOLDER FOLDER (QUOTE INPUT) NIL) (\LAFITE.CLOSE.FOLDER FOLDER T)) else T)))
)
(\LAFITE.AFTERLOGIN
(LAMBDA (HOST USER) (* ; "Edited 22-Aug-88 16:38 by bvm") (* ;; "Called when LOGIN gets new info. If HOST = NIL, this is the global login, which means we should get new data") (COND ((AND (NULL HOST) (NOT *LAFITE-LOGGING-IN*)) (LAFITECLEARCACHE) (LET ((*LAFITE-LOGGING-IN* T) (OLDUSER (CAR \LAFITE.CURRENT.USER)) NEWUSER OLDDATA NEWDATA) (* ; "Compute new current user") (if (NOT (STRING-EQUAL OLDUSER (SETQ NEWUSER (LAFITE.USER.NAME.FROM.LOGIN NIL T)))) then (* ; "Logged in user changed. Clear all those %"personal%" variables that would be affected") (SETQ OLDDATA (CDR (CL:ASSOC OLDUSER LAFITE.USER.INFO :TEST (QUOTE STRING-EQUAL)))) (for VAR in LAFITE.PERSONAL.VARS bind VALUE when (SETQ VALUE (EVALV VAR)) do (if OLDDATA then (LISTPUT OLDDATA VAR VALUE) else (push NEWDATA VAR VALUE)) (SET VAR NIL)) (if NEWDATA then (push LAFITE.USER.INFO (CONS OLDUSER NEWDATA))) (* ;; "Now restore any saved data for new user") (if (SETQ NEWDATA (CL:ASSOC NEWUSER LAFITE.USER.INFO :TEST (QUOTE STRING-EQUAL))) then (for TAIL on (CDR NEWDATA) by (CDDR TAIL) do (SET (CAR TAIL) (CADR TAIL)))))) (AND \LAFITE.ACTIVE (\LAFITE.WAKE.WATCHER)))))
)
)
(* ; "The profile")
(DEFINEQ
(\LAFITE.READ.PROFILE
(LAMBDA (ONLYIFCHANGED) (* ; "Edited 12-Sep-88 16:04 by bvm") (WITH.MONITOR \LAFITE.PROFILELOCK (PROG ((*UPPER-CASE-FILE-NAMES* NIL) (*LA.ABBREVS.IN.PROFILE* NIL) FILENAME NEWDATE) (SETQ \LAFITEPROFILECHANGED) (if (SETQ FILENAME (INFILEP (LA.LONGFILENAME LAFITEINFO.NAME))) then (COND ((OR (NOT ONLYIFCHANGED) (NULL \LAFITEPROFILEDATE) (NULL (SETQ NEWDATE (GETFILEINFO FILENAME (QUOTE ICREATIONDATE)))) (> NEWDATE \LAFITEPROFILEDATE)) (* ; "read in the profile file") (LET ((STREAM (\LAFITE.OPENSTREAM FILENAME (QUOTE INPUT)))) (CL:UNWIND-PROTECT (PROGN (SETQ \LAFITEPROFILEDATE (GETFILEINFO STREAM (QUOTE ICREATIONDATE))) (\LAFITE.PROCESS.PROFILE STREAM)) (CLOSEF STREAM))))) elseif (AND (NOT ONLYIFCHANGED) (SETQ FILENAME (INFILEP (LA.LONGFILENAME "Lafite.profile")))) then (* ; "Read old-style profile") (\LAFITE.READ.OLD.PROFILE FILENAME)) (if (NULL LAFITEMAILFOLDERS) then (SETQ LAFITEMAILFOLDERS (LIST (fetch PACKEDHOST&DIR of \LAFITEDEFAULTHOST&DIR))) (SETQ LAFITEFORMFILES NIL) elseif (NOT (AND (STRING-EQUAL (CAR LAFITEMAILFOLDERS) (fetch PACKEDHOST&DIR of \LAFITEDEFAULTHOST&DIR)) (EQUAL *LA.ABBREVS.IN.PROFILE* (CDR \LAFITE.PSEUDO.DEVICES)))) then (* ; "Profile moved? ") (\LAFITE.RECOMPUTE.FOLDER.NAMES *LA.ABBREVS.IN.PROFILE*)) (SETQ LAFITEMULTIPLEFOLDERSMENU (SETQ LAFITEFOLDERSMENU (SETQ LAFITEFORMSMENU NIL))))))
)
(\LAFITE.PROCESS.PROFILE
(LAMBDA (STREAM MERGE) (* ; "Edited 9-Sep-87 15:09 by bvm:") (* ;; "Process the profile living on STREAM. We are positioned at the start and will read to the end. If MERGE is true, then we are attempting to merge an old profile with the current state; otherwise, we are reading it from scratch.") (LET ((*READTABLE* LAFITEPROFILERDTBL) FORM VARDESC FN) (* ;; "Format is a series of lists (var value).") (while (SETQ FORM (CL:READ STREAM NIL)) do (SETQ VARDESC (ASSOC (CAR FORM) LAFITE.PROFILE.VARS)) (if (NULL VARDESC) then (* ; "Make sure everything we read is on LAFITE.PROFILE.VARS so that it will get dumped back out, too, even if it's a user variable we know nothing about.") (CL:PUSH (SETQ VARDESC (LIST (CAR FORM))) LAFITE.PROFILE.VARS)) (SET (CAR FORM) (if (AND MERGE (SETQ FN (fetch PFRECONCILIATIONFN of VARDESC))) then (* ; "Var says how to reconcile old value with current. Args are (oldvalue currentvalue varname)") (CL:FUNCALL FN (CADR FORM) (EVALV (CAR FORM)) (CAR FORM)) else (CADR FORM))) (if (SETQ FN (fetch PFLOADFN of VARDESC)) then (* ; "Take arbitrary user action upon loading of this var") (CL:FUNCALL FN (CADR FORM) (CAR FORM))))))
)
(\LAFITE.WRITE.PROFILE
(LAMBDA NIL (* ; "Edited 12-Sep-88 16:04 by bvm") (* ;;; "If 'Profile' has changed, write out a new one. Profile is set of mail files and form files known to this Lafite, and anything else that has been entered on LAFITE.PROFILE.VARS") (WITH.MONITOR \LAFITE.PROFILELOCK (NLSETQ (COND (\LAFITEPROFILECHANGED (LET ((*UPPER-CASE-FILE-NAMES* NIL) (*LA.ABBREVS.IN.PROFILE* (CDR \LAFITE.PSEUDO.DEVICES)) (NAME (LA.LONGFILENAME LAFITEINFO.NAME)) OLDNAME OLDDATE PFSTREAM OVERWRITING) (* ;; "Before dumping a new profile, check that a newer one hasn't been written behind our back. This handles two cases -- same user using Lafite from two machines, and file server having been down when we first tried to read profile") (COND ((AND (SETQ OLDNAME (INFILEP NAME)) (SETQ OLDDATE (GETFILEINFO OLDNAME (QUOTE ICREATIONDATE))) (OR (NULL \LAFITEPROFILEDATE) (NOT (= \LAFITEPROFILEDATE OLDDATE)))) (printout PROMPTWINDOW T OLDNAME " has changed since you started this Lafite, rereading it.") (SETQ OVERWRITING (SETQ PFSTREAM (OPENSTREAM OLDNAME (QUOTE BOTH) (QUOTE OLD)))) (\LAFITE.PROCESS.PROFILE PFSTREAM T) (SETFILEPTR PFSTREAM 0)) (T (SETQ PFSTREAM (OPENSTREAM (OR OLDNAME NAME) (QUOTE OUTPUT) (QUOTE OLD/NEW))))) (LINELENGTH MAX.SMALLP PFSTREAM) (for V in LAFITE.PROFILE.VARS do (PRIN2 (LIST (fetch PFVARNAME of V) (CL:FUNCALL (OR (fetch PFDUMPFN of V) (FUNCTION CL:IDENTITY)) (EVALV (fetch PFVARNAME of V)) (fetch PFVARNAME of V))) PFSTREAM LAFITEPROFILERDTBL)) (COND (OVERWRITING (* ; "Truncate old file to current length") (SETFILEINFO PFSTREAM (QUOTE LENGTH) (GETFILEPTR PFSTREAM)))) (FORCEOUTPUT PFSTREAM) (* ; "Do this first to ensure that any change of creation date has happened.") (SETQ \LAFITEPROFILEDATE (GETFILEINFO PFSTREAM (QUOTE ICREATIONDATE))) (CLOSEF PFSTREAM) (SETQ \LAFITEPROFILECHANGED)))))))
)
(\LAFITE.MERGE.NAMELISTS
(LAMBDA (OLDNAMES NEWNAMES) (* ; "Edited 12-Sep-88 16:04 by bvm") (* ;;; "Remove duplicates from the two lists NAMES1 and NAMES2 and merge them") (LET ((DIFFNAMES (CL:SET-DIFFERENCE OLDNAMES NEWNAMES :TEST (FUNCTION STRING-EQUAL)))) (COND ((AND DIFFNAMES (OR (EQUAL *LA.ABBREVS.IN.PROFILE* (CDR \LAFITE.PSEUDO.DEVICES)) (SETQ DIFFNAMES (CL:SET-DIFFERENCE OLDNAMES (for NAME in NEWNAMES collect (* ; "Grumble--abbrevs changed, so have to recompute old list as if with new abbrevs") (LA.SHORTFILENAME (LA.LONGFILENAME NAME NIL NIL *LA.ABBREVS.IN.PROFILE* T))) :TEST (FUNCTION STRING-EQUAL))))) (* ; "Yes, there are some new names") (SORT (APPEND DIFFNAMES NEWNAMES) (FUNCTION UALPHORDER))) (T NEWNAMES))))
)
(\LAFITE.READ.OLD.PROFILE
(LAMBDA (FILE) (* ; "Edited 21-Sep-87 15:16 by bvm:") (* ;; "Read old-style profile, which consisted of the list of folders, then the list of forms.") (LET ((STREAM (\LAFITE.OPENSTREAM FILE (QUOTE INPUT) (QUOTE OLD)))) (CL:UNWIND-PROTECT (PROGN (SETQ LAFITEMAILFOLDERS (MAPCAR (READ STREAM LAFITEPROFILERDTBL) (FUNCTION MKSTRING))) (RPLACD LAFITEMAILFOLDERS (CL:SORT (CDR LAFITEMAILFOLDERS) (FUNCTION UALPHORDER))) (* ; "just in case it wasn't already sorted") (SETQ LAFITEFORMFILES (READ STREAM LAFITEPROFILERDTBL)) (SETQ \LAFITEPROFILECHANGED T)) (CLOSEF STREAM))))
)
(\LAFITE.MERGE.FOLDERS
(LAMBDA (OLDFOLDERS CURRENTFOLDERS) (* ; "Edited 9-Sep-87 16:16 by bvm:") (COND ((STRING-EQUAL (CAR OLDFOLDERS) (CAR CURRENTFOLDERS)) (* ; "same host&dir, ok to merge") (CONS (CAR CURRENTFOLDERS) (\LAFITE.MERGE.NAMELISTS (CDR OLDFOLDERS) (CDR CURRENTFOLDERS)))) (T CURRENTFOLDERS)))
)
(\LAFITE.REPACK.FOLDERS
(LAMBDA (NAMES OLDDIR OLDABBREVS) (* ; "Edited 12-Sep-88 15:57 by bvm") (* ;; "Action taken when you load a profile whose internal host&dir is different from the directory where it lives. Fix up any partially specified names, returning a new list of %"short%" names. We assume that completely unqualified folder names have been moved along with the profile, but that other names haven't.") (for FILE in NAMES bind FIELDS FIRSTFIELD (OLDFIELDS ← (AND OLDDIR (UNPACKFILENAME.STRING OLDDIR))) collect (SETQ FIELDS (UNPACKFILENAME.STRING FILE)) (if (EQ (SETQ FIRSTFIELD (CAR FIELDS)) (QUOTE NAME)) then (* ; "No host & dir at all, so nothing to change.") FILE else (LA.SHORTFILENAME (LA.LONGFILENAME FIELDS NIL OLDFIELDS OLDABBREVS T)))))
)
)
(RPAQ? \LAFITEPROFILEDATE)
(ADDTOVAR LAFITE.PROFILE.VARS (*LA.ABBREVS.IN.PROFILE*) (LAFITEMAILFOLDERS \LAFITE.MERGE.FOLDERS) (LAFITEFORMFILES \LAFITE.MERGE.NAMELISTS))
(* ; "Name mashing")
(DEFINEQ
(LA.LONGFILENAME
(LAMBDA (FILENAME EXT UNPACKEDHOST&DIR HOST.ABBREVS UNPACKEDFLG) (* ; "Edited 12-Sep-88 16:42 by bvm") (* ;;; "Composes a (nearly) full-specified filename, filling in defaults from \LAFITEDEFAULTHOST&DIR") (LET* ((FILEFIELDS (OR (LISTP FILENAME) (UNPACKFILENAME.STRING FILENAME))) (FIRSTFIELD (CAR FILEFIELDS)) SYNONYM SYNFIELDS) (if (AND (EQ FIRSTFIELD (QUOTE DEVICE)) (SETQ SYNONYM (for PAIR in (OR HOST.ABBREVS (CDR \LAFITE.PSEUDO.DEVICES)) bind (DEV ← (CADR FILEFIELDS)) thereis (CL:MEMBER DEV (CAR PAIR) :TEST (QUOTE STRING-EQUAL))))) then (* ; "User gave a synonym for host/dir") (SETQ SYNFIELDS (APPEND (CDR SYNONYM))) (SETQ FILEFIELDS (CDDR FILEFIELDS)) (if (AND (EQ (CAR FILEFIELDS) (QUOTE DIRECTORY)) (LISTGET SYNFIELDS (QUOTE DIRECTORY))) then (* ; "But user also specified a dir. We don't support this really, but let's not lose") (LISTPUT SYNFIELDS (QUOTE DIRECTORY) (CONCAT (LISTGET SYNFIELDS (QUOTE DIRECTORY)) ">" (CADR FILEFIELDS))) (SETQ FILEFIELDS (CDDR FILEFIELDS))) (SETQ FILEFIELDS (NCONC SYNFIELDS FILEFIELDS)) (SETQ FIRSTFIELD (CAR FILEFIELDS))) (for TAIL on (OR UNPACKEDHOST&DIR (fetch UNPACKEDHOST&DIR of \LAFITEDEFAULTHOST&DIR)) by (CDDR TAIL) until (EQ (CAR TAIL) FIRSTFIELD) do (* ; "Add to FILEFIELDS any default fields that do not occur in FILENAME, but only until FILENAME shows up with any such field (so if FILENAME has HOST, never default the directory).") (push FILEFIELDS (CAR TAIL) (CADR TAIL))) (if EXT then (SETQ FILEFIELDS (NCONC FILEFIELDS (LIST (QUOTE EXTENSION) EXT)))) (if UNPACKEDFLG then (* ; "Leave unpacked") FILEFIELDS else (PACKFILENAME.STRING FILEFIELDS))))
)
(LA.SHORTFILENAME
(LAMBDA (FILE EXT KEEPVERSIONFLG) (* ; "Edited 12-Sep-88 16:42 by bvm") (* ;;; "returns that shortest file name that is compatible with \LAFITEDEFAULTHOST&DIR and EXT and no version number -- the result is used in menu creation") (COND (FILE (LET ((FILEFIELDS (COND ((LISTP FILE) (* ; "Already unpacked") (APPEND FILE)) (T (UNPACKFILENAME.STRING FILE)))) REST) (* ;; "Scan FILEFIELDS to see if it has a prefix matching either the default host&dir or one of our funny synonyms.") (for SYNONYM in \LAFITE.PSEUDO.DEVICES when (for (FILETAIL ← FILEFIELDS) (SYNTAIL ← (CDR SYNONYM)) do (if (NULL SYNTAIL) then (* ; "Matched completely") (RETURN (SETQ FILEFIELDS (SETQ REST FILETAIL))) elseif (AND (EQ (CAR FILETAIL) (CAR SYNTAIL)) (STRING-EQUAL (CAR (SETQ FILETAIL (CDR FILETAIL))) (CAR (SETQ SYNTAIL (CDR SYNTAIL))))) then (* ; "Matched that field, keep going") (SETQ FILETAIL (CDR FILETAIL)) (SETQ SYNTAIL (CDR SYNTAIL)) else (RETURN NIL))) do (if (CAR SYNONYM) then (* ; "NIL is for default host & dir") (push FILEFIELDS (QUOTE DEVICE) (CAAR SYNONYM))) (RETURN) finally (* ; "Maybe it matches part of default host&dir") (for (DEFAULTTAIL ← (fetch UNPACKEDHOST&DIR of \LAFITEDEFAULTHOST&DIR)) while (AND DEFAULTTAIL (EQ (CAR FILEFIELDS) (CAR DEFAULTTAIL)) (STRING-EQUAL (CADR FILEFIELDS) (CAR (SETQ DEFAULTTAIL (CDR DEFAULTTAIL))))) do (* ; "Pop off the matching fields") (SETQ FILEFIELDS (CDDR FILEFIELDS)) (SETQ DEFAULTTAIL (CDR DEFAULTTAIL))) (SETQ REST FILEFIELDS)) (while REST do (* ; "Scan the rest of the name to worry about extension and version defaulting") (if (SELECTQ (pop REST) (EXTENSION (AND EXT (STRING-EQUAL (CAR REST) EXT))) (VERSION (NOT KEEPVERSIONFLG)) NIL) then (* ; "Remove a field from the result") (RPLACA REST NIL)) (SETQ REST (CDR REST))) (PACKFILENAME.STRING FILEFIELDS)))))
)
(TOCFILENAME
(LAMBDA (MAILFILE) (* ; "Edited 8-Sep-87 17:21 by bvm:") (COND (MAILFILE (PACKFILENAME.STRING (QUOTE EXTENSION) (CONCAT (UNPACKFILENAME.STRING MAILFILE (QUOTE EXTENSION)) LAFITETOC.EXT) (QUOTE BODY) MAILFILE))))
)
(FORGETMAILFILE
(LAMBDA (FILENAME) (* ; "Edited 7-Sep-88 18:14 by bvm") (* ;;; "removes FILENAME from the list of known mail files and invalidates the menu cache") (LET ((KNOWNFILE (OR (find F in (CDR LAFITEMAILFOLDERS) suchthat (STRING-EQUAL F FILENAME)) (find F in (CDR LAFITEMAILFOLDERS) bind (SHORTNAME ← (LA.SHORTFILENAME FILENAME LAFITEMAIL.EXT)) suchthat (STRING-EQUAL F SHORTNAME))))) (COND (KNOWNFILE (\LAFITE.FOLDER.NAME.CHANGED KNOWNFILE)))))
)
(\LAFITE.FOLDER.NAME.CHANGED
(LAMBDA (OLDNAME NEWNAME) (* ; "Edited 8-Sep-88 17:43 by bvm") (* ;; "Called when a folder named OLDNAME has been renamed to NEWNAME, or deleted in the case where NEWNAME is NIL, or introduced in the case where OLDNAME is NIL.") (if OLDNAME then (* ; "Fix auto-move menus containing this one") (for FOLDER in \ACTIVELAFITEFOLDERS bind ITEMS FOUND WINDOW when (AND (SETQ WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER)) (SETQ ITEMS (WINDOWPROP WINDOW (QUOTE LAFITE.AUTO.MOVE.NAMES))) (SETQ FOUND (CL:MEMBER OLDNAME ITEMS :TEST (QUOTE STRING-EQUAL)))) do (* ; "Remove from the auto-move menu") (WINDOWPROP WINDOW (QUOTE LAFITE.AUTO.MOVE.NAMES) (if NEWNAME then (DSUBST NEWNAME (CAR FOUND) ITEMS) else (DREMOVE (CAR FOUND) ITEMS))) (\LAFITE.UPDATE.MOVE.MENU FOLDER))) (RPLACD LAFITEMAILFOLDERS (LET ((FOLDERS (CDR LAFITEMAILFOLDERS))) (if OLDNAME then (SETQ FOLDERS (DREMOVE OLDNAME FOLDERS))) (if NEWNAME then (CL:MERGE (QUOTE LIST) (LIST NEWNAME) FOLDERS (FUNCTION UALPHORDER)) else FOLDERS))) (SETQ LAFITEFOLDERSMENU (SETQ LAFITEMULTIPLEFOLDERSMENU NIL)) (SETQ \LAFITEPROFILECHANGED T))
)
(\LAFITE.RECOMPUTE.FOLDER.NAMES
(LAMBDA (OLDABBREVS) (* ; "Edited 12-Sep-88 16:37 by bvm") (* ;; "Called when either the host&dir in LAFITEMAILFOLDERS disagrees with \lafitedefaulthost&dir or the abbreviation list changed.") (SETQ LAFITEFORMFILES (\LAFITE.REPACK.FOLDERS LAFITEFORMFILES (CAR LAFITEMAILFOLDERS) OLDABBREVS)) (SETQ LAFITEMAILFOLDERS (CONS (fetch PACKEDHOST&DIR of \LAFITEDEFAULTHOST&DIR) (CL:SORT (\LAFITE.REPACK.FOLDERS (CDR LAFITEMAILFOLDERS) (CAR LAFITEMAILFOLDERS) OLDABBREVS) (FUNCTION UALPHORDER)))) (for FOLDER in \ACTIVELAFITEFOLDERS bind WINDOW ITEMS NEWNAME do (* ; "Update short names") (if (NOT (STREQUAL (fetch (MAILFOLDER SHORTFOLDERNAME) of FOLDER) (SETQ NEWNAME (LA.SHORTFILENAME (fetch (MAILFOLDER FULLFOLDERNAME) of FOLDER) LAFITEMAIL.EXT)))) then (\LAFITE.NEW.SHORT.NAME FOLDER NEWNAME)) (if (AND (SETQ WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER)) (SETQ ITEMS (WINDOWPROP WINDOW (QUOTE LAFITE.AUTO.MOVE.NAMES))) (NOT (EQUAL ITEMS (SETQ ITEMS (for NAME in ITEMS collect (LA.SHORTFILENAME (LA.LONGFILENAME NAME NIL NIL OLDABBREVS T))))))) then (* ; "Recanonicalize the names") (WINDOWPROP WINDOW (QUOTE LAFITE.AUTO.MOVE.NAMES) ITEMS) (\LAFITE.UPDATE.MOVE.MENU FOLDER))))
)
(\LAFITE.NEW.SHORT.NAME
(LAMBDA (FOLDER NEWSHORTNAME) (* ; "Edited 12-Sep-88 16:35 by bvm") (* ;; "Called when FOLDER acquires a new short name, e.g. because abbreviations changed. Updates things in the folder that care about that.") (replace (MAILFOLDER SHORTFOLDERNAME) of FOLDER with NEWSHORTNAME) (LET ((W (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER)) IW) (if W then (* ; "Fix browser title") (SETQ IW (WINDOWPROP W (QUOTE ICONWINDOW))) (if IW then (* ; "Fix icon title") (ICONW.TITLE IW NEWSHORTNAME)) (if (AND (PROG1 (NOT (OPENWP W)) (WINDOWPROP W (QUOTE TITLE) (LAB.TITLE.STRING FOLDER))) (OPENWP W)) then (* ; "Reshrink it after we change the title") (SHRINKW W)))))
)
(\LAFITE.NOTICE.FILE
(LAMBDA (SHORTNAME) (* ; "Edited 7-Sep-88 18:14 by bvm") (* ;; "Adds SHORTNAME to Lafite's menu of folders") (\LAFITE.FOLDER.NAME.CHANGED NIL SHORTNAME))
)
(\LAFITE.UNCACHE.FOLDER
(LAMBDA (ITEM MENU) (* ; "Edited 29-Aug-88 17:23 by bvm") (* ;;; "Remove one or more names from the folder menu.") (PROMPTPRINT "Select the folders to be removed, then select OK.") (LET ((NAMES (LAFITE.SELECT.FOLDERS))) (CLRPROMPT) (if NAMES then (for NAME in NAMES do (FORGETMAILFILE NAME)) (PRINTOUT PROMPTWINDOW T (if (CDR NAMES) then (CONCAT (LENGTH NAMES) " folders") else (CAR NAMES)) " forgotten."))))
)
)
(RPAQ? LAFITE.HOST.ABBREVS NIL)
(RPAQ? \LAFITE.PSEUDO.DEVICES NIL)
(* ; "Prompting for folders")
(DEFINEQ
(\LAFITE.PROMPTFORFOLDER
(LAMBDA (WINDOW) (* ; "Edited 20-Jun-88 17:03 by bvm") (* ;; "Prompts for a folder name from the folders menu and returns it. WINDOW is used if %"Other%" was selected; if NIL, a pop-up window is used. If a filename was typed manually, second value returned is T.") (LET ((FILE (MENU (OR LAFITEFOLDERSMENU (MAKELAFITEMAILFOLDERSMENU))))) (SELECTQ FILE (NIL NIL) (%##ANOTHERFILE## (if (SETQ FILE (PROMPTFORFILENAME WINDOW \LAFITE.LAST.FOLDER.NAME)) then (SETQ \LAFITE.LAST.FOLDER.NAME FILE) (CL:VALUES FILE T))) FILE)))
)
(PROMPTFORFILENAME
(LAMBDA (WINDOW DEFAULT PROMPT) (* ; "Edited 20-Jun-88 18:51 by bvm") (OR PROMPT (SETQ PROMPT (if DEFAULT then "File name (null name aborts command): " else "File name (CR to abort): "))) (RESETLST (RESETSAVE (TTY.PROCESS (THIS.PROCESS))) (RESETSAVE NIL (LIST (COND (WINDOW (FUNCTION CLEARW)) (T (SETQ WINDOW (LET* ((FONT (DEFAULTFONT (QUOTE DISPLAY))) (WIDTH (WIDTHIFWINDOW (+ (STRINGWIDTH PROMPT FONT) (TIMES 50 (CHARWIDTH (CHARCODE A) FONT))))) (HEIGHT (HEIGHTIFWINDOW (FONTPROP FONT (QUOTE HEIGHT))))) (CREATEW (create REGION LEFT ← (MIN LASTMOUSEX (- SCREENWIDTH WIDTH)) BOTTOM ← (MIN LASTMOUSEY (- SCREENHEIGHT HEIGHT)) WIDTH ← WIDTH HEIGHT ← HEIGHT)))) (FUNCTION CLOSEW))) WINDOW)) (TTYINPROMPTFORWORD PROMPT DEFAULT NIL WINDOW NIL NIL (CHARCODE (CR)))))
)
(MAKELAFITEMAILFOLDERSMENU
(LAMBDA NIL (* ; "Edited 12-Sep-88 18:27 by bvm") (SETQ LAFITEFOLDERSMENU (\LAFITE.MAKE.FOLDER.MENU (APPEND (CDR LAFITEMAILFOLDERS) (LIST ANOTHERFOLDERMENUITEM)))))
)
(\LAFITE.ARRANGE.MENU
(LAMBDA (ITEMS FONT MAXHEIGHT) (* ; "Edited 12-Sep-88 18:20 by bvm") (* ;; "Returns 2 values: the number of columns it takes to make a menu no taller than MAXHEIGHT containing ITEMS printed in FONT, and a rearrangement of ITEMS to make the menu appear vertical. We do this manually to get around bugs in the MENU code.") (LET* ((ITEMHEIGHT (FONTPROP (OR FONT MENUFONT) (QUOTE HEIGHT))) (NITEMS (LENGTH ITEMS)) (TOTALHEIGHT (TIMES NITEMS ITEMHEIGHT))) (if (< TOTALHEIGHT MAXHEIGHT) then (CL:VALUES 1 ITEMS) else (LET ((NCOLUMNS (CL:CEILING TOTALHEIGHT MAXHEIGHT))) (CL:VALUES NCOLUMNS (\MAKE.ITEMS.VERT.ORDER ITEMS (CL:CEILING NITEMS NCOLUMNS) NCOLUMNS))))))
)
(\LAFITE.MAKE.FOLDER.MENU
(LAMBDA (ITEMS) (* ; "Edited 24-Oct-88 18:16 by bvm") (* ;; "Make a folders menu out of ITEMS.") (CL:MULTIPLE-VALUE-BIND (NCOLUMNS ITEMS) (\LAFITE.ARRANGE.MENU ITEMS LAFITE.FOLDER.MENU.FONT (- SCREENHEIGHT (FONTPROP WINDOWTITLEFONT (QUOTE HEIGHT)))) (create MENU ITEMS ← ITEMS MENUCOLUMNS ← NCOLUMNS TITLE ← (CONCAT "Folders on " (L-CASE (fetch PACKEDHOST&DIR \LAFITEDEFAULTHOST&DIR))) CENTERFLG ← T MENUFONT ← (OR LAFITE.FOLDER.MENU.FONT MENUFONT))))
)
(LAFITE.SELECT.FOLDERS
(LAMBDA (PRESELECTED) (* ; "Edited 12-Sep-88 18:27 by bvm") (LET ((MENUW LAFITEMULTIPLEFOLDERSMENU) MENU OLDSHADED) (if (NULL MENUW) then (SETQ MENU (\LAFITE.MAKE.FOLDER.MENU (APPEND (CDR LAFITEMAILFOLDERS) (QUOTE (("--OK--" :DONE "Click here when selection is satisfactory") ("--Abort--" :ABORT "Click here to abort selection.")))))) (replace (MENU MENUTITLEFONT) of MENU with WINDOWTITLEFONT) (replace (MENU WHENSELECTEDFN) of MENU with (FUNCTION \LAFITE.HANDLE.MULTIPLE.SELECTION)) (SETQ LAFITEMULTIPLEFOLDERSMENU (SETQ MENUW (MENUWINDOW MENU))) else (SETQ OLDSHADED (COLLECT.SHADED.ITEMS (SETQ MENU (CAR (WINDOWPROP MENUW (QUOTE MENU)))))) (if (LISTGET (fetch (MENU MENUUSERDATA) of MENU) (QUOTE RESULT)) then (* ; "Erase any old result") (LISTPUT (fetch (MENU MENUUSERDATA) of MENU) (QUOTE RESULT) NIL))) (if PRESELECTED then (SETQ PRESELECTED (for ITEM in (fetch (MENU ITEMS) of MENU) collect ITEM when (AND (NLISTP ITEM) (CL:MEMBER ITEM PRESELECTED :TEST (QUOTE STRING-EQUAL))))) (for ITEM in PRESELECTED do (SHADEITEM ITEM MENU LAFITEHARDCOPYBATCHSHADE)) (if OLDSHADED then (SETQ OLDSHADED (CL:SET-DIFFERENCE OLDSHADED PRESELECTED :TEST (QUOTE EQ))))) (for ITEM in OLDSHADED do (SHADEITEM ITEM MENU 0)) (CL:UNWIND-PROTECT (LET (RESULT) (ALLOW.BUTTON.EVENTS) (TTY.PROCESS (THIS.PROCESS)) (* ; "To avoid caret fights") (MOVEW MENUW (MIN LASTMOUSEX (- SCREENWIDTH (fetch (MENU IMAGEWIDTH) of MENU))) (MIN LASTMOUSEY (- SCREENHEIGHT (fetch (MENU IMAGEHEIGHT) of MENU)))) (* ; "Move window to cursor position") (OPENW MENUW) (if (OR OLDSHADED PRESELECTED) then (* ; "Have to get the shading to take effect") (REDISPLAYW MENUW)) (until (SETQ RESULT (LISTGET (fetch (MENU MENUUSERDATA) of MENU) (QUOTE RESULT))) do (BLOCK) (TOTOPW MENUW)) (AND (EQ RESULT :DONE) (COLLECT.SHADED.ITEMS MENU))) (CLOSEW MENUW) (TTY.PROCESS T))))
)
(\LAFITE.HANDLE.MULTIPLE.SELECTION
(LAMBDA (ITEM MENU KEY) (* ; "Edited 29-Aug-88 17:53 by bvm") (if (LISTP ITEM) then (* ; "done") (push (fetch (MENU MENUUSERDATA) of MENU) (QUOTE RESULT) (CADR ITEM)) else (* ; "Select or unselect an item") (SHADEITEM ITEM MENU (SELECTQ (CDR (ASSOC (\ItemNumber ITEM (fetch (MENU ITEMS) of MENU)) (fetch (MENU SHADEDITEMS) of MENU))) ((NIL 0) (* ; "Not yet selected") LAFITEHARDCOPYBATCHSHADE) 0))))
)
(COLLECT.SHADED.ITEMS
(LAMBDA (MENU) (* ; "Edited 29-Aug-88 12:38 by bvm") (* ;; "Return a list of the items currently shaded in MENU") (for PAIR in (fetch (MENU SHADEDITEMS) of MENU) bind (ITEMS ← (fetch (MENU ITEMS) of MENU)) unless (EQ (CDR PAIR) 0) collect (CAR (NTH ITEMS (CAR PAIR)))))
)
)
(* ; "Low level file functions")
(DEFINEQ
(DELETEMAILFOLDER
(LAMBDA (FOLDER) (* ; "Edited 30-Sep-87 15:48 by bvm:") (* ;;; "deletes the associated files and tells Lafite to forget about that mail file") (PROG ((FULL (fetch (MAILFOLDER FULLFOLDERNAME) of FOLDER)) STREAM) (if FULL then (if (AND (SETQ STREAM (fetch (MAILFOLDER FOLDERSTREAM) of FOLDER)) (OPENP STREAM)) then (SETQ FULL (CLOSEF STREAM))) (DELFILE FULL) (DELFILE (TOCFILENAME FULL)) (FORGETMAILFILE (OR (fetch (MAILFOLDER SHORTFOLDERNAME) of FOLDER) (LA.SHORTFILENAME FULL LAFITEMAIL.EXT))))))
)
(\LAFITE.OPEN.FOLDER
(LAMBDA (FOLDER ACCESS IFCHANGED) (* ; "Edited 13-Sep-88 17:47 by bvm") (* ;;; "For Interlisp-D it's too inefficient to keep opening and closing the mail file so we will keep it open --- If the file wants to be open for INPUT do just that -- it may want to be a read-only mail file -- otherwise open it for BOTH --- FILE is always a fully qualified file name") (* ;;; "IFCHANGED controls what to do if the stream has changed since we last used it. :IGNORE means don't bother checking, since I don't care. :OK means rebrowse as necessary, but return the stream. NIL means return NIL if there was a change, after rebrowsing.") (PROG ((*UPPER-CASE-FILE-NAMES* NIL) (STREAM (fetch (MAILFOLDER FOLDERSTREAM) of FOLDER)) (DESIREDACCESS (COND ((EQ ACCESS (QUOTE INPUT)) ACCESS) (T (QUOTE BOTH)))) NEWLENGTH NEWDATE NEWESTDATE CHANGED WASOPEN) (COND ((OR (NOT STREAM) (NOT (OPENP STREAM DESIREDACCESS))) (if STREAM then (* ;; "Have to close file to reopen for BOTH. We do this before date fussing in the hopes that this will force the device to really talk to the server. It might not help, though--the device's GETFILEINFO might still choose to give us an old cached date.") (COND ((OPENP STREAM) (CLOSEF STREAM))) (replace (MAILFOLDER FOLDERSTREAM) of FOLDER with NIL)) (if (EQ (fetch (MAILFOLDER BROWSERSTATUS) of FOLDER) LAS.OUT.OF.DATE) then (* ; "Shouldn't happen--leftover from rebrowse folder. Get out of here") (ERROR!)) (HANDLER-BIND ((CL:ERROR (FUNCTION (LAMBDA (C) (* ; "Problem opening file. Avoid break window--just abort.") (\LAFITE.REPORT.FILE.WONT.OPEN FOLDER C) (ERROR!))))) (PROGN (if (AND (EQ DESIREDACCESS (QUOTE BOTH)) (fetch (MAILFOLDER FOLDEREOFPTR) of FOLDER) (NEQ IFCHANGED :IGNORE)) then (* ;; "Opening for output in general changes the creationdate, so we won't be able to check from the new stream whether the creationdate matches. So we have to obtain the current creation date without opening for write--hope GETFILEINFO works well enough. We further assume that nobody changed the file in the brief interval between getting this info and opening for write. This can be a faulty assumption for devices that are willing to keep a file open even though the server connection went away, but it seems the best we can do.") (SETQ NEWDATE (GETFILEINFO (fetch (MAILFOLDER FULLFOLDERNAME) of FOLDER) (QUOTE ICREATIONDATE)))) (SETQ STREAM (\LAFITE.OPENSTREAM (fetch (MAILFOLDER FULLFOLDERNAME) of FOLDER) DESIREDACCESS NIL (FUNCTION \LAFITE.EOF) (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER) (QUOTE LAFITE))))) (* ; "Finally open it. Ask for big buffers if there's a browser for it.") (AND (EQ DESIREDACCESS (QUOTE BOTH)) (LINELENGTH MAX.SMALLP STREAM)) (* ; "So that LA.PRINTCOUNT won't introduce CR's. Would be nice if PRINTNUM could be given a PRIN3 mode") (SETQ NEWLENGTH (GETEOFPTR STREAM)) (SETQ NEWESTDATE (GETFILEINFO STREAM (QUOTE ICREATIONDATE))) (if (OR (EQ IFCHANGED :IGNORE) (NULL (fetch (MAILFOLDER FOLDEREOFPTR) of FOLDER)) (NULL (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER))) then (* ; "first time opened, just store the info") (replace (MAILFOLDER FOLDEREOFPTR) of FOLDER with NEWLENGTH) elseif (OR (NOT (= NEWLENGTH (fetch (MAILFOLDER FOLDEREOFPTR) of FOLDER))) (AND (OR NEWDATE (SETQ NEWDATE NEWESTDATE)) (NOT (= NEWDATE (fetch (MAILFOLDER FOLDERCREATIONDATE) of FOLDER))))) then (* ; "Folder has changed since we last touched it.") (RETURN (\LAFITE.FOLDER.CHANGED FOLDER STREAM DESIREDACCESS IFCHANGED))) (replace (MAILFOLDER FOLDERCREATIONDATE) of FOLDER with (OR NEWESTDATE 0)) (if (EQ (fetch (MAILFOLDER BROWSERSTATUS) of FOLDER) LAS.LOGGED.OUT) then (* ; "We hadn't gotten around to verifying this one after logout yet--well, it's ok now.") (replace (MAILFOLDER BROWSERSTATUS) of FOLDER with LAS.READY)) (replace (MAILFOLDER FOLDERSTREAM) of FOLDER with STREAM))) (RETURN STREAM)))
)
(\LAFITE.REPORT.FILE.WONT.OPEN
(LAMBDA (FOLDER C FILENAME) (* ; "Edited 22-Aug-88 19:25 by bvm") (* ;; "Called to report an error involved in trying to open FILENAME belonging to FOLDER. C is the condition. FOLDER can be NIL.") (LAB.FORMAT FOLDER T "Failed~@[ to open ~A because~]: ~A" (if (OR (TYPEP C (QUOTE XCL:FILE-WONT-OPEN)) (TYPEP C (QUOTE XCL:PATHNAME-ERROR)) (TYPEP C (QUOTE XCL:FILE-NOT-FOUND))) then (* ;; "Report handler includes the name already (In Lyric, file-not-found is a subtype of pathname-error, but not in Medley, where we might instead want to replace both file-wont-open and file-not-found with parent file-error)") NIL elseif FILENAME else (fetch (MAILFOLDER FULLFOLDERNAME) of FOLDER)) C))
)
(\LAFITE.FOLDER.CHANGED
(LAMBDA (FOLDER STREAM DESIREDACCESS IFCHANGED) (* ; "Edited 7-Jun-88 17:17 by bvm") (* ;; "Called by LAFITE.OPEN.FOLDER when changed detected.") (if (AND LAFITEDEBUGFLG (EQ (fetch (MAILFOLDER BROWSERSTATUS) of FOLDER) LAS.READY)) then (* ; "This is only funny if it didn't happen after logout.") (HELP "Folder has changed--RETURN to proceed.")) (LET* ((BROWSERWINDOW (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER)) (WASOPEN (OPENWP BROWSERWINDOW)) (OLDEOF (fetch (MAILFOLDER FOLDEREOFPTR) of FOLDER)) (NEWEOF (GETEOFPTR STREAM)) MSG LEN ASKFLG HOW) (ALLOW.BUTTON.EVENTS) (* ; "Don't hoard mouse if we got called directly from mouse proc.") (replace (MAILFOLDER BROWSERSTATUS) of FOLDER with LAS.OUT.OF.DATE) (replace (MAILFOLDER FOLDERCREATIONDATE) of FOLDER with (GETFILEINFO STREAM (QUOTE ICREATIONDATE))) (replace (MAILFOLDER FOLDEREOFPTR) of FOLDER with NEWEOF) (replace (MAILFOLDER FOLDERSTREAM) of FOLDER with STREAM) (if (fetch (MAILFOLDER FOLDERNEEDSUPDATE) of FOLDER) then (* ;; "Want to do something more careful here if folder has changes.") (SETQ HOW (if (AND (>= (GETEOFPTR STREAM) (fetch (MAILFOLDER FOLDEREOFPTR) of FOLDER)) (PROGN (* ; "Stream is not shorter than we remember. See if our current last message is still at the start of a message.") (SETFILEPTR STREAM (fetch (LAFITEMSG BEGIN) of (SETQ MSG (NTHMESSAGE (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER) (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER))))) (LA.READSTAMP STREAM)) (SETQ LEN (LA.READCOUNT STREAM)) (= LEN (fetch (LAFITEMSG MESSAGELENGTH) of MSG))) then (* ;; "Folder contains changes, and folder has apparently only been appended to, or had changes written but not expunge. Offer to write out current changes before proceeding.") (SETQ ASKFLG T) "but apparently not expunged. However, you have unsaved changes." else (* ;; "There are unsaved changes, but folder looks expunged--too bad.") "apparently by one or more Expunges, so you can't save your changes."))) (COND ((NOT WASOPEN) (* ; "Want the messages we print to be noticed.") (if (NOT ASKFLG) then (* ; "If we were shrunk, don't bother redisplaying when we expand.") (replace (MAILFOLDER BROWSERUPDATEFROMHERE) of FOLDER with NIL)) (OPENW BROWSERWINDOW))) (LAB.FORMAT FOLDER "~&Folder has changed since you last accessed it...~@[~A~]" HOW) (\LAFITE.REBROWSE.FOLDER FOLDER STREAM ASKFLG (NOT WASOPEN) DESIREDACCESS IFCHANGED)))
)
(\LAFITE.REBROWSE.FOLDER
(LAMBDA (FOLDER STREAM ASK CLOSEFLG DESIREDACCESS IFCHANGED DELETE-TOC) (* ; "Edited 13-Sep-88 18:41 by bvm") (* ;; "Rebrowses FOLDER because something changed. STREAM is current stream open on folder. If ASK is true, then we put up a menu asking whether to save current changes (caller verifies that this is interesting to do). If CLOSEFLG, then folder is shrunk at end. If DELETE-TOC is true, the TOC is deleted before rebrowsing. DESIREDACCESS and IFCHANGED are per the change action desired of \LAFITE.OPEN.FOLDER.") (LET ((BROWSERWINDOW (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER)) TOCFILE) (if ASK then (* ; "Offer to write out current changes before proceeding.") (PROG NIL RETRY (LAB.FORMAT FOLDER "~%%Do you want to save the changes before fetching the new contents? ") (CASE (\LAFITE.FOLDER.CHANGED.MENU FOLDER) (:CLOSE (\LAFITE.FINISH.UPDATE BROWSERWINDOW FOLDER :EXIT) (ERROR!)) ((NIL) (* ; "Don't try to save anything")) (T (* ; "Try doing an Update changes only") (if (NOT (OPENP STREAM (QUOTE OUTPUT))) then (CLOSEF STREAM) (CL:MULTIPLE-VALUE-BIND (NEWSTREAM CONDITION) (IGNORE-ERRORS (\LAFITE.OPENSTREAM (fetch (MAILFOLDER FULLFOLDERNAME) of FOLDER) (QUOTE BOTH) NIL (FUNCTION \LAFITE.EOF) T (QUOTE LAFITE))) (if CONDITION then (* ; "Failed to open for output") (\LAFITE.REPORT.FILE.WONT.OPEN FOLDER CONDITION) (GO RETRY)) (replace (MAILFOLDER FOLDERSTREAM) of FOLDER with (SETQ STREAM NEWSTREAM)) (replace (MAILFOLDER FOLDERCREATIONDATE) of FOLDER with (GETFILEINFO STREAM (QUOTE ICREATIONDATE))) (replace (MAILFOLDER FOLDEREOFPTR) of FOLDER with (GETEOFPTR STREAM)))) (LAB.FORMAT FOLDER "~%%") (RESETLST (LET ((*UPPER-CASE-FILE-NAMES* NIL) (LAFITEVERIFYFLG T) (*LAFITE-VERIFY-ACTION* (FUNCTION (LAMBDA (MSG FOLDER STREAM) (* ; "This message not where we expected, so punt it") (LAB.FORMAT FOLDER " (Failed on #~D)" (fetch (LAFITEMSG %#) of MSG)) (RETFROM (FUNCTION WRITEFOLDERMARKBYTES))))) (MENU (fetch (MAILFOLDER BROWSERMENU) of FOLDER))) (LA.RESETSHADE (LA.MENU.ITEM (FUNCTION \LAFITE.UPDATE) MENU) MENU) (\LAFITE.UPDATE.FOLDER FOLDER))) (* ; "Take the conservative approach--flush the toc and reparse.") (SETQ DELETE-TOC T))))) (if (AND DELETE-TOC (SETQ TOCFILE (INFILEP (TOCFILENAME (fetch (MAILFOLDER FULLFOLDERNAME) of FOLDER))))) then (DELFILE TOCFILE)) (LAB.PROMPTPRINT FOLDER " Rebrowsing...") (CLEARW BROWSERWINDOW) (* ;; "It might be nice to restore the old selection if possible...(save current selection, then call LOADMAILFOLDER, select the same numbered messages, then call LAB.DISPLAYFOLDER)") (if (LAB.LOADFOLDER FOLDER) then (* ; "Succeeded") (COND (CLOSEFLG (\LAFITE.FINISH.UPDATE BROWSERWINDOW FOLDER :SHRINK))) (CASE IFCHANGED (:OK (* ; "Return (possibly new) stream after rebrowse") (\LAFITE.OPEN.FOLDER FOLDER DESIREDACCESS)) ((NIL) (* ; "Return NIL to indicate change") NIL) (T (* ; "Abort operation.") (ERROR!))) else (* ; "Failed. Don't let anything more happen here") (ERROR!))))
)
(\LAFITE.FOLDER.CHANGED.MENU
(LAMBDA (FOLDER) (* ; "Edited 14-Oct-87 19:45 by bvm:") (* ;; "Put up a menu asking whether to save changes before rebrowsing folder. Returns one of T (save), NIL (don't), or :CLOSE (forget it altogether).") (LET ((REG (WINDOWPROP (fetch (MAILFOLDER BROWSERMENUWINDOW) of FOLDER) (QUOTE REGION))) (ITEMS (QUOTE (("Save current changes first" T "Attempt to write out the unsaved new marks and deletions before rebrowsing the folder.") ("Just rebrowse" NIL "Forget any changes I have made to the browser--just get the new contents.") ("Close Browser" :CLOSE "Close the browser now, forgetting any changes."))))) (MENU (create MENU ITEMS ← ITEMS MENUFONT ← LAFITEMENUFONT CENTERFLG ← T MENUROWS ← 1 ITEMWIDTH ← (MAX (QUOTIENT (fetch (REGION WIDTH) of REG) 3) (STRINGWIDTH (CAAR ITEMS) LAFITEMENUFONT))) (PROGN (* ; "Position menu over the browser's menu") (create POSITION XCOORD ← (fetch (REGION LEFT) of REG) YCOORD ← (fetch (REGION BOTTOM) of REG))) T)))
)
(\LAFITE.SET.FOLDER.STREAM
(LAMBDA (FOLDER STREAM) (* ; "Edited 30-Sep-87 16:45 by bvm:") (* ;; "Called from the few places that open/create a stream without going thru lafite.open.folder--stores in FOLDER all the info you like to cache about STREAM. Returns STREAM") (LET ((FULL (FULLNAME STREAM))) (replace (MAILFOLDER FULLFOLDERNAME) of FOLDER with FULL) (replace (MAILFOLDER SHORTFOLDERNAME) of FOLDER with (LA.SHORTFILENAME FULL LAFITEMAIL.EXT)) (replace (MAILFOLDER FOLDEREOFPTR) of FOLDER with (GETEOFPTR STREAM)) (replace (MAILFOLDER FOLDERCREATIONDATE) of FOLDER with (GETFILEINFO STREAM (QUOTE ICREATIONDATE))) (replace (MAILFOLDER FOLDERSTREAM) of FOLDER with STREAM) STREAM))
)
(\LAFITE.OPENSTREAM
(LAMBDA (FILE ACCESS RECOG EOFFN BIGBUFS TYPE) (* ; "Edited 8-Sep-88 14:27 by bvm") (LET* ((*UPPER-CASE-FILE-NAMES* NIL) (S (OPENSTREAM FILE ACCESS RECOG (BQUOTE ((\,@ (AND EOFFN (BQUOTE ((ENDOFSTREAMOP (\, EOFFN)))))) (\,@ (AND BIGBUFS (BQUOTE ((BUFFERS (\, LAFITEBUFFERSIZE)))))) (\,@ (AND TYPE (BQUOTE ((TYPE (\, TYPE))))))))))) (if (AND TYPE (NEQ TYPE (QUOTE TEXT))) then (* ; "Force the stupid device to have eol CR, no matter what it thought (take that, Maiko)") (SETFILEINFO S (QUOTE EOL) (QUOTE CR))) S))
)
(\LAFITE.CREATE.MENU
(LAMBDA (ITEMS TITLE DONTCHANGEOFFSET) (* ; "Edited 23-Aug-88 18:30 by bvm") (* ;; "Create a Lafite menu using its font. Optional title. DONTCHANGEOFFSET inhibits setting the CHANGEOFFSETFLG field. ") (create MENU ITEMS ← ITEMS MENUFONT ← LAFITEMENUFONT TITLE ← TITLE CENTERFLG ← T CHANGEOFFSETFLG ← (NOT DONTCHANGEOFFSET)))
)
(\LAFITE.EOF
(LAMBDA (STREAM) (* ; "Edited 15-Sep-87 18:26 by bvm:") (* ;; "End of stream op for Lafite mail folders. Return endless CR's so that parses eventually stop") (if (NEQ (ACCESS-CHARSET STREAM) 0) then (* ;; "We're in another char set, so just returning CR won't do, since it will be interpreted in the wrong char set. Also, can't just smash CHARSET to 0, since some readers cache the charset.") (LET ((STATE (STREAMPROP STREAM (QUOTE EOFDATA)))) (SELECTQ STATE (NIL (STREAMPROP STREAM (QUOTE EOFDATA) 1) (* ; "First return charset shift byte") NSCHARSETSHIFT) (1 (STREAMPROP STREAM (QUOTE EOFDATA) 2) (* ; "Then charset zero.") 0) (PROGN (* ; "Eek, shouldn't happen. Maybe somebody is stupidly reading bytes, so try a cr") (STREAMPROP STREAM (QUOTE EOFDATA) NIL) (CHARCODE CR)))) else (CHARCODE CR)))
)
(\LAFITE.CLOSE.FOLDER
(LAMBDA (MAILFOLDER REALLYP) (* ; "Edited 14-Oct-87 20:18 by bvm:") (* ;;; "If MAILFOLDER is open for output, make sure it is completely written out. If REALLYP then actually close the file") (LET ((STREAM (fetch (MAILFOLDER FOLDERSTREAM) of MAILFOLDER))) (COND ((AND STREAM (COND ((OPENP STREAM (QUOTE OUTPUT)) (FORCEOUTPUT STREAM T) (* ; "Due to Leaf bug, best to do the FORCEOUTPUT first even if we're really closing it") (replace (MAILFOLDER FOLDERCREATIONDATE) of MAILFOLDER with (GETFILEINFO STREAM (QUOTE ICREATIONDATE))) (* ; "Update creation date in case it's a device where writing to it affects it (always true over savevm for some devices)") REALLYP) (T (AND REALLYP (OPENP STREAM))))) (* ; "Yes, close it for real") (PROG1 (CLOSEF STREAM) (replace (MAILFOLDER FOLDERSTREAM) of MAILFOLDER with NIL))))))
)
(MAILFOLDERBUSY
(LAMBDA (MAILFOLDER) (* bvm%: "29-Dec-83 18:11") (RESETFORM (CURSOR LA.CROSSCURSOR) (BLOCK LAFITEBUSYWAITTIME)))
)
)
(DEFINEQ
(COPY7BITFILE
(LAMBDA (SRCFIL DSTFIL) (* bvm%: " 5-Jan-84 10:57") (RESETLST (PROG (INSTREAM OUTSTREAM CH) (RESETSAVE NIL (LIST (QUOTE CLOSEF) (SETQ INSTREAM (OPENSTREAM SRCFIL (QUOTE INPUT) NIL NIL (QUOTE ((SEQUENTIAL T) (ENDOFSTREAMOP NILL))))))) (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (STREAM) (SETQ STREAM (CLOSEF STREAM)) (AND RESETSTATE (DELFILE STREAM)))) (SETQ OUTSTREAM (OPENSTREAM (OR DSTFIL (PACKFILENAME (QUOTE VERSION) NIL (QUOTE BODY) (FULLNAME INSTREAM))) (QUOTE OUTPUT) (QUOTE NEW) NIL (LIST (QUOTE (SEQUENTIAL T)) (LIST (QUOTE LENGTH) (GETFILEINFO INSTREAM (QUOTE LENGTH)))))))) (while (SETQ CH (BIN INSTREAM)) do (BOUT OUTSTREAM (LOGAND CH 127))) (RETURN (FULLNAME OUTSTREAM)))))
)
(\LAFITE.BROWSE.LAURELFILE
(LAMBDA (ITEM MENU) (* ; "Edited 10-Dec-87 17:26 by bvm:") (\LAFITE.BROWSE.PROC ITEM MENU NIL :LAUREL))
)
(\LAFITE.NOTICE.FOLDERS
(LAMBDA NIL (* ; "Edited 12-Sep-88 17:02 by bvm") (RESETLST (LET ((*UPPER-CASE-FILE-NAMES* NIL) (PATTERN (PROMPTFORFILENAME NIL (CAR \LAFITEDEFAULTHOST&DIR) "Notice mail folders on directory: ")) WINDOW GEN FILE NEWFILES NEWCASEFILES OLDCASEFILES FOUND) (COND (PATTERN (SETQ PATTERN (PACKFILENAME.STRING (APPEND (LA.LONGFILENAME (PACKFILENAME.STRING (QUOTE BODY) PATTERN (QUOTE NAME) (QUOTE *)) LAFITEMAIL.EXT NIL NIL T) (QUOTE (VERSION ""))))) (* ; "Default to *.MAIL;") (SETQ WINDOW (\LAFITE.MAKE.RANDOM.DISPLAY "Noticed Mail Folders" PATTERN (CONCAT "Enumerating " PATTERN "...
"))) (SETQ GEN (\GENERATEFILES PATTERN NIL (QUOTE (RESETLST)))) (COND ((NULL (SETQ FILE (\GENERATENEXTFILE GEN))) (printout WINDOW T "No matching files found.")) (T (do (if (NOT (SETQ FOUND (CL:MEMBER (SETQ FILE (LA.SHORTFILENAME FILE LAFITEMAIL.EXT)) (CDR LAFITEMAILFOLDERS) :TEST (QUOTE STRING-EQUAL)))) then (* ; "New file") (push NEWFILES FILE) (printout WINDOW FILE ", ") elseif (NOT (STREQUAL (CAR FOUND) FILE)) then (* ; "New case or canonicalization") (push NEWCASEFILES FILE) (push OLDCASEFILES (CAR FOUND))) repeatwhile (SETQ FILE (\GENERATENEXTFILE GEN))) (if (NULL (OR NEWFILES NEWCASEFILES)) then (printout WINDOW T "No new files found.") elseif (\LAFITE.GC.FOLDERS.CONFIRM WINDOW (CONCAT (if NEWCASEFILES then (CL:FORMAT NIL "~:[No new files, but~;~%%Also~] found new canonical names for ~D existing folders.~%%" NEWFILES (LENGTH NEWCASEFILES)) else "") "Click Confirm to add these folders to set of known folders.")) then (\LAFITE.SET.NEW.FOLDERS (CL:MERGE (QUOTE LIST) (if NEWCASEFILES then (* ; "Want to add these files as well, and take out the old files.") (SETQ NEWFILES (APPEND NEWCASEFILES NEWFILES)) (* ; "Can use EQ here because we gathered these very strings above.") (CL:SORT (CL:SET-DIFFERENCE (CDR LAFITEMAILFOLDERS) OLDCASEFILES :TEST (QUOTE EQ)) (FUNCTION UALPHORDER)) else (CDR LAFITEMAILFOLDERS)) (CL:SORT NEWFILES (FUNCTION UALPHORDER)) (FUNCTION UALPHORDER)) WINDOW) else (printout WINDOW T "Aborted.")))))))))
)
(\LAFITE.MAKE.RANDOM.DISPLAY
(LAMBDA (TITLE SAMPLESTRING INITIALCONTENT) (* ; "Edited 23-Aug-88 14:54 by bvm") (LET ((REG (WINDOWREGION LAFITESTATUSWINDOW)) (HEIGHT (HEIGHTIFWINDOW (TIMES 6 (FONTPROP NIL (QUOTE HEIGHT))) T)) BOTTOM WINDOW) (SETQ WINDOW (OPENTEXTSTREAM INITIALCONTENT (CREATEW (MAKEWITHINREGION (create REGION LEFT ← (fetch (REGION LEFT) of REG) BOTTOM ← (COND ((< (SETQ BOTTOM (- (fetch (REGION BOTTOM) of REG) HEIGHT)) 0) (* ; "tried placing it below status window, but that's off screen") (fetch (REGION TOP) of REG)) (T BOTTOM)) WIDTH ← (IMAX (FIXR (TIMES 1.5 (STRINGWIDTH SAMPLESTRING))) (TIMES 64 (CHARWIDTH (CHARCODE M)))) HEIGHT ← HEIGHT)) TITLE) NIL NIL (QUOTE (PROMPTWINDOW DON'T)))) (SETFILEPTR WINDOW -1) (LINELENGTH MAX.SMALLP WINDOW) WINDOW))
)
(\LAFITE.GC.FOLDERS
(LAMBDA NIL (* ; "Edited 23-Aug-88 14:53 by bvm") (LET ((*UPPER-CASE-FILE-NAMES* NIL) (WINDOW (\LAFITE.MAKE.RANDOM.DISPLAY "Folders no longer found" (CAR \LAFITEDEFAULTHOST&DIR))) (OLDFILES (CDR LAFITEMAILFOLDERS)) FOUND NOTFOUND OLDCASEFILES NEWCASEFILES) (printout WINDOW "Scanning...") (for F in OLDFILES do (printout WINDOW ".") (if (NULL (SETQ FOUND (INFILEP (LA.LONGFILENAME F LAFITEMAIL.EXT)))) then (printout WINDOW T F " not found.") (push NOTFOUND F) elseif (NOT (STREQUAL (SETQ FOUND (LA.SHORTFILENAME FOUND LAFITEMAIL.EXT)) F)) then (* ; "Different case") (push OLDCASEFILES F) (push NEWCASEFILES FOUND))) (COND ((NULL (OR NOTFOUND NEWCASEFILES)) (printout WINDOW T "All known folders still exist.")) ((\LAFITE.GC.FOLDERS.CONFIRM WINDOW (CONCAT (if NEWCASEFILES then (CL:FORMAT NIL "~:[All folders exist, but~;~%%Also~] found new canonical names for ~D folders.~%%" NOTFOUND (LENGTH NEWCASEFILES)) else "") "Click Confirm to make these changes to the set of known folders.")) (if NOTFOUND then (SETQ OLDFILES (CL:SET-DIFFERENCE OLDFILES NOTFOUND :TEST (QUOTE EQ)))) (* ; "Can use EQ here because we gathered these very strings above.") (\LAFITE.SET.NEW.FOLDERS (if NEWCASEFILES then (CL:SORT (APPEND NEWCASEFILES (CL:SET-DIFFERENCE OLDFILES OLDCASEFILES :TEST (QUOTE EQ))) (FUNCTION UALPHORDER)) else OLDFILES) WINDOW)) (T (printout WINDOW T "Aborted")))))
)
(\LAFITE.GC.FOLDERS.CONFIRM
(LAMBDA (TEXTSTREAM PROMPT) (* ; "Edited 12-Sep-88 11:41 by bvm") (* ;;; "Wait for confirming response from Proceed/Abort menu before changing folders menu. PROMPT is instructions to issue in TEXTSTREAM") (TEDIT.SETSEL TEXTSTREAM (GETEOFPTR TEXTSTREAM) 0 (QUOTE RIGHT)) (TEDIT.NORMALIZECARET TEXTSTREAM) (* ; "This makes the last line visible, I hope") (printout TEXTSTREAM T T PROMPT) (PROG1 (MENU (create MENU ITEMS ← (QUOTE (("Confirm" T "Yes, change the folder menu as indicated.") ("Abort" NIL "No, take no action"))) MENUROWS ← 1 CENTERFLG ← T MENUFONT ← LAFITEMENUFONT MENUBORDERSIZE ← 2) (LET ((REG (WINDOWPROP (LA.WINDOW.FROM.TEXTSTREAM TEXTSTREAM) (QUOTE REGION)))) (create POSITION XCOORD ← (fetch (REGION LEFT) of REG) YCOORD ← (- (fetch (REGION BOTTOM) of REG) (+ 2 (FONTPROP LAFITEMENUFONT (QUOTE HEIGHT)))))) T) (SETFILEPTR TEXTSTREAM -1)))
)
(\LAFITE.SET.NEW.FOLDERS
(LAMBDA (FOLDERS TEXTSTREAM) (* ; "Edited 29-Aug-88 17:15 by bvm") (* ;; "Finish a GC folders or Notice folders command.") (RPLACD LAFITEMAILFOLDERS FOLDERS) (SETQ LAFITEFOLDERSMENU (SETQ LAFITEMULTIPLEFOLDERSMENU NIL)) (SETQ \LAFITEPROFILECHANGED T) (if TEXTSTREAM then (* ; "Use TEDIT.INSERT here instead of printout to insure that scrolling occurs if needed.") (TEDIT.INSERT TEXTSTREAM "
Done." (ADD1 (GETEOFPTR TEXTSTREAM))))))
(\LAFITE.RENAME.FOLDER
(LAMBDA NIL (* ; "Edited 12-Sep-88 16:44 by bvm") (RESETLST (LET ((*UPPER-CASE-FILE-NAMES* NIL) (FOLDERNAME (\LAFITE.PROMPTFORFOLDER)) FULLNAME NEWNAME FOLDER TOC NEWFULLNAME NEWSHORTNAME) (if (OR (NULL FOLDERNAME) (NULL (SETQ NEWNAME (PROMPTFORFILENAME NIL FOLDERNAME "New name: ")))) elseif (NULL (SETQ FULLNAME (INFILEP (LA.LONGFILENAME FOLDERNAME LAFITEMAIL.EXT)))) then (PRINTOUT PROMPTWINDOW T "Can't find " FOLDERNAME) else (PRINTOUT PROMPTWINDOW T "Renaming " FULLNAME "...") (SETQ NEWNAME (LA.LONGFILENAME NEWNAME LAFITEMAIL.EXT)) (if (SETQ FOLDER (LAFITE.OBTAIN.FOLDER FULLNAME)) then (OBTAIN.MONITORLOCK (fetch FOLDERLOCK of FOLDER) NIL T) (\LAFITE.CLOSE.FOLDER FOLDER T)) (if (NULL (SETQ NEWFULLNAME (RENAMEFILE FULLNAME NEWNAME))) then (PRINTOUT PROMPTWINDOW " failed.") else (PRINTOUT PROMPTWINDOW T " to " NEWFULLNAME) (if (SETQ TOC (INFILEP (TOCFILENAME FULLNAME))) then (PRINTOUT PROMPTWINDOW T "Renaming toc file...") (if (NOT (RENAMEFILE TOC (TOCFILENAME NEWFULLNAME))) then (PRINTOUT PROMPTWINDOW T "Could not rename toc file " TOC " - you may want to delete or rename it yourself."))) (SETQ NEWSHORTNAME (LA.SHORTFILENAME NEWFULLNAME LAFITEMAIL.EXT)) (if FOLDER then (* ; "Fix up this guy's name") (replace (MAILFOLDER FULLFOLDERNAME) of FOLDER with NEWFULLNAME) (replace (MAILFOLDER VERSIONLESSFOLDERNAME) of FOLDER with (PACKFILENAME.STRING (QUOTE VERSION) NIL (QUOTE BODY) NEWFULLNAME)) (\LAFITE.NEW.SHORT.NAME FOLDER NEWSHORTNAME)) (\LAFITE.FOLDER.NAME.CHANGED FOLDERNAME NEWSHORTNAME) (PRINTOUT PROMPTWINDOW " done."))))))
)
(\LAFITE.DESCRIBE.FOLDER
(LAMBDA (FOLDER) (* ; "Edited 7-Sep-88 18:55 by bvm") (LAB.FORMAT FOLDER "File ~A contains ~D messages ~@[(~D deleted) ~]in ~D pages." (fetch (MAILFOLDER FULLFOLDERNAME) of FOLDER) (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER) (AND (fetch (MAILFOLDER FOLDERNEEDSEXPUNGE) of FOLDER) (for I from 1 to (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER) bind (MESSAGES ← (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER)) count (fetch (LAFITEMSG DELETED?) of (NTHMESSAGE MESSAGES I)))) (FOLDHI (fetch (MAILFOLDER FOLDEREOFPTR) of FOLDER) BYTESPERPAGE)))
)
(\LAFITE.FIX.LAUREL.FOLDER
(LAMBDA (MAILFOLDER) (* ; "Edited 23-Sep-87 18:45 by bvm:") (RESETLST (PROG (STREAM CH) (OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER) NIL T) (LAB.PROMPTPRINT MAILFOLDER "Laurel scan... ") (SETQ STREAM (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE BOTH) :IGNORE)) (RESETSAVE NIL (LIST (FUNCTION \LAFITE.CLOSE.FOLDER) MAILFOLDER T)) (SETFILEINFO STREAM (QUOTE ENDOFSTREAMOP) (FUNCTION NILL)) (while (SETQ CH (BIN STREAM)) do (COND ((EQ CH (LOGOR 128 (CHARCODE SPACE))) (\BACKFILEPTR STREAM) (BOUT STREAM (CHARCODE SPACE))))) (RETURN (FULLNAME STREAM)))))
)
)
(* ; "Make is easy to load new versions of Lafite")
(DEFINEQ
(LOAD-LAFITE
(LAMBDA (DIR SOURCEP) (* ; "Edited 13-Jun-88 14:42 by bvm") (* ;; "Load Lafite from a specified directory (or the dir where we find the first file). If SOURCEP true we load the sources PROP, else the compiled files SYSLOAD. When loading compiled, we only load files that are noted as already loaded, since those are the only ones that won't be automatically loaded by the FILES command in file LAFITE (which must have been loaded if this function is defined).") (SETQ DIR (MKLIST DIR)) (for FILE in (if SOURCEP then LAFITEFILES else (REMOVE (QUOTE LAFITEDECLS) LAFITEFILES)) bind F when (OR SOURCEP (GET FILE (QUOTE FILEDATES))) collect (if (SETQ F (if SOURCEP then (FINDFILE FILE T DIR) else (FINDFILE-WITH-EXTENSIONS FILE DIR *COMPILED-EXTENSIONS*))) then (SETQ F (LOAD F (CL:IF SOURCEP (QUOTE PROP) (QUOTE SYSLOAD)))) (if (NULL DIR) then (* ; "Fix dir for subsequent loading") (SETQ DIR (LIST (PACKFILENAME.STRING (QUOTE NAME) NIL (QUOTE EXTENSION) NIL (QUOTE VERSION) NIL (QUOTE BODY) F)))) F else (CONCAT FILE " not found"))))
)
)
(RPAQQ LAFITEFILES (LAFITEDECLS LAFITEBROWSE LAFITECOMMANDS LAFITEMAIL LAFITESEND LAFITETEDIT MAILCLIENT NSMAIL LAFITEFIND LAFITE))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(FILESLOAD (SOURCE) LAFITEDECLS)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS MENUFONT TEDIT.DEFAULT.MENU)
)
(CL:PROCLAIM (QUOTE (CL:SPECIAL *LAFITE-LOGGING-IN* *LA.ABBREVS.IN.PROFILE*)))
(ADDTOVAR DONTCOMPILEFNS RELEASE.LAFITE)
DONTEVAL@COMPILE
(DEFINEQ
(RELEASE.LAFITE
(LAMBDA NIL (* ; "Edited 21-Jun-88 18:35 by bvm") (PROCESSPROP (ADD.PROCESS (LIST (FUNCTION (LAMBDA NIL (TTYDISPLAYSTREAM (CREATEW (QUOTE (0 248 467 163)) "Lafite Release")) (DSPSCROLL T) (FILESLOAD (SYSLOAD) COPYFILES) (COPYFILES "{ERIS}<LAFITE>SOURCES>" "{ERIS}<LISPCORE>INTERNAL>LIBRARY>" (QUOTE (>))) (printout T T "Lafite Release Complete")))) (QUOTE BEFOREEXIT) (QUOTE DON'T) (QUOTE NAME) (QUOTE RELEASE.LAFITE)) (QUOTE NAME)))
)
)
)
(/DECLAREDATATYPE (QUOTE MAILFOLDER) (QUOTE (FLAG FLAG FLAG FLAG FLAG (BITS 3) POINTER FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER POINTER POINTER POINTER POINTER WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER)) (QUOTE ((MAILFOLDER 0 (FLAGBITS . 0)) (MAILFOLDER 0 (FLAGBITS . 16)) (MAILFOLDER 0 (FLAGBITS . 32)) (MAILFOLDER 0 (FLAGBITS . 48)) (MAILFOLDER 0 (FLAGBITS . 64)) (MAILFOLDER 0 (BITS . 82)) (MAILFOLDER 0 POINTER) (MAILFOLDER 2 (FLAGBITS . 0)) (MAILFOLDER 2 (FLAGBITS . 16)) (MAILFOLDER 2 (FLAGBITS . 32)) (MAILFOLDER 2 (FLAGBITS . 48)) (MAILFOLDER 2 (FLAGBITS . 64)) (MAILFOLDER 2 (FLAGBITS . 80)) (MAILFOLDER 2 (FLAGBITS . 96)) (MAILFOLDER 2 (FLAGBITS . 112)) (MAILFOLDER 2 POINTER) (MAILFOLDER 4 POINTER) (MAILFOLDER 6 POINTER) (MAILFOLDER 8 POINTER) (MAILFOLDER 10 POINTER) (MAILFOLDER 12 (BITS . 15)) (MAILFOLDER 13 (BITS . 15)) (MAILFOLDER 14 (BITS . 15)) (MAILFOLDER 15 (BITS . 15)) (MAILFOLDER 16 (BITS . 15)) (MAILFOLDER 17 (BITS . 15)) (MAILFOLDER 18 (BITS . 15)) (MAILFOLDER 19 (BITS . 15)) (MAILFOLDER 20 (BITS . 15)) (MAILFOLDER 21 (BITS . 15)) (MAILFOLDER 22 (BITS . 15)) (MAILFOLDER 23 (BITS . 15)) (MAILFOLDER 24 (BITS . 15)) (MAILFOLDER 25 (BITS . 15)) (MAILFOLDER 26 (BITS . 15)) (MAILFOLDER 27 (BITS . 15)) (MAILFOLDER 28 POINTER) (MAILFOLDER 30 POINTER) (MAILFOLDER 32 POINTER) (MAILFOLDER 34 POINTER) (MAILFOLDER 36 POINTER) (MAILFOLDER 38 POINTER) (MAILFOLDER 40 POINTER) (MAILFOLDER 42 POINTER) (MAILFOLDER 44 POINTER) (MAILFOLDER 46 POINTER) (MAILFOLDER 48 POINTER) (MAILFOLDER 50 POINTER) (MAILFOLDER 52 POINTER) (MAILFOLDER 54 POINTER) (MAILFOLDER 56 POINTER) (MAILFOLDER 58 POINTER) (MAILFOLDER 60 POINTER) (MAILFOLDER 62 POINTER))) (QUOTE 64))
(/DECLAREDATATYPE (QUOTE LAFITEMSG) (QUOTE (FLAG FLAG FLAG FLAG FLAG (BITS 3) POINTER BYTE POINTER WORD WORD WORD WORD FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER POINTER POINTER POINTER)) (QUOTE ((LAFITEMSG 0 (FLAGBITS . 0)) (LAFITEMSG 0 (FLAGBITS . 16)) (LAFITEMSG 0 (FLAGBITS . 32)) (LAFITEMSG 0 (FLAGBITS . 48)) (LAFITEMSG 0 (FLAGBITS . 64)) (LAFITEMSG 0 (BITS . 82)) (LAFITEMSG 0 POINTER) (LAFITEMSG 2 (BITS . 7)) (LAFITEMSG 2 POINTER) (LAFITEMSG 4 (BITS . 15)) (LAFITEMSG 5 (BITS . 15)) (LAFITEMSG 6 (BITS . 15)) (LAFITEMSG 7 (BITS . 15)) (LAFITEMSG 8 (FLAGBITS . 0)) (LAFITEMSG 8 (FLAGBITS . 16)) (LAFITEMSG 8 (FLAGBITS . 32)) (LAFITEMSG 8 (FLAGBITS . 48)) (LAFITEMSG 8 (FLAGBITS . 64)) (LAFITEMSG 8 (FLAGBITS . 80)) (LAFITEMSG 8 (FLAGBITS . 96)) (LAFITEMSG 8 (FLAGBITS . 112)) (LAFITEMSG 8 POINTER) (LAFITEMSG 10 POINTER) (LAFITEMSG 12 POINTER) (LAFITEMSG 14 POINTER))) (QUOTE 16))
(ADDTOVAR SYSTEMRECLST
(DATATYPE MAILFOLDER ((BROWSERPROMPTDIRTY FLAG) (BROWSERPROMPTGREW FLAG) (FOLDERNEEDSUPDATE FLAG) (FOLDERNEEDSEXPUNGE FLAG) (FOLDERBEINGUPDATED FLAG) (BROWSERSTATUS BITS 3) (FULLFOLDERNAME POINTER) (FOLDEROKTOSHRINK FLAG) (FOLDERGETSMAIL FLAG) (NIL 6 FLAG) (VERSIONLESSFOLDERNAME POINTER) (SHORTFOLDERNAME POINTER) (FOLDERSTREAM POINTER) (MESSAGEDESCRIPTORS POINTER) (FOLDERLOCK POINTER) (%#OFMESSAGES WORD) (TOCLASTMESSAGE# WORD) (BROWSERFONTHEIGHT WORD) (BROWSERFONTASCENT WORD) (BROWSERFONTDESCENT WORD) (BROWSERMAXXPOS WORD) (ORDINALXPOS WORD) (DATEXPOS WORD) (FROMXPOS WORD) (FROMMAXXPOS WORD) (SUBJECTXPOS WORD) (BROWSERDIGITWIDTH WORD) (FIRSTSELECTEDMESSAGE WORD) (LASTSELECTEDMESSAGE WORD) (FIRSTCHANGEDMESSAGE WORD) (CURRENTPROMPTLINE WORD) (CURRENTDISPLAYEDSTREAM POINTER) (BROWSEREXTENT POINTER) (BROWSERORIGIN POINTER) (FOLDERDISPLAYREGION POINTER) (BROWSERWINDOW POINTER) (BROWSERMENU POINTER) (BROWSERMENUWINDOW POINTER) (BROWSERPROMPTWINDOW POINTER) (ORIGINALBROWSERTITLE POINTER) (FOLDERDISPLAYWINDOWS POINTER) (FOLDEREOFPTR POINTER) (DEFAULTMOVETOFILE POINTER) (CURRENTDISPLAYEDMESSAGE POINTER) (BROWSERUPDATEFROMHERE POINTER) (BROWSERLAYOUT POINTER) (FOLDERCREATIONDATE POINTER) (HARDCOPYMESSAGES POINTER) (HARDCOPYSTREAM POINTER))
)
(DATATYPE LAFITEMSG ((PARSED? FLAG) (DELETED? FLAG) (SEEN? FLAG) (FORMATTED? FLAG) (NIL FLAG) (MODEBITS BITS 3) (BEGIN POINTER) (MARKCHAR BYTE) (MESSAGELENGTH POINTER) (%# WORD) (STAMPLENGTH WORD) (TOCLENGTH WORD) (NIL WORD) (MESSAGELENGTHCHANGED? FLAG) (NIL FLAG) (SELECTED? FLAG) (MSGFROMMECHECKED? FLAG) (MSGFROMMETRUTH FLAG) (MARKSCHANGEDINFILE? FLAG) (MARKSCHANGEDINTOC? FLAG) (NIL FLAG) (DATE POINTER) (FROM POINTER) (SUBJECT POINTER) (TO POINTER))
)
)
(DEFINEQ
(\LAFITE.GLOBAL.INIT
(LAMBDA NIL (* ; "Edited 14-Jun-88 10:44 by bvm") (* ; "need to do this so you can send a message without 'starting' lafite") (DECLARE (GLOBALVARS BackgroundMenu BackgroundMenuCommands)) (LET ((OLDITEM (OR (CL:ASSOC "SendMail" BackgroundMenuCommands :TEST (QUOTE STRING-EQUAL)) (CL:ASSOC "Mail" BackgroundMenuCommands :TEST (QUOTE STRING-EQUAL)))) (NEWITEM LAFITE.BACKGROUND.ITEM)) (SETQ BackgroundMenuCommands (if OLDITEM then (SUBST NEWITEM OLDITEM BackgroundMenuCommands) else (APPEND BackgroundMenuCommands (LIST NEWITEM)))) (SETQ BackgroundMenu NIL)) (LAFITE.INIT.PARSETABLES) (SETQ \LAFITE.MAILSERVERLOCK (CREATE.MONITORLOCK "Lafite Mail Servers")) (* ; "Used by anyone who calls \LAFITE.GET.USER.DATA or otherwise tries to muck with \LAFITEUSERDATA") (SETQ LAFITEPROFILERDTBL (COPYREADTABLE (QUOTE ORIG))) (* ; "For reading and writing the profile") (DEFPRINT (QUOTE MAILFOLDER) (FUNCTION \MAILFOLDER.DEFPRINT)) (if \LAFITEMODE then (* ; "There was a mode enabled on entry. Reset it in case of incompatible mode records") (SETQ \LAFITEMODE (ASSOC (CAR \LAFITEMODE) LAFITEMODELST))) (for MODE in LAFITEMODELST when (LISTP (CDR MODE)) do (\LAFITE.REGISTER.MODE MODE)) NIL)
)
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(FILESLOAD LAFITEBROWSE LAFITECOMMANDS LAFITESEND LAFITEMAIL TEDIT LAFITETEDIT LAFITEFIND ATTACHEDWINDOW)
(CL:PROCLAIM (QUOTE (GLOBAL ANSWERMARK BROWSERMARKXPOSITION DEFAULTMAILFOLDERNAME LAFITE.BACKGROUND.ITEM LAFITE.BROWSER.ICON.PREFERENCE LAFITE.BROWSER.LAYOUTS LAFITE.DISPLAY.SIZE LAFITE.DONT.DISPLAY.HEADERS LAFITE.DONT.FORWARD.HEADERS LAFITE.DONT.HARDCOPY.HEADERS LAFITE.EDITOR.LAYOUTS LAFITE.EDITOR.SIZE LAFITE.EXTRA.DISPLAY.COMMANDS LAFITE.FOLDER.ICON LAFITE.FOLDER.MENU.FONT LAFITE.HOST.ABBREVS LAFITE.LOOKS.SUBCOMMANDS LAFITE.MIDDLE.UPDATE LAFITE.PROFILE.VARS LAFITE.SIGNATURE LAFITE.USE.ALL.MODES LAFITEBROWSERFONT LAFITEBROWSERICONMENU LAFITEBROWSERICONMENUITEMS LAFITEBROWSERMENUITEMS LAFITEBROWSERREGION LAFITEBUFFERSIZE LAFITEBUSYWAITTIME LAFITECLOSEITEM LAFITECOMMANDMENUITEMS LAFITEDEFAULTHOST&DIR LAFITEDELETEDLINEHEIGHT LAFITEDISPLAYAFTERDELETEFLG LAFITEDISPLAYFONT LAFITEDISPLAYREGION LAFITEDL.EXT LAFITEDLDIRECTORIES LAFITEENDOFMESSAGEFONT LAFITEENDOFMESSAGESTR LAFITEEXTRAMENUFLG LAFITEFIXEDWIDTHFONT LAFITEFORM.EXT LAFITEFORMFILES LAFITEFROMFRACTION LAFITEHARDCOPY.MIN.TOC LAFITEHARDCOPYBATCHFLG LAFITEHARDCOPYBATCHSHADE LAFITEHARDCOPYFONT LAFITEHARDCOPYSEPARATOR LAFITEIFFROMMETHENSEENFLG LAFITEINFO.NAME LAFITEMAIL.EXT LAFITEMENUFONT LAFITEMINFROMCHARS LAFITEMODEDEFAULT LAFITEMODELST LAFITEMOVETOCONFIRMFLG LAFITEMSGICONFONT LAFITENEWPAGEFLG LAFITESHOWMODEFLG LAFITESTATUSWINDOWMINWIDTH LAFITESTATUSWINDOWPOSITION LAFITESUBBROWSEMENUITEMS LAFITESUBQUITMENUITEMS LAFITETITLEFONT LAFITETOC.EXT LAFITEUPDATEMENUITEMS MOVETOMARK LAFITEMENUVARS LAFITE.DUMMY.SHADE LAFITE.DUMMY.HALF.SHADE LAFITEEXTRAMENUITEMS LAFITE.EXTRA.MOVE.ITEMS LAFITE.AUTO.MOVE.MENU)))
(CL:PROCLAIM (QUOTE (CL:SPECIAL LAFITEVERIFYFLG)))
(\LAFITE.GLOBAL.INIT)
(COND ((EQ MAKESYSNAME :LYRIC) (FILESLOAD (SYSLOAD) NSCHARPATCH) (* ; "Patch to horrid Lyric NS chars bug") (MOVD? (QUOTE PROMPTFORWORD) (QUOTE TTYINPROMPTFORWORD) NIL T)))
)
(DECLARE%: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA)
(ADDTOVAR NLAML)
(ADDTOVAR LAMA LAFITE)
)
(PUTPROPS LAFITE COPYRIGHT ("Xerox Corporation and Bolt Beranek and Newman Inc." 1982 1983 1984 1985
1986 1987 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (5394 19853 (LAFITE 5404 . 6715) (LAFITE.ON.FROM.BACKGROUND 6717 . 7088) (\LAFITE.OFF
7090 . 7474) (\LAFITE.START.PROC 7476 . 9398) (LAFITE.COMPUTE.CACHED.VARS 9400 . 11875) (
\LAFITE.PROCESS 11877 . 12243) (\LAFITE.START.ABORT 12245 . 12437) (\LAFITE.QUIT 12439 . 12681) (
\LAFITE.RESTART 12683 . 12816) (\LAFITE.SUBQUIT 12818 . 14116) (\LAFITE.QUIT.PROC 14118 . 16917) (
\LAFITEDEFAULTHOST&DIR 16919 . 17637) (LAFITEDEFAULTHOST&DIR 17639 . 17809) (MAKELAFITECOMMANDWINDOW
17811 . 19450) (EXTRACTMENUCOMMAND 19452 . 19700) (DOMAINLAFITECOMMAND 19702 . 19851)) (19920 22888 (
LAFITEMODE 19930 . 20410) (\LAFITE.INFER.MODE 20412 . 20765) (\LAFITE.SHOW.MODE 20767 . 21004) (
\LAFITE.MODE.TITLE 21006 . 21291) (LAFITE.SHOW.MODE.P 21293 . 21534) (LAFITE.ALL.MODES.P 21536 . 21879
) (SET.LAFITE.MODE.INTERACTIVELY 21881 . 22463) (\LAFITE.COMPUTE.MODE.COMMANDS 22465 . 22886)) (23519
25275 (\LAFITE.LOGIN 23529 . 23911) (\LAFITE.LOGIN.NORESTART 23913 . 24019) (LAFITE.PROMPT.FOR.LOGIN
24021 . 25040) (\LAFITE.REAUTHENTICATE 25042 . 25273)) (30292 32451 (LA.RESETSHADE 30302 . 30680) (
LA.MENU.ITEM 30682 . 31100) (NTHMESSAGE 31102 . 31185) (\LAFITE.MAKE.MSGARRAY 31187 . 31617) (
\LAFITE.ADDMESSAGES.TO.ARRAY 31619 . 32200) (\MAILFOLDER.DEFPRINT 32202 . 32449)) (32982 36424 (
LAFITE.AROUNDEXIT 32992 . 33530) (\LAFITE.MARK.FOLDERS.OBSOLETE 33532 . 34448) (\LAFITE.CHECK.FOLDERS
34450 . 34849) (\LAFITE.ASSURE.FOLDER.READY 34851 . 35261) (\LAFITE.AFTERLOGIN 35263 . 36422)) (36453
43269 (\LAFITE.READ.PROFILE 36463 . 37820) (\LAFITE.PROCESS.PROFILE 37822 . 39012) (
\LAFITE.WRITE.PROFILE 39014 . 40848) (\LAFITE.MERGE.NAMELISTS 40850 . 41584) (\LAFITE.READ.OLD.PROFILE
41586 . 42185) (\LAFITE.MERGE.FOLDERS 42187 . 42499) (\LAFITE.REPACK.FOLDERS 42501 . 43267)) (43469
51286 (LA.LONGFILENAME 43479 . 45112) (LA.SHORTFILENAME 45114 . 46937) (TOCFILENAME 46939 . 47170) (
FORGETMAILFILE 47172 . 47632) (\LAFITE.FOLDER.NAME.CHANGED 47634 . 48760) (
\LAFITE.RECOMPUTE.FOLDER.NAMES 48762 . 49978) (\LAFITE.NEW.SHORT.NAME 49980 . 50661) (
\LAFITE.NOTICE.FILE 50663 . 50844) (\LAFITE.UNCACHE.FOLDER 50846 . 51284)) (51394 56714 (
\LAFITE.PROMPTFORFOLDER 51404 . 51954) (PROMPTFORFILENAME 51956 . 52742) (MAKELAFITEMAILFOLDERSMENU
52744 . 52941) (\LAFITE.ARRANGE.MENU 52943 . 53629) (\LAFITE.MAKE.FOLDER.MENU 53631 . 54114) (
LAFITE.SELECT.FOLDERS 54116 . 55971) (\LAFITE.HANDLE.MULTIPLE.SELECTION 55973 . 56413) (
COLLECT.SHADED.ITEMS 56415 . 56712)) (56756 71638 (DELETEMAILFOLDER 56766 . 57286) (
\LAFITE.OPEN.FOLDER 57288 . 61149) (\LAFITE.REPORT.FILE.WONT.OPEN 61151 . 61875) (
\LAFITE.FOLDER.CHANGED 61877 . 64281) (\LAFITE.REBROWSE.FOLDER 64283 . 67248) (
\LAFITE.FOLDER.CHANGED.MENU 67250 . 68240) (\LAFITE.SET.FOLDER.STREAM 68242 . 68936) (
\LAFITE.OPENSTREAM 68938 . 69477) (\LAFITE.CREATE.MENU 69479 . 69832) (\LAFITE.EOF 69834 . 70654) (
\LAFITE.CLOSE.FOLDER 70656 . 71500) (MAILFOLDERBUSY 71502 . 71636)) (71639 80831 (COPY7BITFILE 71649
. 72351) (\LAFITE.BROWSE.LAURELFILE 72353 . 72489) (\LAFITE.NOTICE.FOLDERS 72491 . 74546) (
\LAFITE.MAKE.RANDOM.DISPLAY 74548 . 75326) (\LAFITE.GC.FOLDERS 75328 . 76722) (
\LAFITE.GC.FOLDERS.CONFIRM 76724 . 77614) (\LAFITE.SET.NEW.FOLDERS 77616 . 78076) (
\LAFITE.RENAME.FOLDER 78078 . 79655) (\LAFITE.DESCRIBE.FOLDER 79657 . 80229) (
\LAFITE.FIX.LAUREL.FOLDER 80231 . 80829)) (80892 81956 (LOAD-LAFITE 80902 . 81954)) (82437 82904 (
RELEASE.LAFITE 82447 . 82902)) (87410 88627 (\LAFITE.GLOBAL.INIT 87420 . 88625)))))
STOP