Finish cleanup

.gitignore

@@ -9,10 +9,11 @@
 # older versions
 # leave in for now
 # *~
-# *#
+# *\#
 # \.#*
 # *#
 
 # core files
 
+core
 

README-WINDOWS.txt

@@ -0,0 +1,23 @@
+
+To set up to run medley on Windows:
+
+You need either Docker for Desktop or WSL2.
+
+If you have Docker you can just docker run interlisp/medley
+use a VNC client to connect to localhost
+
+If you want to run under WSL:
+
+Get a windows X server called Xming, the default options will do:
+
+     https://sourceforge.net/projects/xming/
+
+Make Maiko following the instructions there, and 
+copy lde ldex from linux.x86_64 into your path (/usr/local/bin)
+
+export MEDLEYDIR=/mnt/c/path-to-medley-directory
+export HOME=/mnt/c/path-to-windows-home
+export DISPLAY=:0
+export LDEINIT="$MEDLEYDIR"/greetfiles/local-init
+
+lde -screen 1440x800 -g 1440x800 -d your-machine-ip:0 -bw 0 -t "Medley Interlisp" medley/loadups/xfull35.sysout &

README.md

@@ -1,29 +1,35 @@
 # medley 
-This repo is for the overall Lisp environment for Medley / Interlisp-D / Xerox Common Lisp.
-A sub-project is Interlisp/maiko which is the emulator of the Lisp virtual machine. 
+This repo is for the overall Lisp environment for Medley Interlisp.
 
-NOTES:
+A sub-project is Interlisp/maiko which is the emulator of the Lisp virtual machine. 
 
 At the moment we're still in the process of sorting out what we have and insuring we start with a solid base.
 
-File Names and Extensions: Most Interlisp source file names are UPPERCASE and Interlisp didn't use file extensions for its source files.
-(note that any .TEDIT or .TXT file is probably documentation for the package of same name, at least in the library, internal/library, lispusers)
-The current repo has only Lisp sources with .LCOM and .DFASL in .gitignore. But many files don't compile in a vanilla lisp.sysout ;
-there is a file of external declarations (EXPORTS.ALL) and something called ABC that has some other record package declarations.
+File Names and Extensions: Most Interlisp source file names are
+UPPERCASE and Interlisp didn't use file extensions for its source
+files.  (note that any .TEDIT or .TXT file is probably documentation
+for the package of same name, at least in the library,
+internal/library, lispusers)
 
-- get the binaries lde ldex for your machine (darwin.x86_64 (mac) linux.x86_64 (linux, use VirtualBox for windows) linux.arm7l (for Raspberry Pi 4b)
-- 'run-medley -xfull35' should run the xfull35 sysout in the 'loadups' directory
+The current repo has both Lisp sources and compiled .LCOM and .DFASL
+files, because some files don't compile in a vanilla lisp.sysout .
 
 Each directory should have a README.md, but briefly
+- basics -- old sysouts needed (for now) for rebuilding new sysouts
 - docs -- Documentation files (either PDFs or online help)
-- fonts -- raster fonts in various resolutions for display, postscript, interpress, press formats)
-- initfiles -- should have any necessary setup of directories Lisp should look in for load
+- fonts -- raster fonts (or font widths) in various resolutions for display, postscript, interpress, press formats
+- greetfiles -- should have any necessary setup of directories Lisp should look in for load
 - internal -- These _were_ internal to Venue
 - library  -- packages that were supported (30 years ago)
 - lispusers -- packages that were only half supported (ditto)
 - loadups   -- has sysouts and other builds
-- sources   -- sources for Interlisp and Common Lisp implementations)
+- makesysout -- files for making new sysouts for various configurations, based on basics
+- patches -- ""
+- sunloadup --  support information for making a new lisp.sysout from scratch
+- sources   -- sources for Interlisp and Common Lisp implementations
+- unicode  -- data files for support of XCCS to and from Unicode mappings
 
-Note that Interlisp and Common Lisp functions have different compilers, but it's all freely intermixed.
+plus
+   Dockerfile, and scripts for building and running medley
 
 

fonts/adobe/DISPLAYFONTCOERCIONS

@@ -0,0 +1 @@
+(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")

library/lafite/LAFITE

@@ -0,0 +1,890 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
(FILECREATED "22-Aug-94 13:00:22" {DSK}<king>export>lispcore>lafite>parc-94>LAFITE.;2
 73704  
+
+      previous date%: " 6-Aug-93 15:49:08" {DSK}<king>export>lispcore>lafite>parc-94>LAFITE.;1)
+
+
+(* ; "
+Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1993, 1994 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 LAFITE.TOGGLE.SERVER.TRACE)
+              (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 '("Mail" '(\LAFITE.MESSAGEFORM NIL NIL 'LEFT)
+                                                     
+                                   "Send an ordinary message.  See subcommands for other operations."
+                                                     (SUBITEMS ("Turn Lafite on" '(
+                                                                            LAFITE.ON.FROM.BACKGROUND
+                                                                                   )
+                                                                      
+                             "Turn on Lafite, bringing up status window and browsing default folder."
+                                                                      )
+                                                            ("Send Mail" '(\LAFITE.MESSAGEFORM)
+                                                                   
+                                                      "Send a message.  Prompts for type of message."
+                                                                   )
+                                                            ("Set Lafite Mode" '(
+                                                                        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)
+               (\LAFITE.TEMPFILES)
+               (\LAFITE.MODE.CHOICES)
+               (LAFITESUBQUITMENU))
+        (ADDVARS (LAFITEMENUVARS LAFITESUBQUITMENU))
+        (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                                                (* ; "misc utilities")

+              (FNS LA.RESETSHADE LA.MENU.ITEM NTHMESSAGE \LAFITE.MAKE.MSGARRAY 
+                   \LAFITE.ADDMESSAGES.TO.ARRAY \MAILFOLDER.DEFPRINT \LAFITEMSG.DEFPRINT 
+                   LA.POSITION.FROM.REGION MAILFOLDERBUSY)
+              (CURSORS LA.CROSSCURSOR)
+                                                             (* ; "Low level file functions")

+              (FNS TOCFILENAME 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)
+              (FNS \LAFITE.DESCRIBE.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 TEDIT.DEFAULT.MENU LAFITEFILES *COMPILED-EXTENSIONS*)
+               (P (CL:PROCLAIM '(CL:SPECIAL *LAFITE-LOGGING-IN*]
+        (INITRECORDS MAILFOLDER LAFITEMSG)
+        (SYSRECORDS MAILFOLDER LAFITEMSG)
+        [COMS (FNS \LAFITE.GLOBAL.INIT)
+              (DECLARE%: DONTEVAL@LOAD DOCOPY
+                     (FILES LAFITEBROWSE LAFITECOMMANDS LAFITEFOLDERS LAFITESEND LAFITEMAIL 
+                            LAFITESORT TEDIT LAFITETEDIT LAFITEFIND ATTACHEDWINDOW MAILSCAVENGE)
+                     (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? 'PROMPTFORWORD 'TTYINPROMPTFORWORD NIL T]
+        (DECLARE%: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
+                                                                           (NLAML)
+                                                                           (LAMA LAFITE])
+
+(RPAQQ LAFITEVERSION#
 10)
+
+(RPAQQ LAFITESYSTEMDATE
 "22-Aug-94 13:00:29")
+(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 10-Aug-89 17:21 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 LAFITE.FOLDER.STRUCTURE (SETQ LAFITEMAILFOLDERS (SETQ LAFITEFORMFILES NIL))) (SETQ LAFITE.UPDATE.MENU.HASH (HASHARRAY 5)) (\LAFITE.READ.PROFILE) (LAFITE.COMPUTE.CACHED.VARS) (SETQ \LAFITE.READY T) (pushnew \AFTERLOGINFNS (FUNCTION \LAFITE.AFTERLOGIN)) (pushnew AROUNDEXITFNS (FUNCTION LAFITE.AROUNDEXIT)) (SETQ \LAFITE.ACTIVE T) (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  3-Jun-92 17:46 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) (for FIELD in (EVALV USERVAR) collect (if (STRING-EQUAL FIELD "GV") then (* ; "Kludge!  Designed to eat GVGV nonsense that comes AFTER the header") (LIST (QUOTE %
+) (FUNCTION LAFITE.EAT.GVGV)) elseif (EQ FIELD :ORIGINAL) then (LIST "Original-" (FUNCTION LAFITE.HANDLE.ORIGINAL.FIELD)) else (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  3-May-89 19:19 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? (\LAFITE.CREATE.MENU (APPEND (fetch (MENU ITEMS) of (LAB.CHOOSE.UPDATE.MENU HOW? :CLOSE)) (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.HASH (SETQ LAFITEMAINMENU (SETQ LAFITESTATUSWINDOW NIL))))))) (for VAR in LAFITEMENUVARS do (* ; "Clear cached menus") (SET VAR NIL)) (RETURN T))))
+)
+
+(\LAFITEDEFAULTHOST&DIR

+(LAMBDA (HOST&DIR) (* ; "Edited 10-Feb-89 12:53 by bvm") (PROG ((*UPPER-CASE-FILE-NAMES* NIL) (OLDHOST&DIR (fetch PACKEDHOST&DIR of \LAFITEDEFAULTHOST&DIR)) UNPACKED CANONICAL) (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 ((NULL (SETQ CANONICAL (DIRECTORYNAME HOST&DIR))) (printout PROMPTWINDOW T "Warning: " HOST&DIR " not a recognized directory")) (T (SETQ HOST&DIR CANONICAL))) (* ; "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))
+)
+
+(LAFITE.TOGGLE.SERVER.TRACE

+(LAMBDA NIL (* ; "Edited 24-Jul-92 15:14 by bvm") (LET ((CHOICE (MENU (create MENU ITEMS _ (QUOTE (("Quiet" 0 "Don't report server") ("Report" T "Just report server in prompt window") ("Require Confirmation" :ASK "Require approval for posting server choice"))) CENTERFLG _ T TITLE _ "Trace Posting Server?")))) (if CHOICE then (PRINTOUT PROMPTWINDOW T "*NSMAIL-TRACE-SERVERS* = " (SETQ *NSMAIL-TRACE-SERVERS* (AND (NEQ CHOICE 0) CHOICE))))))
+)
+)
+
+(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
 '("Mail" '(\LAFITE.MESSAGEFORM NIL NIL 'LEFT)
+                                          
+                                   "Send an ordinary message.  See subcommands for other operations."
+                                          (SUBITEMS ("Turn Lafite on" '(LAFITE.ON.FROM.BACKGROUND)
+                                                           
+                             "Turn on Lafite, bringing up status window and browsing default folder."
+                                                           )
+                                                 ("Send Mail" '(\LAFITE.MESSAGEFORM)
+                                                        
+                                                      "Send a message.  Prompts for type of message."
+                                                        )
+                                                 ("Set Lafite Mode" '(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 '(HELVETICA 10 BOLD]
+                              [LAFITETITLEFONT (FONTCREATE '(HELVETICA 12 BOLD]
+                              [LAFITEDISPLAYFONT (FONTCREATE '(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 '(GACHA 10]
+                              (LAFITEHARDCOPYFONT LAFITEDISPLAYFONT)
+                              [LAFITEBROWSERFONT (FONTCREATE '(GACHA 10]
+                              [LAFITEMSGICONFONT (FONTCREATE '(HELVETICA 8]
+                              (LAFITE.FOLDER.MENU.FONT NIL)
+                              (LAFITEINFO.NAME "Lafite.info")
+                              (DEFAULTMAILFOLDERNAME "Active.mail")
+                              (LAFITEMAIL.EXT "mail")
+                              (LAFITESTATUSWINDOWMINWIDTH 200)
+                              (LAFITESTATUSWINDOWPOSITION '(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 '(HELVETICA 10 BOLD)))
+
+(RPAQ? LAFITETITLEFONT
 (FONTCREATE '(HELVETICA 12 BOLD)))
+
+(RPAQ? LAFITEDISPLAYFONT
 (FONTCREATE '(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 '(GACHA 10])
+
+(RPAQ? LAFITEHARDCOPYFONT
 LAFITEDISPLAYFONT)
+
+(RPAQ? LAFITEBROWSERFONT
 (FONTCREATE '(GACHA 10)))
+
+(RPAQ? LAFITEMSGICONFONT
 (FONTCREATE '(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
 '(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" '\LAFITE.BROWSE 
+                                          "Browse a mail file; MIDDLE for subcommands")
+                                   ("Send Mail" '\LAFITE.MESSAGEFORM 
+                                      "Open a message composition window; MIDDLE for choice of forms"
+                                          )
+                                   ("Quit" '\LAFITE.QUIT 
+                                          "Update and close all mail files and stop Lafite")))
+
+(RPAQQ LAFITEUPDATEMENUITEMS
 (("Do Hardcopy Only" '\LAFITE.HARDCOPYONLY.PROC 
+                                         "Will print batched hardcopy but not update file")
+                                  ("Write out changes only" '\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" '\LAFITE.EXPUNGE.PROC 
+                                         "Will rewrite mail file, expunging all deleted messages")
+                                  ("Write changes in sorted order" '\LAFITE.EXPUNGE.PROC "Will rewrite mail file so that the messages are permanently stored in the order in which they now appear in the browser."
+                                         )
+                                  ("Expunge & Write out changes (sorted)" '\LAFITE.EXPUNGE.PROC "Will rewrite mail file, expunging deleted messages and writing writing the rest in the order in which they now appear in the browser."
+                                         )
+                                  ("Just close" '\LAFITE.FINISH.UPDATE 
+                                         "Just close the window - don't touch the mail file.")
+                                  ("Just shrink" '\LAFITE.FINISH.UPDATE 
+                                         "Just shrink the window - don't touch the mail file.")))
+
+(RPAQQ LAFITESUBQUITMENUITEMS
 (("Quit" '\LAFITE.QUIT "Turn Lafite off")
+                                   ("Restart" '\LAFITE.RESTART "Turn Lafite off then back on")
+                                   ("Login" '\LAFITE.LOGIN 
+                          "Change the global username/password and restart Lafite with the new user."
+                                          (SUBITEMS ("Just re-authenticate" '\LAFITE.REAUTHENTICATE 
+                                                          "Re-authenticate currently logged-in user."
+                                                           )
+                                                 ("Login without restarting" 
+                                                        '\LAFITE.LOGIN.NORESTART 
+                 "Change the global login but don't restart Lafite (keep the same folders open, etc)"
+                                                        )
+                                                 ("NS Login" '\NSMAIL.LOGIN 
+                                                  "Change the name and/or password for NS operation."
+                                                        )))
+                                   ("Recache" 'LAFITE.COMPUTE.CACHED.VARS 
+                        "Make Lafite recompute cached information based on current variable settings"
+                                          )
+                                   ("Server trace" 'LAFITE.TOGGLE.SERVER.TRACE 
+                                          "Change setting of *NSMAIL-TRACE-SERVERS*")))
+
+(RPAQQ ANOTHERFOLDERMENUITEM
 ("** Other Folder **" '%##ANOTHERFILE## 
+                                        "You will be asked to specify another mail filename"))
+
+(RPAQ? LAFITESTATUSWINDOW
 )
+
+(RPAQ? \ACTIVELAFITEFOLDERS
 )
+
+(RPAQ? \LAFITE.TEMPFILES
 )
+
+(RPAQ? \LAFITE.MODE.CHOICES
 )
+
+(RPAQ? LAFITESUBQUITMENU
 )
+
+(ADDTOVAR LAFITEMENUVARS
 LAFITESUBQUITMENU)
+
+(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)))))
+)
+)
+
+
+
+(* ; "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"))
+)
+
+(\LAFITEMSG.DEFPRINT

+(LAMBDA (MSG STREAM) (* ; "Edited 21-Apr-89 16:07 by bvm") (\DEFPRINT.BY.NAME MSG STREAM (fetch (LAFITEMSG %#) of MSG) "Lafite msg #"))
+)
+
+(LA.POSITION.FROM.REGION

+(LAMBDA (REG XOFFSET YOFFSET) (* ; "Edited 18-Apr-89 14:43 by bvm") (* ;; "Returns a POSITION at the lower left corner of REG, optionally offset by XOFFSET and YOFFSET (T means entire window dimension).") (create POSITION XCOORD _ (+ (fetch (REGION LEFT) of REG) (SELECTQ XOFFSET (NIL 0) (T (fetch (REGION WIDTH) of REG)) XOFFSET)) YCOORD _ (+ (fetch (REGION BOTTOM) of REG) (SELECTQ YOFFSET (NIL 0) (T (fetch (REGION HEIGHT) of REG)) YOFFSET))))
+)
+
+(MAILFOLDERBUSY

+(LAMBDA (MAILFOLDER) (* bvm%: "29-Dec-83 18:11") (RESETFORM (CURSOR LA.CROSSCURSOR) (BLOCK LAFITEBUSYWAITTIME)))
+)
+)
+(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))
+
+
+
+(* ; "Low level file functions")

+
+(DEFINEQ
+
+(TOCFILENAME

+(LAMBDA (FOLDER) (* ; "Edited  1-May-89 12:58 by bvm") (* ;; "Return the name of the toc file corresponding to mail file FOLDER (a folder object or full file name).") (if FOLDER then (if (type? MAILFOLDER FOLDER) then (SETQ FOLDER (fetch (MAILFOLDER FULLFOLDERNAME) of FOLDER))) (PACKFILENAME.STRING (QUOTE EXTENSION) (CONCAT (UNPACKFILENAME.STRING FOLDER (QUOTE EXTENSION)) LAFITETOC.EXT) (QUOTE BODY) FOLDER)))
+)
+
+(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 PROMPTFOLDER) (* ; "Edited  5-Aug-93 19:48 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.") (* ;;; "If PROMPTFOLDER is given, will prompt to confirm creating file if it doesn't exist") (PROG ((*UPPER-CASE-FILE-NAMES* NIL) (STREAM (fetch (MAILFOLDER FOLDERSTREAM) of FOLDER)) (DESIREDACCESS (COND ((EQ ACCESS (QUOTE INPUT)) ACCESS) (T (QUOTE BOTH)))) (RECOG (AND PROMPTFOLDER (QUOTE OLD))) NEWLENGTH NEWDATE NEWESTDATE CHANGED WASOPEN CONDITION) RETRY (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 (SETQ STREAM 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!)) (CL:MULTIPLE-VALUE-SETQ (STREAM CONDITION) (IGNORE-ERRORS (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)))) (* ;; "Finally open it. Ask for big buffers if there's a browser for it.") (\LAFITE.OPENSTREAM (fetch (MAILFOLDER FULLFOLDERNAME) of FOLDER) DESIREDACCESS NIL (FUNCTION \LAFITE.EOF) (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER) (QUOTE LAFITE)))) (if CONDITION then (* ; "Failed to open") (if (AND (EQ RECOG (QUOTE OLD)) (TYPEP CONDITION (QUOTE XCL:FILE-NOT-FOUND))) then (* ; "Just couldn't find it, so maybe create it.  If RECOG was NEW, we normally shouldn't be getting this error") (if (LAB.MOUSECONFIRM PROMPTFOLDER "Click LEFT to confirm creating ~A" (fetch (MAILFOLDER SHORTFOLDERNAME) of FOLDER)) then (SETQ RECOG (QUOTE NEW)) (SETQ ACCESS (QUOTE BOTH)) (GO RETRY) else (* ; "Disconfirmed the create request."))) (* ; "Some problem opening file.  Avoid break window--just abort.") (\LAFITE.REPORT.FILE.WONT.OPEN FOLDER CONDITION) (ERROR!)) (if (EQ DESIREDACCESS (QUOTE BOTH)) then (* ;; "So that LA.PRINTCOUNT won't introduce CR's.  Would be nice if PRINTNUM could be given a PRIN3 mode") (LINELENGTH MAX.SMALLP STREAM)) (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 (EQL NEWLENGTH (fetch (MAILFOLDER FOLDEREOFPTR) of FOLDER))) (AND (OR NEWDATE (SETQ NEWDATE NEWESTDATE)) (NOT (EQL NEWDATE (fetch (MAILFOLDER FOLDERCREATIONDATE) of FOLDER))))) then (* ; "Folder has changed since we last touched it.  (Use eql instead of = to work around as yet unknown problem where the folder's field is NIL).") (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 20-Apr-89 19:35 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") (LA.POSITION.FROM.REGION 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))))))
+)
+)
+(DEFINEQ
+
+(\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)))
+)
+)
+
+
+
+(* ; "Make is easy to load new versions of Lafite")

+
+(DEFINEQ
+
+(LOAD-LAFITE

+(LAMBDA (DIR SOURCEP) (* ; "Edited  3-May-89 18:39 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 (COND ((NOT SOURCEP) (QUOTE SYSLOAD)) ((EQ F (QUOTE LAFITEDECLS)) T) (T (QUOTE PROP))))) (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 LAFITEFOLDERS LAFITEMAIL LAFITESEND 
+                              LAFITESORT LAFITETEDIT NSMAIL OLDNSMAIL NEWNSMAIL LAFITEFIND 
+                              MAILSCAVENGE LAFITE))
+(DECLARE%: DOEVAL@COMPILE DONTCOPY 
+
+(FILESLOAD (SOURCE)
+       LAFITEDECLS)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(LOCALVARS . T)
+)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS TEDIT.DEFAULT.MENU LAFITEFILES *COMPILED-EXTENSIONS*)
+)
+
+
+(CL:PROCLAIM '(CL:SPECIAL *LAFITE-LOGGING-IN*))
+)
+
+(/DECLAREDATATYPE 'MAILFOLDER
+       '(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)
+       '((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 2 POINTER)
+         (MAILFOLDER 2 (FLAGBITS . 0))
+         (MAILFOLDER 2 (FLAGBITS . 16))
+         (MAILFOLDER 2 (FLAGBITS . 32))
+         (MAILFOLDER 2 (FLAGBITS . 48))
+         (MAILFOLDER 1 (FLAGBITS . 0))
+         (MAILFOLDER 1 (FLAGBITS . 16))
+         (MAILFOLDER 1 (FLAGBITS . 32))
+         (MAILFOLDER 1 (FLAGBITS . 48))
+         (MAILFOLDER 4 POINTER)
+         (MAILFOLDER 6 POINTER)
+         (MAILFOLDER 8 POINTER)
+         (MAILFOLDER 10 POINTER)
+         (MAILFOLDER 12 POINTER)
+         (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 (BITS . 15))
+         (MAILFOLDER 29 (BITS . 15))
+         (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)
+         (MAILFOLDER 64 POINTER))
+       '66)
+
+(/DECLAREDATATYPE 'LAFITEMSG
+       '(FLAG FLAG FLAG FLAG FLAG (BITS 3)
+              BYTE WORD POINTER POINTER WORD WORD FLAG FLAG FLAG FLAG POINTER FLAG FLAG FLAG FLAG 
+              POINTER POINTER POINTER FIXP)
+       '((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 (BITS . 135))
+         (LAFITEMSG 1 (BITS . 15))
+         (LAFITEMSG 2 POINTER)
+         (LAFITEMSG 4 POINTER)
+         (LAFITEMSG 6 (BITS . 15))
+         (LAFITEMSG 7 (BITS . 15))
+         (LAFITEMSG 4 (FLAGBITS . 0))
+         (LAFITEMSG 4 (FLAGBITS . 16))
+         (LAFITEMSG 4 (FLAGBITS . 32))
+         (LAFITEMSG 4 (FLAGBITS . 48))
+         (LAFITEMSG 8 POINTER)
+         (LAFITEMSG 8 (FLAGBITS . 0))
+         (LAFITEMSG 8 (FLAGBITS . 16))
+         (LAFITEMSG 8 (FLAGBITS . 32))
+         (LAFITEMSG 8 (FLAGBITS . 48))
+         (LAFITEMSG 10 POINTER)
+         (LAFITEMSG 12 POINTER)
+         (LAFITEMSG 14 POINTER)
+         (LAFITEMSG 16 FIXP))
+       '18)
+(ADDTOVAR SYSTEMRECLST
+
+(DATATYPE MAILFOLDER
 ((BROWSERPROMPTDIRTY FLAG)
+                          (BROWSERPROMPTGREW FLAG)
+                          (FOLDERNEEDSUPDATE FLAG)
+                          (FOLDERNEEDSEXPUNGE FLAG)
+                          (FOLDERBEINGUPDATED FLAG)
+                          (BROWSERSTATUS BITS 3)
+                          (FULLFOLDERNAME POINTER)
+                          (FOLDEROKTOSHRINK FLAG)
+                          (FOLDERGETSMAIL FLAG)
+                          (FOLDEROUTOFORDER FLAG)
+                          (NIL 5 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)
+                         (DATEKNOWN? FLAG)
+                         (DATEFETCHED? FLAG)
+                         (MODEBITS BITS 3)
+                         (MARKCHAR BYTE)
+                         (%# WORD)
+                         (BEGIN POINTER)
+                         (MESSAGELENGTH POINTER)
+                         (STAMPLENGTH WORD)
+                         (TOCLENGTH WORD)
+                         (MESSAGELENGTHCHANGED? FLAG)
+                         (SELECTED? FLAG)
+                         (MSGFROMMECHECKED? FLAG)
+                         (MSGFROMMETRUTH FLAG)
+                         (DATE POINTER)
+                         (NIL FLAG)
+                         (MARKSCHANGEDINFILE? FLAG)
+                         (MARKSCHANGEDINTOC? FLAG)
+                         (NIL FLAG)
+                         (FROM
 POINTER)
+                         (SUBJECT POINTER)
+                         (TO
 POINTER)
+                         (IDATE FIXP)))
+)
+(DEFINEQ
+
+(\LAFITE.GLOBAL.INIT

+(LAMBDA NIL (* ; "Edited 21-Apr-89 16:10 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)) (DEFPRINT (QUOTE LAFITEMSG) (FUNCTION \LAFITEMSG.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 LAFITEFOLDERS LAFITESEND LAFITEMAIL LAFITESORT TEDIT 
+       LAFITETEDIT LAFITEFIND ATTACHEDWINDOW MAILSCAVENGE)
+
+
+(CL:PROCLAIM '(GLOBAL ANSWERMARK BROWSERMARKXPOSITION DEFAULTMAILFOLDERNAME 
+                     LAFITE.2COLUMN.MENU.MIN.ITEMS LAFITE.AUTO.MOVE.MENU 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.DUMMY.HALF.SHADE LAFITE.DUMMY.SHADE 
+                     LAFITE.EDITOR.LAYOUTS LAFITE.EDITOR.SIZE LAFITE.EXTRA.DISPLAY.COMMANDS 
+                     LAFITE.EXTRA.MOVE.ITEMS 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 LAFITEEXTRAMENUITEMS LAFITEFIXEDWIDTHFONT LAFITEFORM.EXT 
+                     LAFITEFORMFILES LAFITEFROMFRACTION LAFITEHARDCOPY.MIN.TOC LAFITEHARDCOPYBATCHFLG
+                     LAFITEHARDCOPYBATCHSHADE LAFITEHARDCOPYFONT LAFITEHARDCOPYSEPARATOR 
+                     LAFITEIFFROMMETHENSEENFLG LAFITEINFO.NAME LAFITEMAIL.EXT LAFITEMENUFONT 
+                     LAFITEMENUVARS LAFITEMINFROMCHARS LAFITEMODEDEFAULT LAFITEMODELST 
+                     LAFITEMOVETOCONFIRMFLG LAFITEMSGICONFONT LAFITENEWPAGEFLG LAFITESHOWMODEFLG 
+                     LAFITESTATUSWINDOWMINWIDTH LAFITESTATUSWINDOWPOSITION LAFITESUBBROWSEMENUITEMS 
+                     LAFITESUBQUITMENUITEMS LAFITETITLEFONT LAFITETOC.EXT LAFITEUPDATEMENUITEMS 
+                     MOVETOMARK))
+
+(CL:PROCLAIM '(CL:SPECIAL LAFITEVERIFYFLG))
+
+
+(\LAFITE.GLOBAL.INIT
)
+
+(COND
+   ((EQ MAKESYSNAME :LYRIC)
+    (FILESLOAD (SYSLOAD)
+           NSCHARPATCH)                                      (* ; 
+
                                                           "Patch to horrid Lyric NS chars bug")

+    (MOVD? 'PROMPTFORWORD '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 1989 1993 1994))
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (7072 22118 (LAFITE 7082 . 8393) (LAFITE.ON.FROM.BACKGROUND 8395 . 8766) (\LAFITE.OFF 
+8768 . 9152) (\LAFITE.START.PROC 9154 . 10930) (LAFITE.COMPUTE.CACHED.VARS 10932 . 13634) (
+\LAFITE.PROCESS 13636 . 14002) (\LAFITE.START.ABORT 14004 . 14196) (\LAFITE.QUIT 14198 . 14440) (
+\LAFITE.RESTART 14442 . 14575) (\LAFITE.SUBQUIT 14577 . 15875) (\LAFITE.QUIT.PROC 15877 . 18613) (
+\LAFITEDEFAULTHOST&DIR 18615 . 19425) (LAFITEDEFAULTHOST&DIR 19427 . 19597) (MAKELAFITECOMMANDWINDOW 
+19599 . 21238) (EXTRACTMENUCOMMAND 21240 . 21488) (DOMAINLAFITECOMMAND 21490 . 21639) (
+LAFITE.TOGGLE.SERVER.TRACE 21641 . 22116)) (22189 25157 (LAFITEMODE 22199 . 22679) (\LAFITE.INFER.MODE
+ 22681 . 23034) (\LAFITE.SHOW.MODE 23036 . 23273) (\LAFITE.MODE.TITLE 23275 . 23560) (
+LAFITE.SHOW.MODE.P 23562 . 23803) (LAFITE.ALL.MODES.P 23805 . 24148) (SET.LAFITE.MODE.INTERACTIVELY 
+24150 . 24732) (\LAFITE.COMPUTE.MODE.COMMANDS 24734 . 25155)) (26410 28166 (\LAFITE.LOGIN 26420 . 
+26802) (\LAFITE.LOGIN.NORESTART 26804 . 26910) (LAFITE.PROMPT.FOR.LOGIN 26912 . 27931) (
+\LAFITE.REAUTHENTICATE 27933 . 28164)) (37585 41027 (LAFITE.AROUNDEXIT 37595 . 38133) (
+\LAFITE.MARK.FOLDERS.OBSOLETE 38135 . 39051) (\LAFITE.CHECK.FOLDERS 39053 . 39452) (
+\LAFITE.ASSURE.FOLDER.READY 39454 . 39864) (\LAFITE.AFTERLOGIN 39866 . 41025)) (41059 43997 (
+LA.RESETSHADE 41069 . 41447) (LA.MENU.ITEM 41449 . 41867) (NTHMESSAGE 41869 . 41952) (
+\LAFITE.MAKE.MSGARRAY 41954 . 42384) (\LAFITE.ADDMESSAGES.TO.ARRAY 42386 . 42967) (
+\MAILFOLDER.DEFPRINT 42969 . 43216) (\LAFITEMSG.DEFPRINT 43218 . 43380) (LA.POSITION.FROM.REGION 43382
+ . 43859) (MAILFOLDERBUSY 43861 . 43995)) (44175 60041 (TOCFILENAME 44185 . 44616) (DELETEMAILFOLDER 
+44618 . 45138) (\LAFITE.OPEN.FOLDER 45140 . 49755) (\LAFITE.REPORT.FILE.WONT.OPEN 49757 . 50481) (
+\LAFITE.FOLDER.CHANGED 50483 . 52887) (\LAFITE.REBROWSE.FOLDER 52889 . 55854) (
+\LAFITE.FOLDER.CHANGED.MENU 55856 . 56779) (\LAFITE.SET.FOLDER.STREAM 56781 . 57475) (
+\LAFITE.OPENSTREAM 57477 . 58016) (\LAFITE.CREATE.MENU 58018 . 58371) (\LAFITE.EOF 58373 . 59193) (
+\LAFITE.CLOSE.FOLDER 59195 . 60039)) (60042 60626 (\LAFITE.DESCRIBE.FOLDER 60052 . 60624)) (60687 
+61793 (LOAD-LAFITE 60697 . 61791)) (69504 70781 (\LAFITE.GLOBAL.INIT 69514 . 70779)))))
+STOP

library/lafite/LAFITE.~1~

@@ -0,0 +1,500 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
(FILECREATED " 6-Aug-93 15:49:08" {DSK}<archive>lafite>sources>lafite.;20
 63548  
+
+      changes to%:  (VARS LAFITEFILES LAFITESUBQUITMENUITEMS LAFITECOMS) (FNS \LAFITE.OPEN.FOLDER LAFITE.COMPUTE.CACHED.VARS)
+
+      previous date%: " 9-Nov-89 12:21:33" {DSK}<archive>lafite>sources>lafite.;18)
+
+
+(* ; "
+Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1993 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 LAFITE.TOGGLE.SERVER.TRACE) (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) (\LAFITE.TEMPFILES) (\LAFITE.MODE.CHOICES) (LAFITESUBQUITMENU)) (ADDVARS (LAFITEMENUVARS LAFITESUBQUITMENU)) (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 (* ; "misc utilities") (FNS LA.RESETSHADE LA.MENU.ITEM NTHMESSAGE \LAFITE.MAKE.MSGARRAY \LAFITE.ADDMESSAGES.TO.ARRAY \MAILFOLDER.DEFPRINT \LAFITEMSG.DEFPRINT LA.POSITION.FROM.REGION MAILFOLDERBUSY) (CURSORS LA.CROSSCURSOR) (* ; "Low level file functions") (FNS TOCFILENAME 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) (FNS \LAFITE.DESCRIBE.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 TEDIT.DEFAULT.MENU LAFITEFILES *COMPILED-EXTENSIONS*) (P (CL:PROCLAIM (QUOTE (CL:SPECIAL *LAFITE-LOGGING-IN*))))) (INITRECORDS MAILFOLDER LAFITEMSG) (SYSRECORDS MAILFOLDER LAFITEMSG) (COMS (FNS \LAFITE.GLOBAL.INIT) (DECLARE%: DONTEVAL@LOAD DOCOPY (FILES LAFITEBROWSE LAFITECOMMANDS LAFITEFOLDERS LAFITESEND LAFITEMAIL LAFITESORT TEDIT LAFITETEDIT LAFITEFIND ATTACHEDWINDOW MAILSCAVENGE) (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# 10)
+
+(RPAQQ LAFITESYSTEMDATE " 6-Aug-93 15:49:09")
+(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 10-Aug-89 17:21 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 LAFITE.FOLDER.STRUCTURE (SETQ LAFITEMAILFOLDERS (SETQ LAFITEFORMFILES NIL))) (SETQ LAFITE.UPDATE.MENU.HASH (HASHARRAY 5)) (\LAFITE.READ.PROFILE) (LAFITE.COMPUTE.CACHED.VARS) (SETQ \LAFITE.READY T) (pushnew \AFTERLOGINFNS (FUNCTION \LAFITE.AFTERLOGIN)) (pushnew AROUNDEXITFNS (FUNCTION LAFITE.AROUNDEXIT)) (SETQ \LAFITE.ACTIVE T) (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  3-Jun-92 17:46 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) (for FIELD in (EVALV USERVAR) collect (if (STRING-EQUAL FIELD "GV") then (* ; "Kludge!  Designed to eat GVGV nonsense that comes AFTER the header") (LIST (QUOTE %
+) (FUNCTION LAFITE.EAT.GVGV)) elseif (EQ FIELD :ORIGINAL) then (LIST "Original-" (FUNCTION LAFITE.HANDLE.ORIGINAL.FIELD)) else (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  3-May-89 19:19 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? (\LAFITE.CREATE.MENU (APPEND (fetch (MENU ITEMS) of (LAB.CHOOSE.UPDATE.MENU HOW? :CLOSE)) (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.HASH (SETQ LAFITEMAINMENU (SETQ LAFITESTATUSWINDOW NIL))))))) (for VAR in LAFITEMENUVARS do (* ; "Clear cached menus") (SET VAR NIL)) (RETURN T))))
+)
+
+(\LAFITEDEFAULTHOST&DIR

+(LAMBDA (HOST&DIR) (* ; "Edited 10-Feb-89 12:53 by bvm") (PROG ((*UPPER-CASE-FILE-NAMES* NIL) (OLDHOST&DIR (fetch PACKEDHOST&DIR of \LAFITEDEFAULTHOST&DIR)) UNPACKED CANONICAL) (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 ((NULL (SETQ CANONICAL (DIRECTORYNAME HOST&DIR))) (printout PROMPTWINDOW T "Warning: " HOST&DIR " not a recognized directory")) (T (SETQ HOST&DIR CANONICAL))) (* ; "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))
+)
+
+(LAFITE.TOGGLE.SERVER.TRACE

+(LAMBDA NIL (* ; "Edited 24-Jul-92 15:14 by bvm") (LET ((CHOICE (MENU (create MENU ITEMS _ (QUOTE (("Quiet" 0 "Don't report server") ("Report" T "Just report server in prompt window") ("Require Confirmation" :ASK "Require approval for posting server choice"))) CENTERFLG _ T TITLE _ "Trace Posting Server?")))) (if CHOICE then (PRINTOUT PROMPTWINDOW T "*NSMAIL-TRACE-SERVERS* = " (SETQ *NSMAIL-TRACE-SERVERS* (AND (NEQ CHOICE 0) CHOICE))))))
+)
+)
+
+(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") ("Write changes in sorted order" (QUOTE \LAFITE.EXPUNGE.PROC) "Will rewrite mail file so that the messages are permanently stored in the order in which they now appear in the browser.") ("Expunge & Write out changes (sorted)" (QUOTE \LAFITE.EXPUNGE.PROC) "Will rewrite mail file, expunging deleted messages and writing writing the rest in the order in which they now appear in the browser.") ("Just close" (QUOTE \LAFITE.FINISH.UPDATE) "Just close the window - don't touch the mail file.") ("Just shrink" (QUOTE \LAFITE.FINISH.UPDATE) "Just shrink the window - don't touch the mail file.")))
+
+(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)") ("NS Login" (QUOTE \NSMAIL.LOGIN) "Change the name and/or password for NS operation."))) ("Recache" (QUOTE LAFITE.COMPUTE.CACHED.VARS) "Make Lafite recompute cached information based on current variable settings") ("Server trace" (QUOTE LAFITE.TOGGLE.SERVER.TRACE) "Change setting of *NSMAIL-TRACE-SERVERS*")))
+
+(RPAQQ ANOTHERFOLDERMENUITEM ("** Other Folder **" (QUOTE %##ANOTHERFILE##) "You will be asked to specify another mail filename"))
+
+(RPAQ? LAFITESTATUSWINDOW)
+
+(RPAQ? \ACTIVELAFITEFOLDERS)
+
+(RPAQ? \LAFITE.TEMPFILES)
+
+(RPAQ? \LAFITE.MODE.CHOICES)
+
+(RPAQ? LAFITESUBQUITMENU)
+
+(ADDTOVAR LAFITEMENUVARS LAFITESUBQUITMENU)
+
+(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)))))
+)
+)
+
+
+
+(* ; "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"))
+)
+
+(\LAFITEMSG.DEFPRINT

+(LAMBDA (MSG STREAM) (* ; "Edited 21-Apr-89 16:07 by bvm") (\DEFPRINT.BY.NAME MSG STREAM (fetch (LAFITEMSG %#) of MSG) "Lafite msg #"))
+)
+
+(LA.POSITION.FROM.REGION

+(LAMBDA (REG XOFFSET YOFFSET) (* ; "Edited 18-Apr-89 14:43 by bvm") (* ;; "Returns a POSITION at the lower left corner of REG, optionally offset by XOFFSET and YOFFSET (T means entire window dimension).") (create POSITION XCOORD _ (+ (fetch (REGION LEFT) of REG) (SELECTQ XOFFSET (NIL 0) (T (fetch (REGION WIDTH) of REG)) XOFFSET)) YCOORD _ (+ (fetch (REGION BOTTOM) of REG) (SELECTQ YOFFSET (NIL 0) (T (fetch (REGION HEIGHT) of REG)) YOFFSET))))
+)
+
+(MAILFOLDERBUSY

+(LAMBDA (MAILFOLDER) (* bvm%: "29-Dec-83 18:11") (RESETFORM (CURSOR LA.CROSSCURSOR) (BLOCK LAFITEBUSYWAITTIME)))
+)
+)
+(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))
+
+
+
+(* ; "Low level file functions")

+
+(DEFINEQ
+
+(TOCFILENAME

+(LAMBDA (FOLDER) (* ; "Edited  1-May-89 12:58 by bvm") (* ;; "Return the name of the toc file corresponding to mail file FOLDER (a folder object or full file name).") (if FOLDER then (if (type? MAILFOLDER FOLDER) then (SETQ FOLDER (fetch (MAILFOLDER FULLFOLDERNAME) of FOLDER))) (PACKFILENAME.STRING (QUOTE EXTENSION) (CONCAT (UNPACKFILENAME.STRING FOLDER (QUOTE EXTENSION)) LAFITETOC.EXT) (QUOTE BODY) FOLDER)))
+)
+
+(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 PROMPTFOLDER) (* ; "Edited  5-Aug-93 19:48 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.") (* ;;; "If PROMPTFOLDER is given, will prompt to confirm creating file if it doesn't exist") (PROG ((*UPPER-CASE-FILE-NAMES* NIL) (STREAM (fetch (MAILFOLDER FOLDERSTREAM) of FOLDER)) (DESIREDACCESS (COND ((EQ ACCESS (QUOTE INPUT)) ACCESS) (T (QUOTE BOTH)))) (RECOG (AND PROMPTFOLDER (QUOTE OLD))) NEWLENGTH NEWDATE NEWESTDATE CHANGED WASOPEN CONDITION) RETRY (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 (SETQ STREAM 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!)) (CL:MULTIPLE-VALUE-SETQ (STREAM CONDITION) (IGNORE-ERRORS (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)))) (* ;; "Finally open it. Ask for big buffers if there's a browser for it.") (\LAFITE.OPENSTREAM (fetch (MAILFOLDER FULLFOLDERNAME) of FOLDER) DESIREDACCESS NIL (FUNCTION \LAFITE.EOF) (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER) (QUOTE LAFITE)))) (if CONDITION then (* ; "Failed to open") (if (AND (EQ RECOG (QUOTE OLD)) (TYPEP CONDITION (QUOTE XCL:FILE-NOT-FOUND))) then (* ; "Just couldn't find it, so maybe create it.  If RECOG was NEW, we normally shouldn't be getting this error") (if (LAB.MOUSECONFIRM PROMPTFOLDER "Click LEFT to confirm creating ~A" (fetch (MAILFOLDER SHORTFOLDERNAME) of FOLDER)) then (SETQ RECOG (QUOTE NEW)) (SETQ ACCESS (QUOTE BOTH)) (GO RETRY) else (* ; "Disconfirmed the create request."))) (* ; "Some problem opening file.  Avoid break window--just abort.") (\LAFITE.REPORT.FILE.WONT.OPEN FOLDER CONDITION) (ERROR!)) (if (EQ DESIREDACCESS (QUOTE BOTH)) then (* ;; "So that LA.PRINTCOUNT won't introduce CR's.  Would be nice if PRINTNUM could be given a PRIN3 mode") (LINELENGTH MAX.SMALLP STREAM)) (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 (EQL NEWLENGTH (fetch (MAILFOLDER FOLDEREOFPTR) of FOLDER))) (AND (OR NEWDATE (SETQ NEWDATE NEWESTDATE)) (NOT (EQL NEWDATE (fetch (MAILFOLDER FOLDERCREATIONDATE) of FOLDER))))) then (* ; "Folder has changed since we last touched it.  (Use eql instead of = to work around as yet unknown problem where the folder's field is NIL).") (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 20-Apr-89 19:35 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") (LA.POSITION.FROM.REGION 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))))))
+)
+)
+(DEFINEQ
+
+(\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)))
+)
+)
+
+
+
+(* ; "Make is easy to load new versions of Lafite")

+
+(DEFINEQ
+
+(LOAD-LAFITE

+(LAMBDA (DIR SOURCEP) (* ; "Edited  3-May-89 18:39 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 (COND ((NOT SOURCEP) (QUOTE SYSLOAD)) ((EQ F (QUOTE LAFITEDECLS)) T) (T (QUOTE PROP))))) (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 LAFITEFOLDERS LAFITEMAIL LAFITESEND LAFITESORT LAFITETEDIT NSMAIL OLDNSMAIL NEWNSMAIL LAFITEFIND MAILSCAVENGE LAFITE))
+(DECLARE%: DOEVAL@COMPILE DONTCOPY 
+
+(FILESLOAD (SOURCE) LAFITEDECLS)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(LOCALVARS . T)
+)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS TEDIT.DEFAULT.MENU LAFITEFILES *COMPILED-EXTENSIONS*)
+)
+
+
+(CL:PROCLAIM (QUOTE (CL:SPECIAL *LAFITE-LOGGING-IN*)))
+)
+
+(/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 FIXP)) (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) (LAFITEMSG 16 FIXP))) (QUOTE 18))
+(ADDTOVAR SYSTEMRECLST
+
+(DATATYPE MAILFOLDER
 ((BROWSERPROMPTDIRTY FLAG) (BROWSERPROMPTGREW FLAG) (FOLDERNEEDSUPDATE FLAG) (FOLDERNEEDSEXPUNGE FLAG) (FOLDERBEINGUPDATED FLAG) (BROWSERSTATUS BITS 3) (FULLFOLDERNAME POINTER) (FOLDEROKTOSHRINK FLAG) (FOLDERGETSMAIL FLAG) (FOLDEROUTOFORDER FLAG) (NIL 5 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) (DATEKNOWN? FLAG) (DATEFETCHED? 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) (IDATE FIXP))
+)
+)
+(DEFINEQ
+
+(\LAFITE.GLOBAL.INIT

+(LAMBDA NIL (* ; "Edited 21-Apr-89 16:10 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)) (DEFPRINT (QUOTE LAFITEMSG) (FUNCTION \LAFITEMSG.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 LAFITEFOLDERS LAFITESEND LAFITEMAIL LAFITESORT TEDIT LAFITETEDIT LAFITEFIND ATTACHEDWINDOW MAILSCAVENGE)
+
+
+(CL:PROCLAIM (QUOTE (GLOBAL ANSWERMARK BROWSERMARKXPOSITION DEFAULTMAILFOLDERNAME LAFITE.2COLUMN.MENU.MIN.ITEMS LAFITE.AUTO.MOVE.MENU 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.DUMMY.HALF.SHADE LAFITE.DUMMY.SHADE LAFITE.EDITOR.LAYOUTS LAFITE.EDITOR.SIZE LAFITE.EXTRA.DISPLAY.COMMANDS LAFITE.EXTRA.MOVE.ITEMS 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 LAFITEEXTRAMENUITEMS LAFITEFIXEDWIDTHFONT LAFITEFORM.EXT LAFITEFORMFILES LAFITEFROMFRACTION LAFITEHARDCOPY.MIN.TOC LAFITEHARDCOPYBATCHFLG LAFITEHARDCOPYBATCHSHADE LAFITEHARDCOPYFONT LAFITEHARDCOPYSEPARATOR LAFITEIFFROMMETHENSEENFLG LAFITEINFO.NAME LAFITEMAIL.EXT LAFITEMENUFONT LAFITEMENUVARS LAFITEMINFROMCHARS LAFITEMODEDEFAULT LAFITEMODELST LAFITEMOVETOCONFIRMFLG LAFITEMSGICONFONT LAFITENEWPAGEFLG LAFITESHOWMODEFLG LAFITESTATUSWINDOWMINWIDTH LAFITESTATUSWINDOWPOSITION LAFITESUBBROWSEMENUITEMS LAFITESUBQUITMENUITEMS LAFITETITLEFONT LAFITETOC.EXT LAFITEUPDATEMENUITEMS MOVETOMARK)))
+
+(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 1989 1993))
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (4282 19328 (LAFITE 4292 . 5603) (LAFITE.ON.FROM.BACKGROUND 5605 . 5976) (\LAFITE.OFF 
+5978 . 6362) (\LAFITE.START.PROC 6364 . 8140) (LAFITE.COMPUTE.CACHED.VARS 8142 . 10844) (
+\LAFITE.PROCESS 10846 . 11212) (\LAFITE.START.ABORT 11214 . 11406) (\LAFITE.QUIT 11408 . 11650) (
+\LAFITE.RESTART 11652 . 11785) (\LAFITE.SUBQUIT 11787 . 13085) (\LAFITE.QUIT.PROC 13087 . 15823) (
+\LAFITEDEFAULTHOST&DIR 15825 . 16635) (LAFITEDEFAULTHOST&DIR 16637 . 16807) (MAKELAFITECOMMANDWINDOW 
+16809 . 18448) (EXTRACTMENUCOMMAND 18450 . 18698) (DOMAINLAFITECOMMAND 18700 . 18849) (
+LAFITE.TOGGLE.SERVER.TRACE 18851 . 19326)) (19395 22363 (LAFITEMODE 19405 . 19885) (\LAFITE.INFER.MODE
+ 19887 . 20240) (\LAFITE.SHOW.MODE 20242 . 20479) (\LAFITE.MODE.TITLE 20481 . 20766) (
+LAFITE.SHOW.MODE.P 20768 . 21009) (LAFITE.ALL.MODES.P 21011 . 21354) (SET.LAFITE.MODE.INTERACTIVELY 
+21356 . 21938) (\LAFITE.COMPUTE.MODE.COMMANDS 21940 . 22361)) (22994 24750 (\LAFITE.LOGIN 23004 . 
+23386) (\LAFITE.LOGIN.NORESTART 23388 . 23494) (LAFITE.PROMPT.FOR.LOGIN 23496 . 24515) (
+\LAFITE.REAUTHENTICATE 24517 . 24748)) (30709 34151 (LAFITE.AROUNDEXIT 30719 . 31257) (
+\LAFITE.MARK.FOLDERS.OBSOLETE 31259 . 32175) (\LAFITE.CHECK.FOLDERS 32177 . 32576) (
+\LAFITE.ASSURE.FOLDER.READY 32578 . 32988) (\LAFITE.AFTERLOGIN 32990 . 34149)) (34183 37121 (
+LA.RESETSHADE 34193 . 34571) (LA.MENU.ITEM 34573 . 34991) (NTHMESSAGE 34993 . 35076) (
+\LAFITE.MAKE.MSGARRAY 35078 . 35508) (\LAFITE.ADDMESSAGES.TO.ARRAY 35510 . 36091) (
+\MAILFOLDER.DEFPRINT 36093 . 36340) (\LAFITEMSG.DEFPRINT 36342 . 36504) (LA.POSITION.FROM.REGION 36506
+ . 36983) (MAILFOLDERBUSY 36985 . 37119)) (37299 53165 (TOCFILENAME 37309 . 37740) (DELETEMAILFOLDER 
+37742 . 38262) (\LAFITE.OPEN.FOLDER 38264 . 42879) (\LAFITE.REPORT.FILE.WONT.OPEN 42881 . 43605) (
+\LAFITE.FOLDER.CHANGED 43607 . 46011) (\LAFITE.REBROWSE.FOLDER 46013 . 48978) (
+\LAFITE.FOLDER.CHANGED.MENU 48980 . 49903) (\LAFITE.SET.FOLDER.STREAM 49905 . 50599) (
+\LAFITE.OPENSTREAM 50601 . 51140) (\LAFITE.CREATE.MENU 51142 . 51495) (\LAFITE.EOF 51497 . 52317) (
+\LAFITE.CLOSE.FOLDER 52319 . 53163)) (53166 53750 (\LAFITE.DESCRIBE.FOLDER 53176 . 53748)) (53811 
+54917 (LOAD-LAFITE 53821 . 54915)) (59961 61238 (\LAFITE.GLOBAL.INIT 59971 . 61236)))))
+STOP

library/lafite/LAFITEDECLS

@@ -0,0 +1,668 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
(FILECREATED "22-Aug-94 12:59:34" {DSK}<king>export>lispcore>lafite>parc-94>LAFITEDECLS.;2
 37889  
+
+      changes to%:  (VARS LAFITEDECLSCOMS)
+                    (RECORDS LAFITEMSG)
+
+      previous date%: "21-Jun-89 12:10:42" {DSK}<king>export>lispcore>lafite>parc-94>LAFITEDECLS.;1
+)
+
+
+(* ; "
+Copyright (c) 1985, 1986, 1987, 1988, 1989, 1994 by Xerox Corporation.  All rights reserved.
+")
+
+(PRETTYCOMPRINT LAFITEDECLSCOMS)
+
+(RPAQQ LAFITEDECLSCOMS
 ((RECORDS LAFITEOPS LAFITEMODEDATA LAFITEMSG MAILFOLDER FOLDERGROUP 
+                                   DEFAULTHOST&DIR MAILSERVER MAILSERVEROPS OPENEDMAILBOX OUTBOX 
+                                   PROFILEVAR)
+                            (COMS                            (* ; 
+
                                                      "characteristics of standard Laurel messages")

+                                  (CONSTANTS (LAFITEBASICSTAMPLENGTH 19)
+                                         (LAFITESTAMPLENGTH 24)
+                                         (DELETEDFLAG (CHARCODE D))
+                                         (UNDELETEDFLAG (CHARCODE U))
+                                         (SEENFLAG (CHARCODE S))
+                                         (UNSEENFLAG (CHARCODE U))
+                                         (DUPLICATEMARK 128)))
+                            (COMS                            (* ; "Stuff for table of contents")

+                                  (CONSTANTS LAFITETOCPASSWORD LAFITETOCHEADERLENGTH))
+                            (COMS                            (* ; 
+
                                         "Browser status values.  %"Ready%" values have low bit 1.")

+                                  (CONSTANTS LAS.READY LAS.LOGGED.OUT)
+                                  (CONSTANTS LAS.PARSING LAS.FLUSHED LAS.OUT.OF.DATE))
+                            (COMS                            (* ; 
+
                                          "Bits for figuring out which menu to use on Update, etc.")

+                                  (CONSTANTS (\HARDCOPY.MENU.BIT 1)
+                                         (\UPDATE.MENU.BIT 2)
+                                         (\TOC.MENU.BIT 4)
+                                         (\EXPUNGE.MENU.BIT 8)
+                                         (\SORT.MENU.BIT 16)
+                                         (\EXPUNGE&SORT.MENU.BIT 32)
+                                         (\CLOSE.MENU.BIT 64)
+                                         (\SHRINK.MENU.BIT 128)))
+                            (COMS                            (* ; 
+
                                            "For iterating over the selected messages of a browser")

+                                  (I.S.OPRS SELECTEDIN))
+                            (MACROS WORDIN FIXPIN WORDOUT FIXPOUT UCASECODE NTHMESSAGE .LAFITEMENU. 
+                                   MAYBEVERIFYMSG UNSEENMARKP)
+                            (COMS (GLOBALVARS * LAFITEGLOBALS)
+                                  [P (CL:PROCLAIM '(CL:SPECIAL *LAFITE-MODE-DATA* 
+                                                          *UPPER-CASE-FILE-NAMES* \#DISPLAYLINES]
+                                                             (* ; 
+
     "LAFITE.PROCLAMATIONS are exported to user in file LAFITE--these are the documented variables")

+                                  (P * LAFITE.PROCLAMATIONS))
+                            (COMS                            (* ; 
+
                                "For debugging with Masterscope, here are fns not called from code")

+                                  (VARS LAFITE.CALLED.FROM.LITERALS LAFITE.PROGRAMMER.ENTRIES)
+                                  (COMMANDS WHONOTLAFITE CHECKLAFITE))
+                            (DECLARE%: DONTEVAL@COMPILE (TEMPLATES WINDOWPROP WINDOWADDPROP 
+                                                               WINDOWDELPROP PROCESSPROP TEXTPROP))))
+(DECLARE%: EVAL@COMPILE
+
+(RECORD LAFITEOPS
 (LAFITEMODE MODEINDEX SENDPARSER SENDER ANSWERER AUTHENTICATOR MESSAGEP 
+                             MESSAGE-FROM-SELFP LOGIN))
+
+(RECORD LAFITEMODEDATA
 (LAFITEOPS (FULLUSERNAME CREDENTIALS UNPACKEDUSERNAME SHORTUSERNAME 
+                                             FROMFIELD)
+                                  MAILSERVERS))
+
+(DATATYPE LAFITEMSG
 ((PARSED? FLAG)                      (* ; 
+
     "True if we have parsed the message, and thus filled in the fields DATE, FROM, SUBJECT below.")

+                         (DELETED? FLAG)                     (* ; 
+
                                                           "True if message marked for deletion")

+                         (SEEN? FLAG)                        (* ; "True if message is examined.")

+                         (DATEKNOWN? FLAG)                   (* ; 
+
                        "True if DATE field correctly parsed into IDATE [formerly formatted? flag]")

+                         (DATEFETCHED? FLAG)                 (* ; 
+
                                             "True if IDATE field contains a date (could be guess)")

+                         (MODEBITS BITS 3)                   (* ; 
+
                                                           "Mode in which the message was received")

+                         (MARKCHAR BYTE)                     (* ; "Arbitrary mark byte")

+                         (%# WORD)                           (* ; "Ordinal number of message")

+                         (BEGIN POINTER)                     (* ; "Start of the whole message")

+                         (MESSAGELENGTH POINTER)             (* ; "Lengfth of whole message")

+                         (STAMPLENGTH WORD)                  (* ; 
+
                                                      "Number of bytes in file header (usually 24)")

+                         (TOCLENGTH WORD)                    (* ; 
+
                                                     "Number of bytes this message consumes on toc")

+                         (MESSAGELENGTHCHANGED? FLAG)        (* ; 
+
"True if we have decided that the true length of this message is different from what the file says")

+                         (SELECTED? FLAG)                    (* ; "True if msg currently selected")

+                         (MSGFROMMECHECKED? FLAG)            (* ; 
+
                                         "True if we have tested whether this message is from self")

+                         (MSGFROMMETRUTH FLAG)               (* ; "Is it?")

+                         (DATE POINTER)                      (* ; 
+
                                                           "The fields of the parse (strings)")

+                         (NIL FLAG)
+                         (MARKSCHANGEDINFILE? FLAG)
+                         (MARKSCHANGEDINTOC? FLAG)
+                         (NIL FLAG)
+                         (FROM
 POINTER)
+                         (SUBJECT POINTER)
+                         (TO
 POINTER)
+                         (IDATE FIXP)                        (* ; 
+
                                                           "Integer form of DATE (for sorting)")

+                         )
+
+                        (* ;; "BEGIN is the only absolute pointer into the message file -- all other positions are relative to BEGIN -- see the ACCESSFNS")

+
+                        (BLOCKRECORD LAFITEMSG ((PARSED&DELETED&SEENBITS BITS 3)
+                                                             (* ; "For toc version 8")

+                                                (DATEBITS BITS 2)
+                                                             (* ; "For toc version 10")

+                                                (NIL BITS 3)
+                                                (NIL BYTE)
+                                                (NIL WORD)))
+                        (BLOCKRECORD LAFITEMSG ((MSGFLAGBITS BITS 8)
+                                                (NIL BYTE)
+                                                (NIL WORD)
+                                                (NIL BITS 4)
+                                                (NIL POINTER)
+                                                (NIL BITS 4)
+                                                (NIL POINTER)
+                                                (NIL WORD)
+                                                (NIL WORD)
+                                                (NIL BITS 4)
+                                                (NIL POINTER)
+                                                (NIL BITS 1)
+                                                (MARKSCHANGEDBITS BITS 2)
+                                                (NIL BITS 1)
+                                                (NIL 3 POINTER)
+                                                (IDATEHI WORD)
+                                                (IDATELO WORD)))
+                        [ACCESSFNS LAFITEMSG ((END (+ (fetch
 (LAFITEMSG MESSAGELENGTH)
+                                                         of
 DATUM)
+                                                      (fetch
 (LAFITEMSG BEGIN) of
 DATUM)))
+                                              (START (+ (fetch
 (LAFITEMSG BEGIN) of
 DATUM)
+                                                        (fetch
 (LAFITEMSG STAMPLENGTH)
+                                                           of
 DATUM)))
+                                              (MSGFROMMEP (COND
+                                                             ((fetch
 (LAFITEMSG MSGFROMMECHECKED?
+                                                                                ) of
 DATUM)
+                                                              (fetch
 (LAFITEMSG MSGFROMMETRUTH)
+                                                                 of
 DATUM))
+                                                             (T (LA.MSGFROMMEP DATUM)))
+                                                     (PROG1 (replace
 (LAFITEMSG MSGFROMMETRUTH)
+                                                               of
 DATUM with
 NEWVALUE)
+                                                         (replace
 (LAFITEMSG MSGFROMMECHECKED?)
+                                                            of
 DATUM with
 T)))
+                                              (MARKSCHANGED? (NEQ 0 (fetch
 (LAFITEMSG 
+                                                                                     MARKSCHANGEDBITS
+                                                                                      ) of
 DATUM)
+                                                                  )
+                                                     (replace
 (LAFITEMSG MARKSCHANGEDBITS)
+                                                        of
 DATUM with
 3))
+                                              (MODE (CL:NTH (fetch
 (LAFITEMSG MODEBITS)
+                                                               of
 DATUM)
+                                                           *LAFITE-WELL-KNOWN-MODES*)
+                                                    (replace
 (LAFITEMSG MODEBITS) of
 DATUM
+                                                       WITH
 (OR (CL:POSITION NEWVALUE 
+                                                                           *LAFITE-WELL-KNOWN-MODES*)
+                                                                    0])
+
+(DATATYPE MAILFOLDER
 ((BROWSERPROMPTDIRTY FLAG)          (* ; 
+
                                                        "Something's been printed in prompt window")

+                          (BROWSERPROMPTGREW FLAG)           (* ; 
+
                                                           "Browser prompt window has expanded")

+                          (FOLDERNEEDSUPDATE FLAG)           (* ; "Something changed")

+                          (FOLDERNEEDSEXPUNGE FLAG)          (* ; "True if deleted msgs")

+                          (FOLDERBEINGUPDATED FLAG)          (* ; "True during Update cmd")

+                          (BROWSERSTATUS BITS 3)             (* ; "Ready, etc.")

+                          (FULLFOLDERNAME POINTER)           (* ; "Full name of actual file")

+                          (FOLDEROKTOSHRINK FLAG)            (* ; 
+
                        "Kludge to allow you to call SHRINKW without invoking the Update? question")

+                          (FOLDERGETSMAIL FLAG)              (* ; "True if GetMail ok")

+                          (FOLDEROUTOFORDER FLAG)            (* ; "True if folder has been sorted")

+                          (NIL 5 FLAG)
+                          (VERSIONLESSFOLDERNAME POINTER)    (* ; "Versionless for conflict check")

+                          (SHORTFOLDERNAME POINTER)          (* ; "Normal name displayed to user")

+                          (FOLDERSTREAM POINTER)             (* ; "Stream open on the file, or NIL")

+                          (MESSAGEDESCRIPTORS POINTER)       (* ; "Array of LAFITEMSG")

+                          (FOLDERLOCK POINTER)               (* ; "Monitor lock for all access")

+                          (%#OFMESSAGES WORD)
+                          (TOCLASTMESSAGE# WORD)             (* ; 
+
                                                           "Last message that is in TOC file")

+                          (BROWSERFONTHEIGHT WORD)           (* ; "Cached info about browser font")

+                          (BROWSERFONTASCENT WORD)
+                          (BROWSERFONTDESCENT WORD)
+                          (BROWSERMAXXPOS WORD)              (* ; "For extent computations")

+                          (ORDINALXPOS WORD)                 (* ; "Where msg # starts")

+                          (DATEXPOS WORD)                    (* ; "Where msg date starts")

+                          (FROMXPOS WORD)                    (* ; "Where msg From starts")

+                          (FROMMAXXPOS WORD)                 (* ; "Beyond here, From is truncated")

+                          (SUBJECTXPOS WORD)                 (* ; "Where msg subject starts")

+                          (BROWSERDIGITWIDTH WORD)
+                          (FIRSTSELECTEDMESSAGE WORD)        (* ; 
+
                                                           "First/last msgs currently selected")

+                          (LASTSELECTEDMESSAGE WORD)
+                          (FIRSTCHANGEDMESSAGE WORD)         (* ; 
+
                                                "First message with any change--not currently used")

+                          (CURRENTPROMPTLINE WORD)           (* ; 
+
                                                  "Value of \currentdisplayline for browser prompt")

+                          (CURRENTDISPLAYEDSTREAM POINTER)   (* ; 
+
                           "The backing core file for the current message (not used interestingly)")

+                          (BROWSEREXTENT POINTER)
+                          (BROWSERORIGIN POINTER)
+                          (FOLDERDISPLAYREGION POINTER)      (* ; 
+
                                             "Region of display window (valid when browser shrunk)")

+                          (BROWSERWINDOW POINTER)            (* ; 
+
                                                         "The browser window and various pieces...")

+                          (BROWSERMENU POINTER)
+                          (BROWSERMENUWINDOW POINTER)
+                          (BROWSERPROMPTWINDOW POINTER)
+                          (ORIGINALBROWSERTITLE POINTER)     (* ; 
+
                                               "Original title before we added %"default move to%"")

+                          (FOLDERDISPLAYWINDOWS POINTER)     (* ; "WIndows currently displaying messages from this folder.  First element is %"primary%" display window, or NIL")

+                          (FOLDEREOFPTR POINTER)             (* ; "Length of file")

+                          (DEFAULTMOVETOFILE POINTER)        (* ; "Folder we last moved to, or NIL")

+                          (CURRENTDISPLAYEDMESSAGE POINTER)  (* ; 
+
                                            "Message descriptor of most recently displayed message")

+                          (BROWSERUPDATEFROMHERE POINTER)    (* ; 
+
        "First potentially changed message, from which redisplay needs to occur when icon expands.")

+                          (BROWSERLAYOUT POINTER)            (* ; 
+
                            "The element of LAFITEBROWSERLAYOUTS used to build this window, if any")

+                          (FOLDERCREATIONDATE POINTER)       (* ; "the ICREATIONDATE of the file")

+                          (HARDCOPYMESSAGES POINTER)         (* ; 
+
                                                         "List of msg descriptors being hardcopied")

+                          (HARDCOPYSTREAM POINTER)           (* ; 
+
                                                           "A Textstream for pending hardcopy")

+                          )
+                         (BLOCKRECORD MAILFOLDER ((NIL 5 FLAG)
+                                                  (NIL BITS 2)
+                                                  (BROWSERREADYBIT FLAG)
+                                                             (* ; 
+
                                                           "Low bit of status on means ready")

+                                                  ))
+                         [ACCESSFNS MAILFOLDER ((BROWSERREADY (fetch
 (MAILFOLDER BROWSERREADYBIT)
+                                                                 of
 DATUM)
+                                                       (REPLACE
 (MAILFOLDER BROWSERSTATUS)
+                                                          OF
 DATUM WITH
 (COND
+                                                                                   (NEWVALUE 
+                                                                                          LAS.READY)
+                                                                                   (T LAS.PARSING])
+
+(RECORD FOLDERGROUP
 (FGNAME (FGTOPLEVEL . FGSUBGROUPS) . FGFOLDERS))
+
+(RECORD DEFAULTHOST&DIR
 (PACKEDHOST&DIR . UNPACKEDHOST&DIR)
+                            (PROPRECORD UNPACKEDHOST&DIR (DEFAULTDIR DEFAULTHOST DEFAULTDEV)))
+
+(RECORD MAILSERVER
 (MAILSERVEROPS MAILPORT MAILSERVERNAME CONTINUANCE NEWMAILP . MAILSTATE))
+
+(RECORD MAILSERVEROPS
 (POLLNEWMAIL OPENMAILBOX NEXTMESSAGE RETRIEVEMESSAGE CLOSEMAILBOX 
+                                 SERVERPORTFROMNAME))
+
+(RECORD OPENEDMAILBOX
 (MAILBOX . PROPERTIES)
+                          (PROPRECORD PROPERTIES (%#OFMESSAGES)))
+
+(RECORD OUTBOX
 (OBWINDOW OBSIZE OBHEIGHT OBDESCENT OBORIGIN OBITEMS))
+
+(RECORD PROFILEVAR
 (PFVARNAME PFRECONCILIATIONFN PFLOADFN PFDUMPFN))
+)
+
+(/DECLAREDATATYPE 'LAFITEMSG
+       '(FLAG FLAG FLAG FLAG FLAG (BITS 3)
+              BYTE WORD POINTER POINTER WORD WORD FLAG FLAG FLAG FLAG POINTER FLAG FLAG FLAG FLAG 
+              POINTER POINTER POINTER FIXP)
+       '((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 (BITS . 135))
+         (LAFITEMSG 1 (BITS . 15))
+         (LAFITEMSG 2 POINTER)
+         (LAFITEMSG 4 POINTER)
+         (LAFITEMSG 6 (BITS . 15))
+         (LAFITEMSG 7 (BITS . 15))
+         (LAFITEMSG 4 (FLAGBITS . 0))
+         (LAFITEMSG 4 (FLAGBITS . 16))
+         (LAFITEMSG 4 (FLAGBITS . 32))
+         (LAFITEMSG 4 (FLAGBITS . 48))
+         (LAFITEMSG 8 POINTER)
+         (LAFITEMSG 8 (FLAGBITS . 0))
+         (LAFITEMSG 8 (FLAGBITS . 16))
+         (LAFITEMSG 8 (FLAGBITS . 32))
+         (LAFITEMSG 8 (FLAGBITS . 48))
+         (LAFITEMSG 10 POINTER)
+         (LAFITEMSG 12 POINTER)
+         (LAFITEMSG 14 POINTER)
+         (LAFITEMSG 16 FIXP))
+       '18)
+
+(/DECLAREDATATYPE 'MAILFOLDER
+       '(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)
+       '((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 2 POINTER)
+         (MAILFOLDER 2 (FLAGBITS . 0))
+         (MAILFOLDER 2 (FLAGBITS . 16))
+         (MAILFOLDER 2 (FLAGBITS . 32))
+         (MAILFOLDER 2 (FLAGBITS . 48))
+         (MAILFOLDER 1 (FLAGBITS . 0))
+         (MAILFOLDER 1 (FLAGBITS . 16))
+         (MAILFOLDER 1 (FLAGBITS . 32))
+         (MAILFOLDER 1 (FLAGBITS . 48))
+         (MAILFOLDER 4 POINTER)
+         (MAILFOLDER 6 POINTER)
+         (MAILFOLDER 8 POINTER)
+         (MAILFOLDER 10 POINTER)
+         (MAILFOLDER 12 POINTER)
+         (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 (BITS . 15))
+         (MAILFOLDER 29 (BITS . 15))
+         (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)
+         (MAILFOLDER 64 POINTER))
+       '66)
+
+
+
+(* ; "characteristics of standard Laurel messages")

+
+(DECLARE%: EVAL@COMPILE 
+
+(RPAQQ LAFITEBASICSTAMPLENGTH
 19)
+
+(RPAQQ LAFITESTAMPLENGTH
 24)
+
+(RPAQ DELETEDFLAG
 (CHARCODE D))
+
+(RPAQ UNDELETEDFLAG
 (CHARCODE U))
+
+(RPAQ SEENFLAG
 (CHARCODE S))
+
+(RPAQ UNSEENFLAG
 (CHARCODE U))
+
+(RPAQQ DUPLICATEMARK
 128)
+
+
+(CONSTANTS (LAFITEBASICSTAMPLENGTH 19)
+       (LAFITESTAMPLENGTH 24)
+       (DELETEDFLAG (CHARCODE D))
+       (UNDELETEDFLAG (CHARCODE U))
+       (SEENFLAG (CHARCODE S))
+       (UNSEENFLAG (CHARCODE U))
+       (DUPLICATEMARK 128))
+)
+
+
+
+(* ; "Stuff for table of contents")

+
+(DECLARE%: EVAL@COMPILE 
+
+(RPAQQ LAFITETOCPASSWORD
 45610)
+
+(RPAQQ LAFITETOCHEADERLENGTH
 10)
+
+
+(CONSTANTS LAFITETOCPASSWORD LAFITETOCHEADERLENGTH)
+)
+
+
+
+(* ; "Browser status values.  %"Ready%" values have low bit 1.")

+
+(DECLARE%: EVAL@COMPILE 
+
+(RPAQQ LAS.READY
 1)
+
+(RPAQQ LAS.LOGGED.OUT
 3)
+
+
+(CONSTANTS LAS.READY LAS.LOGGED.OUT)
+)
+(DECLARE%: EVAL@COMPILE 
+
+(RPAQQ LAS.PARSING
 0)
+
+(RPAQQ LAS.FLUSHED
 2)
+
+(RPAQQ LAS.OUT.OF.DATE
 4)
+
+
+(CONSTANTS LAS.PARSING LAS.FLUSHED LAS.OUT.OF.DATE)
+)
+
+
+
+(* ; "Bits for figuring out which menu to use on Update, etc.")

+
+(DECLARE%: EVAL@COMPILE 
+
+(RPAQQ \HARDCOPY.MENU.BIT
 1)
+
+(RPAQQ \UPDATE.MENU.BIT
 2)
+
+(RPAQQ \TOC.MENU.BIT
 4)
+
+(RPAQQ \EXPUNGE.MENU.BIT
 8)
+
+(RPAQQ \SORT.MENU.BIT
 16)
+
+(RPAQQ \EXPUNGE&SORT.MENU.BIT
 32)
+
+(RPAQQ \CLOSE.MENU.BIT
 64)
+
+(RPAQQ \SHRINK.MENU.BIT
 128)
+
+
+(CONSTANTS (\HARDCOPY.MENU.BIT 1)
+       (\UPDATE.MENU.BIT 2)
+       (\TOC.MENU.BIT 4)
+       (\EXPUNGE.MENU.BIT 8)
+       (\SORT.MENU.BIT 16)
+       (\EXPUNGE&SORT.MENU.BIT 32)
+       (\CLOSE.MENU.BIT 64)
+       (\SHRINK.MENU.BIT 128))
+)
+
+
+
+(* ; "For iterating over the selected messages of a browser")

+
+(DECLARE%: EVAL@COMPILE 
+
+[I.S.OPR 'SELECTEDIN NIL '(bind
 ($$MESSAGES _ (fetch
 (MAILFOLDER MESSAGEDESCRIPTORS)
+                                                     of
 BODY))
+                                 ($$MSG# _ (SUB1 (fetch
 (MAILFOLDER FIRSTSELECTEDMESSAGE)
+                                                    of
 BODY)))
+                                 ($$MSGLAST _ (fetch
 (MAILFOLDER LASTSELECTEDMESSAGE)
+                                                 of
 BODY)) until
 (IGREATERP (add
 $$MSG# 1
+                                                                                           )
+                                                                                $$MSGLAST)
+                             when
 (fetch
 (LAFITEMSG SELECTED?) of
 (SETQ I.V.
+                                                                               (NTHMESSAGE $$MESSAGES
+                                                                                      $$MSG#]
+)
+(DECLARE%: EVAL@COMPILE 
+
+(PROGN (PUTPROPS WORDIN DMACRO (= . \WIN))
+       (PUTPROPS WORDIN MACRO (= . \WIN)))
+
+[PUTPROPS FIXPIN DMACRO (OPENLAMBDA (STREAM)
+                               (\MAKENUMBER (WORDIN STREAM)
+                                      (WORDIN STREAM]
+
+(PUTPROPS WORDOUT DMACRO (= . \WOUT))
+
+[PUTPROPS FIXPOUT DMACRO (OPENLAMBDA (STREAM N)
+                                (PROGN (WORDOUT STREAM (LRSH N 16))
+                                       (WORDOUT STREAM (LOGAND N 65535]
+
+[PUTPROPS UCASECODE MACRO (OPENLAMBDA (CHAR)
+                                 (COND
+                                    ((AND (IGEQ CHAR (CHARCODE a))
+                                          (ILEQ CHAR (CHARCODE z)))
+                                     (LOGAND CHAR 95))
+                                    (T CHAR]
+
+(PUTPROPS NTHMESSAGE MACRO (= . ELT))
+
+[PUTPROPS .LAFITEMENU. MACRO ((NAME ITEMS TITLE)
+                              (PROGN (DECLARE
 (GLOBALVARS NAME))
+                                     (OR NAME (SETQ NAME (\LAFITE.CREATE.MENU ITEMS TITLE]
+
+[PUTPROPS MAYBEVERIFYMSG MACRO ((MSG MAILFOLDER)
+                                (AND LAFITEVERIFYFLG (\LAFITE.VERIFYMSG MSG MAILFOLDER]
+
+[PUTPROPS UNSEENMARKP MACRO (OPENLAMBDA (MK)
+                                   (OR (EQ MK UNSEENMARK)
+                                       (EQ MK HEARDMARK]
+)
+
+(RPAQQ LAFITEGLOBALS
 
+       (*LAFITE-WELL-KNOWN-MODES* ANOTHERFOLDERMENUITEM AROUNDEXITFNS BackgroundMenu 
+              BackgroundMenuCommands FORWARDMARK HARDCOPYBATCHMARK HARDCOPYMARK HEARDMARK 
+              LA.CROSSCURSOR LA.SELECTION.BITMAP LAFITE.PERSONAL.VARS LAFITE.UPDATE.MENU.HASH 
+              LAFITE.USER.INFO LAFITEEOL LAFITEFOLDERSMENU LAFITEFORMSMENU LAFITEITEMBUSYSHADE 
+              LAFITEMAILFOLDERS LAFITEMAINMENU LAFITEMULTIPLEFOLDERSMENU LAFITEPROFILERDTBL 
+              LAFITESTATUSWINDOW LAFITESUBBROWSEMENU LAFITESUBQUITMENU LAFITESYSTEMDATE 
+              LAFITEVERSION# LASTMOUSEBUTTONS LASTMOUSEX LASTMOUSEY LOGINHOST/DIR PROMPTWINDOW 
+              SCREENHEIGHT SCREENWIDTH SEENMARK UNSEENMARK UNSUPPLIEDFIELDSTR UPPERCASEARRAY 
+              WINDOWTITLEFONT \ACTIVELAFITEFOLDERS \AFTERLOGINFNS \LAFITE.ACTIVE \LAFITE.ACTIVE.MODES
+              \LAFITE.BROWSELOCK \LAFITE.CURRENT.USER \LAFITE.HARDCOPYLOCK \LAFITE.LAST.STATUS 
+              \LAFITE.MAILSERVERLOCK \LAFITE.MAINLOCK \LAFITE.MODE.CHOICES \LAFITE.OUTBOX 
+              \LAFITE.PROFILELOCK \LAFITE.PSEUDO.DEVICES \LAFITE.READY \LAFITE.TEMPFILES 
+              \LAFITEDEFAULTHOST&DIR \LAFITEMODE \LAFITEPROFILECHANGED \LAFITEPROFILEDATE 
+              \LAPARSE.DONT.DISPLAY.HEADERS \LAPARSE.DONT.FORWARD.HEADERS 
+              \LAPARSE.DONT.HARDCOPY.HEADERS LAFITE.FOLDER.STRUCTURE LAFITE.SPACER.MENU.ITEM))
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS *LAFITE-WELL-KNOWN-MODES* ANOTHERFOLDERMENUITEM AROUNDEXITFNS BackgroundMenu 
+       BackgroundMenuCommands FORWARDMARK HARDCOPYBATCHMARK HARDCOPYMARK HEARDMARK LA.CROSSCURSOR 
+       LA.SELECTION.BITMAP LAFITE.PERSONAL.VARS LAFITE.UPDATE.MENU.HASH LAFITE.USER.INFO LAFITEEOL 
+       LAFITEFOLDERSMENU LAFITEFORMSMENU LAFITEITEMBUSYSHADE LAFITEMAILFOLDERS LAFITEMAINMENU 
+       LAFITEMULTIPLEFOLDERSMENU LAFITEPROFILERDTBL LAFITESTATUSWINDOW LAFITESUBBROWSEMENU 
+       LAFITESUBQUITMENU LAFITESYSTEMDATE LAFITEVERSION# LASTMOUSEBUTTONS LASTMOUSEX LASTMOUSEY 
+       LOGINHOST/DIR PROMPTWINDOW SCREENHEIGHT SCREENWIDTH SEENMARK UNSEENMARK UNSUPPLIEDFIELDSTR 
+       UPPERCASEARRAY WINDOWTITLEFONT \ACTIVELAFITEFOLDERS \AFTERLOGINFNS \LAFITE.ACTIVE 
+       \LAFITE.ACTIVE.MODES \LAFITE.BROWSELOCK \LAFITE.CURRENT.USER \LAFITE.HARDCOPYLOCK 
+       \LAFITE.LAST.STATUS \LAFITE.MAILSERVERLOCK \LAFITE.MAINLOCK \LAFITE.MODE.CHOICES 
+       \LAFITE.OUTBOX \LAFITE.PROFILELOCK \LAFITE.PSEUDO.DEVICES \LAFITE.READY \LAFITE.TEMPFILES 
+       \LAFITEDEFAULTHOST&DIR \LAFITEMODE \LAFITEPROFILECHANGED \LAFITEPROFILEDATE 
+       \LAPARSE.DONT.DISPLAY.HEADERS \LAPARSE.DONT.FORWARD.HEADERS \LAPARSE.DONT.HARDCOPY.HEADERS 
+       LAFITE.FOLDER.STRUCTURE LAFITE.SPACER.MENU.ITEM)
+)
+
+(CL:PROCLAIM '(CL:SPECIAL *LAFITE-MODE-DATA* *UPPER-CASE-FILE-NAMES* \#DISPLAYLINES))
+
+
+
+(* ; "LAFITE.PROCLAMATIONS are exported to user in file LAFITE--these are the documented variables")

+
+
+(RPAQQ LAFITE.PROCLAMATIONS
 
+       [(CL:PROCLAIM '(GLOBAL ANSWERMARK BROWSERMARKXPOSITION DEFAULTMAILFOLDERNAME 
+                             LAFITE.2COLUMN.MENU.MIN.ITEMS LAFITE.AUTO.MOVE.MENU 
+                             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.DUMMY.HALF.SHADE LAFITE.DUMMY.SHADE LAFITE.EDITOR.LAYOUTS 
+                             LAFITE.EDITOR.SIZE LAFITE.EXTRA.DISPLAY.COMMANDS LAFITE.EXTRA.MOVE.ITEMS
+                             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 LAFITEEXTRAMENUITEMS 
+                             LAFITEFIXEDWIDTHFONT LAFITEFORM.EXT LAFITEFORMFILES LAFITEFROMFRACTION 
+                             LAFITEHARDCOPY.MIN.TOC LAFITEHARDCOPYBATCHFLG LAFITEHARDCOPYBATCHSHADE 
+                             LAFITEHARDCOPYFONT LAFITEHARDCOPYSEPARATOR LAFITEIFFROMMETHENSEENFLG 
+                             LAFITEINFO.NAME LAFITEMAIL.EXT LAFITEMENUFONT LAFITEMENUVARS 
+                             LAFITEMINFROMCHARS LAFITEMODEDEFAULT LAFITEMODELST 
+                             LAFITEMOVETOCONFIRMFLG LAFITEMSGICONFONT LAFITENEWPAGEFLG 
+                             LAFITESHOWMODEFLG LAFITESTATUSWINDOWMINWIDTH LAFITESTATUSWINDOWPOSITION
+                             LAFITESUBBROWSEMENUITEMS LAFITESUBQUITMENUITEMS LAFITETITLEFONT 
+                             LAFITETOC.EXT LAFITEUPDATEMENUITEMS MOVETOMARK))
+        (CL:PROCLAIM '(CL:SPECIAL LAFITEVERIFYFLG])
+
+(CL:PROCLAIM '(GLOBAL ANSWERMARK BROWSERMARKXPOSITION DEFAULTMAILFOLDERNAME 
+                     LAFITE.2COLUMN.MENU.MIN.ITEMS LAFITE.AUTO.MOVE.MENU 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.DUMMY.HALF.SHADE LAFITE.DUMMY.SHADE 
+                     LAFITE.EDITOR.LAYOUTS LAFITE.EDITOR.SIZE LAFITE.EXTRA.DISPLAY.COMMANDS 
+                     LAFITE.EXTRA.MOVE.ITEMS 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 LAFITEEXTRAMENUITEMS LAFITEFIXEDWIDTHFONT LAFITEFORM.EXT 
+                     LAFITEFORMFILES LAFITEFROMFRACTION LAFITEHARDCOPY.MIN.TOC LAFITEHARDCOPYBATCHFLG
+                     LAFITEHARDCOPYBATCHSHADE LAFITEHARDCOPYFONT LAFITEHARDCOPYSEPARATOR 
+                     LAFITEIFFROMMETHENSEENFLG LAFITEINFO.NAME LAFITEMAIL.EXT LAFITEMENUFONT 
+                     LAFITEMENUVARS LAFITEMINFROMCHARS LAFITEMODEDEFAULT LAFITEMODELST 
+                     LAFITEMOVETOCONFIRMFLG LAFITEMSGICONFONT LAFITENEWPAGEFLG LAFITESHOWMODEFLG 
+                     LAFITESTATUSWINDOWMINWIDTH LAFITESTATUSWINDOWPOSITION LAFITESUBBROWSEMENUITEMS 
+                     LAFITESUBQUITMENUITEMS LAFITETITLEFONT LAFITETOC.EXT LAFITEUPDATEMENUITEMS 
+                     MOVETOMARK))
+
+(CL:PROCLAIM '(CL:SPECIAL LAFITEVERIFYFLG))
+
+
+
+(* ; "For debugging with Masterscope, here are fns not called from code")

+
+
+(RPAQQ LAFITE.CALLED.FROM.LITERALS
 
+       (GV.CLOSEMAILBOX GV.INIT.MAIL.USER GV.MAKEANSWERFORM GV.NEXTMESSAGE GV.OPENMAILBOX 
+              GV.POLLNEWMAIL GV.PORTFROMNAME GV.RETRIEVEMESSAGE LAFITE.COMPUTE.CACHED.VARS 
+              LAFITE.GRAB.DATE LAFITE.ON.FROM.BACKGROUND LAFITE.PARSE.DATE.FIELD.ONLY 
+              LAFITE.READ.FORMAT LAFITE.READ.LINE.FOR.TOC LAFITE.READ.NAME.FIELD 
+              LAFITE.READ.ONE.LINE.FOR.TOC LAFITE.RENAME.GROUP MAKELAFITESUPPORTFORM 
+              MAKELISPSUPPORTFORM SET.LAFITE.MODE.INTERACTIVELY \GV.MESSAGE.FROM.SELF.P \GV.MESSAGE.P
+              \GV.SEND.PARSE \GV.SENDMESSAGE \LAFITE.ANSWER \LAFITE.BROWSE \LAFITE.BROWSE.FORGET 
+              \LAFITE.BROWSE.PROC \LAFITE.CANCEL.HARDCOPY \LAFITE.COPYTO \LAFITE.DELETE 
+              \LAFITE.DELETE.GROUP \LAFITE.DESCRIBE.FOLDER \LAFITE.DISPLAY \LAFITE.EDIT.HIERARCHY 
+              \LAFITE.ENABLE.MOVE.MENU \LAFITE.EXPUNGE.PROC \LAFITE.FIND \LAFITE.FIND.AGAIN 
+              \LAFITE.FIND.RELATED \LAFITE.FIND.RELATED.BACKWARD \LAFITE.FORWARD \LAFITE.GC.FOLDERS 
+              \LAFITE.GETMAIL \LAFITE.GETMAIL.FROM.ICON \LAFITE.GLOBAL.INIT \LAFITE.GO.TO.FIRST 
+              \LAFITE.GO.TO.INTERACTIVE \LAFITE.GO.TO.LAST \LAFITE.HARDCOPY 
+              \LAFITE.HARDCOPY.FROM.DISPLAY \LAFITE.HARDCOPYONLY.PROC \LAFITE.LOGIN.NORESTART 
+              \LAFITE.MERGE.FOLDERS \LAFITE.MERGE.NAMELISTS \LAFITE.MERGE.STRUCTURES 
+              \LAFITE.MESSAGEFORM \LAFITE.MOVETO \LAFITE.NOTICE.FOLDERS \LAFITE.QUIT \LAFITE.QUIT 
+              \LAFITE.REAUTHENTICATE \LAFITE.REHIDE.HEADERS \LAFITE.RENAME.FOLDER \LAFITE.RESTART 
+              \LAFITE.RESTORE.MOVE.MENU \LAFITE.SET.DEFAULT.LOOKS \LAFITE.SET.FIXED.LOOKS 
+              \LAFITE.SET.LOOKS.FROM.MENU \LAFITE.SORT.BY.DATE.REGION \LAFITE.UNCACHE.FOLDER 
+              \LAFITE.UNCACHE.MESSAGEFORM \LAFITE.UNDELETE \LAFITE.UNHIDE.HEADERS \LAFITE.UPDATE 
+              \LAFITE.UPDATE.PROC \LAFITE.UPDATE.PROC \MAILOBJ.EXPAND \MAILOBJ.FB \MAILOBJ.HARDCOPY 
+              \MAILOBJ.INIT \MAILOBJ.PUT.FILE \MAILOBJ.VIEW \NS.READ.ENVELOPE.ITEM 
+              \NS.WRITE.ENVELOPE.ITEM \NSMAIL.AUTHENTICATE \NSMAIL.LOGIN \NSMAIL.MAKEANSWERFORM 
+              \NSMAIL.MESSAGE.FROM.SELF.P \NSMAIL.MESSAGE.P \NSMAIL.SEND \NSMAIL.SEND.PARSE 
+              \SENDMSG.CHANGE.MODE \SENDMSG.DELIVER \SENDMSG.SAVE.FORM))
+
+(RPAQQ LAFITE.PROGRAMMER.ENTRIES
 
+       (LAFITEDEFAULTHOST&DIR LOAD-LAFITE LAFITE.SENDMESSAGE BUILD.LAFITE.LAYOUTS 
+              LAB.SELECTED.MESSAGES LAFITE.DELETE.MESSAGES LAFITE.MOVE.MESSAGES 
+              LAFITE.HARDCOPY.MESSAGES LAFITE.OBTAIN.FOLDER MAILSCAVENGE MS.EXPAND GV.READTOC 
+              GV.WRITETOC GV.DELETEMESSAGE))
+
+(DEFCOMMAND (WHONOTLAFITE :HISTORY) NIL 
+   '((CL:SET-DIFFERENCE (CL:SET-DIFFERENCE (%. WHO ON ANY IN LAFITEFILES IS NOT CALLED)
+                               LAFITE.CALLED.FROM.LITERALS)
+            LAFITE.PROGRAMMER.ENTRIES)))
+
+(DEFCOMMAND (CHECKLAFITE :HISTORY) NIL '[(FOR
 FILE IN
 LAFITEFILES
+                                            DO
 (EVAL `(%. CHECK ,FILE])
+(DECLARE%: DONTEVAL@COMPILE 
+
+(SETTEMPLATE 'WINDOWPROP '(EVAL PROP EVAL . PPE))
+
+(SETTEMPLATE 'WINDOWADDPROP '(EVAL PROP EVAL EVAL . PPE))
+
+(SETTEMPLATE 'WINDOWDELPROP '(EVAL PROP EVAL . PPE))
+
+(SETTEMPLATE 'PROCESSPROP '(EVAL PROP EVAL . PPE))
+
+(SETTEMPLATE 'TEXTPROP '(EVAL PROP EVAL . PPE))
+)
+(PUTPROPS LAFITEDECLS COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 1989 1994))
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL)))
+STOP

library/lafite/LAFITEDECLS.~1~

@@ -0,0 +1,223 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
(FILECREATED "21-Jun-89 12:10:42" {POOH/N}<POOH>LAFITE>SOURCES>LAFITEDECLS;9
 24176  
+
+      changes to%:  (VARS LAFITE.PROCLAMATIONS)
+
+      previous date%: " 8-May-89 16:49:04" {POOH/N}<POOH>LAFITE>SOURCES>LAFITEDECLS;8)
+
+
+(* "
+Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation.  All rights reserved.
+")
+
+(PRETTYCOMPRINT LAFITEDECLSCOMS)
+
+(RPAQQ LAFITEDECLSCOMS ((RECORDS LAFITEOPS LAFITEMODEDATA LAFITEMSG MAILFOLDER FOLDERGROUP DEFAULTHOST&DIR MAILSERVER MAILSERVEROPS OPENEDMAILBOX OUTBOX PROFILEVAR) (COMS (* ; "characteristics of standard Laurel messages") (CONSTANTS (LAFITEBASICSTAMPLENGTH 19) (LAFITESTAMPLENGTH 24) (DELETEDFLAG (CHARCODE D)) (UNDELETEDFLAG (CHARCODE U)) (SEENFLAG (CHARCODE S)) (UNSEENFLAG (CHARCODE U)) (DUPLICATEMARK 128))) (COMS (* ; "Stuff for table of contents") (CONSTANTS LAFITETOCPASSWORD LAFITETOCHEADERLENGTH)) (COMS (* ; "Browser status values.  %"Ready%" values have low bit 1.") (CONSTANTS LAS.READY LAS.LOGGED.OUT) (CONSTANTS LAS.PARSING LAS.FLUSHED LAS.OUT.OF.DATE)) (COMS (* ; "Bits for figuring out which menu to use on Update, etc.") (CONSTANTS (\HARDCOPY.MENU.BIT 1) (\UPDATE.MENU.BIT 2) (\TOC.MENU.BIT 4) (\EXPUNGE.MENU.BIT 8) (\SORT.MENU.BIT 16) (\EXPUNGE&SORT.MENU.BIT 32) (\CLOSE.MENU.BIT 64) (\SHRINK.MENU.BIT 128))) (COMS (* ; "For iterating over the selected messages of a browser") (I.S.OPRS SELECTEDIN)) (MACROS WORDIN FIXPIN WORDOUT FIXPOUT UCASECODE NTHMESSAGE .LAFITEMENU. MAYBEVERIFYMSG UNSEENMARKP) (COMS (GLOBALVARS * LAFITEGLOBALS) (P (COND ((< (IDATE TEDITSYSTEMDATE) (IDATE "1-mar-88 00:00")) (* ; "Bug in older TEXTPROP--just compile it closed.") (REMPROP (QUOTE TEXTPROP) (QUOTE COMPILER:OPTIMIZER-LIST)))) (CL:PROCLAIM (QUOTE (CL:SPECIAL *LAFITE-MODE-DATA* *UPPER-CASE-FILE-NAMES* \#DISPLAYLINES)))) (* ; "LAFITE.PROCLAMATIONS are exported to user in file LAFITE--these are the documented variables") (P * LAFITE.PROCLAMATIONS)) (COMS (* ; "For debugging with Masterscope, here are fns not called from code") (VARS LAFITE.CALLED.FROM.LITERALS LAFITE.PROGRAMMER.ENTRIES) (COMMANDS WHONOTLAFITE CHECKLAFITE)) (DECLARE%: DONTEVAL@COMPILE (TEMPLATES WINDOWPROP WINDOWADDPROP WINDOWDELPROP PROCESSPROP TEXTPROP))))
+(DECLARE%: EVAL@COMPILE
+
+(RECORD LAFITEOPS
 (LAFITEMODE MODEINDEX SENDPARSER SENDER ANSWERER AUTHENTICATOR MESSAGEP MESSAGE-FROM-SELFP LOGIN)
+)
+
+(RECORD LAFITEMODEDATA
 (LAFITEOPS (FULLUSERNAME CREDENTIALS UNPACKEDUSERNAME SHORTUSERNAME FROMFIELD) MAILSERVERS)
+)
+
+(DATATYPE LAFITEMSG
 ((PARSED? FLAG) (* ; "True if we have parsed the message, and thus filled in the fields DATE, FROM, SUBJECT below.") (DELETED? FLAG) (* ; "True if message marked for deletion") (SEEN? FLAG) (* ; "True if message is examined.") (DATEKNOWN? FLAG) (* ; "True if DATE field correctly parsed into IDATE [formerly formatted? flag]") (DATEFETCHED? FLAG) (* ; "True if IDATE field contains a date (could be guess)") (MODEBITS BITS 3) (* ; "Mode in which the message was received") (BEGIN POINTER) (* ; "Start of the whole message") (MARKCHAR BYTE) (* ; "Arbitrary mark byte") (MESSAGELENGTH POINTER) (* ; "Lengfth of whole message") (%# WORD) (* ; "Ordinal number of message") (STAMPLENGTH WORD) (* ; "Number of bytes in file header (usually 24)") (TOCLENGTH WORD) (* ; "Number of bytes this message consumes on toc") (NIL WORD) (MESSAGELENGTHCHANGED? FLAG) (* ; "True if we have decided that the true length of this message is different from what the file says") (NIL FLAG) (SELECTED? FLAG) (* ; "True if msg currently selected") (MSGFROMMECHECKED? FLAG) (* ; "True if we have tested whether this message is from self") (MSGFROMMETRUTH FLAG) (* ; "Is it?") (MARKSCHANGEDINFILE? FLAG) (MARKSCHANGEDINTOC? FLAG) (NIL FLAG) (DATE POINTER) (* ; "The fields of the parse (strings)") (FROM POINTER) (SUBJECT POINTER) (TO POINTER) (IDATE FIXP) (* ; "Integer form of DATE (for sorting)"))
+ (* ;; "BEGIN is the only absolute pointer into the message file -- all other positions are relative to BEGIN -- see the ACCESSFNS")
+ (BLOCKRECORD LAFITEMSG ((PARSED&DELETED&SEENBITS BITS 3) (* ; "For toc version 8") (DATEBITS BITS 2) (* ; "For toc version 10") (NIL BITS 3) (NIL POINTER)))
+ (BLOCKRECORD LAFITEMSG ((MSGFLAGBITS BITS 8) (NIL POINTER) (NIL BYTE) (NIL POINTER) (NIL WORD) (NIL WORD) (NIL WORD) (NIL WORD) (NIL BITS 5) (MARKSCHANGEDBITS BITS 2) (NIL BITS 1) (NIL 4 POINTER) (IDATEHI WORD) (IDATELO WORD)))
+ (ACCESSFNS LAFITEMSG ((END (+ (fetch (LAFITEMSG MESSAGELENGTH) of DATUM) (fetch (LAFITEMSG BEGIN) of DATUM))) (START (+ (fetch (LAFITEMSG BEGIN) of DATUM) (fetch (LAFITEMSG STAMPLENGTH) of DATUM))) (MSGFROMMEP (COND ((fetch (LAFITEMSG MSGFROMMECHECKED?) of DATUM) (fetch (LAFITEMSG MSGFROMMETRUTH) of DATUM)) (T (LA.MSGFROMMEP DATUM))) (PROG1 (replace (LAFITEMSG MSGFROMMETRUTH) of DATUM with NEWVALUE) (replace (LAFITEMSG MSGFROMMECHECKED?) of DATUM with T))) (MARKSCHANGED? (NEQ 0 (fetch (LAFITEMSG MARKSCHANGEDBITS) of DATUM)) (replace (LAFITEMSG MARKSCHANGEDBITS) of DATUM with 3)) (MODE (CL:NTH (fetch (LAFITEMSG MODEBITS) of DATUM) *LAFITE-WELL-KNOWN-MODES*) (replace (LAFITEMSG MODEBITS) of DATUM WITH (OR (CL:POSITION NEWVALUE *LAFITE-WELL-KNOWN-MODES*) 0)))))
+)
+
+(DATATYPE MAILFOLDER
 ((BROWSERPROMPTDIRTY FLAG) (* ; "Something's been printed in prompt window") (BROWSERPROMPTGREW FLAG) (* ; "Browser prompt window has expanded") (FOLDERNEEDSUPDATE FLAG) (* ; "Something changed") (FOLDERNEEDSEXPUNGE FLAG) (* ; "True if deleted msgs") (FOLDERBEINGUPDATED FLAG) (* ; "True during Update cmd") (BROWSERSTATUS BITS 3) (* ; "Ready, etc.") (FULLFOLDERNAME POINTER) (* ; "Full name of actual file") (FOLDEROKTOSHRINK FLAG) (* ; "Kludge to allow you to call SHRINKW without invoking the Update? question") (FOLDERGETSMAIL FLAG) (* ; "True if GetMail ok") (FOLDEROUTOFORDER FLAG) (* ; "True if folder has been sorted") (NIL 5 FLAG) (VERSIONLESSFOLDERNAME POINTER) (* ; "Versionless for conflict check") (SHORTFOLDERNAME POINTER) (* ; "Normal name displayed to user") (FOLDERSTREAM POINTER) (* ; "Stream open on the file, or NIL") (MESSAGEDESCRIPTORS POINTER) (* ; "Array of LAFITEMSG") (FOLDERLOCK POINTER) (* ; "Monitor lock for all access") (%#OFMESSAGES WORD) (TOCLASTMESSAGE# WORD) (* ; "Last message that is in TOC file") (BROWSERFONTHEIGHT WORD) (* ; "Cached info about browser font") (BROWSERFONTASCENT WORD) (BROWSERFONTDESCENT WORD) (BROWSERMAXXPOS WORD) (* ; "For extent computations") (ORDINALXPOS WORD) (* ; "Where msg # starts") (DATEXPOS WORD) (* ; "Where msg date starts") (FROMXPOS WORD) (* ; "Where msg From starts") (FROMMAXXPOS WORD) (* ; "Beyond here, From is truncated") (SUBJECTXPOS WORD) (* ; "Where msg subject starts") (BROWSERDIGITWIDTH WORD) (FIRSTSELECTEDMESSAGE WORD) (* ; "First/last msgs currently selected") (LASTSELECTEDMESSAGE WORD) (FIRSTCHANGEDMESSAGE WORD) (* ; "First message with any change--not currently used") (CURRENTPROMPTLINE WORD) (* ; "Value of \currentdisplayline for browser prompt") (CURRENTDISPLAYEDSTREAM POINTER) (* ; "The backing core file for the current message (not used interestingly)") (BROWSEREXTENT POINTER) (BROWSERORIGIN POINTER) (FOLDERDISPLAYREGION POINTER) (* ; "Region of display window (valid when browser shrunk)") (BROWSERWINDOW POINTER) (* ; "The browser window and various pieces...") (BROWSERMENU POINTER) (BROWSERMENUWINDOW POINTER) (BROWSERPROMPTWINDOW POINTER) (ORIGINALBROWSERTITLE POINTER) (* ; "Original title before we added %"default move to%"") (FOLDERDISPLAYWINDOWS POINTER) (* ; "WIndows currently displaying messages from this folder.  First element is %"primary%" display window, or NIL") (FOLDEREOFPTR POINTER) (* ; "Length of file") (DEFAULTMOVETOFILE POINTER) (* ; "Folder we last moved to, or NIL") (CURRENTDISPLAYEDMESSAGE POINTER) (* ; "Message descriptor of most recently displayed message") (BROWSERUPDATEFROMHERE POINTER) (* ; "First potentially changed message, from which redisplay needs to occur when icon expands.") (BROWSERLAYOUT POINTER) (* ; "The element of LAFITEBROWSERLAYOUTS used to build this window, if any") (FOLDERCREATIONDATE POINTER) (* ; "the ICREATIONDATE of the file") (HARDCOPYMESSAGES POINTER) (* ; "List of msg descriptors being hardcopied") (HARDCOPYSTREAM POINTER) (* ; "A Textstream for pending hardcopy"))
+ (BLOCKRECORD MAILFOLDER ((NIL 5 FLAG) (NIL BITS 2) (BROWSERREADYBIT FLAG) (* ; "Low bit of status on means ready")))
+ (ACCESSFNS MAILFOLDER ((BROWSERREADY (fetch (MAILFOLDER BROWSERREADYBIT) of DATUM) (REPLACE (MAILFOLDER BROWSERSTATUS) OF DATUM WITH (COND (NEWVALUE LAS.READY) (T LAS.PARSING))))))
+)
+
+(RECORD FOLDERGROUP
 (FGNAME (FGTOPLEVEL . FGSUBGROUPS) . FGFOLDERS))
+
+(RECORD DEFAULTHOST&DIR
 (PACKEDHOST&DIR . UNPACKEDHOST&DIR) (PROPRECORD UNPACKEDHOST&DIR (DEFAULTDIR DEFAULTHOST DEFAULTDEV))
+)
+
+(RECORD MAILSERVER
 (MAILSERVEROPS MAILPORT MAILSERVERNAME CONTINUANCE NEWMAILP . MAILSTATE))
+
+(RECORD MAILSERVEROPS
 (POLLNEWMAIL OPENMAILBOX NEXTMESSAGE RETRIEVEMESSAGE CLOSEMAILBOX SERVERPORTFROMNAME)
+)
+
+(RECORD OPENEDMAILBOX
 (MAILBOX . PROPERTIES) (PROPRECORD PROPERTIES (%#OFMESSAGES)))
+
+(RECORD OUTBOX
 (OBWINDOW OBSIZE OBHEIGHT OBDESCENT OBORIGIN OBITEMS))
+
+(RECORD PROFILEVAR
 (PFVARNAME PFRECONCILIATIONFN PFLOADFN PFDUMPFN))
+)
+
+(/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 FIXP)) (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) (LAFITEMSG 16 FIXP))) (QUOTE 18))
+
+(/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))
+
+
+
+(* ; "characteristics of standard Laurel messages")

+
+(DECLARE%: EVAL@COMPILE 
+
+(RPAQQ LAFITEBASICSTAMPLENGTH 19)
+
+(RPAQQ LAFITESTAMPLENGTH 24)
+
+(RPAQ DELETEDFLAG (CHARCODE D))
+
+(RPAQ UNDELETEDFLAG (CHARCODE U))
+
+(RPAQ SEENFLAG (CHARCODE S))
+
+(RPAQ UNSEENFLAG (CHARCODE U))
+
+(RPAQQ DUPLICATEMARK 128)
+
+
+(CONSTANTS (LAFITEBASICSTAMPLENGTH 19) (LAFITESTAMPLENGTH 24) (DELETEDFLAG (CHARCODE D)) (UNDELETEDFLAG (CHARCODE U)) (SEENFLAG (CHARCODE S)) (UNSEENFLAG (CHARCODE U)) (DUPLICATEMARK 128))
+)
+
+
+
+(* ; "Stuff for table of contents")

+
+(DECLARE%: EVAL@COMPILE 
+
+(RPAQQ LAFITETOCPASSWORD 45610)
+
+(RPAQQ LAFITETOCHEADERLENGTH 10)
+
+
+(CONSTANTS LAFITETOCPASSWORD LAFITETOCHEADERLENGTH)
+)
+
+
+
+(* ; "Browser status values.  %"Ready%" values have low bit 1.")

+
+(DECLARE%: EVAL@COMPILE 
+
+(RPAQQ LAS.READY 1)
+
+(RPAQQ LAS.LOGGED.OUT 3)
+
+
+(CONSTANTS LAS.READY LAS.LOGGED.OUT)
+)
+(DECLARE%: EVAL@COMPILE 
+
+(RPAQQ LAS.PARSING 0)
+
+(RPAQQ LAS.FLUSHED 2)
+
+(RPAQQ LAS.OUT.OF.DATE 4)
+
+
+(CONSTANTS LAS.PARSING LAS.FLUSHED LAS.OUT.OF.DATE)
+)
+
+
+
+(* ; "Bits for figuring out which menu to use on Update, etc.")

+
+(DECLARE%: EVAL@COMPILE 
+
+(RPAQQ \HARDCOPY.MENU.BIT 1)
+
+(RPAQQ \UPDATE.MENU.BIT 2)
+
+(RPAQQ \TOC.MENU.BIT 4)
+
+(RPAQQ \EXPUNGE.MENU.BIT 8)
+
+(RPAQQ \SORT.MENU.BIT 16)
+
+(RPAQQ \EXPUNGE&SORT.MENU.BIT 32)
+
+(RPAQQ \CLOSE.MENU.BIT 64)
+
+(RPAQQ \SHRINK.MENU.BIT 128)
+
+
+(CONSTANTS (\HARDCOPY.MENU.BIT 1) (\UPDATE.MENU.BIT 2) (\TOC.MENU.BIT 4) (\EXPUNGE.MENU.BIT 8) (\SORT.MENU.BIT 16) (\EXPUNGE&SORT.MENU.BIT 32) (\CLOSE.MENU.BIT 64) (\SHRINK.MENU.BIT 128))
+)
+
+
+
+(* ; "For iterating over the selected messages of a browser")

+
+(DECLARE%: EVAL@COMPILE 
+
+(I.S.OPR (QUOTE SELECTEDIN) NIL (QUOTE (bind ($$MESSAGES _ (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of BODY)) ($$MSG# _ (SUB1 (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of BODY))) ($$MSGLAST _ (fetch (MAILFOLDER LASTSELECTEDMESSAGE) of BODY)) until (IGREATERP (add $$MSG# 1) $$MSGLAST) when (fetch (LAFITEMSG SELECTED?) of (SETQ I.V. (NTHMESSAGE $$MESSAGES $$MSG#))))))
+)
+(DECLARE%: EVAL@COMPILE 
+
+(PROGN (PUTPROPS WORDIN DMACRO (= . \WIN)) (PUTPROPS WORDIN MACRO (= . \WIN)))
+
+(PUTPROPS FIXPIN DMACRO (OPENLAMBDA (STREAM) (\MAKENUMBER (WORDIN STREAM) (WORDIN STREAM))))
+
+(PUTPROPS WORDOUT DMACRO (= . \WOUT))
+
+(PUTPROPS FIXPOUT DMACRO (OPENLAMBDA (STREAM N) (PROGN (WORDOUT STREAM (LRSH N 16)) (WORDOUT STREAM (LOGAND N 65535)))))
+
+(PUTPROPS UCASECODE MACRO (OPENLAMBDA (CHAR) (COND ((AND (IGEQ CHAR (CHARCODE a)) (ILEQ CHAR (CHARCODE z))) (LOGAND CHAR 95)) (T CHAR))))
+
+(PUTPROPS NTHMESSAGE MACRO (= . ELT))
+
+(PUTPROPS .LAFITEMENU. MACRO ((NAME ITEMS TITLE) (PROGN (DECLARE (GLOBALVARS NAME)) (OR NAME (SETQ NAME (\LAFITE.CREATE.MENU ITEMS TITLE))))))
+
+(PUTPROPS MAYBEVERIFYMSG MACRO ((MSG MAILFOLDER) (AND LAFITEVERIFYFLG (\LAFITE.VERIFYMSG MSG MAILFOLDER))))
+
+(PUTPROPS UNSEENMARKP MACRO (OPENLAMBDA (MK) (OR (EQ MK UNSEENMARK) (EQ MK HEARDMARK))))
+)
+
+(RPAQQ LAFITEGLOBALS (*LAFITE-WELL-KNOWN-MODES* ANOTHERFOLDERMENUITEM AROUNDEXITFNS BackgroundMenu BackgroundMenuCommands FORWARDMARK HARDCOPYBATCHMARK HARDCOPYMARK HEARDMARK LA.CROSSCURSOR LA.SELECTION.BITMAP LAFITE.PERSONAL.VARS LAFITE.UPDATE.MENU.HASH LAFITE.USER.INFO LAFITEEOL LAFITEFOLDERSMENU LAFITEFORMSMENU LAFITEITEMBUSYSHADE LAFITEMAILFOLDERS LAFITEMAINMENU LAFITEMULTIPLEFOLDERSMENU LAFITEPROFILERDTBL LAFITESTATUSWINDOW LAFITESUBBROWSEMENU LAFITESUBQUITMENU LAFITESYSTEMDATE LAFITEVERSION# LASTMOUSEBUTTONS LASTMOUSEX LASTMOUSEY LOGINHOST/DIR PROMPTWINDOW SCREENHEIGHT SCREENWIDTH SEENMARK UNSEENMARK UNSUPPLIEDFIELDSTR UPPERCASEARRAY WINDOWTITLEFONT \ACTIVELAFITEFOLDERS \AFTERLOGINFNS \LAFITE.ACTIVE \LAFITE.ACTIVE.MODES \LAFITE.BROWSELOCK \LAFITE.CURRENT.USER \LAFITE.HARDCOPYLOCK \LAFITE.LAST.STATUS \LAFITE.MAILSERVERLOCK \LAFITE.MAINLOCK \LAFITE.MODE.CHOICES \LAFITE.OUTBOX \LAFITE.PROFILELOCK \LAFITE.PSEUDO.DEVICES \LAFITE.READY \LAFITE.TEMPFILES \LAFITEDEFAULTHOST&DIR \LAFITEMODE \LAFITEPROFILECHANGED \LAFITEPROFILEDATE \LAPARSE.DONT.DISPLAY.HEADERS \LAPARSE.DONT.FORWARD.HEADERS \LAPARSE.DONT.HARDCOPY.HEADERS LAFITE.FOLDER.STRUCTURE LAFITE.SPACER.MENU.ITEM))
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS *LAFITE-WELL-KNOWN-MODES* ANOTHERFOLDERMENUITEM AROUNDEXITFNS BackgroundMenu BackgroundMenuCommands FORWARDMARK HARDCOPYBATCHMARK HARDCOPYMARK HEARDMARK LA.CROSSCURSOR LA.SELECTION.BITMAP LAFITE.PERSONAL.VARS LAFITE.UPDATE.MENU.HASH LAFITE.USER.INFO LAFITEEOL LAFITEFOLDERSMENU LAFITEFORMSMENU LAFITEITEMBUSYSHADE LAFITEMAILFOLDERS LAFITEMAINMENU LAFITEMULTIPLEFOLDERSMENU LAFITEPROFILERDTBL LAFITESTATUSWINDOW LAFITESUBBROWSEMENU LAFITESUBQUITMENU LAFITESYSTEMDATE LAFITEVERSION# LASTMOUSEBUTTONS LASTMOUSEX LASTMOUSEY LOGINHOST/DIR PROMPTWINDOW SCREENHEIGHT SCREENWIDTH SEENMARK UNSEENMARK UNSUPPLIEDFIELDSTR UPPERCASEARRAY WINDOWTITLEFONT \ACTIVELAFITEFOLDERS \AFTERLOGINFNS \LAFITE.ACTIVE \LAFITE.ACTIVE.MODES \LAFITE.BROWSELOCK \LAFITE.CURRENT.USER \LAFITE.HARDCOPYLOCK \LAFITE.LAST.STATUS \LAFITE.MAILSERVERLOCK \LAFITE.MAINLOCK \LAFITE.MODE.CHOICES \LAFITE.OUTBOX \LAFITE.PROFILELOCK \LAFITE.PSEUDO.DEVICES \LAFITE.READY \LAFITE.TEMPFILES \LAFITEDEFAULTHOST&DIR \LAFITEMODE \LAFITEPROFILECHANGED \LAFITEPROFILEDATE \LAPARSE.DONT.DISPLAY.HEADERS \LAPARSE.DONT.FORWARD.HEADERS \LAPARSE.DONT.HARDCOPY.HEADERS LAFITE.FOLDER.STRUCTURE LAFITE.SPACER.MENU.ITEM)
+)
+
+(COND ((< (IDATE TEDITSYSTEMDATE) (IDATE "1-mar-88 00:00")) (* ; "Bug in older TEXTPROP--just compile it closed.") (REMPROP (QUOTE TEXTPROP) (QUOTE COMPILER:OPTIMIZER-LIST))))
+
+(CL:PROCLAIM (QUOTE (CL:SPECIAL *LAFITE-MODE-DATA* *UPPER-CASE-FILE-NAMES* \#DISPLAYLINES)))
+
+
+
+(* ; "LAFITE.PROCLAMATIONS are exported to user in file LAFITE--these are the documented variables")

+
+
+(RPAQQ LAFITE.PROCLAMATIONS ((CL:PROCLAIM (QUOTE (GLOBAL ANSWERMARK BROWSERMARKXPOSITION DEFAULTMAILFOLDERNAME LAFITE.2COLUMN.MENU.MIN.ITEMS LAFITE.AUTO.MOVE.MENU 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.DUMMY.HALF.SHADE LAFITE.DUMMY.SHADE LAFITE.EDITOR.LAYOUTS LAFITE.EDITOR.SIZE LAFITE.EXTRA.DISPLAY.COMMANDS LAFITE.EXTRA.MOVE.ITEMS 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 LAFITEEXTRAMENUITEMS LAFITEFIXEDWIDTHFONT LAFITEFORM.EXT LAFITEFORMFILES LAFITEFROMFRACTION LAFITEHARDCOPY.MIN.TOC LAFITEHARDCOPYBATCHFLG LAFITEHARDCOPYBATCHSHADE LAFITEHARDCOPYFONT LAFITEHARDCOPYSEPARATOR LAFITEIFFROMMETHENSEENFLG LAFITEINFO.NAME LAFITEMAIL.EXT LAFITEMENUFONT LAFITEMENUVARS LAFITEMINFROMCHARS LAFITEMODEDEFAULT LAFITEMODELST LAFITEMOVETOCONFIRMFLG LAFITEMSGICONFONT LAFITENEWPAGEFLG LAFITESHOWMODEFLG LAFITESTATUSWINDOWMINWIDTH LAFITESTATUSWINDOWPOSITION LAFITESUBBROWSEMENUITEMS LAFITESUBQUITMENUITEMS LAFITETITLEFONT LAFITETOC.EXT LAFITEUPDATEMENUITEMS MOVETOMARK))) (CL:PROCLAIM (QUOTE (CL:SPECIAL LAFITEVERIFYFLG)))))
+
+(CL:PROCLAIM (QUOTE (GLOBAL ANSWERMARK BROWSERMARKXPOSITION DEFAULTMAILFOLDERNAME LAFITE.2COLUMN.MENU.MIN.ITEMS LAFITE.AUTO.MOVE.MENU 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.DUMMY.HALF.SHADE LAFITE.DUMMY.SHADE LAFITE.EDITOR.LAYOUTS LAFITE.EDITOR.SIZE LAFITE.EXTRA.DISPLAY.COMMANDS LAFITE.EXTRA.MOVE.ITEMS 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 LAFITEEXTRAMENUITEMS LAFITEFIXEDWIDTHFONT LAFITEFORM.EXT LAFITEFORMFILES LAFITEFROMFRACTION LAFITEHARDCOPY.MIN.TOC LAFITEHARDCOPYBATCHFLG LAFITEHARDCOPYBATCHSHADE LAFITEHARDCOPYFONT LAFITEHARDCOPYSEPARATOR LAFITEIFFROMMETHENSEENFLG LAFITEINFO.NAME LAFITEMAIL.EXT LAFITEMENUFONT LAFITEMENUVARS LAFITEMINFROMCHARS LAFITEMODEDEFAULT LAFITEMODELST LAFITEMOVETOCONFIRMFLG LAFITEMSGICONFONT LAFITENEWPAGEFLG LAFITESHOWMODEFLG LAFITESTATUSWINDOWMINWIDTH LAFITESTATUSWINDOWPOSITION LAFITESUBBROWSEMENUITEMS LAFITESUBQUITMENUITEMS LAFITETITLEFONT LAFITETOC.EXT LAFITEUPDATEMENUITEMS MOVETOMARK)))
+
+(CL:PROCLAIM (QUOTE (CL:SPECIAL LAFITEVERIFYFLG)))
+
+
+
+(* ; "For debugging with Masterscope, here are fns not called from code")

+
+
+(RPAQQ LAFITE.CALLED.FROM.LITERALS (GV.CLOSEMAILBOX GV.INIT.MAIL.USER GV.MAKEANSWERFORM GV.NEXTMESSAGE GV.OPENMAILBOX GV.POLLNEWMAIL GV.PORTFROMNAME GV.RETRIEVEMESSAGE LAFITE.COMPUTE.CACHED.VARS LAFITE.GRAB.DATE LAFITE.ON.FROM.BACKGROUND LAFITE.PARSE.DATE.FIELD.ONLY LAFITE.READ.FORMAT LAFITE.READ.LINE.FOR.TOC LAFITE.READ.NAME.FIELD LAFITE.READ.ONE.LINE.FOR.TOC LAFITE.RENAME.GROUP MAKELAFITESUPPORTFORM MAKELISPSUPPORTFORM SET.LAFITE.MODE.INTERACTIVELY \GV.MESSAGE.FROM.SELF.P \GV.MESSAGE.P \GV.SEND.PARSE \GV.SENDMESSAGE \LAFITE.ANSWER \LAFITE.BROWSE \LAFITE.BROWSE.FORGET \LAFITE.BROWSE.PROC \LAFITE.CANCEL.HARDCOPY \LAFITE.COPYTO \LAFITE.DELETE \LAFITE.DELETE.GROUP \LAFITE.DESCRIBE.FOLDER \LAFITE.DISPLAY \LAFITE.EDIT.HIERARCHY \LAFITE.ENABLE.MOVE.MENU \LAFITE.EXPUNGE.PROC \LAFITE.FIND \LAFITE.FIND.AGAIN \LAFITE.FIND.RELATED \LAFITE.FIND.RELATED.BACKWARD \LAFITE.FORWARD \LAFITE.GC.FOLDERS \LAFITE.GETMAIL \LAFITE.GETMAIL.FROM.ICON \LAFITE.GLOBAL.INIT \LAFITE.GO.TO.FIRST \LAFITE.GO.TO.INTERACTIVE \LAFITE.GO.TO.LAST \LAFITE.HARDCOPY \LAFITE.HARDCOPY.FROM.DISPLAY \LAFITE.HARDCOPYONLY.PROC \LAFITE.LOGIN.NORESTART \LAFITE.MERGE.FOLDERS \LAFITE.MERGE.NAMELISTS \LAFITE.MERGE.STRUCTURES \LAFITE.MESSAGEFORM \LAFITE.MOVETO \LAFITE.NOTICE.FOLDERS \LAFITE.QUIT \LAFITE.QUIT \LAFITE.REAUTHENTICATE \LAFITE.REHIDE.HEADERS \LAFITE.RENAME.FOLDER \LAFITE.RESTART \LAFITE.RESTORE.MOVE.MENU \LAFITE.SET.DEFAULT.LOOKS \LAFITE.SET.FIXED.LOOKS \LAFITE.SET.LOOKS.FROM.MENU \LAFITE.SORT.BY.DATE.REGION \LAFITE.UNCACHE.FOLDER \LAFITE.UNCACHE.MESSAGEFORM \LAFITE.UNDELETE \LAFITE.UNHIDE.HEADERS \LAFITE.UPDATE \LAFITE.UPDATE.PROC \LAFITE.UPDATE.PROC \MAILOBJ.EXPAND \MAILOBJ.FB \MAILOBJ.HARDCOPY \MAILOBJ.INIT \MAILOBJ.PUT.FILE \MAILOBJ.VIEW \NS.READ.ENVELOPE.ITEM \NS.WRITE.ENVELOPE.ITEM \NSMAIL.AUTHENTICATE \NSMAIL.LOGIN \NSMAIL.MAKEANSWERFORM \NSMAIL.MESSAGE.FROM.SELF.P \NSMAIL.MESSAGE.P \NSMAIL.SEND \NSMAIL.SEND.PARSE \SENDMSG.CHANGE.MODE \SENDMSG.DELIVER \SENDMSG.SAVE.FORM))
+
+(RPAQQ LAFITE.PROGRAMMER.ENTRIES (LAFITEDEFAULTHOST&DIR LOAD-LAFITE LAFITE.SENDMESSAGE BUILD.LAFITE.LAYOUTS LAB.SELECTED.MESSAGES LAFITE.DELETE.MESSAGES LAFITE.MOVE.MESSAGES LAFITE.HARDCOPY.MESSAGES LAFITE.OBTAIN.FOLDER MAILSCAVENGE MS.EXPAND GV.READTOC GV.WRITETOC GV.DELETEMESSAGE))
+
+(DEFCOMMAND (WHONOTLAFITE :HISTORY) NIL (QUOTE ((CL:SET-DIFFERENCE (CL:SET-DIFFERENCE (%. WHO ON ANY IN LAFITEFILES IS NOT CALLED) LAFITE.CALLED.FROM.LITERALS) LAFITE.PROGRAMMER.ENTRIES))))
+
+(DEFCOMMAND (CHECKLAFITE :HISTORY) NIL (QUOTE ((FOR FILE IN LAFITEFILES DO (EVAL (BQUOTE (%. CHECK (\, FILE))))))))
+(DECLARE%: DONTEVAL@COMPILE 
+
+(SETTEMPLATE (QUOTE WINDOWPROP) (QUOTE (EVAL PROP EVAL . PPE)))
+
+(SETTEMPLATE (QUOTE WINDOWADDPROP) (QUOTE (EVAL PROP EVAL EVAL . PPE)))
+
+(SETTEMPLATE (QUOTE WINDOWDELPROP) (QUOTE (EVAL PROP EVAL . PPE)))
+
+(SETTEMPLATE (QUOTE PROCESSPROP) (QUOTE (EVAL PROP EVAL . PPE)))
+
+(SETTEMPLATE (QUOTE TEXTPROP) (QUOTE (EVAL PROP EVAL . PPE)))
+)
+(PUTPROPS LAFITEDECLS COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 1989))
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL)))
+STOP

library/lafite/LAFITEFIND

@@ -0,0 +1,191 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
(FILECREATED " 3-Jun-92 10:10:41" {DSK}<usr>local>users>welch>lisp>lafite>LAFITEFIND.;2
 15951  
+
+      previous date%: "15-Jun-90 16:06:40" {DSK}<usr>local>users>welch>lisp>lafite>LAFITEFIND.;1)
+
+
+(* ; "
+Copyright (c) 1984, 1985, 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation.  All rights reserved.
+")
+
+(PRETTYCOMPRINT LAFITEFINDCOMS)
+
+(RPAQQ LAFITEFINDCOMS
 ((FNS \LAFITE.FIND \LAFITE.FIND.RELATED \LAFITE.FIND.RELATED.BACKWARD 
+                                \LAFITE.GO.TO.FIRST \LAFITE.GO.TO.INTERACTIVE \LAFITE.GO.TO.LAST 
+                                \LAFITE.FIND.AGAIN \LAFITE.FIND.PROMPT \LAFITE.DO.FIND 
+                                \LAFITE.FIND.START)
+                           (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS SEARCHSTATE)
+                                  (GLOBALVARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS 
+                                         LAFITEFINDTYPEMENU LAFITEFINDAREAMENU LAFITEEXTRAMENU 
+                                         LAFITEEXTRAMENUFLG \LAFITE.LAST.SEARCH)
+                                  (FILES (SOURCE)
+                                         LAFITEDECLS)
+                                  (LOCALVARS . T))
+                           (INITVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)
+                           (VARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS)
+                           (ADDVARS [LAFITEEXTRAMENUITEMS ("Find" '\LAFITE.FIND 
+                                                                 "Search mail for something")
+                                           ["Find Related" '\LAFITE.FIND.RELATED 
+                                            "Find all messages from here on in reply to this message"
+                                                  (SUBITEMS ("Find Related Forward" 
+                                                                   '\LAFITE.FIND.RELATED)
+                                                         ("Find Related Backward" 
+                                                                '\LAFITE.FIND.RELATED.BACKWARD]
+                                           ("Find Again" '\LAFITE.FIND.AGAIN "Repeat previous search"
+                                                  )
+                                           ("Go to #" '\LAFITE.GO.TO.INTERACTIVE 
+                                                 "Scroll to and select a specific message by number."
+                                                  (SUBITEMS ("Go to First" '\LAFITE.GO.TO.FIRST 
+                                                                "Scroll to and select first message."
+                                                                   )
+                                                         ("Go to Last" '\LAFITE.GO.TO.LAST 
+                                                                "Scroll to and select last message."]
+                                  (LAFITEMENUVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU))
+                           (VARS (\LAFITE.LAST.SEARCH))))
+(DEFINEQ
+
+(\LAFITE.FIND

+(LAMBDA (MAILFOLDER) (* bvm%: "25-Feb-86 14:29") (* ; "Invoked by Find command") (PROG (SEARCHDIRECTION SEARCHAREA SEARCHSTRING) (OR (SETQ SEARCHDIRECTION (MENU (OR LAFITEFINDTYPEMENU (SETQ LAFITEFINDTYPEMENU (create MENU ITEMS _ LAFITEFINDTYPEMENUITEMS MENUFONT _ LAFITEMENUFONT CENTERFLG _ T))))) (RETURN)) (OR (SETQ SEARCHAREA (MENU (OR LAFITEFINDAREAMENU (SETQ LAFITEFINDAREAMENU (create MENU ITEMS _ LAFITEFINDAREAMENUITEMS MENUFONT _ LAFITEMENUFONT CENTERFLG _ T))))) (RETURN)) (COND ((EQ SEARCHAREA (QUOTE Related)) (SETQ SEARCHSTRING (fetch (LAFITEMSG SUBJECT) of (NTHMESSAGE (fetch MESSAGEDESCRIPTORS of MAILFOLDER) (fetch LASTSELECTEDMESSAGE of MAILFOLDER)))) (COND ((STRING-EQUAL (SUBSTRING SEARCHSTRING 1 4) "Re: ") (SETQ SEARCHSTRING (SUBSTRING SEARCHSTRING 5)))) (SETQ SEARCHAREA (QUOTE Subject))) ((SETQ SEARCHSTRING (\LAFITE.FIND.PROMPT MAILFOLDER SEARCHAREA))) (T (RETURN))) (\LAFITE.DO.FIND MAILFOLDER (CAR SEARCHDIRECTION) SEARCHAREA SEARCHSTRING NIL (EQ (CADR SEARCHDIRECTION) (QUOTE ALL)))))
+)
+
+(\LAFITE.FIND.RELATED

+(LAMBDA (MAILFOLDER DIRECTION) (* bvm%: "25-Feb-86 12:42") (* ;;; "Find message that shares subject with this one.") (OR DIRECTION (SETQQ DIRECTION FORWARD)) (LET* ((FROM# (\LAFITE.FIND.START MAILFOLDER DIRECTION)) (SEARCHSTRING (fetch (LAFITEMSG SUBJECT) of (NTHMESSAGE (fetch MESSAGEDESCRIPTORS of MAILFOLDER) FROM#)))) (COND ((OR (NULL SEARCHSTRING) (EQ (NCHARS SEARCHSTRING) 0)) (LAB.PROMPTPRINT MAILFOLDER " can't--message has no Subject")) (T (COND ((STRING-EQUAL (SUBSTRING SEARCHSTRING 1 4) "Re: ") (SETQ SEARCHSTRING (SUBSTRING SEARCHSTRING 5)))) (\LAFITE.DO.FIND MAILFOLDER DIRECTION (QUOTE Subject) SEARCHSTRING FROM# T T)))))
+)
+
+(\LAFITE.FIND.RELATED.BACKWARD

+(LAMBDA (MAILFOLDER) (* bvm%: " 5-Mar-84 17:28") (\LAFITE.FIND.RELATED MAILFOLDER (QUOTE BACKWARD))))
+
+(\LAFITE.GO.TO.FIRST

+(LAMBDA (FOLDER) (* ; "Edited 23-Aug-88 18:35 by bvm") (AND (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER) (LAB.GO.TO.MESSAGE FOLDER 1)))
+)
+
+(\LAFITE.GO.TO.INTERACTIVE

+(LAMBDA (FOLDER) (* ; "Edited 23-Aug-88 18:35 by bvm") (* ;; "Called from title menu to go to some user specified message.") (ALLOW.BUTTON.EVENTS) (LET ((N (PROGN (TTY.PROCESS (THIS.PROCESS)) (LAB.PROMPTPRINT FOLDER "Type or select number of message.") (PROG1 (RNUMBER "Message#" NIL NIL NIL T NIL T T) (TTY.PROCESS T)))) MAX) (if (AND N (> N 0)) then (if (> N (SETQ MAX (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER))) then (LAB.FORMAT FOLDER T "There are only ~D messages in this folder." MAX) (SETQ N MAX) else (\LAFITE.MAYBE.CLEAR.PROMPT FOLDER)) (LAB.GO.TO.MESSAGE FOLDER N))))
+)
+
+(\LAFITE.GO.TO.LAST

+(LAMBDA (FOLDER) (* ; "Edited 23-Aug-88 18:35 by bvm") (AND (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER) (LAB.GO.TO.MESSAGE FOLDER (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER))))
+)
+
+(\LAFITE.FIND.AGAIN

+  [LAMBDA (MAILFOLDER)
                                   (* ; "Edited 15-Jun-90 16:03 by jds")

+    (LET ((LASTSEARCH \LAFITE.LAST.SEARCH))
+         (COND
+            (LASTSEARCH (\LAFITE.DO.FIND
 MAILFOLDER (fetch
 (SEARCHSTATE SEARCHDIRECTION)
+                                                           of
 LASTSEARCH)
+                               (fetch
 (SEARCHSTATE SEARCHAREA) of
 LASTSEARCH)
+                               (fetch
 (SEARCHSTATE SEARCHSTRING) of
 LASTSEARCH)))
+            (T (\LAFITE.FIND
 MAILFOLDER])
+
+(\LAFITE.FIND.PROMPT

+  [LAMBDA (MAILFOLDER SEARCHAREA)
                        (* ; "Edited 15-Jun-90 16:03 by jds")

+
+(* ;;; "prompt for search string for a search of the indicated area.  Return NIL if aborted.")

+
+    (RESETLST
+        (LET ((WINDOW (fetch
 (MAILFOLDER BROWSERPROMPTWINDOW) of
 MAILFOLDER))
+              (LASTSEARCH \LAFITE.LAST.SEARCH)
+              RESULT)
+             (CLEARW WINDOW)
+             (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (W)
+                                              (COND
+                                                 (RESETSTATE (printout W "...aborted")))
+                                              (WINDOWPROP W 'PROCESS NIL]
+                                  WINDOW))
+             (COND
+                ([COND
+                    ((EQ SEARCHAREA 'Mark)
+                     (LAB.PROMPTPRINT MAILFOLDER T "Find message marked: ")
+                     (RESETSAVE (TTYDISPLAYSTREAM WINDOW))
+                     (< (SETQ RESULT (\GETKEY))
+                        (CHARCODE SPACE)))
+                    (T (NULL (SETQ RESULT (TTYINPROMPTFORWORD (CONCAT "Find " SEARCHAREA " string: ")
+                                                 (AND LASTSEARCH (NOT (fetch
 (SEARCHSTATE 
+                                                                                        SEARCHREPLYTO
+                                                                                        )
+                                                                         of
 LASTSEARCH))
+                                                      (EQ SEARCHAREA (fetch
 (SEARCHSTATE 
+                                                                                       SEARCHAREA)
+                                                                        of
 LASTSEARCH))
+                                                      (fetch
 (SEARCHSTATE SEARCHSTRING)
+                                                         of
 LASTSEARCH))
+                                                 NIL WINDOW NIL NIL (CHARCODE (CR]
+                 (ERROR!)))
+             RESULT))])
+
+(\LAFITE.DO.FIND

+(LAMBDA (MAILFOLDER DIRECTION AREA SEARCHSTRING FROM# ALLFLG REPLYTO?) (* ; "Edited 23-Sep-87 18:35 by bvm:") (PROG ((MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER)) (LASTMSG# (fetch (MAILFOLDER %#OFMESSAGES) of MAILFOLDER)) MSG MSG# ADDFLG %#FOUND FIRSTFOUND# INSTREAM CURRENT LASTSEL MARK) (SELECTQ AREA (Body (ALLOW.BUTTON.EVENTS) (* ; "Could take a while") (SETQ INSTREAM (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE INPUT) :ABORT))) (Mark (SETQ SEARCHSTRING (UCASECODE SEARCHSTRING))) NIL) (COND ((NOT FROM#) (SETQ FROM# (\LAFITE.FIND.START MAILFOLDER DIRECTION)))) (SETQ MSG# (COND (ALLFLG (* ; "Be sure to include starting message, assuming it matches") (SELECTQ DIRECTION (FORWARD (SUB1 FROM#)) (ADD1 FROM#))) (T FROM#))) LP (until (SELECTQ DIRECTION (FORWARD (> (add MSG# 1) LASTMSG#)) (<= (add MSG# -1) 0)) do (SETQ MSG (NTHMESSAGE MESSAGES MSG#)) (COND ((SELECTQ AREA (From (* ; "Include the To: field in messages from self") (OR (STRPOS SEARCHSTRING (fetch (LAFITEMSG FROM) of MSG) 1 NIL NIL NIL UPPERCASEARRAY) (AND (fetch (LAFITEMSG MSGFROMMEP) of MSG) (STRPOS SEARCHSTRING (fetch (LAFITEMSG TO) of MSG) 1 NIL NIL NIL UPPERCASEARRAY)))) (Subject (STRPOS SEARCHSTRING (fetch (LAFITEMSG SUBJECT) of MSG) 1 NIL NIL NIL UPPERCASEARRAY)) (Body (FILEPOS SEARCHSTRING INSTREAM (fetch (LAFITEMSG START) of MSG) (fetch (LAFITEMSG END) of MSG) NIL NIL UPPERCASEARRAY)) (Mark (OR (EQ (SETQ MARK (fetch (LAFITEMSG MARKCHAR) of MSG)) SEARCHSTRING) (EQ (UCASECODE MARK) SEARCHSTRING))) (SHOULDNT)) (COND ((NOT ADDFLG) (UNSELECTALLMESSAGES MAILFOLDER) (SETQ ADDFLG T))) (LA.SELECTRANGE MAILFOLDER MSG# MSG# T) (LA.SHOW.SELECTION MAILFOLDER MSG (QUOTE REPLACE)) (COND ((NOT %#FOUND) (SETQ %#FOUND 1) (COND ((NOT ALLFLG) (LAB.PROMPTPRINT MAILFOLDER "Found in message " MSG#) (LAB.EXPOSEMESSAGE MAILFOLDER MSG) (RETURN))) (SETQ FIRSTFOUND# MSG#)) (T (add %#FOUND 1)))))) (COND ((OR (NULL %#FOUND) (AND (EQ %#FOUND 1) (EQ FIRSTFOUND# FROM#))) (* ; "Didn't find it, or found it only in the starting message (in the case of ALLFLG)") (COND (REPLYTO? (LAB.PROMPTPRINT MAILFOLDER "No related message found")) (T (LAB.PROMPTPRINT MAILFOLDER "%"" (COND ((FIXP SEARCHSTRING) (CHARACTER SEARCHSTRING)) (T SEARCHSTRING)) "%" not found")))) (ALLFLG (* ; "Multiple find") (LAB.PROMPTPRINT MAILFOLDER "Found in " %#FOUND " messages") (LAB.EXPOSEMESSAGE MAILFOLDER (NTHMESSAGE MESSAGES (COND ((AND (SETQ CURRENT (fetch (MAILFOLDER CURRENTDISPLAYEDMESSAGE) of MAILFOLDER)) (fetch (LAFITEMSG SELECTED?) of CURRENT)) (* ; "Scroll to message that would be displayed if user clicked 'Display' now") (COND ((EQ (fetch (LAFITEMSG %#) of CURRENT) (SETQ LASTSEL (fetch (MAILFOLDER LASTSELECTEDMESSAGE) of MAILFOLDER))) (* ; "Currently displaying the last one, so cycle back to first") (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of MAILFOLDER)) (T (LAB.FIND.SELECTED.MSG MAILFOLDER (ADD1 (fetch (LAFITEMSG %#) of CURRENT)) LASTSEL)))) (T (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of MAILFOLDER))))))) (SETQ \LAFITE.LAST.SEARCH (create SEARCHSTATE SEARCHSTRING _ SEARCHSTRING SEARCHDIRECTION _ DIRECTION SEARCHAREA _ AREA SEARCHREPLYTO _ REPLYTO?))))
+)
+
+(\LAFITE.FIND.START

+(LAMBDA (MAILFOLDER DIRECTION) (* bvm%: "25-Feb-86 12:33") (* ;; "Return the message to start searching from.  Forward searches start from last selected message, backward from first.  However, if that message is not visible, but some other message is, start from the visible message and print warning") (LET ((LAST# (fetch LASTSELECTEDMESSAGE of MAILFOLDER)) (FIRST# (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER)) VIS) (LAB.PROMPTPRINT MAILFOLDER T "Searching") (COND ((AND (NEQ LAST# FIRST#) (SELECTQ DIRECTION (BACKWARD (< (SETQ LAST# FIRST#) (SETQ VIS (FIRSTVISIBLEMESSAGE MAILFOLDER)))) (> LAST# (SETQ VIS (LASTVISIBLEMESSAGE MAILFOLDER))))) (* ; "Extreme selected message not visible, so tell user where search will start") (COND ((SETQ VIS (SELECTQ DIRECTION (BACKWARD (LAB.FIND.SELECTED.MSG MAILFOLDER VIS (LASTVISIBLEMESSAGE MAILFOLDER))) (LAB.REV.FIND.SELECTED.MSG MAILFOLDER (FIRSTVISIBLEMESSAGE MAILFOLDER) VIS))) (SETQ LAST# VIS))) (LAB.PROMPTPRINT MAILFOLDER " from msg " LAST#))) (LAB.PROMPTPRINT MAILFOLDER (QUOTE |...|)) LAST#))
+)
+)
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+(DECLARE%: EVAL@COMPILE
+
+(RECORD SEARCHSTATE
 (SEARCHSTRING SEARCHDIRECTION SEARCHAREA SEARCHREPLYTO))
+)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU 
+       LAFITEEXTRAMENU LAFITEEXTRAMENUFLG \LAFITE.LAST.SEARCH)
+)
+
+
+(FILESLOAD (SOURCE)
+       LAFITEDECLS)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(LOCALVARS . T)
+)
+)
+
+(RPAQ? LAFITEFINDTYPEMENU
 NIL)
+
+(RPAQ? LAFITEFINDAREAMENU
 NIL)
+
+(RPAQQ LAFITEFINDAREAMENUITEMS
 ((From 'From "Search From: field for string (or To: if from self)"
+                                          )
+                                    (Subject 'Subject "Search Subject: field for string")
+                                    (Body 'Body "Search message bodies for string")
+                                    (Mark 'Mark "Search for messages with specified mark character")
+                                    (Related 'Related 
+                                           "Search for a message with same Subject, modulo Re:")))
+
+(RPAQQ LAFITEFINDTYPEMENUITEMS
 (("Find Next One" '(FORWARD ONE)
+                                           "Search forward from selected message")
+                                    ("Find Next All" '(FORWARD ALL)
+                                           "Search forward from selected message")
+                                    ("Find Previous One" '(BACKWARD ONE)
+                                           "Search backward from selected message")
+                                    ("Find Previous All" '(BACKWARD ALL)
+                                           "Search backward from selected message")))
+
+(ADDTOVAR LAFITEEXTRAMENUITEMS
 ("Find" '\LAFITE.FIND "Search mail for something")
+                                   ["Find Related" '\LAFITE.FIND.RELATED 
+                                          "Find all messages from here on in reply to this message"
+                                          (SUBITEMS ("Find Related Forward" '\LAFITE.FIND.RELATED)
+                                                 ("Find Related Backward" 
+                                                        '\LAFITE.FIND.RELATED.BACKWARD]
+                                   ("Find Again" '\LAFITE.FIND.AGAIN "Repeat previous search")
+                                   ("Go to #" '\LAFITE.GO.TO.INTERACTIVE 
+                                          "Scroll to and select a specific message by number."
+                                          (SUBITEMS ("Go to First" '\LAFITE.GO.TO.FIRST 
+                                                           "Scroll to and select first message.")
+                                                 ("Go to Last" '\LAFITE.GO.TO.LAST 
+                                                        "Scroll to and select last message."))))
+
+(ADDTOVAR LAFITEMENUVARS
 LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)
+
+(RPAQQ \LAFITE.LAST.SEARCH
 NIL)
+(PUTPROPS LAFITEFIND COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1990 1992))
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (3089 12861 (\LAFITE.FIND 3099 . 4131) (\LAFITE.FIND.RELATED 4133 . 4798) (
+\LAFITE.FIND.RELATED.BACKWARD 4800 . 4936) (\LAFITE.GO.TO.FIRST 4938 . 5105) (
+\LAFITE.GO.TO.INTERACTIVE 5107 . 5719) (\LAFITE.GO.TO.LAST 5721 . 5929) (\LAFITE.FIND.AGAIN 5931 . 
+6513) (\LAFITE.FIND.PROMPT 6515 . 8637) (\LAFITE.DO.FIND 8639 . 11790) (\LAFITE.FIND.START 11792 . 
+12859)))))
+STOP

library/lafite/LAFITEFIND.~1~

@@ -0,0 +1,97 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
(FILECREATED "23-Aug-88 18:58:15" {ERIS}<LAFITE>SOURCES>LAFITEFIND.;13
 12215  
+
+      changes to%:  (VARS LAFITEFINDCOMS) (FNS \LAFITE.GO.TO.LAST \LAFITE.GO.TO.FIRST \LAFITE.GO.TO.INTERACTIVE)
+
+      previous date%: "29-Jul-88 11:59:44" {ERIS}<LAFITE>SOURCES>LAFITEFIND.;12)
+
+
+(* "
+Copyright (c) 1984, 1985, 1986, 1987, 1988 by Xerox Corporation.  All rights reserved.
+")
+
+(PRETTYCOMPRINT LAFITEFINDCOMS)
+
+(RPAQQ LAFITEFINDCOMS ((FNS \LAFITE.FIND \LAFITE.FIND.RELATED \LAFITE.FIND.RELATED.BACKWARD \LAFITE.GO.TO.FIRST \LAFITE.GO.TO.INTERACTIVE \LAFITE.GO.TO.LAST \LAFITE.FIND.AGAIN \LAFITE.FIND.PROMPT \LAFITE.DO.FIND \LAFITE.FIND.START) (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS SEARCHSTATE) (GLOBALVARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU LAFITEEXTRAMENU LAFITEEXTRAMENUFLG \LAFITE.LAST.SEARCH) (FILES (SOURCE) LAFITEDECLS) (LOCALVARS . T)) (INITVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU) (VARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS) (ADDVARS (LAFITEEXTRAMENUITEMS ("Find" (QUOTE \LAFITE.FIND) "Search mail for something") ("Find Related" (QUOTE \LAFITE.FIND.RELATED) "Find all messages from here on in reply to this message" (SUBITEMS ("Find Related Forward" (QUOTE \LAFITE.FIND.RELATED)) ("Find Related Backward" (QUOTE \LAFITE.FIND.RELATED.BACKWARD)))) ("Find Again" (QUOTE \LAFITE.FIND.AGAIN) "Repeat previous search") ("Go to #" (QUOTE \LAFITE.GO.TO.INTERACTIVE) "Scroll to and select a specific message by number." (SUBITEMS ("Go to First" (QUOTE \LAFITE.GO.TO.FIRST) "Scroll to and select first message.") ("Go to Last" (QUOTE \LAFITE.GO.TO.LAST) "Scroll to and select last message.")))) (LAFITEMENUVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)) (VARS (\LAFITE.LAST.SEARCH))))
+(DEFINEQ
+
+(\LAFITE.FIND

+(LAMBDA (MAILFOLDER) (* bvm%: "25-Feb-86 14:29") (* ; "Invoked by Find command") (PROG (SEARCHDIRECTION SEARCHAREA SEARCHSTRING) (OR (SETQ SEARCHDIRECTION (MENU (OR LAFITEFINDTYPEMENU (SETQ LAFITEFINDTYPEMENU (create MENU ITEMS _ LAFITEFINDTYPEMENUITEMS MENUFONT _ LAFITEMENUFONT CENTERFLG _ T))))) (RETURN)) (OR (SETQ SEARCHAREA (MENU (OR LAFITEFINDAREAMENU (SETQ LAFITEFINDAREAMENU (create MENU ITEMS _ LAFITEFINDAREAMENUITEMS MENUFONT _ LAFITEMENUFONT CENTERFLG _ T))))) (RETURN)) (COND ((EQ SEARCHAREA (QUOTE Related)) (SETQ SEARCHSTRING (fetch (LAFITEMSG SUBJECT) of (NTHMESSAGE (fetch MESSAGEDESCRIPTORS of MAILFOLDER) (fetch LASTSELECTEDMESSAGE of MAILFOLDER)))) (COND ((STRING-EQUAL (SUBSTRING SEARCHSTRING 1 4) "Re: ") (SETQ SEARCHSTRING (SUBSTRING SEARCHSTRING 5)))) (SETQ SEARCHAREA (QUOTE Subject))) ((SETQ SEARCHSTRING (\LAFITE.FIND.PROMPT MAILFOLDER SEARCHAREA))) (T (RETURN))) (\LAFITE.DO.FIND MAILFOLDER (CAR SEARCHDIRECTION) SEARCHAREA SEARCHSTRING NIL (EQ (CADR SEARCHDIRECTION) (QUOTE ALL)))))
+)
+
+(\LAFITE.FIND.RELATED

+(LAMBDA (MAILFOLDER DIRECTION) (* bvm%: "25-Feb-86 12:42") (* ;;; "Find message that shares subject with this one.") (OR DIRECTION (SETQQ DIRECTION FORWARD)) (LET* ((FROM# (\LAFITE.FIND.START MAILFOLDER DIRECTION)) (SEARCHSTRING (fetch (LAFITEMSG SUBJECT) of (NTHMESSAGE (fetch MESSAGEDESCRIPTORS of MAILFOLDER) FROM#)))) (COND ((OR (NULL SEARCHSTRING) (EQ (NCHARS SEARCHSTRING) 0)) (LAB.PROMPTPRINT MAILFOLDER " can't--message has no Subject")) (T (COND ((STRING-EQUAL (SUBSTRING SEARCHSTRING 1 4) "Re: ") (SETQ SEARCHSTRING (SUBSTRING SEARCHSTRING 5)))) (\LAFITE.DO.FIND MAILFOLDER DIRECTION (QUOTE Subject) SEARCHSTRING FROM# T T)))))
+)
+
+(\LAFITE.FIND.RELATED.BACKWARD

+(LAMBDA (MAILFOLDER) (* bvm%: " 5-Mar-84 17:28") (\LAFITE.FIND.RELATED MAILFOLDER (QUOTE BACKWARD))))
+
+(\LAFITE.GO.TO.FIRST

+(LAMBDA (FOLDER) (* ; "Edited 23-Aug-88 18:35 by bvm") (AND (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER) (LAB.GO.TO.MESSAGE FOLDER 1)))
+)
+
+(\LAFITE.GO.TO.INTERACTIVE

+(LAMBDA (FOLDER) (* ; "Edited 23-Aug-88 18:35 by bvm") (* ;; "Called from title menu to go to some user specified message.") (ALLOW.BUTTON.EVENTS) (LET ((N (PROGN (TTY.PROCESS (THIS.PROCESS)) (LAB.PROMPTPRINT FOLDER "Type or select number of message.") (PROG1 (RNUMBER "Message#" NIL NIL NIL T NIL T T) (TTY.PROCESS T)))) MAX) (if (AND N (> N 0)) then (if (> N (SETQ MAX (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER))) then (LAB.FORMAT FOLDER T "There are only ~D messages in this folder." MAX) (SETQ N MAX) else (\LAFITE.MAYBE.CLEAR.PROMPT FOLDER)) (LAB.GO.TO.MESSAGE FOLDER N))))
+)
+
+(\LAFITE.GO.TO.LAST

+(LAMBDA (FOLDER) (* ; "Edited 23-Aug-88 18:35 by bvm") (AND (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER) (LAB.GO.TO.MESSAGE FOLDER (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER))))
+)
+
+(\LAFITE.FIND.AGAIN

+(LAMBDA (MAILFOLDER) (* bvm%: "25-Feb-86 12:42") (LET ((LASTSEARCH \LAFITE.LAST.SEARCH)) (COND (LASTSEARCH (\LAFITE.DO.FIND MAILFOLDER (fetch SEARCHDIRECTION of LASTSEARCH) (fetch SEARCHAREA of LASTSEARCH) (fetch SEARCHSTRING of LASTSEARCH))) (T (\LAFITE.FIND MAILFOLDER)))))
+)
+
+(\LAFITE.FIND.PROMPT

+(LAMBDA (MAILFOLDER SEARCHAREA) (* ; "Edited 14-Jun-88 11:15 by bvm") (* ;;; "prompt for search string for a search of the indicated area.  Return NIL if aborted.") (RESETLST (LET ((WINDOW (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER)) (LASTSEARCH \LAFITE.LAST.SEARCH) RESULT) (CLEARW WINDOW) (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (W) (COND (RESETSTATE (printout W "...aborted"))) (WINDOWPROP W (QUOTE PROCESS) NIL))) WINDOW)) (COND ((COND ((EQ SEARCHAREA (QUOTE Mark)) (LAB.PROMPTPRINT MAILFOLDER T "Find message marked: ") (RESETSAVE (TTYDISPLAYSTREAM WINDOW)) (< (SETQ RESULT (\GETKEY)) (CHARCODE SPACE))) (T (NULL (SETQ RESULT (TTYINPROMPTFORWORD (CONCAT "Find " SEARCHAREA " string: ") (AND LASTSEARCH (NOT (fetch SEARCHREPLYTO of LASTSEARCH)) (EQ SEARCHAREA (fetch SEARCHAREA of LASTSEARCH)) (fetch SEARCHSTRING of LASTSEARCH)) NIL WINDOW NIL NIL (CHARCODE (CR))))))) (ERROR!))) RESULT)))
+)
+
+(\LAFITE.DO.FIND

+(LAMBDA (MAILFOLDER DIRECTION AREA SEARCHSTRING FROM# ALLFLG REPLYTO?) (* ; "Edited 23-Sep-87 18:35 by bvm:") (PROG ((MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER)) (LASTMSG# (fetch (MAILFOLDER %#OFMESSAGES) of MAILFOLDER)) MSG MSG# ADDFLG %#FOUND FIRSTFOUND# INSTREAM CURRENT LASTSEL MARK) (SELECTQ AREA (Body (ALLOW.BUTTON.EVENTS) (* ; "Could take a while") (SETQ INSTREAM (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE INPUT) :ABORT))) (Mark (SETQ SEARCHSTRING (UCASECODE SEARCHSTRING))) NIL) (COND ((NOT FROM#) (SETQ FROM# (\LAFITE.FIND.START MAILFOLDER DIRECTION)))) (SETQ MSG# (COND (ALLFLG (* ; "Be sure to include starting message, assuming it matches") (SELECTQ DIRECTION (FORWARD (SUB1 FROM#)) (ADD1 FROM#))) (T FROM#))) LP (until (SELECTQ DIRECTION (FORWARD (> (add MSG# 1) LASTMSG#)) (<= (add MSG# -1) 0)) do (SETQ MSG (NTHMESSAGE MESSAGES MSG#)) (COND ((SELECTQ AREA (From (* ; "Include the To: field in messages from self") (OR (STRPOS SEARCHSTRING (fetch (LAFITEMSG FROM) of MSG) 1 NIL NIL NIL UPPERCASEARRAY) (AND (fetch (LAFITEMSG MSGFROMMEP) of MSG) (STRPOS SEARCHSTRING (fetch (LAFITEMSG TO) of MSG) 1 NIL NIL NIL UPPERCASEARRAY)))) (Subject (STRPOS SEARCHSTRING (fetch (LAFITEMSG SUBJECT) of MSG) 1 NIL NIL NIL UPPERCASEARRAY)) (Body (FILEPOS SEARCHSTRING INSTREAM (fetch (LAFITEMSG START) of MSG) (fetch (LAFITEMSG END) of MSG) NIL NIL UPPERCASEARRAY)) (Mark (OR (EQ (SETQ MARK (fetch (LAFITEMSG MARKCHAR) of MSG)) SEARCHSTRING) (EQ (UCASECODE MARK) SEARCHSTRING))) (SHOULDNT)) (COND ((NOT ADDFLG) (UNSELECTALLMESSAGES MAILFOLDER) (SETQ ADDFLG T))) (LA.SELECTRANGE MAILFOLDER MSG# MSG# T) (LA.SHOW.SELECTION MAILFOLDER MSG (QUOTE REPLACE)) (COND ((NOT %#FOUND) (SETQ %#FOUND 1) (COND ((NOT ALLFLG) (LAB.PROMPTPRINT MAILFOLDER "Found in message " MSG#) (LAB.EXPOSEMESSAGE MAILFOLDER MSG) (RETURN))) (SETQ FIRSTFOUND# MSG#)) (T (add %#FOUND 1)))))) (COND ((OR (NULL %#FOUND) (AND (EQ %#FOUND 1) (EQ FIRSTFOUND# FROM#))) (* ; "Didn't find it, or found it only in the starting message (in the case of ALLFLG)") (COND (REPLYTO? (LAB.PROMPTPRINT MAILFOLDER "No related message found")) (T (LAB.PROMPTPRINT MAILFOLDER "%"" (COND ((FIXP SEARCHSTRING) (CHARACTER SEARCHSTRING)) (T SEARCHSTRING)) "%" not found")))) (ALLFLG (* ; "Multiple find") (LAB.PROMPTPRINT MAILFOLDER "Found in " %#FOUND " messages") (LAB.EXPOSEMESSAGE MAILFOLDER (NTHMESSAGE MESSAGES (COND ((AND (SETQ CURRENT (fetch (MAILFOLDER CURRENTDISPLAYEDMESSAGE) of MAILFOLDER)) (fetch (LAFITEMSG SELECTED?) of CURRENT)) (* ; "Scroll to message that would be displayed if user clicked 'Display' now") (COND ((EQ (fetch (LAFITEMSG %#) of CURRENT) (SETQ LASTSEL (fetch (MAILFOLDER LASTSELECTEDMESSAGE) of MAILFOLDER))) (* ; "Currently displaying the last one, so cycle back to first") (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of MAILFOLDER)) (T (LAB.FIND.SELECTED.MSG MAILFOLDER (ADD1 (fetch (LAFITEMSG %#) of CURRENT)) LASTSEL)))) (T (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of MAILFOLDER))))))) (SETQ \LAFITE.LAST.SEARCH (create SEARCHSTATE SEARCHSTRING _ SEARCHSTRING SEARCHDIRECTION _ DIRECTION SEARCHAREA _ AREA SEARCHREPLYTO _ REPLYTO?))))
+)
+
+(\LAFITE.FIND.START

+(LAMBDA (MAILFOLDER DIRECTION) (* bvm%: "25-Feb-86 12:33") (* ;; "Return the message to start searching from.  Forward searches start from last selected message, backward from first.  However, if that message is not visible, but some other message is, start from the visible message and print warning") (LET ((LAST# (fetch LASTSELECTEDMESSAGE of MAILFOLDER)) (FIRST# (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER)) VIS) (LAB.PROMPTPRINT MAILFOLDER T "Searching") (COND ((AND (NEQ LAST# FIRST#) (SELECTQ DIRECTION (BACKWARD (< (SETQ LAST# FIRST#) (SETQ VIS (FIRSTVISIBLEMESSAGE MAILFOLDER)))) (> LAST# (SETQ VIS (LASTVISIBLEMESSAGE MAILFOLDER))))) (* ; "Extreme selected message not visible, so tell user where search will start") (COND ((SETQ VIS (SELECTQ DIRECTION (BACKWARD (LAB.FIND.SELECTED.MSG MAILFOLDER VIS (LASTVISIBLEMESSAGE MAILFOLDER))) (LAB.REV.FIND.SELECTED.MSG MAILFOLDER (FIRSTVISIBLEMESSAGE MAILFOLDER) VIS))) (SETQ LAST# VIS))) (LAB.PROMPTPRINT MAILFOLDER " from msg " LAST#))) (LAB.PROMPTPRINT MAILFOLDER (QUOTE |...|)) LAST#))
+)
+)
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+(DECLARE%: EVAL@COMPILE
+
+(RECORD SEARCHSTATE
 (SEARCHSTRING SEARCHDIRECTION SEARCHAREA SEARCHREPLYTO))
+)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU LAFITEEXTRAMENU LAFITEEXTRAMENUFLG \LAFITE.LAST.SEARCH)
+)
+
+
+(FILESLOAD (SOURCE) LAFITEDECLS)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(LOCALVARS . T)
+)
+)
+
+(RPAQ? LAFITEFINDTYPEMENU NIL)
+
+(RPAQ? LAFITEFINDAREAMENU NIL)
+
+(RPAQQ LAFITEFINDAREAMENUITEMS ((From (QUOTE From) "Search From: field for string (or To: if from self)") (Subject (QUOTE Subject) "Search Subject: field for string") (Body (QUOTE Body) "Search message bodies for string") (Mark (QUOTE Mark) "Search for messages with specified mark character") (Related (QUOTE Related) "Search for a message with same Subject, modulo Re:")))
+
+(RPAQQ LAFITEFINDTYPEMENUITEMS (("Find Next One" (QUOTE (FORWARD ONE)) "Search forward from selected message") ("Find Next All" (QUOTE (FORWARD ALL)) "Search forward from selected message") ("Find Previous One" (QUOTE (BACKWARD ONE)) "Search backward from selected message") ("Find Previous All" (QUOTE (BACKWARD ALL)) "Search backward from selected message")))
+
+(ADDTOVAR LAFITEEXTRAMENUITEMS ("Find" (QUOTE \LAFITE.FIND) "Search mail for something") ("Find Related" (QUOTE \LAFITE.FIND.RELATED) "Find all messages from here on in reply to this message" (SUBITEMS ("Find Related Forward" (QUOTE \LAFITE.FIND.RELATED)) ("Find Related Backward" (QUOTE \LAFITE.FIND.RELATED.BACKWARD)))) ("Find Again" (QUOTE \LAFITE.FIND.AGAIN) "Repeat previous search") ("Go to #" (QUOTE \LAFITE.GO.TO.INTERACTIVE) "Scroll to and select a specific message by number." (SUBITEMS ("Go to First" (QUOTE \LAFITE.GO.TO.FIRST) "Scroll to and select first message.") ("Go to Last" (QUOTE \LAFITE.GO.TO.LAST) "Scroll to and select last message."))))
+
+(ADDTOVAR LAFITEMENUVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)
+
+(RPAQQ \LAFITE.LAST.SEARCH NIL)
+(PUTPROPS LAFITEFIND COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988))
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (1823 10123 (\LAFITE.FIND 1833 . 2865) (\LAFITE.FIND.RELATED 2867 . 3532) (
+\LAFITE.FIND.RELATED.BACKWARD 3534 . 3670) (\LAFITE.GO.TO.FIRST 3672 . 3839) (
+\LAFITE.GO.TO.INTERACTIVE 3841 . 4453) (\LAFITE.GO.TO.LAST 4455 . 4663) (\LAFITE.FIND.AGAIN 4665 . 
+4966) (\LAFITE.FIND.PROMPT 4968 . 5899) (\LAFITE.DO.FIND 5901 . 9052) (\LAFITE.FIND.START 9054 . 10121
+)))))
+STOP

library/lafite/LAFITEFIND.~2~

@@ -0,0 +1,191 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
(FILECREATED " 3-Jun-92 10:10:41" {DSK}<usr>local>users>welch>lisp>lafite>LAFITEFIND.;2
 15951  
+
+      previous date%: "15-Jun-90 16:06:40" {DSK}<usr>local>users>welch>lisp>lafite>LAFITEFIND.;1)
+
+
+(* ; "
+Copyright (c) 1984, 1985, 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation.  All rights reserved.
+")
+
+(PRETTYCOMPRINT LAFITEFINDCOMS)
+
+(RPAQQ LAFITEFINDCOMS
 ((FNS \LAFITE.FIND \LAFITE.FIND.RELATED \LAFITE.FIND.RELATED.BACKWARD 
+                                \LAFITE.GO.TO.FIRST \LAFITE.GO.TO.INTERACTIVE \LAFITE.GO.TO.LAST 
+                                \LAFITE.FIND.AGAIN \LAFITE.FIND.PROMPT \LAFITE.DO.FIND 
+                                \LAFITE.FIND.START)
+                           (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS SEARCHSTATE)
+                                  (GLOBALVARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS 
+                                         LAFITEFINDTYPEMENU LAFITEFINDAREAMENU LAFITEEXTRAMENU 
+                                         LAFITEEXTRAMENUFLG \LAFITE.LAST.SEARCH)
+                                  (FILES (SOURCE)
+                                         LAFITEDECLS)
+                                  (LOCALVARS . T))
+                           (INITVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)
+                           (VARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS)
+                           (ADDVARS [LAFITEEXTRAMENUITEMS ("Find" '\LAFITE.FIND 
+                                                                 "Search mail for something")
+                                           ["Find Related" '\LAFITE.FIND.RELATED 
+                                            "Find all messages from here on in reply to this message"
+                                                  (SUBITEMS ("Find Related Forward" 
+                                                                   '\LAFITE.FIND.RELATED)
+                                                         ("Find Related Backward" 
+                                                                '\LAFITE.FIND.RELATED.BACKWARD]
+                                           ("Find Again" '\LAFITE.FIND.AGAIN "Repeat previous search"
+                                                  )
+                                           ("Go to #" '\LAFITE.GO.TO.INTERACTIVE 
+                                                 "Scroll to and select a specific message by number."
+                                                  (SUBITEMS ("Go to First" '\LAFITE.GO.TO.FIRST 
+                                                                "Scroll to and select first message."
+                                                                   )
+                                                         ("Go to Last" '\LAFITE.GO.TO.LAST 
+                                                                "Scroll to and select last message."]
+                                  (LAFITEMENUVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU))
+                           (VARS (\LAFITE.LAST.SEARCH))))
+(DEFINEQ
+
+(\LAFITE.FIND

+(LAMBDA (MAILFOLDER) (* bvm%: "25-Feb-86 14:29") (* ; "Invoked by Find command") (PROG (SEARCHDIRECTION SEARCHAREA SEARCHSTRING) (OR (SETQ SEARCHDIRECTION (MENU (OR LAFITEFINDTYPEMENU (SETQ LAFITEFINDTYPEMENU (create MENU ITEMS _ LAFITEFINDTYPEMENUITEMS MENUFONT _ LAFITEMENUFONT CENTERFLG _ T))))) (RETURN)) (OR (SETQ SEARCHAREA (MENU (OR LAFITEFINDAREAMENU (SETQ LAFITEFINDAREAMENU (create MENU ITEMS _ LAFITEFINDAREAMENUITEMS MENUFONT _ LAFITEMENUFONT CENTERFLG _ T))))) (RETURN)) (COND ((EQ SEARCHAREA (QUOTE Related)) (SETQ SEARCHSTRING (fetch (LAFITEMSG SUBJECT) of (NTHMESSAGE (fetch MESSAGEDESCRIPTORS of MAILFOLDER) (fetch LASTSELECTEDMESSAGE of MAILFOLDER)))) (COND ((STRING-EQUAL (SUBSTRING SEARCHSTRING 1 4) "Re: ") (SETQ SEARCHSTRING (SUBSTRING SEARCHSTRING 5)))) (SETQ SEARCHAREA (QUOTE Subject))) ((SETQ SEARCHSTRING (\LAFITE.FIND.PROMPT MAILFOLDER SEARCHAREA))) (T (RETURN))) (\LAFITE.DO.FIND MAILFOLDER (CAR SEARCHDIRECTION) SEARCHAREA SEARCHSTRING NIL (EQ (CADR SEARCHDIRECTION) (QUOTE ALL)))))
+)
+
+(\LAFITE.FIND.RELATED

+(LAMBDA (MAILFOLDER DIRECTION) (* bvm%: "25-Feb-86 12:42") (* ;;; "Find message that shares subject with this one.") (OR DIRECTION (SETQQ DIRECTION FORWARD)) (LET* ((FROM# (\LAFITE.FIND.START MAILFOLDER DIRECTION)) (SEARCHSTRING (fetch (LAFITEMSG SUBJECT) of (NTHMESSAGE (fetch MESSAGEDESCRIPTORS of MAILFOLDER) FROM#)))) (COND ((OR (NULL SEARCHSTRING) (EQ (NCHARS SEARCHSTRING) 0)) (LAB.PROMPTPRINT MAILFOLDER " can't--message has no Subject")) (T (COND ((STRING-EQUAL (SUBSTRING SEARCHSTRING 1 4) "Re: ") (SETQ SEARCHSTRING (SUBSTRING SEARCHSTRING 5)))) (\LAFITE.DO.FIND MAILFOLDER DIRECTION (QUOTE Subject) SEARCHSTRING FROM# T T)))))
+)
+
+(\LAFITE.FIND.RELATED.BACKWARD

+(LAMBDA (MAILFOLDER) (* bvm%: " 5-Mar-84 17:28") (\LAFITE.FIND.RELATED MAILFOLDER (QUOTE BACKWARD))))
+
+(\LAFITE.GO.TO.FIRST

+(LAMBDA (FOLDER) (* ; "Edited 23-Aug-88 18:35 by bvm") (AND (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER) (LAB.GO.TO.MESSAGE FOLDER 1)))
+)
+
+(\LAFITE.GO.TO.INTERACTIVE

+(LAMBDA (FOLDER) (* ; "Edited 23-Aug-88 18:35 by bvm") (* ;; "Called from title menu to go to some user specified message.") (ALLOW.BUTTON.EVENTS) (LET ((N (PROGN (TTY.PROCESS (THIS.PROCESS)) (LAB.PROMPTPRINT FOLDER "Type or select number of message.") (PROG1 (RNUMBER "Message#" NIL NIL NIL T NIL T T) (TTY.PROCESS T)))) MAX) (if (AND N (> N 0)) then (if (> N (SETQ MAX (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER))) then (LAB.FORMAT FOLDER T "There are only ~D messages in this folder." MAX) (SETQ N MAX) else (\LAFITE.MAYBE.CLEAR.PROMPT FOLDER)) (LAB.GO.TO.MESSAGE FOLDER N))))
+)
+
+(\LAFITE.GO.TO.LAST

+(LAMBDA (FOLDER) (* ; "Edited 23-Aug-88 18:35 by bvm") (AND (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER) (LAB.GO.TO.MESSAGE FOLDER (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER))))
+)
+
+(\LAFITE.FIND.AGAIN

+  [LAMBDA (MAILFOLDER)
                                   (* ; "Edited 15-Jun-90 16:03 by jds")

+    (LET ((LASTSEARCH \LAFITE.LAST.SEARCH))
+         (COND
+            (LASTSEARCH (\LAFITE.DO.FIND
 MAILFOLDER (fetch
 (SEARCHSTATE SEARCHDIRECTION)
+                                                           of
 LASTSEARCH)
+                               (fetch
 (SEARCHSTATE SEARCHAREA) of
 LASTSEARCH)
+                               (fetch
 (SEARCHSTATE SEARCHSTRING) of
 LASTSEARCH)))
+            (T (\LAFITE.FIND
 MAILFOLDER])
+
+(\LAFITE.FIND.PROMPT

+  [LAMBDA (MAILFOLDER SEARCHAREA)
                        (* ; "Edited 15-Jun-90 16:03 by jds")

+
+(* ;;; "prompt for search string for a search of the indicated area.  Return NIL if aborted.")

+
+    (RESETLST
+        (LET ((WINDOW (fetch
 (MAILFOLDER BROWSERPROMPTWINDOW) of
 MAILFOLDER))
+              (LASTSEARCH \LAFITE.LAST.SEARCH)
+              RESULT)
+             (CLEARW WINDOW)
+             (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (W)
+                                              (COND
+                                                 (RESETSTATE (printout W "...aborted")))
+                                              (WINDOWPROP W 'PROCESS NIL]
+                                  WINDOW))
+             (COND
+                ([COND
+                    ((EQ SEARCHAREA 'Mark)
+                     (LAB.PROMPTPRINT MAILFOLDER T "Find message marked: ")
+                     (RESETSAVE (TTYDISPLAYSTREAM WINDOW))
+                     (< (SETQ RESULT (\GETKEY))
+                        (CHARCODE SPACE)))
+                    (T (NULL (SETQ RESULT (TTYINPROMPTFORWORD (CONCAT "Find " SEARCHAREA " string: ")
+                                                 (AND LASTSEARCH (NOT (fetch
 (SEARCHSTATE 
+                                                                                        SEARCHREPLYTO
+                                                                                        )
+                                                                         of
 LASTSEARCH))
+                                                      (EQ SEARCHAREA (fetch
 (SEARCHSTATE 
+                                                                                       SEARCHAREA)
+                                                                        of
 LASTSEARCH))
+                                                      (fetch
 (SEARCHSTATE SEARCHSTRING)
+                                                         of
 LASTSEARCH))
+                                                 NIL WINDOW NIL NIL (CHARCODE (CR]
+                 (ERROR!)))
+             RESULT))])
+
+(\LAFITE.DO.FIND

+(LAMBDA (MAILFOLDER DIRECTION AREA SEARCHSTRING FROM# ALLFLG REPLYTO?) (* ; "Edited 23-Sep-87 18:35 by bvm:") (PROG ((MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER)) (LASTMSG# (fetch (MAILFOLDER %#OFMESSAGES) of MAILFOLDER)) MSG MSG# ADDFLG %#FOUND FIRSTFOUND# INSTREAM CURRENT LASTSEL MARK) (SELECTQ AREA (Body (ALLOW.BUTTON.EVENTS) (* ; "Could take a while") (SETQ INSTREAM (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE INPUT) :ABORT))) (Mark (SETQ SEARCHSTRING (UCASECODE SEARCHSTRING))) NIL) (COND ((NOT FROM#) (SETQ FROM# (\LAFITE.FIND.START MAILFOLDER DIRECTION)))) (SETQ MSG# (COND (ALLFLG (* ; "Be sure to include starting message, assuming it matches") (SELECTQ DIRECTION (FORWARD (SUB1 FROM#)) (ADD1 FROM#))) (T FROM#))) LP (until (SELECTQ DIRECTION (FORWARD (> (add MSG# 1) LASTMSG#)) (<= (add MSG# -1) 0)) do (SETQ MSG (NTHMESSAGE MESSAGES MSG#)) (COND ((SELECTQ AREA (From (* ; "Include the To: field in messages from self") (OR (STRPOS SEARCHSTRING (fetch (LAFITEMSG FROM) of MSG) 1 NIL NIL NIL UPPERCASEARRAY) (AND (fetch (LAFITEMSG MSGFROMMEP) of MSG) (STRPOS SEARCHSTRING (fetch (LAFITEMSG TO) of MSG) 1 NIL NIL NIL UPPERCASEARRAY)))) (Subject (STRPOS SEARCHSTRING (fetch (LAFITEMSG SUBJECT) of MSG) 1 NIL NIL NIL UPPERCASEARRAY)) (Body (FILEPOS SEARCHSTRING INSTREAM (fetch (LAFITEMSG START) of MSG) (fetch (LAFITEMSG END) of MSG) NIL NIL UPPERCASEARRAY)) (Mark (OR (EQ (SETQ MARK (fetch (LAFITEMSG MARKCHAR) of MSG)) SEARCHSTRING) (EQ (UCASECODE MARK) SEARCHSTRING))) (SHOULDNT)) (COND ((NOT ADDFLG) (UNSELECTALLMESSAGES MAILFOLDER) (SETQ ADDFLG T))) (LA.SELECTRANGE MAILFOLDER MSG# MSG# T) (LA.SHOW.SELECTION MAILFOLDER MSG (QUOTE REPLACE)) (COND ((NOT %#FOUND) (SETQ %#FOUND 1) (COND ((NOT ALLFLG) (LAB.PROMPTPRINT MAILFOLDER "Found in message " MSG#) (LAB.EXPOSEMESSAGE MAILFOLDER MSG) (RETURN))) (SETQ FIRSTFOUND# MSG#)) (T (add %#FOUND 1)))))) (COND ((OR (NULL %#FOUND) (AND (EQ %#FOUND 1) (EQ FIRSTFOUND# FROM#))) (* ; "Didn't find it, or found it only in the starting message (in the case of ALLFLG)") (COND (REPLYTO? (LAB.PROMPTPRINT MAILFOLDER "No related message found")) (T (LAB.PROMPTPRINT MAILFOLDER "%"" (COND ((FIXP SEARCHSTRING) (CHARACTER SEARCHSTRING)) (T SEARCHSTRING)) "%" not found")))) (ALLFLG (* ; "Multiple find") (LAB.PROMPTPRINT MAILFOLDER "Found in " %#FOUND " messages") (LAB.EXPOSEMESSAGE MAILFOLDER (NTHMESSAGE MESSAGES (COND ((AND (SETQ CURRENT (fetch (MAILFOLDER CURRENTDISPLAYEDMESSAGE) of MAILFOLDER)) (fetch (LAFITEMSG SELECTED?) of CURRENT)) (* ; "Scroll to message that would be displayed if user clicked 'Display' now") (COND ((EQ (fetch (LAFITEMSG %#) of CURRENT) (SETQ LASTSEL (fetch (MAILFOLDER LASTSELECTEDMESSAGE) of MAILFOLDER))) (* ; "Currently displaying the last one, so cycle back to first") (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of MAILFOLDER)) (T (LAB.FIND.SELECTED.MSG MAILFOLDER (ADD1 (fetch (LAFITEMSG %#) of CURRENT)) LASTSEL)))) (T (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of MAILFOLDER))))))) (SETQ \LAFITE.LAST.SEARCH (create SEARCHSTATE SEARCHSTRING _ SEARCHSTRING SEARCHDIRECTION _ DIRECTION SEARCHAREA _ AREA SEARCHREPLYTO _ REPLYTO?))))
+)
+
+(\LAFITE.FIND.START

+(LAMBDA (MAILFOLDER DIRECTION) (* bvm%: "25-Feb-86 12:33") (* ;; "Return the message to start searching from.  Forward searches start from last selected message, backward from first.  However, if that message is not visible, but some other message is, start from the visible message and print warning") (LET ((LAST# (fetch LASTSELECTEDMESSAGE of MAILFOLDER)) (FIRST# (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER)) VIS) (LAB.PROMPTPRINT MAILFOLDER T "Searching") (COND ((AND (NEQ LAST# FIRST#) (SELECTQ DIRECTION (BACKWARD (< (SETQ LAST# FIRST#) (SETQ VIS (FIRSTVISIBLEMESSAGE MAILFOLDER)))) (> LAST# (SETQ VIS (LASTVISIBLEMESSAGE MAILFOLDER))))) (* ; "Extreme selected message not visible, so tell user where search will start") (COND ((SETQ VIS (SELECTQ DIRECTION (BACKWARD (LAB.FIND.SELECTED.MSG MAILFOLDER VIS (LASTVISIBLEMESSAGE MAILFOLDER))) (LAB.REV.FIND.SELECTED.MSG MAILFOLDER (FIRSTVISIBLEMESSAGE MAILFOLDER) VIS))) (SETQ LAST# VIS))) (LAB.PROMPTPRINT MAILFOLDER " from msg " LAST#))) (LAB.PROMPTPRINT MAILFOLDER (QUOTE |...|)) LAST#))
+)
+)
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+(DECLARE%: EVAL@COMPILE
+
+(RECORD SEARCHSTATE
 (SEARCHSTRING SEARCHDIRECTION SEARCHAREA SEARCHREPLYTO))
+)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU 
+       LAFITEEXTRAMENU LAFITEEXTRAMENUFLG \LAFITE.LAST.SEARCH)
+)
+
+
+(FILESLOAD (SOURCE)
+       LAFITEDECLS)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(LOCALVARS . T)
+)
+)
+
+(RPAQ? LAFITEFINDTYPEMENU
 NIL)
+
+(RPAQ? LAFITEFINDAREAMENU
 NIL)
+
+(RPAQQ LAFITEFINDAREAMENUITEMS
 ((From 'From "Search From: field for string (or To: if from self)"
+                                          )
+                                    (Subject 'Subject "Search Subject: field for string")
+                                    (Body 'Body "Search message bodies for string")
+                                    (Mark 'Mark "Search for messages with specified mark character")
+                                    (Related 'Related 
+                                           "Search for a message with same Subject, modulo Re:")))
+
+(RPAQQ LAFITEFINDTYPEMENUITEMS
 (("Find Next One" '(FORWARD ONE)
+                                           "Search forward from selected message")
+                                    ("Find Next All" '(FORWARD ALL)
+                                           "Search forward from selected message")
+                                    ("Find Previous One" '(BACKWARD ONE)
+                                           "Search backward from selected message")
+                                    ("Find Previous All" '(BACKWARD ALL)
+                                           "Search backward from selected message")))
+
+(ADDTOVAR LAFITEEXTRAMENUITEMS
 ("Find" '\LAFITE.FIND "Search mail for something")
+                                   ["Find Related" '\LAFITE.FIND.RELATED 
+                                          "Find all messages from here on in reply to this message"
+                                          (SUBITEMS ("Find Related Forward" '\LAFITE.FIND.RELATED)
+                                                 ("Find Related Backward" 
+                                                        '\LAFITE.FIND.RELATED.BACKWARD]
+                                   ("Find Again" '\LAFITE.FIND.AGAIN "Repeat previous search")
+                                   ("Go to #" '\LAFITE.GO.TO.INTERACTIVE 
+                                          "Scroll to and select a specific message by number."
+                                          (SUBITEMS ("Go to First" '\LAFITE.GO.TO.FIRST 
+                                                           "Scroll to and select first message.")
+                                                 ("Go to Last" '\LAFITE.GO.TO.LAST 
+                                                        "Scroll to and select last message."))))
+
+(ADDTOVAR LAFITEMENUVARS
 LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)
+
+(RPAQQ \LAFITE.LAST.SEARCH
 NIL)
+(PUTPROPS LAFITEFIND COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1990 1992))
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (3089 12861 (\LAFITE.FIND 3099 . 4131) (\LAFITE.FIND.RELATED 4133 . 4798) (
+\LAFITE.FIND.RELATED.BACKWARD 4800 . 4936) (\LAFITE.GO.TO.FIRST 4938 . 5105) (
+\LAFITE.GO.TO.INTERACTIVE 5107 . 5719) (\LAFITE.GO.TO.LAST 5721 . 5929) (\LAFITE.FIND.AGAIN 5931 . 
+6513) (\LAFITE.FIND.PROMPT 6515 . 8637) (\LAFITE.DO.FIND 8639 . 11790) (\LAFITE.FIND.START 11792 . 
+12859)))))
+STOP

library/lafite/LAFITEFOLDERS

@@ -0,0 +1,293 @@
+(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
+
(FILECREATED " 2-Nov-89 18:16:37" "{pooh/n}<pooh>lafite>sources>lafitefolders;9"
 42102  
+
+      changes to%:  (FNS PROMPTFORFILENAME \LAFITE.RENAME.FOLDER)
+
+      previous date%: "29-Aug-89 11:11:20" "{pooh/n}<pooh>lafite>sources>lafitefolders;8")
+
+
+(* "
+Copyright (c) 1989 by Xerox Corporation.  All rights reserved.
+")
+
+(PRETTYCOMPRINT LAFITEFOLDERSCOMS)
+
+(RPAQQ LAFITEFOLDERSCOMS ((* ;; "Maintenance of Lafite's folder structures, menus etc.") (COMS (* ; "The profile") (FNS \LAFITE.READ.PROFILE \LAFITE.PROCESS.PROFILE \LAFITE.WRITE.PROFILE \LAFITE.MERGE.NAMELISTS \LAFITE.READ.OLD.PROFILE \LAFITE.MERGE.FOLDERS \LAFITE.MERGE.STRUCTURES \LAFITE.REPACK.FOLDERS) (INITVARS (\LAFITEPROFILECHANGED) (LAFITEMAILFOLDERS) (\LAFITEPROFILEDATE)) (ADDVARS (LAFITE.PROFILE.VARS (*LA.ABBREVS.IN.PROFILE*) (LAFITEMAILFOLDERS \LAFITE.MERGE.FOLDERS) (LAFITEFORMFILES \LAFITE.MERGE.NAMELISTS) (LAFITE.FOLDER.STRUCTURE \LAFITE.MERGE.STRUCTURES)))) (COMS (* ; "Prompting for folders") (FNS \LAFITE.PROMPTFORFOLDER PROMPTFORFILENAME MAKELAFITEMAILFOLDERSMENU MAKELAFITEFOLDERSMENUITEMS LAFITE.GROUP.ITEM \LAFITE.ARRANGE.MENU \LAFITE.MAKE.FOLDER.MENU LAFITE.SELECT.FOLDERS LAFITE.SELECT.MULTIPLE \LAFITE.HANDLE.MULTIPLE.SELECTION COLLECT.SHADED.ITEMS) (INITVARS (LAFITE.2COLUMN.MENU.MIN.ITEMS 10) (LAFITEFOLDERSMENU) (LAFITEMULTIPLEFOLDERSMENU)) (ADDVARS (LAFITEMENUVARS LAFITEFOLDERSMENU LAFITEMULTIPLEFOLDERSMENU))) (COMS (* ; "Name hacking") (FNS LA.LONGFILENAME LA.SHORTFILENAME FORGETMAILFILE \LAFITE.FOLDER.NAME.CHANGED \LAFITE.CHANGE.NAME.IN.LIST \LAFITE.RECOMPUTE.FOLDER.NAMES \LAFITE.NEW.SHORT.NAME \LAFITE.NOTICE.FILE \LAFITE.UNCACHE.FOLDER) (INITVARS LAFITE.HOST.ABBREVS \LAFITE.PSEUDO.DEVICES)) (COMS (* ; "Hacking the hierarchy") (FNS \LAFITE.NOTICE.FOLDERS \LAFITE.GC.FOLDERS \LAFITE.GC.FOLDERS.CONFIRM \LAFITE.MAKE.RANDOM.DISPLAY \LAFITE.CHANGE.FOLDER.LIST \LAFITE.RENAME.FOLDER \LAFITE.ADD.NEW.GROUP \LAFITE.CHECK.GROUP.NAME \LAFITE.CHANGE.GROUP.MEMBERS \LAFITE.SELECT.GROUP.FOLDERS \LAFITE.CHANGE.SUBGROUPS \LAFITE.CHANGE.TOP.GROUPS \LAFITE.DELETE.GROUP LAFITE.RENAME.GROUP \LAFITE.EDIT.HIERARCHY LAFITE.FIND.GROUP UALPHORDERCAR) (VARS LAFITE.SPACER.MENU.ITEM LAFITE.GROUP.COMMANDS (LAFITE.GROUP.COMMANDS.MENU))) (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE) LAFITEDECLS) (LOCALVARS . T) (GLOBALVARS MENUFONT LAFITE.GROUP.COMMANDS.MENU LAFITE.GROUP.COMMANDS) (P (CL:PROCLAIM (QUOTE (CL:SPECIAL *LA.ABBREVS.IN.PROFILE*)))))))
+
+
+
+(* ;; "Maintenance of Lafite's folder structures, menus etc.")

+
+
+
+
+(* ; "The profile")

+
+(DEFINEQ
+
+(\LAFITE.READ.PROFILE

+(LAMBDA (ONLYIFCHANGED) (* ; "Edited  8-May-89 16:20 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 (SETQ LAFITE.FOLDER.STRUCTURE NIL)) else (if (AND LAFITE.FOLDER.STRUCTURE (LET ((TMP (CADR (CAR LAFITE.FOLDER.STRUCTURE)))) (OR (NLISTP TMP) (NOT (FMEMB (CAR TMP) (QUOTE (T NIL))))))) then (* ; "Old style without the %"top-level%" flag.  Fix up.  Make top-level everything that's without a parent.") (LET (SUBGROUPS) (for GROUP in LAFITE.FOLDER.STRUCTURE do (SETQ SUBGROUPS (APPEND (CADR GROUP) SUBGROUPS)) (RPLACA (CDR GROUP) (CONS NIL (CADR GROUP)))) (for GROUP in LAFITE.FOLDER.STRUCTURE unless (CL:MEMBER (CAR GROUP) SUBGROUPS :TEST (QUOTE STRING-EQUAL)) do (replace FGTOPLEVEL of GROUP with T)))) (if (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*)) (if LAFITEFORMFILES then (* ; "Canonicalize them.  Old profiles may have stored long names.  Yuck.") (SETQ LAFITEFORMFILES (CL:REMOVE-DUPLICATES (for NAME in LAFITEFORMFILES collect (LA.SHORTFILENAME NAME LAFITEFORM.EXT)) :TEST (QUOTE STRING-EQUAL))))) (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.MERGE.STRUCTURES

+(LAMBDA (NEWSTRUCTURE) (* ; "Edited 12-Apr-89 16:57 by bvm") (for GROUP in NEWSTRUCTURE do (RPLACD (CDR GROUP) (CL:INTERSECTION (CDDR GROUP) (CDR LAFITEMAILFOLDERS)))))
+)
+
+(\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? \LAFITEPROFILECHANGED)
+
+(RPAQ? LAFITEMAILFOLDERS)
+
+(RPAQ? \LAFITEPROFILEDATE)
+
+(ADDTOVAR LAFITE.PROFILE.VARS (*LA.ABBREVS.IN.PROFILE*) (LAFITEMAILFOLDERS \LAFITE.MERGE.FOLDERS) (LAFITEFORMFILES \LAFITE.MERGE.NAMELISTS) (LAFITE.FOLDER.STRUCTURE \LAFITE.MERGE.STRUCTURES))
+
+
+
+(* ; "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  2-Nov-89 17:56 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)))) (WINDOWPROP WINDOW (QUOTE PAGEFULLFN) (FUNCTION NILL)) (FUNCTION CLOSEW))) WINDOW)) (TTYINPROMPTFORWORD PROMPT DEFAULT NIL WINDOW NIL NIL (CHARCODE (CR)))))
+)
+
+(MAKELAFITEMAILFOLDERSMENU

+(LAMBDA NIL (* ; "Edited 12-Apr-89 15:31 by bvm") (SETQ LAFITEFOLDERSMENU (\LAFITE.MAKE.FOLDER.MENU (MAKELAFITEFOLDERSMENUITEMS))))
+)
+
+(MAKELAFITEFOLDERSMENUITEMS

+(LAMBDA NIL (* ; "Edited 29-Jun-89 10:33 by bvm") (if LAFITE.FOLDER.STRUCTURE then (LET (UNGROUPED.FOLDERS GROUPED.FOLDERS SUBGROUPS GROUP) (for GROUP in LAFITE.FOLDER.STRUCTURE do (SETQ GROUPED.FOLDERS (APPEND (fetch FGFOLDERS of GROUP) GROUPED.FOLDERS)) (SETQ SUBGROUPS (APPEND (fetch FGSUBGROUPS of GROUP) SUBGROUPS))) (SETQ UNGROUPED.FOLDERS (for FOLDER in (CDR LAFITEMAILFOLDERS) collect FOLDER unless (CL:MEMBER FOLDER GROUPED.FOLDERS :TEST (QUOTE STRING-EQUAL)))) (* ; "This is just SET-DIFFERENCE, but writing it this way forces the order to be preserved, so I don't have to SORT again.") (NCONC (for GROUP in LAFITE.FOLDER.STRUCTURE when (OR (fetch FGTOPLEVEL of GROUP) (NOT (CL:MEMBER (fetch FGNAME of GROUP) SUBGROUPS :TEST (QUOTE STRING-EQUAL)))) collect (* ; "Groups that are explicitly top-level or aren't already subgroups of another") (LAFITE.GROUP.ITEM GROUP (LIST (fetch FGNAME of GROUP)))) (LIST LAFITE.SPACER.MENU.ITEM) UNGROUPED.FOLDERS (LIST ANOTHERFOLDERMENUITEM))) else (APPEND (CDR LAFITEMAILFOLDERS) (LIST LAFITE.SPACER.MENU.ITEM ANOTHERFOLDERMENUITEM))))
+)
+
+(LAFITE.GROUP.ITEM

+(LAMBDA (GROUP SUPERS) (* ; "Edited  8-May-89 15:51 by bvm") (LET ((FOLDERS (fetch FGFOLDERS of GROUP)) (SUBGROUPITEMS (for SUBGROUP in (fetch FGSUBGROUPS of GROUP) unless (CL:MEMBER SUBGROUP SUPERS :TEST (QUOTE STRING-EQUAL)) collect (LAFITE.GROUP.ITEM (LAFITE.FIND.GROUP SUBGROUP) (CONS SUBGROUP SUPERS))))) (BQUOTE ((\, (CAR GROUP)) NIL "Slide out the submenu to choose a folder from this group" (SUBITEMS (\,@ FOLDERS) (\,@ (AND SUBGROUPITEMS FOLDERS (LIST LAFITE.SPACER.MENU.ITEM))) (\,@ SUBGROUPITEMS))))))
+)
+
+(\LAFITE.ARRANGE.MENU

+(LAMBDA (ITEMS FONT MAXHEIGHT TITLE) (* ; "Edited 21-Jun-89 11:58 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 (viz. that the column width is at least as wide as the menu title).  We also make 2 columns when the title is much wider than the columns would need to be") (OR FONT (SETQ FONT MENUFONT)) (LET* ((ITEMHEIGHT (FONTPROP FONT (QUOTE HEIGHT))) (NITEMS (LENGTH ITEMS)) (TOTALHEIGHT (TIMES NITEMS ITEMHEIGHT))) (if (OR (> TOTALHEIGHT MAXHEIGHT) (AND (> NITEMS LAFITE.2COLUMN.MENU.MIN.ITEMS) (> (TIMES 2 (STRINGWIDTH TITLE WINDOWTITLEFONT)) (TIMES 3 (for I in ITEMS bind (MAXWIDTH _ 0) when (AND (STRINGP (if (LISTP I) then (SETQ I (CAR I)) else I)) (> (SETQ I (STRINGWIDTH I FONT)) MAXWIDTH)) do (SETQ MAXWIDTH I) finally (RETURN MAXWIDTH)))))) then (* ; "1 column would be taller than MAXHEIGHT, or the title is more than 50%% wider than the widest item") (LET ((NCOLUMNS (MAX 2 (CL:CEILING TOTALHEIGHT MAXHEIGHT)))) (CL:VALUES NCOLUMNS (\MAKE.ITEMS.VERT.ORDER ITEMS (CL:CEILING NITEMS NCOLUMNS) NCOLUMNS))) else (CL:VALUES 1 ITEMS))))
+)
+
+(\LAFITE.MAKE.FOLDER.MENU

+(LAMBDA (ITEMS TITLE) (* ; "Edited 13-Apr-89 15:02 by bvm") (* ;; "Make a folders menu out of ITEMS.") (OR TITLE (SETQ TITLE (CONCAT "Folders on " (L-CASE (fetch PACKEDHOST&DIR \LAFITEDEFAULTHOST&DIR))))) (CL:MULTIPLE-VALUE-BIND (NCOLUMNS ITEMS) (\LAFITE.ARRANGE.MENU ITEMS LAFITE.FOLDER.MENU.FONT (- SCREENHEIGHT (FONTPROP WINDOWTITLEFONT (QUOTE HEIGHT))) TITLE) (create MENU ITEMS _ ITEMS MENUCOLUMNS _ NCOLUMNS TITLE _ TITLE CENTERFLG _ T MENUFONT _ (OR LAFITE.FOLDER.MENU.FONT MENUFONT))))
+)
+
+(LAFITE.SELECT.FOLDERS

+(LAMBDA (PRESELECTED NILOK) (* ; "Edited  8-May-89 16:43 by bvm") (* ;; "Offer menu of folders, return all folders selected.  If NILOK is true, then return :ABORT if aborted, else just NIL.") (LET ((RESULT (LAFITE.SELECT.MULTIPLE (CDR LAFITEMAILFOLDERS) PRESELECTED NIL NIL (QUOTE LAFITEMULTIPLEFOLDERSMENU)))) (AND (OR NILOK (NEQ RESULT :ABORT)) RESULT)))
+)
+
+(LAFITE.SELECT.MULTIPLE

+(LAMBDA (ITEMS PRESELECTED TITLE PROMPT MENUVAR) (* ; "Edited  8-May-89 16:41 by bvm") (* ;; "Put up a menu containing ITEMS, with PRESELECTED among them already shaded.  Let user select multiply from the menu, and return a list of the selected items.  MENUVAR optionally caches the menu from last time--you must clear it whenever ITEMS changes.") (LET ((MENUW (AND MENUVAR (EVALV MENUVAR))) MENU OLDSHADED) (if (NULL MENUW) then (SETQ MENU (\LAFITE.MAKE.FOLDER.MENU (APPEND ITEMS (CONS LAFITE.SPACER.MENU.ITEM (QUOTE (("--OK--" :DONE "Click here when selection is satisfactory") ("--Abort--" :ABORT "Click here to abort selection."))))) TITLE)) (replace (MENU MENUTITLEFONT) of MENU with WINDOWTITLEFONT) (replace (MENU WHENSELECTEDFN) of MENU with (FUNCTION \LAFITE.HANDLE.MULTIPLE.SELECTION)) (SETQ MENUW (MENUWINDOW MENU)) (if MENUVAR then (SET MENUVAR MENUW)) 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 PROMPT then (CLRPROMPT) (PRINTOUT PROMPTWINDOW PROMPT T "Click OK when finished.")) (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)) (if (EQ RESULT :DONE) then (COLLECT.SHADED.ITEMS MENU) else (* ; "Return keyword, such as :ABORT") RESULT)) (CLOSEW MENUW) (TTY.PROCESS T) (if PROMPT then (CLRPROMPT)))))
+)
+
+(\LAFITE.HANDLE.MULTIPLE.SELECTION

+(LAMBDA (ITEM MENU KEY) (* ; "Edited 12-Apr-89 17:58 by bvm") (if (AND (LISTP ITEM) (CL:KEYWORDP (CADR 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)))))
+)
+)
+
+(RPAQ? LAFITE.2COLUMN.MENU.MIN.ITEMS 10)
+
+(RPAQ? LAFITEFOLDERSMENU)
+
+(RPAQ? LAFITEMULTIPLEFOLDERSMENU)
+
+(ADDTOVAR LAFITEMENUVARS LAFITEFOLDERSMENU LAFITEMULTIPLEFOLDERSMENU)
+
+
+
+(* ; "Name hacking")

+
+(DEFINEQ
+
+(LA.LONGFILENAME

+(LAMBDA (FILENAME EXT UNPACKEDHOST&DIR HOST.ABBREVS UNPACKEDFLG) (* ; "Edited 18-Apr-89 15:44 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)) QUALTAIL 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))) (OR UNPACKEDHOST&DIR (SETQ UNPACKEDHOST&DIR (fetch UNPACKEDHOST&DIR of \LAFITEDEFAULTHOST&DIR))) (if (NEQ UNPACKEDHOST&DIR (SETQ QUALTAIL (find TAIL on UNPACKEDHOST&DIR by (CDDR TAIL) suchthat (EQ (CAR TAIL) FIRSTFIELD)))) then (* ; "Want 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).") (* ; "I was going to write a single loop with xcl:collect, but dwim got in the way...") (SETQ FILEFIELDS (NCONC (for TAIL on UNPACKEDHOST&DIR until (EQ TAIL QUALTAIL) collect (CAR TAIL)) FILEFIELDS))) (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)))))
+)
+
+(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-May-89 15:44 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 (\LAFITE.CHANGE.NAME.IN.LIST (CDR LAFITEMAILFOLDERS) OLDNAME NEWNAME)) (for GROUP in LAFITE.FOLDER.STRUCTURE when (CL:MEMBER OLDNAME (fetch FGFOLDERS of GROUP) :TEST (QUOTE STRING-EQUAL)) do (replace FGFOLDERS of GROUP with (\LAFITE.CHANGE.NAME.IN.LIST (fetch FGFOLDERS of GROUP) OLDNAME NEWNAME))) (SETQ LAFITEFOLDERSMENU (SETQ LAFITEMULTIPLEFOLDERSMENU NIL)) (SETQ \LAFITEPROFILECHANGED T))
+)
+
+(\LAFITE.CHANGE.NAME.IN.LIST

+(LAMBDA (FOLDERS OLDNAME NEWNAME) (* ; "Edited 29-Aug-89 11:10 by bvm") (* ;; "Return FOLDERS with OLDNAME replace with NEWNAME (or deleted if new = nil)") (if OLDNAME then (SETQ FOLDERS (CL:DELETE OLDNAME FOLDERS :TEST (QUOTE STRING-EQUAL)))) (if NEWNAME then (CL:MERGE (QUOTE LIST) (LIST NEWNAME) FOLDERS (FUNCTION UALPHORDER)) else FOLDERS))
+)
+
+(\LAFITE.RECOMPUTE.FOLDER.NAMES

+(LAMBDA (OLDABBREVS) (* ; "Edited  8-May-89 15:45 by bvm") (* ;; "Called when either the host&dir in LAFITEMAILFOLDERS disagrees with \lafitedefaulthost&dir or the abbreviation list changed.") (LET ((OLDHOST&DIR (CAR LAFITEMAILFOLDERS))) (SETQ LAFITEFORMFILES (\LAFITE.REPACK.FOLDERS LAFITEFORMFILES OLDHOST&DIR OLDABBREVS)) (SETQ LAFITEMAILFOLDERS (CONS (fetch PACKEDHOST&DIR of \LAFITEDEFAULTHOST&DIR) (CL:SORT (\LAFITE.REPACK.FOLDERS (CDR LAFITEMAILFOLDERS) OLDHOST&DIR OLDABBREVS) (FUNCTION UALPHORDER)))) (for GROUP in LAFITE.FOLDER.STRUCTURE do (replace FGFOLDERS of GROUP with (CL:SORT (\LAFITE.REPACK.FOLDERS (fetch FGFOLDERS of GROUP) OLDHOST&DIR 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)
+
+
+
+(* ; "Hacking the hierarchy")

+
+(DEFINEQ
+
+(\LAFITE.NOTICE.FOLDERS

+(LAMBDA NIL (* ; "Edited 12-Apr-89 16:35 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 (CONS (CAR FOUND) FILE))) 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.CHANGE.FOLDER.LIST NEWFILES NEWCASEFILES NIL WINDOW) else (printout WINDOW T "Aborted.")))))))))
+)
+
+(\LAFITE.GC.FOLDERS

+(LAMBDA NIL (* ; "Edited 12-Apr-89 16:35 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 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 NEWCASEFILES (CONS F 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.")) (\LAFITE.CHANGE.FOLDER.LIST NIL NEWCASEFILES NOTFOUND WINDOW)) (T (printout WINDOW T "Aborted")))))
+)
+
+(\LAFITE.GC.FOLDERS.CONFIRM

+(LAMBDA (TEXTSTREAM PROMPT) (* ; "Edited 20-Apr-89 19:36 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) (LA.POSITION.FROM.REGION (WINDOWPROP (LA.WINDOW.FROM.TEXTSTREAM TEXTSTREAM) (QUOTE REGION)) NIL (- (+ 2 (FONTPROP LAFITEMENUFONT (QUOTE HEIGHT))))) T) (SETFILEPTR TEXTSTREAM -1)))
+)
+
+(\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.CHANGE.FOLDER.LIST

+(LAMBDA (NEWFILES NEWCASEFILES NOTFOUND TEXTSTREAM) (* ; "Edited 12-Apr-89 16:34 by bvm") (* ;; "Change Lafite's set of folders by adding NEWFILES, removing NOTFOUND and renaming each (oldname . newname) in NEWCASEFILES.  Outputs %"Done%" to optional TEXTSTREAM") (for FILE in NEWFILES do (* ; "add these") (\LAFITE.FOLDER.NAME.CHANGED NIL FILE)) (for FILE in NOTFOUND do (* ; "forget these") (\LAFITE.FOLDER.NAME.CHANGED FILE NIL)) (for FILE in NEWCASEFILES do (* ; "Fix case on these") (\LAFITE.FOLDER.NAME.CHANGED (CAR FILE) (CDR FILE))) (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  2-Nov-89 17:59 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 (CONCAT "Rename " (UNPACKFILENAME.STRING FOLDERNAME (QUOTE NAME)) " to be: ")))) (STREQUAL NEWNAME FOLDERNAME)) then (PRINTOUT PROMPTWINDOW T FOLDERNAME " not renamed.") 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.ADD.NEW.GROUP

+(LAMBDA (SUPERGROUP) (* ; "Edited  8-May-89 16:51 by bvm") (LET ((GROUP (PROMPTFORFILENAME NIL NIL "Name of new group (CR to abort): ")) MEMBERS) (if (AND GROUP (\LAFITE.CHECK.GROUP.NAME GROUP) (NEQ (SETQ MEMBERS (\LAFITE.SELECT.GROUP.FOLDERS GROUP)) :ABORT)) then (if SUPERGROUP then (SETQ SUPERGROUP (LAFITE.FIND.GROUP SUPERGROUP)) (replace FGSUBGROUPS of SUPERGROUP with (MERGE (fetch FGSUBGROUPS of SUPERGROUP) (LIST GROUP) (FUNCTION UALPHORDER)))) (SETQ LAFITE.FOLDER.STRUCTURE (MERGE LAFITE.FOLDER.STRUCTURE (LIST (create FOLDERGROUP FGNAME _ GROUP FGTOPLEVEL _ (NOT SUPERGROUP) FGFOLDERS _ MEMBERS)) (FUNCTION UALPHORDERCAR))) (SETQ \LAFITEPROFILECHANGED T) (SETQ LAFITEFOLDERSMENU))) NIL)
+)
+
+(\LAFITE.CHECK.GROUP.NAME

+(LAMBDA (NAME) (* ; "Edited  8-May-89 15:53 by bvm") (* ;; "Verify that NAME is not yet the name of a group.  Return NAME if unique, NIL if it already exists.") (LET ((FOUND (LAFITE.FIND.GROUP NAME))) (if FOUND then (printout PROMPTWINDOW T "There's already a group named " (fetch FGNAME of FOUND) ".") NIL else NAME)))
+)
+
+(\LAFITE.CHANGE.GROUP.MEMBERS

+(LAMBDA (NAME) (* ; "Edited  8-May-89 15:53 by bvm") (LET* ((GROUP (LAFITE.FIND.GROUP NAME)) (NEWMEMBERS (\LAFITE.SELECT.GROUP.FOLDERS NAME (fetch FGFOLDERS of GROUP)))) (if (NEQ NEWMEMBERS :ABORT) then (replace FGFOLDERS of GROUP with (SORT NEWMEMBERS (FUNCTION UALPHORDER))) (SETQ \LAFITEPROFILECHANGED T) (SETQ LAFITEFOLDERSMENU))) NIL)
+)
+
+(\LAFITE.SELECT.GROUP.FOLDERS

+(LAMBDA (GROUPNAME PRESELECTED) (* ; "Edited  8-May-89 16:42 by bvm") (* ;; "Like LAFITE.SELECT.FOLDERS, but called to select a subset of folders to put in group GROUPNAME.") (LAFITE.SELECT.MULTIPLE (LET* ((ALLFOLDERS (CDR LAFITEMAILFOLDERS)) (GROUPED (CL:REMOVE-DUPLICATES (for GROUP in LAFITE.FOLDER.STRUCTURE join (APPEND (fetch FGFOLDERS of GROUP))) :TEST (QUOTE STRING-EQUAL))) (UNGROUPED (AND (> (LENGTH ALLFOLDERS) (LENGTH GROUPED)) (CL:SET-DIFFERENCE ALLFOLDERS GROUPED :TEST (QUOTE STRING-EQUAL))))) (* ; "The LENGTH check is an optimization to skip the SET-DIFFERENCE call when everybody is in a group.") (if UNGROUPED then (* ; "Show the ungrouped ones in a clump to make it easier to see which folders still need to be classified") (NCONC UNGROUPED (LIST LAFITE.SPACER.MENU.ITEM) (SORT GROUPED (FUNCTION UALPHORDER))) else ALLFOLDERS)) PRESELECTED (CONCAT "Folders in group " GROUPNAME) (CL:FORMAT NIL "Select which folders should belong to ~A." GROUPNAME)))
+)
+
+(\LAFITE.CHANGE.SUBGROUPS

+(LAMBDA (NAME) (* ; "Edited  8-May-89 16:41 by bvm") (LET* ((GROUP (LAFITE.FIND.GROUP NAME)) (CANDIDATES (MAPCAR (CL:REMOVE GROUP LAFITE.FOLDER.STRUCTURE) (FUNCTION CAR)))) (if CANDIDATES then (LET ((NEWMEMBERS (LAFITE.SELECT.MULTIPLE CANDIDATES (fetch FGSUBGROUPS of GROUP) (CONCAT "Subgroups of " NAME) (CL:FORMAT NIL "Select which groups should lie below ~A in the folder hierarchy." NAME)))) (if (NEQ NEWMEMBERS :ABORT) then (replace FGSUBGROUPS of GROUP with (SORT NEWMEMBERS (FUNCTION UALPHORDER))) (SETQ \LAFITEPROFILECHANGED T) (SETQ LAFITEFOLDERSMENU))) else (PROMPTPRINT "No other groups are yet defined."))))
+)
+
+(\LAFITE.CHANGE.TOP.GROUPS

+(LAMBDA NIL (* ; "Edited  8-May-89 16:43 by bvm") (if LAFITE.FOLDER.STRUCTURE then (LET ((NEWTOP (LAFITE.SELECT.MULTIPLE (for GROUP in LAFITE.FOLDER.STRUCTURE collect (fetch FGNAME of GROUP)) (for GROUP in LAFITE.FOLDER.STRUCTURE when (fetch FGTOPLEVEL of GROUP) collect (fetch FGNAME of GROUP)) "Top level groups" "Select which groups should appear in the top-level folder menu."))) (if (NEQ NEWTOP :ABORT) then (for GROUP in LAFITE.FOLDER.STRUCTURE do (replace FGTOPLEVEL of GROUP with (AND (CL:MEMBER (fetch FGNAME of GROUP) NEWTOP :TEST (QUOTE STRING-EQUAL)) T))) (SETQ \LAFITEPROFILECHANGED T) (SETQ LAFITEFOLDERSMENU))) else (PROMPTPRINT "No groups are yet defined.")))
+)
+
+(\LAFITE.DELETE.GROUP

+(LAMBDA (NAME) (* ; "Edited  8-May-89 15:54 by bvm") (LET ((GROUP (LAFITE.FIND.GROUP NAME))) (if (AND GROUP (MOUSECONFIRM (CONCAT "Click LEFT to confirm deleting group " NAME) "")) then (for OTHER in (SETQ LAFITE.FOLDER.STRUCTURE (DREMOVE GROUP LAFITE.FOLDER.STRUCTURE)) bind FOUND when (SETQ FOUND (CL:MEMBER NAME (fetch FGSUBGROUPS of OTHER) :TEST (QUOTE STRING-EQUAL))) do (* ; "Remove this as subgroup") (replace FGSUBGROUPS of OTHER with (DREMOVE (CAR FOUND) (fetch FGSUBGROUPS of OTHER)))) (SETQ \LAFITEPROFILECHANGED T) (SETQ LAFITEFOLDERSMENU))))
+)
+
+(LAFITE.RENAME.GROUP

+(LAMBDA (OLDNAME NEWNAME) (* ; "Edited  8-May-89 15:54 by bvm") (if (AND (OR NEWNAME (SETQ NEWNAME (PROMPTFORFILENAME NIL OLDNAME (CONCAT "New name for group " OLDNAME " (CR to abort): ")))) (OR (STRING-EQUAL NEWNAME OLDNAME) (\LAFITE.CHECK.GROUP.NAME NEWNAME))) then (LET ((OLDGROUP (LAFITE.FIND.GROUP OLDNAME)) FOUND) (if (NULL OLDGROUP) then (PRINTOUT PROMPTWINDOW T "Group " OLDNAME " not found.") else (replace FGNAME of OLDGROUP with NEWNAME) (for GROUP in (SORT LAFITE.FOLDER.STRUCTURE (FUNCTION UALPHORDERCAR)) when (SETQ FOUND (CL:MEMBER OLDNAME (fetch FGSUBGROUPS of GROUP) :TEST (QUOTE STRING-EQUAL))) do (SORT (DSUBST NEWNAME (CAR FOUND) (fetch FGSUBGROUPS of GROUP)) (FUNCTION UALPHORDER))) (SETQ \LAFITEPROFILECHANGED T) (SETQ LAFITEFOLDERSMENU) (PRINTOUT PROMPTWINDOW T "Group " OLDNAME " renamed to " NEWNAME)))))
+)
+
+(\LAFITE.EDIT.HIERARCHY

+(LAMBDA NIL (* ; "Edited 13-Apr-89 14:43 by bvm") (if (NULL LAFITE.FOLDER.STRUCTURE) then (\LAFITE.ADD.NEW.GROUP) else (LET ((GROUP (MENU (create MENU ITEMS _ (NCONC1 (MAPCAR LAFITE.FOLDER.STRUCTURE (FUNCTION CAR)) (QUOTE ("**New Group**" :NEW "Define a new folder group"))) CENTERFLG _ T TITLE _ "Edit which group?")))) (if (EQ GROUP :NEW) then (\LAFITE.ADD.NEW.GROUP) elseif GROUP then (LET ((CMD (MENU (.LAFITEMENU. LAFITE.GROUP.COMMANDS.MENU LAFITE.GROUP.COMMANDS "Change group how?")))) (AND CMD (CL:FUNCALL CMD GROUP)))))))
+)
+
+(LAFITE.FIND.GROUP

+(LAMBDA (NAME) (* ; "Edited  8-May-89 15:51 by bvm") (* ;; "Return the FOLDERGROUP object named NAME.") (CL:ASSOC NAME LAFITE.FOLDER.STRUCTURE :TEST (QUOTE STRING-EQUAL)))
+)
+
+(UALPHORDERCAR

+(LAMBDA (X Y) (* ; "Edited 13-Apr-89 14:38 by bvm") (ALPHORDER (CAR X) (CAR Y) UPPERCASEARRAY)))
+)
+
+(RPAQQ LAFITE.SPACER.MENU.ITEM (#*(32 1)OOOOOOOO NIL "(this is not a choice)"))
+
+(RPAQQ LAFITE.GROUP.COMMANDS (("Delete Group" (QUOTE \LAFITE.DELETE.GROUP) "Remove this group from the hierarchy") ("Rename Group" (QUOTE LAFITE.RENAME.GROUP) "Change the name of this group") ("Change Members" (QUOTE \LAFITE.CHANGE.GROUP.MEMBERS) "Change the membership of this group") ("Change Subgroups" (QUOTE \LAFITE.CHANGE.SUBGROUPS) "Change the subgroups of this group") ("Create Subgroup" (QUOTE \LAFITE.ADD.NEW.GROUP) "Create a new group and make it a subgroup of this group")))
+
+(RPAQQ LAFITE.GROUP.COMMANDS.MENU NIL)
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+
+(FILESLOAD (SOURCE) LAFITEDECLS)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(LOCALVARS . T)
+)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS MENUFONT LAFITE.GROUP.COMMANDS.MENU LAFITE.GROUP.COMMANDS)
+)
+
+
+(CL:PROCLAIM (QUOTE (CL:SPECIAL *LA.ABBREVS.IN.PROFILE*)))
+)
+(PUTPROPS LAFITEFOLDERS COPYRIGHT ("Xerox Corporation" 1989))
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (2597 10462 (\LAFITE.READ.PROFILE 2607 . 4811) (\LAFITE.PROCESS.PROFILE 4813 . 6003) (
+\LAFITE.WRITE.PROFILE 6005 . 7839) (\LAFITE.MERGE.NAMELISTS 7841 . 8575) (\LAFITE.READ.OLD.PROFILE 
+8577 . 9176) (\LAFITE.MERGE.FOLDERS 9178 . 9490) (\LAFITE.MERGE.STRUCTURES 9492 . 9692) (
+\LAFITE.REPACK.FOLDERS 9694 . 10460)) (10780 19324 (\LAFITE.PROMPTFORFOLDER 10790 . 11340) (
+PROMPTFORFILENAME 11342 . 12183) (MAKELAFITEMAILFOLDERSMENU 12185 . 12349) (MAKELAFITEFOLDERSMENUITEMS
+ 12351 . 13466) (LAFITE.GROUP.ITEM 13468 . 14005) (\LAFITE.ARRANGE.MENU 14007 . 15289) (
+\LAFITE.MAKE.FOLDER.MENU 15291 . 15816) (LAFITE.SELECT.FOLDERS 15818 . 16203) (LAFITE.SELECT.MULTIPLE 
+16205 . 18549) (\LAFITE.HANDLE.MULTIPLE.SELECTION 18551 . 19023) (COLLECT.SHADED.ITEMS 19025 . 19322))
+ (19529 28038 (LA.LONGFILENAME 19539 . 21414) (LA.SHORTFILENAME 21416 . 23239) (FORGETMAILFILE 23241
+ . 23701) (\LAFITE.FOLDER.NAME.CHANGED 23703 . 24926) (\LAFITE.CHANGE.NAME.IN.LIST 24928 . 25307) (
+\LAFITE.RECOMPUTE.FOLDER.NAMES 25309 . 26730) (\LAFITE.NEW.SHORT.NAME 26732 . 27413) (
+\LAFITE.NOTICE.FILE 27415 . 27596) (\LAFITE.UNCACHE.FOLDER 27598 . 28036)) (28146 41112 (
+\LAFITE.NOTICE.FOLDERS 28156 . 29796) (\LAFITE.GC.FOLDERS 29798 . 30885) (\LAFITE.GC.FOLDERS.CONFIRM 
+30887 . 31697) (\LAFITE.MAKE.RANDOM.DISPLAY 31699 . 32477) (\LAFITE.CHANGE.FOLDER.LIST 32479 . 33232) 
+(\LAFITE.RENAME.FOLDER 33234 . 34964) (\LAFITE.ADD.NEW.GROUP 34966 . 35691) (\LAFITE.CHECK.GROUP.NAME 
+35693 . 36044) (\LAFITE.CHANGE.GROUP.MEMBERS 36046 . 36421) (\LAFITE.SELECT.GROUP.FOLDERS 36423 . 
+37429) (\LAFITE.CHANGE.SUBGROUPS 37431 . 38082) (\LAFITE.CHANGE.TOP.GROUPS 38084 . 38792) (
+\LAFITE.DELETE.GROUP 38794 . 39376) (LAFITE.RENAME.GROUP 39378 . 40234) (\LAFITE.EDIT.HIERARCHY 40236
+ . 40795) (LAFITE.FIND.GROUP 40797 . 40993) (UALPHORDERCAR 40995 . 41110)))))
+STOP

library/lafite/LAFITEHAX

@@ -0,0 +1,81 @@
+(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
+
(FILECREATED "26-Feb-93 14:36:38" "{DSK}<tilde>vanmelle>lisp>lafite>LAFITEHAX.;12"
 9033   
+
+      changes to%:  (FNS \NSMAIL.PARSE1 \NSMAIL.NEW.CHECKSERVER LAFITE.TOGGLE.SERVER.TRACE LAFITE.HANDLE.ORIGINAL.FIELD LAFITE.COMPUTE.CACHED.VARS LAFITE.NEW.PARSE.HEADER INIT.NEW.PARSE.HANDLER)
+ (VARS LAFITEHAXCOMS)
+
+      previous date%: " 3-Jun-92 16:10:47" "{DSK}<tilde>vanmelle>lisp>lafite>LAFITEHAX.;1")
+
+
+(* ; "
+Copyright (c) 1992, 1993 by Xerox Corporation.  All rights reserved.
+")
+
+(PRETTYCOMPRINT LAFITEHAXCOMS)
+
+(RPAQQ LAFITEHAXCOMS ((COMS (* ; "New header parser") (FNS LAFITE.NEW.PARSE.HEADER LAFITE.HANDLE.ORIGINAL.FIELD INIT.NEW.PARSE.HANDLER LAFITE.COMPUTE.CACHED.VARS) (INITVARS (*LAFITE-MAX-FIELD-WIDTH* 100) (*LAFITE-PARSE-HEADER-STRING-RESOURCE*)) (GLOBALVARS *LAFITE-MAX-FIELD-WIDTH* *LAFITE-PARSE-HEADER-STRING-RESOURCE*) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (INIT.NEW.PARSE.HANDLER)))) (COMS (* ; "automatically handle internet addresses") (FNS \NSMAIL.PARSE1)) (COMS (FNS LAFITE.TOGGLE.SERVER.TRACE) (APPENDVARS (LAFITESUBQUITMENUITEMS ("Server trace" (QUOTE LAFITE.TOGGLE.SERVER.TRACE) "Change setting of *NSMAIL-TRACE-SERVERS*"))) (VARS (LAFITESUBQUITMENU)))))
+
+
+
+(* ; "New header parser")

+
+(DEFINEQ
+
+(LAFITE.NEW.PARSE.HEADER

+(LAMBDA (STREAM PARSETABLE START END ONCEONLY CHECKEOF) (* ; "Edited  3-Jun-92 17:30 by bvm") (PROG ((FIELD (OR *LAFITE-PARSE-HEADER-STRING-RESOURCE* (SETQ *LAFITE-PARSE-HEADER-STRING-RESOURCE* (ALLOCSTRING *LAFITE-MAX-FIELD-WIDTH*)))) PARSERESULT PARSEBEGIN CH I PATLEN) (DECLARE (SPECVARS PARSETABLE PARSERESULT PARSEBEGIN)) (* ; "For Parse result functions to access") (if START then (SETFILEPTR STREAM START)) TOP (SETQ PARSEBEGIN (GETFILEPTR STREAM)) (SETQ I 0) (do (SELCHARQ (SETQ CH (READCCODE STREAM)) ((CR TAB SPACE NIL) (* ; "Whitespace before a colon is illegal (or if it's a cr at start of line, it's the official end of header)") (if CHECKEOF then (push PARSERESULT (LIST (QUOTE EOF) PARSEBEGIN T))) (IF (EQ CH (CHARCODE CR)) THEN (FOR CHOICE IN PARSETABLE WHEN (EQ (CAR CHOICE) (QUOTE %
+)) DO (* ; "Kludge for something to call at end of header") (RETURN (CL:FUNCALL (CADR CHOICE) STREAM (CAR CHOICE) 1 (CDDR CHOICE))))) (GO EXIT)) NIL) (if (< I *LAFITE-MAX-FIELD-WIDTH*) then (CL:SETF (CL:CHAR FIELD I) (CL:CODE-CHAR CH)) (add I 1)) (if (EQ CH (CHARCODE ":")) then (for CHOICE in PARSETABLE WHEN (AND (<= (SETQ PATLEN (NCHARS (CAR CHOICE))) I) (STRING-EQUAL FIELD (CAR CHOICE) :END1 PATLEN)) do (LAFITE.SKIP.WHITE.SPACE STREAM) (COND ((OR (EQ (CL:FUNCALL (CADR CHOICE) STREAM FIELD I (CDDR CHOICE)) (QUOTE STOP)) ONCEONLY) (GO EXIT)) (T (GO NEXTLINE)))) (* ;; "Get here if parse of current line failed") (LA.SKIP.TO.EOL STREAM CH) (GO NEXTLINE))) NEXTLINE (COND ((COND (END (< (GETFILEPTR STREAM) END)) (T (NOT (\EOFP STREAM)))) (GO TOP))) EXIT (replace CHARSET of STREAM with 0) (* ; "Don't let any temporary change in charset affect future operations.  This is not a call to CHARSET because of stupid bug that causes it to write a charset change!!!") (RETURN PARSERESULT)))
+)
+
+(LAFITE.HANDLE.ORIGINAL.FIELD

+(LAMBDA (STREAM FIELD FIELDLEN IGNORE) (DECLARE (USEDFREE PARSERESULT PARSEBEGIN PARSETABLE)) (* ; "Edited  3-Jun-92 17:51 by bvm") (* ;; "Called when we parsed a header starting %"Original-xxx:...%"  We want to hide the %"Original-%" part, and also hide the matching %"xxx:%" field that (we assume) occurs later") (LA.SKIP.TO.EOL STREAM) (push PARSERESULT (LIST PARSEBEGIN (+ PARSEBEGIN (CONSTANT (NCHARS "Original-"))))) (push PARSETABLE (LIST (CL:SUBSEQ FIELD (CONSTANT (NCHARS "Original-")) FIELDLEN) (FUNCTION LAFITE.EAT.UNDESIRABLE.FIELD))) (* ; "Note that we have to COPY the characters of field, since that string is volatile") NIL)
+)
+
+(INIT.NEW.PARSE.HANDLER

+(LAMBDA NIL (* ; "Edited  3-Jun-92 17:42 by bvm") (FOR FN IN (QUOTE (\LAFITE.APPEND.MESSAGE.BODY MESSAGEDISPLAYER)) DO (CHANGENAME FN (QUOTE LAFITE.PARSE.HEADER) (QUOTE LAFITE.NEW.PARSE.HEADER))) (LAFITE.COMPUTE.CACHED.VARS))
+)
+
+(LAFITE.COMPUTE.CACHED.VARS

+(LAMBDA NIL (* ; "Edited  3-Jun-92 17:46 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) (for FIELD in (EVALV USERVAR) collect (if (STRING-EQUAL FIELD "GV") then (* ; "Kludge!  Designed to eat GVGV nonsense that comes AFTER the header") (LIST (QUOTE %
+) (FUNCTION LAFITE.EAT.GVGV)) ELSEIF (EQ FIELD :ORIGINAL) THEN (LIST "Original-" (FUNCTION LAFITE.HANDLE.ORIGINAL.FIELD)) else (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))
+)
+)
+
+(RPAQ? *LAFITE-MAX-FIELD-WIDTH* 100)
+
+(RPAQ? *LAFITE-PARSE-HEADER-STRING-RESOURCE*)
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS *LAFITE-MAX-FIELD-WIDTH* *LAFITE-PARSE-HEADER-STRING-RESOURCE*)
+)
+(DECLARE%: DONTEVAL@LOAD DOCOPY 
+
+(INIT.NEW.PARSE.HANDLER)
+)
+
+
+
+(* ; "automatically handle internet addresses")

+
+(DEFINEQ
+
+(\NSMAIL.PARSE1

+(LAMBDA (FIELD DEFAULTDOMAIN EDITWINDOW) (* ; "Edited 26-Feb-93 14:34 by bvm") (COND (FIELD (bind ADDR (START _ 1) COMMA DOT when (PROGN (SETQ ADDR (SUBSTRING FIELD START (AND (SETQ COMMA (STRPOS (QUOTE %,) FIELD START)) (SUB1 COMMA)))) (do (* ; "Strip leading blanks") (SELCHARQ (CHCON1 ADDR) ((SPACE TAB) (GNC ADDR)) (RETURN))) (do (* ; "Strip trailing blanks") (SELCHARQ (NTHCHARCODE ADDR -1) ((SPACE TAB) (GLC ADDR)) (RETURN))) (NEQ (NCHARS ADDR) 0)) collect (if (AND (STRPOS (QUOTE @) ADDR) (NOT (STRPOS (QUOTE %:) ADDR)) (EQ DEFAULTDOMAIN (fetch (LAFITEMODEDATA UNPACKEDUSERNAME) of *LAFITE-MODE-DATA*)) (SETQ DOT (STRPOS (QUOTE %.) ADDR NIL NIL NIL NIL NIL T))) then (* ;; "It's an Internet address--turn the last dot into a colon.  Don't do this if we're not being called from the places that parse with respect to the user's own name.  E.g., when building an answer form, there are often names that are abbreviated relative to the message sender's name.") (create NSNAME NSOBJECT _ (SUBSTRING ADDR 1 (SUB1 DOT)) NSDOMAIN _ (SUBSTRING ADDR (ADD1 DOT)) NSORGANIZATION _ "Xerox") else (PARSE.NSNAME ADDR NIL DEFAULTDOMAIN)) repeatwhile (COND (COMMA (SETQ START (ADD1 COMMA))))))))
+)
+)
+(DEFINEQ
+
+(LAFITE.TOGGLE.SERVER.TRACE

+(LAMBDA NIL (* ; "Edited 24-Jul-92 15:14 by bvm") (LET ((CHOICE (MENU (create MENU ITEMS _ (QUOTE (("Quiet" 0 "Don't report server") ("Report" T "Just report server in prompt window") ("Require Confirmation" :ASK "Require approval for posting server choice"))) CENTERFLG _ T TITLE _ "Trace Posting Server?")))) (if CHOICE then (PRINTOUT PROMPTWINDOW T "*NSMAIL-TRACE-SERVERS* = " (SETQ *NSMAIL-TRACE-SERVERS* (AND (NEQ CHOICE 0) CHOICE))))))
+)
+)
+
+(APPENDTOVAR LAFITESUBQUITMENUITEMS
 ("Server trace" (QUOTE LAFITE.TOGGLE.SERVER.TRACE) "Change setting of *NSMAIL-TRACE-SERVERS*")
+)
+
+(RPAQQ LAFITESUBQUITMENU NIL)
+(PUTPROPS LAFITEHAX COPYRIGHT ("Xerox Corporation" 1992 1993))
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (1281 6753 (LAFITE.NEW.PARSE.HEADER 1291 . 3112) (LAFITE.HANDLE.ORIGINAL.FIELD 3114 . 
+3790) (INIT.NEW.PARSE.HANDLER 3792 . 4047) (LAFITE.COMPUTE.CACHED.VARS 4049 . 6751)) (7070 8290 (
+\NSMAIL.PARSE1 7080 . 8288)) (8291 8778 (LAFITE.TOGGLE.SERVER.TRACE 8301 . 8776)))))
+STOP

library/lafite/LAFITESEND.~1~

@@ -0,0 +1,436 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
(FILECREATED " 6-Aug-93 15:48:00" {DSK}<archive>lafite>sources>lafitesend.;15
 58121  
+
+      changes to%:  (VARS LAFITESENDCOMS)
+
+      previous date%: "30-May-90 16:26:31" {DSK}<archive>lafite>sources>lafitesend.;14)
+
+
+(* ; "
+Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993 by Xerox Corporation.  All rights reserved.
+")
+
+(PRETTYCOMPRINT LAFITESENDCOMS)
+
+(RPAQQ LAFITESENDCOMS ((COMS (* ; "Sending mail") (FNS DOLAFITESENDINGCOMMAND \SENDMESSAGE.INITIATE \SENDMSG.DELIVER \SENDMSG.EXIT.TEDIT \SENDMSG.SAVE.FORM \LAFITE.HEADER.EOF \LAFITE.INSERT.REPLYTO \SENDMSG.REPLYTO \SENDMSG.CHANGE.MODE \SENDMSG.FIND.FIELD \SENDMESSAGE.PARSE \LAFITE.PREPARE.SEND \LAFITE.PREPARE.ERROR \LAFITE.CHOOSE.MSG.FORMAT LAFITE.MAKE.PLAIN.TEXTSTREAM \SENDMESSAGE.MENUPROMPT \SENDMESSAGE.PROMPT \SENDMESSAGEFAIL) (FNS \SENDMESSAGE \SENDMESSAGE.RESTARTABLE \SENDMESSAGE.CLEANUP \SENDMESSAGE.MAKEWINDOW MAKELAFITEDELIVERMENU \LAFITE.CLOSEMSG? \LAFITE.AFTER.DELIVER \LAFITE.UNSENT.ICON \LAFITE.FETCH.SUBJECT LAFITE.SENDMESSAGE \SENDMESSAGE0 LA.ASSURE.PROMPT.WINDOW \LAFITE.SEND.FAIL \LAFITE.INVALID.RECIPIENTS \SENDMESSAGE.ABORT)) (COMS (* ; "Outbox hacking") (FNS \OUTBOX.CREATE \OUTBOX.RESET \OUTBOX.CLOSEFN \OUTBOX.REPAINTFN \OUTBOX.RESHAPEFN \OUTBOX.SHADEITEM \OUTBOX.BUTTONFN \OUTBOX.DISPLAYLINE \OUTBOX.ADD.ITEM) (INITVARS (LAFITEOUTBOXSIZE 2) (\LAFITE.OUTBOX)) (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS OUTBOXITEM) (GLOBALVARS LAFITEOUTBOXSIZE))) (COMS (* ; "Built-in message forms") (FNS \LAFITE.MESSAGEFORM MAKELAFITESUPPORTFORM MAKELISPSUPPORTFORM MAKEXXXSUPPORTFORM MAKENEWMESSAGEFORM MAKELAFITEPRIVATEFORMSITEMS \LAFITE.UNCACHE.MESSAGEFORM \LAFITE.DELETE.MESSAGEFORM \LAFITE.SELECT.FORM \LAFITE.DELETE.FORM.INTERNAL \LAFITE.READ.FORM \LAFITE.FIND.TEMPLATE)) (COMS (* ; "ANSWER") (FNS \LAFITE.ANSWER \LAFITE.ANSWER.PROC MAKEANSWERFORM LA.PRINT.COMMA.LIST LAFITE.FILL.IN.ANSWER.FORM)) (COMS (* ; "FORWARD") (FNS \LAFITE.FORWARD \LAFITE.FORWARD.PROC MAKEFORWARDFORM)) (COMS (VARS LAFITESENDINGMENUITEMS LAFITEFORMSMENUITEMS LAFITEFORMATMENUITEMS LAFITEFORWARDSTRINGS) (ADDVARS (\SYSTEMCACHEVARS \LAFITE.REPORT.MACHINE) (LAFITESPECIALFORMS ("Lisp Report" (FUNCTION MAKELISPSUPPORTFORM) "A form to report a Lisp bug or suggestion") ("Lafite Report" (FUNCTION MAKELAFITESUPPORTFORM) "A form to report a Lafite bug or suggestion")) (LAFITEMENUVARS LAFITEFORMSMENU LAFITEFORMATMENU)) (INITVARS (\LAFITE.REPORT.MACHINE) (LAFITECURRENTEDITORWINDOWS) (LAFITEFORMFILES) (LAFITEFORMSMENU) (LAFITEFORMATMENU)) (INITVARS (LAFITEEDITORFONT LAFITEDISPLAYFONT) (LAFITEFORM.EXT "Lafite-form") (LAFITEFORMDIRECTORIES NIL) (LAFITE.EDITOR.SIZE (QUOTE (470 . 300))) (LAFITE.EDITOR.LAYOUTS NIL) (LAFITEFORWARDSUBJECTSTR NIL) (LAFITESUPPORT NIL) (LISPSUPPORT NIL) (MESSAGESTR ">>Message<<") (RECIPIENTSSTR ">>Recipients<<") (SUBJECTSTR ">>Subject<<") (LAFITE.SEND.FORMATTED (QUOTE ((NSCHARS :ASK) (CHARLOOKS :ASK) (PARALOOKS :ASK) (IMAGEOBJ T)))))) (COMS (* ; "Obsolete") (INITVARS (LAFITEEDITORREGION NIL))) (COMS (* ; "ICON stuff") (VARS LAFITE.MSG.ICON)) (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS SENDINGCOMMAND) (GLOBALVARS \LAFITE.REPORT.MACHINE LAFITECURRENTEDITORWINDOWS LAFITEEDITORFONT LAFITEEDITORREGION LAFITEFORMATMENU LAFITEFORMSMENUITEMS LAFITEFORMATMENUITEMS LAFITEFORWARDSTRINGS LAFITEFORWARDSUBJECTSTR LAFITESENDINGMENUITEMS LAFITESPECIALFORMS LAFITESUPPORT LISPSUPPORT MAKESYSDATE MESSAGESTR RECIPIENTSSTR SUBJECTSTR LAFITE.MSG.ICON LAFITEFORMDIRECTORIES LAFITE.SEND.FORMATTED) (FILES (SOURCE) LAFITEDECLS) (LOCALVARS . T))))
+
+
+
+(* ; "Sending mail")

+
+(DEFINEQ
+
+(DOLAFITESENDINGCOMMAND

+(LAMBDA (ITEM MENU KEY) (* bvm%: "31-Jul-84 15:03") (* ;;; "this function is invoked by buttoning the menu on top of the 'sending' window") (PROG ((WINDOW (WINDOWPROP (WFROMMENU MENU) (QUOTE MAINWINDOW))) PROC) (AND (SETQ PROC (WINDOWPROP WINDOW (QUOTE PROCESS))) (PROCESS.APPLY PROC (FUNCTION \SENDMESSAGE.INITIATE) (LIST WINDOW MENU ITEM)))))
+)
+
+(\SENDMESSAGE.INITIATE

+(LAMBDA (WINDOW MENU ITEM) (* ; "Edited 31-Jan-89 16:59 by bvm") (* ;; "Called by selecting a menu command from a message composition window") (ERSETQ (RESETLST (LET ((COMMAND (EXTRACTMENUCOMMAND ITEM))) (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (ITEM MENU) (COND (RESETSTATE (* ; "In case of error/abort, set menu & proc back to normal") (SHADEITEM ITEM MENU WHITESHADE) (replace (MENU WHENSELECTEDFN) of MENU with (FUNCTION DOLAFITESENDINGCOMMAND)) (PROCESSPROP (THIS.PROCESS) (QUOTE BEFOREEXIT) NIL))))) ITEM MENU)) (SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE) (* ; "Now disable the menu") (replace (MENU WHENSELECTEDFN) of MENU with (FUNCTION NILL)) (PROCESSPROP (THIS.PROCESS) (QUOTE BEFOREEXIT) (QUOTE DON'T)) (* ; "Don't let anyone logout now!") (CL:FUNCALL COMMAND WINDOW (WINDOWPROP WINDOW (QUOTE TEXTSTREAM)) MENU ITEM)))))
+)
+
+(\SENDMSG.DELIVER

+(LAMBDA (WINDOW TEXTSTREAM MENU ITEM) (* ; "Edited 31-Jan-89 16:41 by bvm") (LET (PARSE) (printout (GETPROMPTWINDOW WINDOW) T "Parsing...") (OR (SETQ PARSE (\SENDMESSAGE.PARSE TEXTSTREAM WINDOW)) (ERROR!)) (\SENDMSG.EXIT.TEDIT WINDOW TEXTSTREAM (create SENDINGCOMMAND COMMAND _ (QUOTE %##SEND##) ITEM _ ITEM MENU _ MENU MESSAGE _ TEXTSTREAM MESSAGEPARSE _ PARSE))))
+)
+
+(\SENDMSG.EXIT.TEDIT

+(LAMBDA (WINDOW TEXTSTREAM VALUE) (* ; "Edited 31-Jan-89 16:39 by bvm") (WINDOWADDPROP WINDOW (QUOTE CLOSEFN) (QUOTE DON'T)) (* ; "Keep TEDIT.QUIT from closing the window") (TEDIT.QUIT TEXTSTREAM VALUE) (LA.DETACH.TEDIT TEXTSTREAM))
+)
+
+(\SENDMSG.SAVE.FORM

+(LAMBDA (WINDOW TEXTSTREAM MENU ITEM) (* ; "Edited  3-Nov-89 15:33 by bvm") (* ;; "Shortcut to TEdit Put that saves on mail directory and remembers it as a %"Saved Form%"") (LET ((*UPPER-CASE-FILE-NAMES* NIL) (PROMPT "Save under name: ") (FORMNAME (WINDOWPROP WINDOW (QUOTE LAFITEFORM))) PWINDOW FORMFILE) (COND (FORMNAME (SETQ FORMNAME (LA.SHORTFILENAME FORMNAME LAFITEFORM.EXT)))) (SETQ PWINDOW (LA.ASSURE.PROMPT.WINDOW WINDOW PROMPT (OR FORMNAME "XXX"))) (* ; "Kludge to keep it small") (CLEARW PWINDOW) (COND ((SETQ FORMFILE (PROMPTFORFILENAME PWINDOW FORMNAME PROMPT)) (SETQ FORMNAME (LA.SHORTFILENAME (TEDIT.PUT TEXTSTREAM (LA.LONGFILENAME FORMFILE LAFITEFORM.EXT) NIL (if (EQ (TEDIT.FORMATTEDFILEP TEXTSTREAM) (QUOTE NSCHARS)) then (* ; "Force no formatting--TEdit defaultly saves formatting even if only ns chars") T)) LAFITEFORM.EXT)) (WINDOWPROP WINDOW (QUOTE LAFITEFORM) FORMNAME) (COND ((NOT (CL:MEMBER FORMNAME LAFITEFORMFILES :TEST (QUOTE STRING-EQUAL))) (SETQ LAFITEFORMFILES (APPEND LAFITEFORMFILES (LIST FORMNAME))) (SETQ \LAFITEPROFILECHANGED T) (SETQ LAFITEFORMSMENU))))) (* ;; "Exit with error to restore window state (what a kludge)") (ERROR!)))
+)
+
+(\LAFITE.HEADER.EOF

+(LAMBDA (TEXTSTREAM) (* ; "Edited  3-Nov-89 14:29 by bvm") (* ;; "Return the character number in TEXTSTREAM of the blank line following the header") (ADD1 (CADAR (LAFITE.PARSE.HEADER TEXTSTREAM NIL 0 NIL NIL T))))
+)
+
+(\LAFITE.INSERT.REPLYTO

+(LAMBDA (TEXTSTREAM NAME HIGHLIGHT HEADEREOF) (* ; "Edited  3-Nov-89 12:57 by bvm") (* ;; "Insert a %"Reply-to: name%" field in this message.  If HIGHLIGHT, leave the name pending-delete selected for potential replacement.") (TEDIT.INSERT TEXTSTREAM (CONCAT "Reply-to: " NAME LAFITEEOL) (OR HEADEREOF (SETQ HEADEREOF (\LAFITE.HEADER.EOF TEXTSTREAM)))) (if HIGHLIGHT then (TEDIT.SETSEL TEXTSTREAM (+ HEADEREOF (CONSTANT (NCHARS "Reply-to: "))) (NCHARS NAME) (QUOTE RIGHT) T)))
+)
+
+(\SENDMSG.REPLYTO

+(LAMBDA (WINDOW TEXTSTREAM MENU ITEM) (* ; "Edited  3-Nov-89 14:03 by bvm") (* ;; "Add a Reply-to field to the message") (\LAFITE.INSERT.REPLYTO TEXTSTREAM (fetch (LAFITEMODEDATA FULLUSERNAME) of (\LAFITE.GET.USER.DATA (TEXTPROP TEXTSTREAM (QUOTE LAFITEMODE)))) T) (* ;; "Exit with error to restore window state (what a kludge)") (ERROR!))
+)
+
+(\SENDMSG.CHANGE.MODE

+(LAMBDA (WINDOW TEXTSTREAM MENU ITEM) (* ; "Edited  5-Jan-90 18:06 by bvm") (LET* ((OLDMODE (TEXTPROP TEXTSTREAM (QUOTE LAFITEMODE))) (OTHERMODES (for MODE in LAFITEMODELST unless (OR (EQ (fetch (LAFITEOPS LAFITEMODE) of MODE) OLDMODE) (NLISTP (CDR MODE))) collect (fetch (LAFITEOPS LAFITEMODE) of MODE))) (NEWMODE (if (NULL OTHERMODES) then (\SENDMESSAGE.PROMPT WINDOW "There are no other modes") elseif (CDR OTHERMODES) then (MENU (\LAFITE.CREATE.MENU OTHERMODES "New mode")) else (CAR OTHERMODES)))) (if NEWMODE then (LET* ((TITLE (WINDOWPROP WINDOW (QUOTE TITLE))) (OLDMODEDATA (\LAFITE.GET.USER.DATA OLDMODE)) (NEWMODEDATA (\LAFITE.GET.USER.DATA NEWMODE)) N N2) (if (NULL NEWMODEDATA) then (\SENDMESSAGE.PROMPT WINDOW (CL:FORMAT NIL "Can't authenticate user in ~A mode" NEWMODE)) else (LET ((OLDNAME (fetch (LAFITEMODEDATA FULLUSERNAME) of OLDMODEDATA)) (END (TEDIT.FIND TEXTSTREAM "
+
+" 1)) START N LEN NEW OLDSEL) (if END then (add END 1)) (* ; "Don't search past end of header.  END now points at second cr.") (for FIELD in (QUOTE ("cc" "Reply-to")) when (AND (SETQ N (\SENDMSG.FIND.FIELD TEXTSTREAM FIELD END)) (PROGN (SETQ LEN (CADR N)) (SETQ N (CAR N)) (SETQ START (STRPOS OLDNAME (SETQ OLDSEL (TEDIT.SEL.AS.STRING TEXTSTREAM (create SELECTION CH# _ N DCH _ LEN))) NIL NIL NIL NIL UPPERCASEARRAY)))) do (* ; "Change field containing old user name to new.  This is much more complicated than it needs to be because TEDIT.FIND is case sensitive.") (TEDIT.DELETE TEXTSTREAM N LEN) (TEDIT.INSERT TEXTSTREAM (SETQ NEW (CONCAT (OR (SUBSTRING OLDSEL 1 (SUB1 START)) "") (fetch (LAFITEMODEDATA FULLUSERNAME) of NEWMODEDATA) (OR (SUBSTRING OLDSEL (+ START (NCHARS OLDNAME))) ""))) N) (AND END (add END (- (NCHARS NEW) LEN)))) (if (SETQ N (\SENDMSG.FIND.FIELD TEXTSTREAM "To" END)) then (* ; "Leave the To field selected for address modification") (TEDIT.SETSEL TEXTSTREAM (CAR N) (CADR N) (QUOTE RIGHT) T)) (TEXTPROP TEXTSTREAM (QUOTE LAFITEMODE) NEWMODE) (if (SETQ N (STRPOS (CONCAT "(" OLDMODE ")") TITLE)) then (WINDOWPROP WINDOW (QUOTE TITLE) (CONCAT (SUBSTRING TITLE 1 N) NEWMODE ")"))) (\SENDMESSAGE.PROMPT WINDOW "Message mode is now " NEWMODE))))) (* ;; "Exit with error so that the window is restored to previous state") (ERROR!)))
+)
+
+(\SENDMSG.FIND.FIELD

+(LAMBDA (TEXTSTREAM FIELD END) (* ; "Edited  5-Jan-90 17:54 by bvm") (* ;; "Find and select the header field beginning with %"FIELD:%".  Return starting index.") (LET* ((STR (CONCAT "
+" FIELD ": ")) (N (TEDIT.FIND TEXTSTREAM STR 1 END)) N2) (if (AND N (SETQ N2 (TEDIT.FIND TEXTSTREAM "
+" (add N (NCHARS STR)) END))) then (LIST N (- N2 N))))))
+
+(\SENDMESSAGE.PARSE

+(LAMBDA (MSG EDITORWINDOW) (* ; "Edited 10-Aug-89 17:25 by bvm") (* ;; "Parse MSG in the current mode, returning a parse structure that the corresponding sender will be happy with") (LET* ((MODE (TEXTPROP MSG (QUOTE LAFITEMODE))) (*LAFITE-MODE-DATA* (\LAFITE.GET.USER.DATA MODE))) (if *LAFITE-MODE-DATA* then (CL:FUNCALL (fetch (LAFITEMODEDATA SENDPARSER) of *LAFITE-MODE-DATA*) MSG EDITORWINDOW) else (\SENDMESSAGE.PROMPT EDITORWINDOW (CL:FORMAT NIL "Can't authenticate user in ~A mode" MODE)))))
+)
+
+(\LAFITE.PREPARE.SEND

+(LAMBDA (MSG EDITORWINDOW PARSETABLE) (* bvm%: "13-Nov-84 12:50") (* ;; "Does generic things to MSG, a textstream about to be sent as a message: makes sure it ends in a CR, has no leading CRs, and parses it according to PARSETABLE which defaults to \LAPARSE.FULL -- returns a parse, whose first element tries to be (EOF end-of-header-position)") (PROG (MSGEOF HEADEREOF MSGFIELDS EOFINFO) (COND ((NOT (TYPENAMEP MSG (QUOTE STREAM))) (RETURN (LISPERROR "ILLEGAL ARG" MSG)))) (COND (EDITORWINDOW (* ; "Scroll so that beginning of message is visible") (TEDIT.SETSEL MSG 1 0 (QUOTE LEFT)) (TEDIT.NORMALIZECARET MSG) (first (SETFILEPTR MSG 0) until (NEQ (BIN MSG) (CHARCODE EOL)) do (* ; "hack to get rid of leading CRs") (TEDIT.DELETE MSG 1 1)) (SETFILEPTR MSG (SUB1 (SETQ MSGEOF (GETEOFPTR MSG)))) (COND ((NEQ (BIN MSG) (CHARCODE EOL)) (* ; "Make sure message ends in eol") (TEDIT.INSERT MSG LAFITEEOL (ADD1 MSGEOF) NIL T))))) (SETFILEINFO MSG (QUOTE ENDOFSTREAMOP) (FUNCTION \LAFITE.EOF)) (* ; "Avoid parsing failure if header-only message") (SETQ MSGFIELDS (LAFITE.PARSE.HEADER MSG (OR PARSETABLE \LAPARSE.FULL) 0 (SETQ MSGEOF (GETEOFPTR MSG)) NIL T)) (COND ((EQ (CAR (SETQ EOFINFO (CAR MSGFIELDS))) (QUOTE EOF)) (SETQ HEADEREOF (CADR EOFINFO)) (COND ((CADDR EOFINFO) (* ; "Error") (RETURN (\LAFITE.PREPARE.ERROR MSG EDITORWINDOW HEADEREOF)))) (COND ((= HEADEREOF MSGEOF) (* ; "Parse ended at eof, so message does not end in double CR -- add another") (SETFILEPTR MSG MSGEOF) (BOUT MSG (CHARCODE CR)))) (RPLACA (CDR EOFINFO) (SETQ HEADEREOF (ADD1 HEADEREOF))) (* ; "Add one for tedit fileptr one-based nonsense"))) (RETURN MSGFIELDS)))
+)
+
+(\LAFITE.PREPARE.ERROR

+(LAMBDA (MSG EDITORWINDOW HEADEREOF) (* bvm%: "13-Nov-84 12:53") (* ;;; "Called when header of MSG contained a line not conforming to spec.  Most likely cause is user deleted the blank line between header and message.  Print a suitable error message") (PROG (LINE) (SETFILEPTR MSG HEADEREOF) (SETQ LINE (LAFITE.READ.TO.EOL MSG)) (SETFILEPTR MSG HEADEREOF) (BOUT MSG (CHARCODE CR)) (\SENDMESSAGEFAIL EDITORWINDOW (CONCAT "Header not understood: %"" (COND ((> (NCHARS LINE) 30) (CONCAT (SUBSTRING LINE 1 30) (QUOTE ...))) (T LINE))) "%".   Assumed this was not part of header, and inserted blank line before it.  If this is correct, press 'Deliver' again, else edit the message appropriately.")))
+)
+
+(\LAFITE.CHOOSE.MSG.FORMAT

+(LAMBDA (TEXTSTREAM HEADEREOF EDITORWINDOW) (* ; "Edited  3-Feb-89 18:36 by bvm") (* ;; "Ask if user intends to retain formatting info, and if so, send formatted") (LET ((FORMATTING (TEDIT.FORMATTEDFILEP TEXTSTREAM)) TMP) (COND ((NULL FORMATTING) (* ; "It's just plain text") (QUOTE TEXT)) ((AND (TEXTSTREAMP TEXTSTREAM) (TEXTPROP TEXTSTREAM (QUOTE LAFITEFORMAT)))) ((NULL EDITORWINDOW) (* ; "Nobody to interact with") (QUOTE TEDIT)) (T (SELECTQ (COND ((NLISTP LAFITE.SEND.FORMATTED) LAFITE.SEND.FORMATTED) ((SETQ TMP (ASSOC FORMATTING LAFITE.SEND.FORMATTED)) (CADR TMP)) (T :ASK)) (T (* ; "Send formatted") (QUOTE TEDIT)) (NIL (* ; "Send unformatted") (QUOTE TEXT)) (SELECTQ (SETQ TMP (\SENDMESSAGE.MENUPROMPT EDITORWINDOW (OR LAFITEFORMATMENU (SETQ LAFITEFORMATMENU (\LAFITE.CREATE.MENU LAFITEFORMATMENUITEMS "Retain formatting information?" T))) (CONCAT "Message " (SELECTQ FORMATTING (CHARLOOKS "has font information") (PARALOOKS "has paragraph formatting") (NSCHARS "uses extended character set") (IMAGEOBJ "contains images") "has unknown formatting") ".") (QUOTE LAFITEFORMATMENU))) (ABORT NIL) TMP))))))
+)
+
+(LAFITE.MAKE.PLAIN.TEXTSTREAM

+(LAMBDA (TEXTSTREAM START) (* ; "Edited 24-Sep-87 16:48 by bvm:") (* ;; "Coerces TEXTSTREAM to a %"plain text%" stream, returning the new stream.  If START is specified, only copies from that file pointer onward.") (LET ((PLAIN (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH)))) (SETFILEPTR TEXTSTREAM (OR START (SETQ START 0))) (* ;; "TEXT streams return character codes on BIN, so we have to translate to bytes on output side to handle fat chars correctly and avoid image objects") (to (- (GETEOFPTR TEXTSTREAM) START) do (\OUTCHAR PLAIN (OR (FIXP (BIN TEXTSTREAM)) (CHARCODE *)))) (* ; "Reopen to avoid core bug") (OPENSTREAM (CLOSEF PLAIN) (QUOTE INPUT))))
+)
+
+(\SENDMESSAGE.MENUPROMPT

+(LAMBDA (EDITWINDOW MENU PROMPT MENUVAR) (* ; "Edited 20-Apr-89 19:37 by bvm") (* ;; "Prompt with MENU at the upper left corner of EDITWINDOW, printing PROMPT in the prompt window.  If MENUVAR is specified, it is the global variable that holds this menu, which we smash to NIL while inside MENU, lest someone else try to use it") (LET ((PWINDOW (GETPROMPTWINDOW EDITWINDOW)) RESULT) (CLEARW PWINDOW) (printout PWINDOW PROMPT) (if MENUVAR then (SET MENUVAR NIL)) (SETQ RESULT (MENU MENU (LA.POSITION.FROM.REGION (WINDOWPROP PWINDOW (QUOTE REGION)) NIL T) T)) (CLEARW PWINDOW) (if MENUVAR then (SET MENUVAR MENU)) RESULT))
+)
+
+(\SENDMESSAGE.PROMPT

+(LAMBDA (EDITORWINDOW MESS1 MESS2) (* ; "Edited 31-Jan-89 17:03 by bvm") (* ;; "Display message MESS1 & optionally MESS2 in the prompt window of EDITORWINDOW.  Returns NIL always") (LET ((PWINDOW (COND (EDITORWINDOW (LA.ASSURE.PROMPT.WINDOW EDITORWINDOW MESS1 MESS2)) (T PROMPTWINDOW)))) (CLEARW PWINDOW) (PRIN3 MESS1 PWINDOW) (COND (MESS2 (PRIN3 MESS2 PWINDOW))) NIL))
+)
+
+(\SENDMESSAGEFAIL

+(LAMBDA (EDITORWINDOW MESS1 MESS2) (* ; "Edited 31-Jan-89 17:02 by bvm") (\SENDMESSAGE.PROMPT EDITORWINDOW MESS1 MESS2) (RETFROM (QUOTE \SENDMESSAGE.PARSE)))
+)
+)
+(DEFINEQ
+
+(\SENDMESSAGE

+(LAMBDA (FORM TEDITPROPS FORMNAME) (* ; "Edited 10-Feb-89 12:22 by bvm") (* ;;; "FORM can be a string, file, or stream --- The value of \SENDMESSAGE is T only if the message was actually sent") (OR (TEXTSTREAMP FORM) (SETQ FORM (OPENTEXTSTREAM FORM NIL NIL NIL TEDITPROPS))) (TEDIT.STREAMCHANGEDP FORM T) (* ; "Clear the changed bit") (if (NOT (LISTGET TEDITPROPS (QUOTE LEAVETTY))) then (* ; "Take control of the keyboard") (TTY.PROCESS (THIS.PROCESS))) (PROG ((MODE (LISTGET TEDITPROPS (QUOTE LAFITEMODE)))) (* ; "Old way of specifying mode") (if MODE then (TEXTPROP FORM (QUOTE LAFITEMODE) MODE) elseif (TEXTPROP FORM (QUOTE LAFITEMODE)) elseif (SETQ MODE (fetch LAFITEMODE of \LAFITEMODE)) then (TEXTPROP FORM (QUOTE LAFITEMODE) MODE) else (PRINTOUT PROMPTWINDOW T "Can't send mail without a Lafite mode.") (RETURN NIL)) (RETURN (\SENDMESSAGE.RESTARTABLE FORM TEDITPROPS NIL FORMNAME))))
+)
+
+(\SENDMESSAGE.RESTARTABLE

+(LAMBDA (FORM TEDITPROPS EDITORWINDOW FORMNAME) (* ; "Edited  3-Nov-89 15:06 by bvm") (bind (CURRENTMESSAGE _ FORM) (FIRSTTIME _ T) EDITORRESULT DONE SENTOK PARSE do (PROCESSPROP (THIS.PROCESS) (QUOTE BEFOREEXIT) NIL) (* ; "Allow LOGOUT until delivery is attempted.  Need to do this if we loop or restart") (COND ((NULL (PROG1 EDITORWINDOW (SETQ EDITORWINDOW (\SENDMESSAGE.MAKEWINDOW CURRENTMESSAGE NIL EDITORWINDOW (TEXTPROP FORM (QUOTE LAFITEMODE)))))) (* ; "First time thru.  Fix it so that we can restart if aborted") (PROCESSPROP (THIS.PROCESS) (QUOTE RESTARTFORM) (LIST (FUNCTION \SENDMESSAGE.RESTARTABLE) (KWOTE FORM) (KWOTE TEDITPROPS) (KWOTE EDITORWINDOW))) (* ; "If process is reset or aborted, this is how to resurrect") (PROCESSPROP (THIS.PROCESS) (QUOTE RESTARTABLE) T) (WINDOWPROP EDITORWINDOW (QUOTE LAFITEFORM) FORMNAME))) (COND (FIRSTTIME (RESETSAVE NIL (LIST (FUNCTION \SENDMESSAGE.CLEANUP) EDITORWINDOW)) (push LAFITECURRENTEDITORWINDOWS EDITORWINDOW) (SETQ FIRSTTIME))) (SETQ EDITORRESULT (TEDIT FORM EDITORWINDOW T (APPEND TEDITPROPS (LIST (QUOTE FONT) LAFITEEDITORFONT)))) (COND ((TTY.PROCESSP) (* ; "give back the keyboard") (TTY.PROCESS T))) (WINDOWDELPROP EDITORWINDOW (QUOTE CLOSEFN) (QUOTE DON'T)) (* ; "let the window close") (COND ((NOT (type? SENDINGCOMMAND EDITORRESULT)) (* ; "get out anyway since the user used the TEDIT `quit' command instead of one of the sending commands") (SETQ DONE T)) (T (* ; "the user used the lafite menu to get out rather than the TEDIT menu so we have to do something") (* ; "make sure CURRENTMESSAGE is always a string") (SETQ CURRENTMESSAGE (fetch (SENDINGCOMMAND MESSAGE) of EDITORRESULT)) (SETQ DONE (SELECTQ (AND EDITORRESULT (fetch (SENDINGCOMMAND COMMAND) of EDITORRESULT)) (%##SEND## (SETQ SENTOK (\SENDMESSAGE0 CURRENTMESSAGE EDITORWINDOW (SETQ PARSE (fetch (SENDINGCOMMAND MESSAGEPARSE) of EDITORRESULT))))) (SHOULDNT))) (SHADEITEM (fetch (SENDINGCOMMAND ITEM) of EDITORRESULT) (fetch (SENDINGCOMMAND MENU) of EDITORRESULT) WHITESHADE) (* ; "Unshade command.  DOLAFITESENDINGCOMMAND shaded it to begin with"))) (COND (DONE (* ; "Message successfully dispatched") (PROCESSPROP (THIS.PROCESS) (QUOTE RESTARTABLE) NIL) (* ; "Don't try to restart if there's any sort of error now") (COND (CURRENTMESSAGE (* ; "Mark text unchanged now, so no trouble closing icon") (TEDIT.STREAMCHANGEDP CURRENTMESSAGE T))) (COND ((NULL SENTOK) (CLOSEW EDITORWINDOW)) (T (* ; "shrink the window") (\LAFITE.AFTER.DELIVER EDITORWINDOW CURRENTMESSAGE PARSE))) (RETURN SENTOK)) (T (* ; "Loop if deliver failed or \LAFITE.SAVE.FORM was aborted.")))))
+)
+
+(\SENDMESSAGE.CLEANUP

+(LAMBDA (EDITORWINDOW) (* ; "Edited  6-Oct-87 15:58 by bvm:") (SETQ LAFITECURRENTEDITORWINDOWS (REMOVE EDITORWINDOW LAFITECURRENTEDITORWINDOWS)))
+)
+
+(\SENDMESSAGE.MAKEWINDOW

+(LAMBDA (MESSAGEFORM TITLE WINDOW MODE) (* ; "Edited  3-Nov-89 16:16 by bvm") (* ;;; "Editor for Mail system Lafite -- Handles the process mechanism right") (* ;;; "Assumes that it's running in a separate process created above") (PROG ((MENU (MAKELAFITEDELIVERMENU)) EDITWINDOW LAYOUT REGION) (COND ((NOT TITLE) (SETQ TITLE "Message Editor") (if (AND MODE (LAFITE.SHOW.MODE.P)) then (SETQ TITLE (CONCAT TITLE " (" MODE ")"))))) (COND ((WINDOWP (SETQ EDITWINDOW WINDOW)) (WINDOWPROP EDITWINDOW (QUOTE TITLE) TITLE) (for W in (ATTACHEDWINDOWS EDITWINDOW) when (WINDOWPROP W (QUOTE MENUWINDOW)) do (* ; "there's already an attached window menu, make sure we have a delivery menu in it.") (LET ((OLDMENU (CAR (WINDOWPROP W (QUOTE MENU))))) (if (if (NULL OLDMENU) then (* ; "E.g., after ABORT got removed") T elseif (NOT (EQUAL (fetch (MENU ITEMS) of MENU) (fetch (MENU ITEMS) of OLDMENU))) then (DELETEMENU OLDMENU NIL W) (* ; "Get rid of different menu") T else (SETQ MENU OLDMENU) (* ; "They're the same, don't fuss") NIL) else (ADDMENU MENU W (QUOTE (0 . 0))) (* ; "Now make it fit") (MENUWRESHAPEFN W))) (RETURN) finally (* ; "No attached menu yet") (ATTACHWINDOW (SETQ W (MENUWINDOW MENU)) EDITWINDOW (QUOTE TOP)) (WINDOWPROP W (QUOTE MENUWINDOW) T))) (T (SETQ REGION (if (for old LAYOUT in LAFITE.EDITOR.LAYOUTS unless (for WINDOW in LAFITECURRENTEDITORWINDOWS thereis (EQ (WINDOWPROP WINDOW (QUOTE LAFITE.LAYOUT)) LAYOUT)) do (* ; "Use first layout not already in use") (RETURN (CAR LAYOUT))) elseif (AND (NULL LAFITECURRENTEDITORWINDOWS) (type? REGION LAFITEEDITORREGION)) then (* ; "Old way of doing this for a single window") LAFITEEDITORREGION elseif LAFITE.EDITOR.SIZE then (* ; "Get window of appropriate size") (GETBOXREGION (CAR LAFITE.EDITOR.SIZE) (CDR LAFITE.EDITOR.SIZE)) else (GETREGION))) (SETQ EDITWINDOW (CREATEMENUEDWINDOW MENU TITLE (QUOTE TOP) (create REGION using REGION HEIGHT _ (- (fetch (REGION HEIGHT) of REGION) (HEIGHTIFWINDOW (FONTPROP LAFITEEDITORFONT (QUOTE HEIGHT))))))) (WINDOWPROP (CAR (ATTACHEDWINDOWS EDITWINDOW)) (QUOTE MENUWINDOW) T) (if LAYOUT then (WINDOWPROP EDITWINDOW (QUOTE LAFITE.LAYOUT) LAYOUT) (WINDOWPROP EDITWINDOW (QUOTE ICONPOSITION) (CADR LAYOUT))))) (GETPROMPTWINDOW EDITWINDOW 1 LAFITEEDITORFONT) (COND (NIL (* ; "don't let TEDIT close the window") (WINDOWADDPROP EDITWINDOW (QUOTE CLOSEFN) (QUOTE DON'T)))) (PROGN (WINDOWDELPROP EDITWINDOW (QUOTE CLOSEFN) (FUNCTION CLOSEATTACHEDWINDOWS)) (* ; "On closing, get rid of attachments, don't just close them") (WINDOWADDPROP EDITWINDOW (QUOTE CLOSEFN) (FUNCTION DETACHALLWINDOWS)) (WINDOWADDPROP EDITWINDOW (QUOTE CLOSEFN) (FUNCTION \LAFITE.CLOSEMSG?) T)) (WINDOWPROP EDITWINDOW (QUOTE ICONFN) (FUNCTION \LAFITE.UNSENT.ICON)) (WINDOWPROP EDITWINDOW (QUOTE PROCESS) (THIS.PROCESS)) (* ; "Associate this process with the edit window") (replace (MENU WHENSELECTEDFN) of MENU with (FUNCTION DOLAFITESENDINGCOMMAND)) (* ; "Enable the menu") (RETURN EDITWINDOW)))
+)
+
+(MAKELAFITEDELIVERMENU

+(LAMBDA NIL (* bvm%: "28-Mar-84 12:47") (create MENU ITEMS _ LAFITESENDINGMENUITEMS CENTERFLG _ T MENUFONT _ LAFITEMENUFONT WHENSELECTEDFN _ (FUNCTION DOLAFITESENDINGCOMMAND)))
+)
+
+(\LAFITE.CLOSEMSG?

+(LAMBDA (WINDOW) (* ; "Edited  3-Sep-87 17:21 by bvm:") (* ;; "This is the first CLOSEFN on a message sending window.  If contents have changed, get confirmation") (LET ((TEXTSTREAM (WINDOWPROP WINDOW (QUOTE TEXTSTREAM)))) (COND ((OR (NULL TEXTSTREAM) (NOT (TEDIT.STREAMCHANGEDP TEXTSTREAM))) (* ; "TEXTSTREAM is null once TEdit's gotten thru with it.") NIL) ((MOUSECONFIRM "Message has been edited -- LEFT to flush anyway" T (GETPROMPTWINDOW WINDOW)) (TEDIT.STREAMCHANGEDP TEXTSTREAM T) (* ; "Reset bit so question doesn't get asked a second time") NIL) (T (QUOTE DON'T)))))
+)
+
+(\LAFITE.AFTER.DELIVER

+(LAMBDA (EDITORWINDOW TEXTSTREAM PARSE) (* ; "Edited 30-May-90 16:25 by bvm") (TEDIT.ASSURE.NO.BACKING.FILE TEXTSTREAM) (* ; "In case the backing file gets deleted") (\OUTBOX.ADD.ITEM TEXTSTREAM (OR (CAR PARSE) UNSUPPLIEDFIELDSTR)) (LET ((FORMNAME (WINDOWPROP EDITORWINDOW (QUOTE LAFITEFORM) NIL))) (if (AND FORMNAME (EQ (CAR (UNPACKFILENAME.STRING FORMNAME)) (QUOTE NAME))) then (* ;; "See if user wants to keep the form, or if it was saved just as a checkpoint.  Do this only for files saved in primary directory") (LET* ((PWINDOW (GETPROMPTWINDOW EDITORWINDOW)) (MENUW (find W in (ATTACHEDWINDOWS EDITORWINDOW) suchthat (WINDOWPROP W (QUOTE MENUWINDOW)))) (MENU (create MENU ITEMS _ (QUOTE (("Delete File" T "Delete the file(s) in which this message was earlier saved.") ("Retain Saved Form" NIL "Don't delete the saved form, I want to use it again."))) WHENSELECTEDFN _ (FUNCTION (LAMBDA (ITEM MENU KEY) (LET ((W (WFROMMENU MENU))) (WINDOWPROP W (QUOTE RESULT) ITEM) (SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE)))) MENUFONT _ LAFITEMENUFONT CENTERFLG _ T ITEMWIDTH _ (IQUOTIENT (WINDOWPROP PWINDOW (QUOTE WIDTH)) 2) MENUROWS _ 1)) RESULT (MSG (CONCAT "Delivery complete.  Do you want to delete the saved form of this message (" FORMNAME ")?"))) (LA.ASSURE.PROMPT.WINDOW EDITORWINDOW MSG) (TERPRI PWINDOW) (PRIN3 MSG PWINDOW) (ADDMENU MENU MENUW (QUOTE (0 . 0))) (until (SETQ RESULT (WINDOWPROP MENUW (QUOTE RESULT))) do (BLOCK 500)) (if (CADR RESULT) then (PRINTOUT PWINDOW T "Deleting file(s)... " (if (\LAFITE.DELETE.FORM.INTERNAL FORMNAME) then "done." else "failed.")))))) (DETACHALLWINDOWS EDITORWINDOW) (CLOSEW EDITORWINDOW))
+)
+
+(\LAFITE.UNSENT.ICON

+(LAMBDA (WINDOW OLDICON) (* ; "Edited 24-Sep-87 16:58 by bvm:") (TITLEDICONW LAFITE.MSG.ICON (\LAFITE.FETCH.SUBJECT (WINDOWPROP WINDOW (QUOTE TEXTSTREAM))) LAFITEMSGICONFONT (WINDOWPROP WINDOW (QUOTE ICONPOSITION)) T))
+)
+
+(\LAFITE.FETCH.SUBJECT

+(LAMBDA (TEXTSTREAM) (* bvm%: " 2-Mar-86 16:27") (COND (TEXTSTREAM (RESETLST (RESETSAVE NIL (LIST (FUNCTION SETFILEINFO) TEXTSTREAM (QUOTE ENDOFSTREAMOP) (GETFILEINFO TEXTSTREAM (QUOTE ENDOFSTREAMOP)))) (SETFILEINFO TEXTSTREAM (QUOTE ENDOFSTREAMOP) (FUNCTION \LAFITE.EOF)) (LET ((STR (LAFITE.PARSE.HEADER TEXTSTREAM \LAPARSE.SUBJECTFIELD 0 NIL T))) (COND ((STRING-EQUAL STR SUBJECTSTR) UNSUPPLIEDFIELDSTR) (T STR)))))))
+)
+
+(LAFITE.SENDMESSAGE

+(LAMBDA (MESSAGEFORM) (* ; "Edited 12-Sep-88 14:07 by bvm") (* ;;; "this is the external interface to sending a message") (SETQ MESSAGEFORM (OPENTEXTSTREAM MESSAGEFORM)) (LET* ((MODE (TEXTPROP MESSAGEFORM (QUOTE LAFITEMODE))) (*LAFITE-MODE-DATA* (\LAFITE.GET.USER.DATA MODE)) PARSE) (AND *LAFITE-MODE-DATA* (SETQ PARSE (CL:FUNCALL (fetch (LAFITEMODEDATA SENDPARSER) of *LAFITE-MODE-DATA*) MESSAGEFORM)) (CL:FUNCALL (fetch (LAFITEMODEDATA SENDER) of *LAFITE-MODE-DATA*) MESSAGEFORM PARSE))))
+)
+
+(\SENDMESSAGE0

+(LAMBDA (TEXTSTREAM WINDOW PARSE) (* ; "Edited 12-Sep-88 14:04 by bvm") (PROG ((PWINDOW (GETPROMPTWINDOW WINDOW)) *LAFITE-MODE-DATA* MENUW OLDMENU ABORTMENU RESULT) (for W in (ATTACHEDWINDOWS WINDOW) when (SETQ OLDMENU (CAR (WINDOWPROP W (QUOTE MENU)))) do (SETQ MENUW W) (DELETEMENU OLDMENU NIL MENUW) (* ; "Remove Deliver menu, add Abort menu") (ADDMENU (SETQ ABORTMENU (create MENU ITEMS _ (QUOTE (("Abort" NIL "Abort delivery of this message"))) WHENSELECTEDFN _ (FUNCTION \SENDMESSAGE.ABORT) MENUFONT _ LAFITEMENUFONT CENTERFLG _ T ITEMWIDTH _ (fetch ITEMWIDTH of OLDMENU))) MENUW (QUOTE (0 . 0))) (RETURN)) (if (NULL (SETQ *LAFITE-MODE-DATA* (\LAFITE.GET.USER.DATA (TEXTPROP TEXTSTREAM (QUOTE LAFITEMODE))))) then (printout PWINDOW "Failed to authenticate user.") else (SETQ RESULT (ERSETQ (RESETLST (CL:FUNCALL (fetch (LAFITEMODEDATA SENDER) of *LAFITE-MODE-DATA*) TEXTSTREAM PARSE WINDOW MENUW)))) (COND ((NULL RESULT) (printout PWINDOW "aborted.")) ((SETQ RESULT (CAR RESULT)) (printout PWINDOW "done.")))) (RETURN (COND (RESULT (* ; "Success") (CLOSEF TEXTSTREAM) (* ; "Explicit Close here after successful delivery so that TEdit can close any files it might have open") RESULT) (T (* ; "Restore Deliver menu") (COND ((WINDOWPROP MENUW (QUOTE MENU)) (DELETEMENU ABORTMENU NIL MENUW))) (ADDMENU OLDMENU MENUW (QUOTE (0 . 0)) NIL) (WINDOWPROP MENUW (QUOTE ABORT) NIL) NIL)))))
+)
+
+(LA.ASSURE.PROMPT.WINDOW

+(LAMBDA (MAINWINDOW MESS1 MESS2) (* bvm%: "24-Feb-85 18:33") (* ;;; "Returns prompt window for MAINWINDOW assuring that it is big enough to print MESS1 and MESS2") (LET ((PWINDOW (GETPROMPTWINDOW MAINWINDOW)) %#LINES) (COND ((> (SETQ %#LINES (QUOTIENT (+ (STRINGWIDTH MESS1 PWINDOW) (COND (MESS2 (STRINGWIDTH MESS2 PWINDOW)) (T 0))) (WINDOWPROP PWINDOW (QUOTE WIDTH)))) 0) (* ; "Make sure prompt window is big enough") (GETPROMPTWINDOW MAINWINDOW (ADD1 %#LINES))) (T PWINDOW))))
+)
+
+(\LAFITE.SEND.FAIL

+(LAMBDA (EDITORWINDOW ERRMSG) (* bvm%: "24-Feb-85 18:38") (* ;; "Print a message explaining why delivery failed") (LET ((FULLMSG (CONCAT "Delivery failed -- " ERRMSG)) PWINDOW) (COND (EDITORWINDOW (CLEARW (SETQ PWINDOW (LA.ASSURE.PROMPT.WINDOW EDITORWINDOW FULLMSG)))) (T (TERPRI (SETQ PWINDOW PROMPTWINDOW)))) (PRIN3 FULLMSG PWINDOW) NIL))
+)
+
+(\LAFITE.INVALID.RECIPIENTS

+(LAMBDA (NAMES) (* bvm%: " 5-Nov-84 15:26") (* ;;; "Returns an 'invalid recipients' error string") (PROG (NAME) (SETQ NAME (for RECIPIENT in NAMES join (LIST ", " RECIPIENT))) (RPLACA NAME ": ") (COND ((CDR NAMES) (push NAME "s"))) (RETURN (CONCATLIST (CONS "Invalid recipient" NAME)))))
+)
+
+(\SENDMESSAGE.ABORT

+(LAMBDA (ITEM MENU KEY) (* bvm%: " 1-Jun-84 12:21") (* ; "The WHENSELECTEDFN for the Abort menu") (PROG ((W (WFROMMENU MENU))) (WINDOWPROP W (QUOTE ABORT) T) (SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE)))
+)
+)
+
+
+
+(* ; "Outbox hacking")

+
+(DEFINEQ
+
+(\OUTBOX.CREATE

+(LAMBDA NIL (* bvm%: "21-Dec-84 22:35") (PROG (FONT NLINES W FONTHEIGHT) (OR (AND LAFITESTATUSWINDOW (FIXP (SETQ NLINES LAFITEOUTBOXSIZE)) (IGREATERP NLINES 0)) (RETURN)) (SETQ FONTHEIGHT (FONTPROP (SETQ FONT LAFITEBROWSERFONT) (QUOTE HEIGHT))) (SETQ W (CREATEW (CREATEREGION 0 0 (WINDOWPROP LAFITESTATUSWINDOW (QUOTE WIDTH)) (HEIGHTIFWINDOW (ITIMES NLINES FONTHEIGHT) T)) "Delivered Messages" NIL T)) (ATTACHWINDOW W LAFITESTATUSWINDOW (QUOTE BOTTOM) (QUOTE JUSTIFY) (QUOTE LOCALCLOSE)) (DSPFONT FONT W) (WINDOWADDPROP W (QUOTE CLOSEFN) (FUNCTION \OUTBOX.CLOSEFN)) (WINDOWPROP W (QUOTE REPAINTFN) (FUNCTION \OUTBOX.REPAINTFN)) (WINDOWPROP W (QUOTE BUTTONEVENTFN) (FUNCTION \OUTBOX.BUTTONFN)) (WINDOWPROP W (QUOTE RESHAPEFN) (FUNCTION \OUTBOX.RESHAPEFN)) (WINDOWPROP W (QUOTE MINSIZE) (CONS 0 (HEIGHTIFWINDOW FONTHEIGHT T))) (RETURN (SETQ \LAFITE.OUTBOX (\OUTBOX.RESET (create OUTBOX OBWINDOW _ W OBSIZE _ NLINES OBHEIGHT _ FONTHEIGHT OBDESCENT _ (FONTPROP FONT (QUOTE DESCENT))))))))
+)
+
+(\OUTBOX.RESET

+(LAMBDA (OUTBOX) (* bvm%: " 9-Nov-84 16:29") (PROG ((WINDOW (fetch OBWINDOW of OUTBOX))) (CLEARW WINDOW) (LINELENGTH MAX.SMALLP WINDOW) (DSPRIGHTMARGIN MAX.SMALLP WINDOW) (replace OBORIGIN of OUTBOX with (IPLUS (DSPYPOSITION NIL WINDOW) (fetch OBHEIGHT of OUTBOX))) (RETURN OUTBOX)))
+)
+
+(\OUTBOX.CLOSEFN

+(LAMBDA (WINDOW) (* bvm%: " 8-Nov-84 16:02") (SETQ \LAFITE.OUTBOX)))
+
+(\OUTBOX.REPAINTFN

+(LAMBDA (WINDOW REGION) (* bvm%: "13-Nov-84 10:57") (PROG ((OUTBOX \LAFITE.OUTBOX)) (OR (EQ WINDOW (fetch OBWINDOW of OUTBOX)) (RETURN)) (MOVETO 0 (IDIFFERENCE (fetch OBORIGIN of OUTBOX) (fetch OBHEIGHT of OUTBOX)) WINDOW) (for ITEM in (fetch OBITEMS of OUTBOX) do (\OUTBOX.DISPLAYLINE OUTBOX ITEM) (TERPRI WINDOW))))
+)
+
+(\OUTBOX.RESHAPEFN

+(LAMBDA (WINDOW OLDIMAGE IMAGEREGION OLDSCREENREGION) (* bvm%: "13-Nov-84 10:57") (COND ((EQ WINDOW (fetch OBWINDOW of \LAFITE.OUTBOX)) (PROG ((NLINES (IQUOTIENT (WINDOWPROP WINDOW (QUOTE HEIGHT)) (fetch OBHEIGHT of \LAFITE.OUTBOX))) (OLDSIZE (fetch OBSIZE of \LAFITE.OUTBOX)) N ITEMS) (COND ((NEQ NLINES OLDSIZE) (replace OBSIZE of \LAFITE.OUTBOX with NLINES) (COND ((AND (ILESSP NLINES OLDSIZE) (IGREATERP (SETQ N (IDIFFERENCE (LENGTH (SETQ ITEMS (fetch OBITEMS of \LAFITE.OUTBOX))) NLINES)) 0)) (replace OBITEMS of \LAFITE.OUTBOX with (CDR (NTH ITEMS N))))))) (\OUTBOX.RESET \LAFITE.OUTBOX) (REDISPLAYW WINDOW)))))
+)
+
+(\OUTBOX.SHADEITEM

+(LAMBDA (OUTBOX ITEM N SHADE OPERATION) (* ; "Edited  3-Sep-87 17:24 by bvm:") (* ;;; "Shade the indicated ITEM in OUTBOX using texture SHADE blted with OPERATION") (PROG ((W (fetch OBWINDOW of OUTBOX)) HEIGHT) (BLTSHADE SHADE W 0 (- (fetch OBORIGIN of OUTBOX) (+ (ITIMES N (SETQ HEIGHT (fetch OBHEIGHT of OUTBOX))) (fetch OBDESCENT of OUTBOX))) NIL HEIGHT OPERATION) (COND ((EQ OPERATION (QUOTE REPLACE)) (\OUTBOX.DISPLAYLINE OUTBOX ITEM N)))))
+)
+
+(\OUTBOX.BUTTONFN

+(LAMBDA (WINDOW) (* bvm%: "13-Nov-84 10:58") (* ;;; "BUTTONEVENTFN for the outbox.  If a message is selected, edit it") (PROG ((SELECTIONREGION (DSPCLIPPINGREGION NIL WINDOW)) (OUTBOX \LAFITE.OUTBOX) SELECTED SEL# NEWSEL# ITEMS HEIGHT ORIGIN DESCENT LASTX LASTY MAXITEM) (COND ((OR (NOT (SETQ ITEMS (fetch OBITEMS of OUTBOX))) (NEQ WINDOW (fetch OBWINDOW of OUTBOX))) (* ; "Nothing to select") (RETURN))) (SETQ MAXITEM (LENGTH ITEMS)) (SETQ HEIGHT (fetch OBHEIGHT of OUTBOX)) (SETQ DESCENT (fetch OBDESCENT of OUTBOX)) (SETQ ORIGIN (fetch OBORIGIN of OUTBOX)) (* ;; "keep looping until all mouse buttons are up") (do (GETMOUSESTATE) (COND ((OR (NOT (INSIDEP SELECTIONREGION (SETQ LASTX (LASTMOUSEX WINDOW)) (SETQ LASTY (LASTMOUSEY WINDOW)))) (> (SETQ NEWSEL# (ADD1 (QUOTIENT (- ORIGIN (+ LASTY DESCENT)) HEIGHT))) MAXITEM)) (* ;; "I would like to just return here and let the next window take over, but current mouse arrangement means I'll never get control back unless user lets up on mouse") (COND (SELECTED (\OUTBOX.SHADEITEM OUTBOX SELECTED SEL# BLACKSHADE (QUOTE INVERT)) (SETQ SELECTED (SETQ SEL# NIL)))) (COND ((LASTMOUSESTATE UP) (RETURN)) (T (BLOCK)))) ((LASTMOUSESTATE UP) (* ; "Let mouse up while over a selection.  Do it") (COND (SELECTED (\LAFITE.PROCESS (LIST (FUNCTION \SENDMESSAGE) (KWOTE (COPYTEXTSTREAM (fetch OBITEXT of SELECTED)))) (QUOTE MESSAGESENDER) T (QUOTE NO)) (\OUTBOX.SHADEITEM OUTBOX SELECTED SEL# BLACKSHADE (QUOTE INVERT)))) (RETURN)) ((NEQ NEWSEL# SEL#) (COND (SELECTED (\OUTBOX.SHADEITEM OUTBOX SELECTED SEL# BLACKSHADE (QUOTE INVERT)))) (\OUTBOX.SHADEITEM OUTBOX (SETQ SELECTED (CAR (NTH ITEMS (SETQ SEL# NEWSEL#)))) SEL# BLACKSHADE (QUOTE INVERT)))))))
+)
+
+(\OUTBOX.DISPLAYLINE

+(LAMBDA (OUTBOX ITEM N) (* bvm%: " 8-Nov-84 21:35") (PROG ((W (fetch OBWINDOW of OUTBOX))) (COND (N (MOVETO 0 (IDIFFERENCE (fetch OBORIGIN of OUTBOX) (ITIMES N (fetch OBHEIGHT of OUTBOX))) W))) (printout W (fetch OBIDATE of ITEM) %,, (fetch OBISUBJECT of ITEM))))
+)
+
+(\OUTBOX.ADD.ITEM

+(LAMBDA (TEXTSTREAM SUBJECT) (* ; "Edited  3-Sep-87 18:08 by bvm:") (PROG ((OUTBOX (OR \LAFITE.OUTBOX (\OUTBOX.CREATE))) W N ITEM BOTTOM HEIGHT ITEMS) (OR OUTBOX (RETURN)) (COND ((>= (SETQ N (LENGTH (SETQ ITEMS (fetch OBITEMS of OUTBOX)))) (fetch OBSIZE of OUTBOX)) (replace OBITEMS of OUTBOX with (SETQ ITEMS (CDR ITEMS))) (BITBLT (SETQ W (fetch OBWINDOW of OUTBOX)) 0 (SETQ BOTTOM (- (fetch OBORIGIN of OUTBOX) (+ (ITIMES N (SETQ HEIGHT (fetch OBHEIGHT of OUTBOX))) (fetch OBDESCENT of OUTBOX)))) W 0 (+ BOTTOM HEIGHT) NIL (ITIMES HEIGHT (SUB1 N)) (QUOTE INPUT) (QUOTE REPLACE)) (BLTSHADE WHITESHADE W 0 BOTTOM NIL HEIGHT (QUOTE REPLACE))) (T (SETQ N (ADD1 N)))) (replace OBITEMS of OUTBOX with (NCONC1 ITEMS (SETQ ITEM (create OUTBOXITEM OBITEXT _ TEXTSTREAM OBIDATE _ (DATE (DATEFORMAT NO.DATE NO.SECONDS)) OBISUBJECT _ SUBJECT)))) (\OUTBOX.DISPLAYLINE OUTBOX ITEM N)))
+)
+)
+
+(RPAQ? LAFITEOUTBOXSIZE 2)
+
+(RPAQ? \LAFITE.OUTBOX)
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+(DECLARE%: EVAL@COMPILE
+
+(RECORD OUTBOXITEM
 (OBITEXT OBIDATE OBISUBJECT OBIWINDOW))
+)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS LAFITEOUTBOXSIZE)
+)
+)
+
+
+
+(* ; "Built-in message forms")

+
+(DEFINEQ
+
+(\LAFITE.MESSAGEFORM

+(LAMBDA (ITEM MENU BUTTON) (* ; "Edited 23-Feb-89 12:50 by bvm") (COND ((NULL (OR \LAFITEMODE (\LAFITE.INFER.MODE))) (printout PROMPTWINDOW T "Must set Lafite Mode before sending mail")) (T (RESETLST (AND ITEM (LA.RESETSHADE ITEM MENU)) (PROG ((*UPPER-CASE-FILE-NAMES* NIL) FORM FORMNAME FULLFORMNAME) (COND ((EQ BUTTON (QUOTE LEFT)) (SETQ FORM (MAKENEWMESSAGEFORM))) ((NOT (SETQ FORM (MENU (.LAFITEMENU. LAFITEFORMSMENU (APPEND (MAKELAFITEPRIVATEFORMSITEMS "Use the form defined in this file.") LAFITESPECIALFORMS LAFITEFORMSMENUITEMS) "Message Forms")))) (RETURN)) ((EQ FORM (QUOTE %##ANOTHERFORM##)) (* ; "user buttoned 'Another Form'") (OR (SETQ FORMNAME (PROMPTFORFILENAME)) (RETURN))) ((DEFINEDP FORM) (OR (SETQ FORM (CL:FUNCALL FORM)) (RETURN))) ((BOUNDP FORM) (SETQ FORM (OR (EVALV FORM) (MAKENEWMESSAGEFORM)))) (T (* ; "other private form") (SETQ FORMNAME FORM))) (COND ((NULL FORMNAME) (* ; "Have form already")) ((OR (SETQ FULLFORMNAME (INFILEP (LA.LONGFILENAME FORMNAME LAFITEFORM.EXT))) (AND LAFITEFORMDIRECTORIES (SETQ FULLFORMNAME (FINDFILE (PACKFILENAME.STRING (QUOTE BODY) FORMNAME (QUOTE EXTENSION) LAFITEFORM.EXT) T LAFITEFORMDIRECTORIES)))) (* ; "read the form and return it") (COND ((NOT (CL:MEMBER (SETQ FORMNAME (LA.SHORTFILENAME FULLFORMNAME LAFITEFORM.EXT)) LAFITEFORMFILES :TEST (QUOTE STRING-EQUAL))) (push LAFITEFORMFILES FORMNAME) (SETQ \LAFITEPROFILECHANGED T) (SETQ LAFITEFORMSMENU))) (SETQ FORM (\LAFITE.READ.FORM FULLFORMNAME))) (T (printout PROMPTWINDOW T FORMNAME " not found.") (RETURN))) (ADD.PROCESS (LIST (FUNCTION \SENDMESSAGE) (KWOTE FORM) NIL (KWOTE FORMNAME)) (QUOTE NAME) (QUOTE MESSAGESENDER) (QUOTE RESTARTABLE) (QUOTE NO)) (* ; "Finally, start authenticating if we haven't yet.") (\LAFITE.GET.USER.DATA (AND (TEXTSTREAMP FORM) (TEXTPROP FORM (QUOTE LAFITEMODE)))))))))
+)
+
+(MAKELAFITESUPPORTFORM

+(LAMBDA NIL (* bvm%: "12-Mar-85 00:39") (MAKEXXXSUPPORTFORM "Lafite" LAFITESUPPORT LAFITESYSTEMDATE)))
+
+(MAKELISPSUPPORTFORM

+(LAMBDA NIL (* bvm%: "12-Mar-85 00:39") (MAKEXXXSUPPORTFORM "Lisp" LISPSUPPORT)))
+
+(MAKEXXXSUPPORTFORM

+(LAMBDA (SYSTEMNAME ADDRESS SYSTEMDATE) (* ; "Edited  3-May-89 18:37 by bvm") (PROG ((SUBJFIELD ">>Terse summary of problem<<") (UCODEVERSION (MICROCODEVERSION)) (SCRATCH (OPENSTREAM "{nodircore}" (QUOTE BOTH))) TEXTSTREAM SELECTPOSITION MODE) (COND ((LISTP ADDRESS) (* ; "Mode-dependent address.  Pick the first address that's in a mode we know how to send") (SETQ ADDRESS (for PAIR in ADDRESS when (\LAFITE.GET.USER.DATA (SETQ MODE (CAR PAIR))) do (RETURN (CADR PAIR))))) (T (* ; "Just send in current mode") (SETQ MODE (fetch LAFITEMODE of \LAFITEMODE)))) (COND ((NOT ADDRESS) (printout PROMPTWINDOW T "Can't -- no address known for " SYSTEMNAME " report.") (RETURN))) (SETQ TEXTSTREAM (OPENTEXTSTREAM (CONCAT "Subject: " SYSTEMNAME ": ") NIL NIL NIL (LIST (QUOTE FONT) LAFITEEDITORFONT))) (SETQ SELECTPOSITION (ADD1 (GETEOFPTR TEXTSTREAM))) (PROGN (* ; "Now write the main stuff to a scratch stream. faster than bouting a byte at a time to tedit") (printout SCRATCH SUBJFIELD T) (printout SCRATCH "To: " ADDRESS T) (printout SCRATCH "cc: " (FULLUSERNAME NIL MODE) T T) (COND (SYSTEMDATE (printout SCRATCH SYSTEMNAME " System Date: " SYSTEMDATE T))) (printout SCRATCH "Lisp System Date: " MAKESYSDATE " (" (L-CASE (MKSTRING MAKESYSNAME) T) ")" T) (printout SCRATCH "Machine: " (OR \LAFITE.REPORT.MACHINE (PROGN (SETQ \LAFITE.REPORT.MACHINE (L-CASE (MACHINETYPE) T)) (COND ((EQ \PUP.READY T) (SETQ \LAFITE.REPORT.MACHINE (CONCAT \LAFITE.REPORT.MACHINE " (" (ETHERHOSTNAME NIL T) ")")))) \LAFITE.REPORT.MACHINE)) T) (printout SCRATCH "Microcode version: " .I1.8 (fetch HIBYTE of UCODEVERSION) "," .I1.8 (fetch LOBYTE of UCODEVERSION) T) (printout SCRATCH "Memory size: " .I4.8 (REALMEMORYSIZE) T) (printout SCRATCH "Frequency: >> Always, Intermittent, Once <<
+Impact: >> Fatal, Serious, Moderate, Annoying, Minor <<" T T) (printout SCRATCH ">>detailed problem description<<" T)) (TEDIT.SETSEL TEXTSTREAM SELECTPOSITION 0 (QUOTE RIGHT)) (TEDIT.INCLUDE TEXTSTREAM SCRATCH) (TEDIT.SETSEL TEXTSTREAM SELECTPOSITION (NCHARS SUBJFIELD) (QUOTE RIGHT) T) (TEXTPROP TEXTSTREAM (QUOTE LAFITEMODE) MODE) (RETURN TEXTSTREAM)))
+)
+
+(MAKENEWMESSAGEFORM

+(LAMBDA NIL (* ; "Edited  6-Jun-88 12:22 by bvm") (LET ((OUTSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (LIST (QUOTE FONT) LAFITEEDITORFONT))) SELECTPOSITION) (printout OUTSTREAM "Subject: ") (SETQ SELECTPOSITION (ADD1 (GETFILEPTR OUTSTREAM))) (printout OUTSTREAM SUBJECTSTR T) (printout OUTSTREAM "To: " RECIPIENTSSTR T) (printout OUTSTREAM "cc: " (FULLUSERNAME) T T) (printout OUTSTREAM MESSAGESTR T) (if LAFITE.SIGNATURE then (* ; "Pre-sign it") (PRIN3 LAFITE.SIGNATURE OUTSTREAM)) (TEDIT.SETSEL OUTSTREAM SELECTPOSITION (NCHARS SUBJECTSTR) (QUOTE RIGHT) T) OUTSTREAM))
+)
+
+(MAKELAFITEPRIVATEFORMSITEMS

+(LAMBDA (HELPSTR) (* ; "Edited 23-Feb-89 12:38 by bvm") (for FORMFILE in (SORT LAFITEFORMFILES) when FORMFILE collect (BQUOTE ((\, (if (U-CASEP FORMFILE) then (CL:STRING-CAPITALIZE FORMFILE) else FORMFILE)) (QUOTE (\, FORMFILE)) (\, HELPSTR)))))
+)
+
+(\LAFITE.UNCACHE.MESSAGEFORM

+(LAMBDA (ITEM MENU) (* ; "Edited  8-Nov-89 12:38 by bvm") (LET ((FORM (\LAFITE.SELECT.FORM "Forget about this message form"))) (COND (FORM (SETQ LAFITEFORMFILES (DREMOVE FORM LAFITEFORMFILES)) (SETQ \LAFITEPROFILECHANGED T) (SETQ LAFITEFORMSMENU) (printout PROMPTWINDOW T FORM " forgotten.")))))
+)
+
+(\LAFITE.DELETE.MESSAGEFORM

+(LAMBDA (ITEM MENU) (* ; "Edited  8-Nov-89 12:38 by bvm") (LET ((FORM (\LAFITE.SELECT.FORM "Delete this saved message"))) (if (AND FORM (PROGN (CLRPROMPT) (MOUSECONFIRM (CL:FORMAT NIL "Click LEFT to confirm deleting saved message '~A'" FORM) T PROMPTWINDOW))) then (\LAFITE.DELETE.FORM.INTERNAL FORM))))
+)
+
+(\LAFITE.SELECT.FORM

+(LAMBDA (MSG) (* ; "Edited  8-Nov-89 12:37 by bvm") (COND ((NULL LAFITEFORMFILES) (printout PROMPTWINDOW T "You have no private message forms")) (T (MENU (\LAFITE.CREATE.MENU (MAKELAFITEPRIVATEFORMSITEMS MSG) "Private Forms")))))
+)
+
+(\LAFITE.DELETE.FORM.INTERNAL

+(LAMBDA (FORMNAME) (* ; "Edited  8-Nov-89 12:34 by bvm") (LET ((*UPPER-CASE-FILE-NAMES* NIL) (LONGNAME (LA.LONGFILENAME FORMNAME LAFITEFORM.EXT)) FULL) (while (SETQ FULL (FULLNAME LONGNAME (QUOTE OLDEST))) do (if (NOT (DELFILE FULL)) then (PRINTOUT PROMPTWINDOW T "Could not delete " FULL) (RETURN NIL)) finally (SETQ LAFITEFORMFILES (CL:DELETE FORMNAME LAFITEFORMFILES :TEST (QUOTE STRING-EQUAL))) (SETQ \LAFITEPROFILECHANGED T) (SETQ LAFITEFORMSMENU) (PRINTOUT PROMPTWINDOW T FORMNAME " deleted.") (RETURN T))))
+)
+
+(\LAFITE.READ.FORM

+(LAMBDA (FILE) (* ; "Edited  2-Nov-89 15:55 by bvm") (* ;;; "copies the messaage form in the FILE into a text stream") (PROG ((TEXTSTREAM (OPENTEXTSTREAM (OPENSTREAM FILE (QUOTE INPUT)) NIL NIL NIL (LIST (QUOTE FONT) LAFITEEDITORFONT))) NAME CH) (SETFILEPTR TEXTSTREAM 0) (COND ((OR (EQ (SETQ CH (BIN TEXTSTREAM)) (CHARCODE %")) (AND (EQ CH (CHARCODE CR)) (EQ (BIN TEXTSTREAM) (CHARCODE %")))) (* ; "Old-style form, get rid of surrounding double quotes") (TEDIT.DELETE TEXTSTREAM 1 (ADD1 (GETFILEPTR TEXTSTREAM))) (TEDIT.DELETE TEXTSTREAM (GETEOFPTR TEXTSTREAM) 1))) (bind (OPENMARKER _ (CONSTANT (ALLOCSTRING 1 (CHARCODE ^A)))) J (I _ 1) while (SETQ I (TEDIT.FIND TEXTSTREAM OPENMARKER I)) do (* ; "Change Laurel forms into Lafite forms") (COND ((AND (SETQ J (TEDIT.FIND TEXTSTREAM (CONSTANT (ALLOCSTRING 1 (CHARCODE ^B))) (ADD1 I) (IPLUS I 70))) (NOT (TEDIT.FIND TEXTSTREAM OPENMARKER (ADD1 I) J))) (TEDIT.DELETE TEXTSTREAM J 1) (TEDIT.INSERT TEXTSTREAM "<<" J) (TEDIT.DELETE TEXTSTREAM I 1) (TEDIT.INSERT TEXTSTREAM ">>" I) (SETQ I J)) (T (RETURN)))) (bind (I _ 1) while (SETQ I (TEDIT.FIND TEXTSTREAM ">>Self<<" I)) do (* ; "Replace '>>Self<<' with user name") (OR NAME (SETQ NAME (FULLUSERNAME))) (TEDIT.DELETE TEXTSTREAM I 8) (TEDIT.INSERT TEXTSTREAM NAME I) (SETFILEPTR TEXTSTREAM I) (* ; "Patch around tedit bug...")) (\LAFITE.FIND.TEMPLATE TEXTSTREAM) (RETURN TEXTSTREAM)))
+)
+
+(\LAFITE.FIND.TEMPLATE

+(LAMBDA (TEXTSTREAM) (* bvm%: "22-Apr-84 23:59") (LET (SELECTSTART) (COND ((SETQ SELECTSTART (TEDIT.FIND TEXTSTREAM ">>*<<" 1 NIL T)) (* ; "Wait until TEDIT.FIND gets fixed") (* ; "highlight the first 'blank' to fill in") (COND ((LISTP SELECTSTART) (SETQ SELECTSTART (CAR SELECTSTART)))) (TEDIT.SETSEL TEXTSTREAM SELECTSTART (+ 2 (- (TEDIT.FIND TEXTSTREAM "<<" SELECTSTART) SELECTSTART)) (QUOTE RIGHT) T) T) (T (TEDIT.SETSEL TEXTSTREAM 1 0 (QUOTE LEFT))))))
+)
+)
+
+
+
+(* ; "ANSWER")

+
+(DEFINEQ
+
+(\LAFITE.ANSWER

+(LAMBDA (WINDOW FOLDERDATA ITEM MENU) (* bvm%: " 1-Feb-84 15:08") (ADD.PROCESS (LIST (FUNCTION \LAFITE.ANSWER.PROC) (KWOTE WINDOW) (KWOTE FOLDERDATA) (KWOTE ITEM) (KWOTE MENU)) (QUOTE NAME) (QUOTE MESSAGEANSWERER) (QUOTE RESTARTABLE) (QUOTE NO)))
+)
+
+(\LAFITE.ANSWER.PROC

+(LAMBDA (WINDOW MAILFOLDER ITEM MENU) (* bvm%: "29-May-84 15:59") (PROG (MSGDESCRIPTOR FORM) (SETQ FORM (RESETLST (LA.RESETSHADE ITEM MENU) (WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER) (\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER) (COND ((NOT (LAB.ASSURE.SELECTIONS MAILFOLDER)) (MAKEANSWERFORM (SETQ MSGDESCRIPTOR (find MSGDESCRIPTOR selectedin MAILFOLDER suchthat T)) MAILFOLDER)))))) (COND ((AND FORM (\SENDMESSAGE FORM)) (WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER) (PROG ((MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))) (COND ((AND MESSAGES (EQ MSGDESCRIPTOR (NTHMESSAGE MESSAGES (fetch (LAFITEMSG %#) of MSGDESCRIPTOR)))) (* ; "If message got expunged since we constructed the answer form, we can't do anything") (MARKMESSAGE MSGDESCRIPTOR MAILFOLDER ANSWERMARK)))))))))
+)
+
+(MAKEANSWERFORM

+(LAMBDA (MSGDESCRIPTORS MAILFOLDER) (* ; "Edited 10-Aug-89 17:28 by bvm") (LET* ((FIRSTMSG (if (LISTP MSGDESCRIPTORS) then (CAR MSGDESCRIPTORS) else MSGDESCRIPTORS)) (MODEBITS (fetch (LAFITEMSG MODEBITS) of FIRSTMSG)) (MODE (CL:NTH MODEBITS *LAFITE-WELL-KNOWN-MODES*))) (if (NULL MODE) then (if (OR (NEQ MODEBITS 0) (NULL (SETQ MODE (\LAFITE.GUESS.MODE FIRSTMSG)))) then (LAB.PROMPTPRINT MAILFOLDER (if (EQ MODEBITS 0) then "Message of unknown protocol." else "Warning: This message was retrieved under a protocol not currently enabled.")) (LAB.PROMPTPRINT MAILFOLDER "Will answer in " (SETQ MODE (fetch (LAFITEOPS LAFITEMODE) of \LAFITEMODE)) " mode; this may not work.  "))) (* ;; "Currently we only pay attention to the first message.  If we ever do otherwise, we'll want to notice whether the other messages are in the same mode") (LET ((*LAFITE-MODE-DATA* (\LAFITE.GET.USER.DATA MODE)) MSG) (* ;; "Before returning the form, tag it with a mail mode") (if (NULL *LAFITE-MODE-DATA*) then (LAB.FORMAT MAILFOLDER "Failed: can't authenticate user in ~A mode" MODE) elseif (SETQ MSG (CL:FUNCALL (fetch (LAFITEMODEDATA ANSWERER) of *LAFITE-MODE-DATA*) MSGDESCRIPTORS MAILFOLDER)) then (if (TEXTSTREAMP MSG) then (TEXTPROP MSG (QUOTE LAFITEMODE) MODE) MSG else (OPENTEXTSTREAM MSG NIL NIL NIL (BQUOTE (LAFITEMODE (\, MODE)))))))))
+)
+
+(LA.PRINT.COMMA.LIST

+(LAMBDA (STRINGS STREAM) (* ; "Edited  6-Jun-88 12:50 by bvm") (for STR in STRINGS bind NTHTIME when STR do (COND (NTHTIME (PRIN3 ", " STREAM)) (T (SETQ NTHTIME T))) (PRIN3 STR STREAM)))
+)
+
+(LAFITE.FILL.IN.ANSWER.FORM

+(LAMBDA (SUBJECT FROM DATE TO CC ADDRESSPRINTFN) (* ; "Edited 10-Jun-88 17:19 by bvm") (* ;; "Construct an answer form replying to a message from FROM on DATE with specified SUBJECT.  Reply should go to the lists of names TO and CC.  ADDRESSPRINTFN is a function that prints a list of names suitably for the protocol in question.") (LET ((OUTSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (LIST (QUOTE FONT) LAFITEEDITORFONT))) SELECTPOSITION) (LINELENGTH MAX.SMALLP OUTSTREAM) (* ; "Sigh, apparently text streams have linelength") (PROGN (printout OUTSTREAM "Subject: ") (if SUBJECT then (COND ((NOT (STRING-EQUAL (SUBSTRING SUBJECT 1 3) "Re:")) (printout OUTSTREAM "Re: "))) (printout OUTSTREAM SUBJECT) else (printout OUTSTREAM "(reply to message)"))) (PROGN (printout OUTSTREAM T "In-reply-to: ") (if (NULL FROM) then (printout OUTSTREAM "your") else (printout OUTSTREAM FROM "'s")) (printout OUTSTREAM " message of " DATE T)) (PROGN (printout OUTSTREAM "To: ") (if TO then (CL:FUNCALL ADDRESSPRINTFN TO OUTSTREAM) else (* ; "No to, so ask to fill in") (printout OUTSTREAM RECIPIENTSSTR T)) (TERPRI OUTSTREAM)) (COND (CC (printout OUTSTREAM "cc: ") (CL:FUNCALL ADDRESSPRINTFN CC OUTSTREAM) (TERPRI OUTSTREAM))) (TERPRI OUTSTREAM) (SETQ SELECTPOSITION (ADD1 (GETFILEPTR OUTSTREAM))) (printout OUTSTREAM MESSAGESTR T) (if LAFITE.SIGNATURE then (* ; "Pre-sign it") (PRIN3 LAFITE.SIGNATURE OUTSTREAM)) (TEDIT.SETSEL OUTSTREAM SELECTPOSITION (NCHARS MESSAGESTR) (QUOTE RIGHT) T) OUTSTREAM))
+)
+)
+
+
+
+(* ; "FORWARD")

+
+(DEFINEQ
+
+(\LAFITE.FORWARD

+(LAMBDA (WINDOW MAILFOLDER ITEM MENU) (* bvm%: " 1-Feb-84 15:05") (ADD.PROCESS (LIST (FUNCTION \LAFITE.FORWARD.PROC) (KWOTE WINDOW) (KWOTE MAILFOLDER) (KWOTE ITEM) (KWOTE MENU)) (QUOTE NAME) (QUOTE MESSAGEFORWARDER) (QUOTE RESTARTABLE) (QUOTE NO)))
+)
+
+(\LAFITE.FORWARD.PROC

+(LAMBDA (WINDOW MAILFOLDER ITEM MENU) (* ; "Edited 14-Oct-87 16:20 by bvm:") (PROG (FORWARDEDMSGS FORM) (* ;; "the reason to get the MSG#S first is that they may have changed by the time \SENDMESSAGE finishes and then we would have marked the wrong ones") (RESETLST (OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER) NIL T) (LA.RESETSHADE ITEM MENU) (\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER) (COND ((NOT (LAB.ASSURE.SELECTIONS MAILFOLDER)) (SETQ FORM (MAKEFORWARDFORM WINDOW MAILFOLDER (SETQ FORWARDEDMSGS (LAB.SELECTED.MESSAGES MAILFOLDER))))))) (COND ((AND FORM (\SENDMESSAGE FORM)) (WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER) (PROG ((MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))) (COND (MESSAGES (* ; "Make sure folder hasn't been closed since") (for MSG in FORWARDEDMSGS when (EQ MSG (NTHMESSAGE MESSAGES (fetch (LAFITEMSG %#) of MSG))) do (* ; "If message got expunged since we constructed the forward form, we can't do anything") (MARKMESSAGE MSG MAILFOLDER FORWARDMARK))))))))))
+)
+
+(MAKEFORWARDFORM

+(LAMBDA (WINDOW FOLDER MESSAGELIST) (* ; "Edited  5-Jan-90 17:46 by bvm") (* ;; "Make a message form that forwards each of the messages in MESSAGELIST") (PROG ((FOLDERSTREAM (\LAFITE.OPEN.FOLDER FOLDER (QUOTE INPUT) :ABORT)) (TEXTSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (LIST (QUOTE FONT) LAFITEEDITORFONT))) (CURMSG (CAR MESSAGELIST)) SUBJECT SELECTPOSITION SELECTLEN) (OR (fetch (LAFITEMSG PARSED?) of CURMSG) (LAFITE.PARSE.MSG.FOR.TOC CURMSG FOLDER)) (LINELENGTH MAX.SMALLP TEXTSTREAM) (PRIN3 "Subject: " TEXTSTREAM) (COND ((OR LAFITEFORWARDSUBJECTSTR (NULL (SETQ SUBJECT (fetch (LAFITEMSG SUBJECT) of CURMSG)))) (SETQ SELECTPOSITION (ADD1 (GETFILEPTR TEXTSTREAM))) (SETQ SELECTLEN (NCHARS (SETQ SUBJECT (OR LAFITEFORWARDSUBJECTSTR SUBJECTSTR)))) (PRIN3 SUBJECT TEXTSTREAM)) (T (CL:FORMAT TEXTSTREAM "[~@[~A: ~]~A]" (fetch (LAFITEMSG FROM) of CURMSG) SUBJECT))) (TERPRI TEXTSTREAM) (PRIN3 "To: " TEXTSTREAM) (COND ((NOT SELECTPOSITION) (SETQ SELECTPOSITION (ADD1 (GETFILEPTR TEXTSTREAM))) (SETQ SELECTLEN (NCHARS RECIPIENTSSTR)))) (CL:FORMAT TEXTSTREAM "~A
+cc: ~A
+
+~A
+" RECIPIENTSSTR (FULLUSERNAME) (CAR LAFITEFORWARDSTRINGS)) (if LAFITE.SIGNATURE then (* ; "Sign it up here, after the user's inserted comments, if any") (PRIN3 LAFITE.SIGNATURE TEXTSTREAM) (TERPRI TEXTSTREAM)) (for MSGDESCRIPTOR in MESSAGELIST bind NTHTIME do (PRIN3 (COND (NTHTIME (* ; "%"Next message%"") (CADDR LAFITEFORWARDSTRINGS)) (T (* ; "%"Begin forwarded messages%"") (SETQ NTHTIME T) (CADR LAFITEFORWARDSTRINGS))) TEXTSTREAM) (TERPRI TEXTSTREAM) (\LAFITE.APPEND.MESSAGE.BODY TEXTSTREAM FOLDERSTREAM MSGDESCRIPTOR \LAPARSE.DONT.FORWARD.HEADERS) (TERPRI TEXTSTREAM) (TEDIT.CARETLOOKS TEXTSTREAM LAFITEEDITORFONT)) (PRIN3 (CADDDR LAFITEFORWARDSTRINGS) TEXTSTREAM) (TERPRI TEXTSTREAM) (TEDIT.SETSEL TEXTSTREAM SELECTPOSITION SELECTLEN (QUOTE RIGHT) T) (RETURN TEXTSTREAM)))
+)
+)
+
+(RPAQQ LAFITESENDINGMENUITEMS (("Deliver" (QUOTE \SENDMSG.DELIVER) "Send the message in the edit window") ("Reply To" (QUOTE \SENDMSG.REPLYTO) "Insert a Reply-to field in this message") ("Change Mode" (QUOTE \SENDMSG.CHANGE.MODE) "Change the mode (mail protocol) used to send this message.") ("Save" (QUOTE \SENDMSG.SAVE.FORM) "Save the message in a file for later use (retrieve with middle-button SendMail)")))
+
+(RPAQQ LAFITEFORMSMENUITEMS (("Saved Form" (QUOTE %##ANOTHERFORM##) "You will be asked to specify a filename for the form") ("Standard Form" (FUNCTION MAKENEWMESSAGEFORM) "A clean message form")))
+
+(RPAQQ LAFITEFORMATMENUITEMS (("Send Formatted Message" (QUOTE TEDIT)) ("Send Plain Text" (QUOTE TEXT)) ("Abort" (QUOTE ABORT))))
+
+(RPAQQ LAFITEFORWARDSTRINGS (">>CoveringMessage<<" "
+     ----- Begin Forwarded Messages -----
+" "
+     ----- Next Message -----
+" "
+     ----- End Forwarded Messages -----"))
+
+(ADDTOVAR \SYSTEMCACHEVARS \LAFITE.REPORT.MACHINE)
+
+(ADDTOVAR LAFITESPECIALFORMS ("Lisp Report" (FUNCTION MAKELISPSUPPORTFORM) "A form to report a Lisp bug or suggestion") ("Lafite Report" (FUNCTION MAKELAFITESUPPORTFORM) "A form to report a Lafite bug or suggestion"))
+
+(ADDTOVAR LAFITEMENUVARS LAFITEFORMSMENU LAFITEFORMATMENU)
+
+(RPAQ? \LAFITE.REPORT.MACHINE)
+
+(RPAQ? LAFITECURRENTEDITORWINDOWS)
+
+(RPAQ? LAFITEFORMFILES)
+
+(RPAQ? LAFITEFORMSMENU)
+
+(RPAQ? LAFITEFORMATMENU)
+
+(RPAQ? LAFITEEDITORFONT LAFITEDISPLAYFONT)
+
+(RPAQ? LAFITEFORM.EXT "Lafite-form")
+
+(RPAQ? LAFITEFORMDIRECTORIES NIL)
+
+(RPAQ? LAFITE.EDITOR.SIZE (QUOTE (470 . 300)))
+
+(RPAQ? LAFITE.EDITOR.LAYOUTS NIL)
+
+(RPAQ? LAFITEFORWARDSUBJECTSTR NIL)
+
+(RPAQ? LAFITESUPPORT NIL)
+
+(RPAQ? LISPSUPPORT NIL)
+
+(RPAQ? MESSAGESTR ">>Message<<")
+
+(RPAQ? RECIPIENTSSTR ">>Recipients<<")
+
+(RPAQ? SUBJECTSTR ">>Subject<<")
+
+(RPAQ? LAFITE.SEND.FORMATTED (QUOTE ((NSCHARS :ASK) (CHARLOOKS :ASK) (PARALOOKS :ASK) (IMAGEOBJ T))))
+
+
+
+(* ; "Obsolete")

+
+
+(RPAQ? LAFITEEDITORREGION NIL)
+
+
+
+(* ; "ICON stuff")

+
+
+(RPAQQ LAFITE.MSG.ICON (#*(82 72)@@@@@@@@@GO@@@@@@@@@@@@@@@@@@@@@AOOL@@@@@@@@@@@@@@@@@@@@GH@O@@@@@@@@@@@@@@@@@@@CN@@CL@@@@@@@@@@@@@@@@@@OH@@@OH@@@@@@@@@@@@@@@@CL@@@@CN@@@@@@@@@@@@@@@@O@@@@@@GH@@@@@@@@@@@@@@CL@@@@@@AN@@@@@@@@@@@@@AO@@@@@@@@GL@@@@@@@@@@@@GL@@@@@@@@AO@@@@@@@@@@@AN@@@@@@@@@@CL@@@@@@@@@@GH@@@@@@@@@@@O@@@@@@@@@CN@@@@@@@@@@@@CL@@@@@@@@OH@@@@@@@@@@@@@OH@@@@@@CL@@@@@@@@@@@@@@CN@@@@@@O@@@@@@@@@@@@@@@@GH@@@@CL@@@@@@@@@@@@@@@@AN@@@@O@@@@@@@@@@@@@@@@@@GH@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@O@@@@@@@@@@@@@@@@@@GL@@@ML@@@@@@@@@@@@@@@@ALL@@@LN@@@@@@@@@@@@@@@@CHL@@@LCH@@@@@@@@@@@@@@@N@L@@@LAL@@@@@@@@@@@@@@CL@L@@@L@G@@@@@@@@@@@@@@G@@L@@@L@CL@@@@@@@@@@@@AL@@L@@@L@@N@@@@@@@@@@@@CH@@L@@@L@@CH@@@@@@@@@@@N@@@L@@@L@@AL@@@@@@@@@@AL@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@N@@@@@@@@@@@@CH@@L@@@L@CL@@@@@@@@@@@@AL@@L@@@L@G@@@@@@@@@@@@@@G@@L@@@LAL@@@@@@@@@@@@@@CL@L@@@LCH@@@@@@@@@@@@@@@N@L@@@LN@@@@@@@@@@@@@@@@CHL@@@ML@@@@@@@@@@@@@@@@ALL@@@O@@@@@@@@@@@@@@@@@@GL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@ 
+#*(82 72)@@@@@@@@@GO@@@@@@@@@@@@@@@@@@@@@AOOL@@@@@@@@@@@@@@@@@@@@GOOO@@@@@@@@@@@@@@@@@@@COOOOL@@@@@@@@@@@@@@@@@@OOOOOOH@@@@@@@@@@@@@@@@COOOOOON@@@@@@@@@@@@@@@@OOOOOOOOH@@@@@@@@@@@@@@COOOOOOOON@@@@@@@@@@@@@AOOOOOOOOOOL@@@@@@@@@@@@GOOOOOOOOOOO@@@@@@@@@@@AOOOOOOOOOOOOL@@@@@@@@@@GOOOOOOOOOOOOO@@@@@@@@@COOOOOOOOOOOOOOL@@@@@@@@OOOOOOOOOOOOOOOOH@@@@@@COOOOOOOOOOOOOOOON@@@@@@OOOOOOOOOOOOOOOOOOH@@@@COOOOOOOOOOOOOOOOOON@@@@OOOOOOOOOOOOOOOOOOOOH@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@ (8 8 64 36)))
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+(DECLARE%: EVAL@COMPILE
+
+(RECORD SENDINGCOMMAND
 (COMMAND ITEM MENU MESSAGE MESSAGEPARSE) (TYPE? (AND (LISTP DATUM) (FMEMB (fetch COMMAND of DATUM) (QUOTE (%##SEND## %##SAVE## %##FORGETIT##)))))
+)
+)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS \LAFITE.REPORT.MACHINE LAFITECURRENTEDITORWINDOWS LAFITEEDITORFONT LAFITEEDITORREGION LAFITEFORMATMENU LAFITEFORMSMENUITEMS LAFITEFORMATMENUITEMS LAFITEFORWARDSTRINGS LAFITEFORWARDSUBJECTSTR LAFITESENDINGMENUITEMS LAFITESPECIALFORMS LAFITESUPPORT LISPSUPPORT MAKESYSDATE MESSAGESTR RECIPIENTSSTR SUBJECTSTR LAFITE.MSG.ICON LAFITEFORMDIRECTORIES LAFITE.SEND.FORMATTED)
+)
+
+
+(FILESLOAD (SOURCE) LAFITEDECLS)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(LOCALVARS . T)
+)
+)
+(PUTPROPS LAFITESEND COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1993))
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (3626 16457 (DOLAFITESENDINGCOMMAND 3636 . 4010) (\SENDMESSAGE.INITIATE 4012 . 4868) (
+\SENDMSG.DELIVER 4870 . 5259) (\SENDMSG.EXIT.TEDIT 5261 . 5520) (\SENDMSG.SAVE.FORM 5522 . 6714) (
+\LAFITE.HEADER.EOF 6716 . 6955) (\LAFITE.INSERT.REPLYTO 6957 . 7462) (\SENDMSG.REPLYTO 7464 . 7827) (
+\SENDMSG.CHANGE.MODE 7829 . 10098) (\SENDMSG.FIND.FIELD 10100 . 10467) (\SENDMESSAGE.PARSE 10469 . 
+10992) (\LAFITE.PREPARE.SEND 10994 . 12656) (\LAFITE.PREPARE.ERROR 12658 . 13381) (
+\LAFITE.CHOOSE.MSG.FORMAT 13383 . 14526) (LAFITE.MAKE.PLAIN.TEXTSTREAM 14528 . 15221) (
+\SENDMESSAGE.MENUPROMPT 15223 . 15874) (\SENDMESSAGE.PROMPT 15876 . 16272) (\SENDMESSAGEFAIL 16274 . 
+16455)) (16458 29698 (\SENDMESSAGE 16468 . 17379) (\SENDMESSAGE.RESTARTABLE 17381 . 20007) (
+\SENDMESSAGE.CLEANUP 20009 . 20182) (\SENDMESSAGE.MAKEWINDOW 20184 . 23172) (MAKELAFITEDELIVERMENU 
+23174 . 23379) (\LAFITE.CLOSEMSG? 23381 . 23981) (\LAFITE.AFTER.DELIVER 23983 . 25644) (
+\LAFITE.UNSENT.ICON 25646 . 25891) (\LAFITE.FETCH.SUBJECT 25893 . 26341) (LAFITE.SENDMESSAGE 26343 . 
+26859) (\SENDMESSAGE0 26861 . 28266) (LA.ASSURE.PROMPT.WINDOW 28268 . 28777) (\LAFITE.SEND.FAIL 28779
+ . 29144) (\LAFITE.INVALID.RECIPIENTS 29146 . 29467) (\SENDMESSAGE.ABORT 29469 . 29696)) (29730 35510 
+(\OUTBOX.CREATE 29740 . 30746) (\OUTBOX.RESET 30748 . 31052) (\OUTBOX.CLOSEFN 31054 . 31143) (
+\OUTBOX.REPAINTFN 31145 . 31487) (\OUTBOX.RESHAPEFN 31489 . 32131) (\OUTBOX.SHADEITEM 32133 . 32603) (
+\OUTBOX.BUTTONFN 32605 . 34317) (\OUTBOX.DISPLAYLINE 34319 . 34609) (\OUTBOX.ADD.ITEM 34611 . 35508)) 
+(35797 44286 (\LAFITE.MESSAGEFORM 35807 . 37649) (MAKELAFITESUPPORTFORM 37651 . 37780) (
+MAKELISPSUPPORTFORM 37782 . 37888) (MAKEXXXSUPPORTFORM 37890 . 40031) (MAKENEWMESSAGEFORM 40033 . 
+40625) (MAKELAFITEPRIVATEFORMSITEMS 40627 . 40907) (\LAFITE.UNCACHE.MESSAGEFORM 40909 . 41239) (
+\LAFITE.DELETE.MESSAGEFORM 41241 . 41578) (\LAFITE.SELECT.FORM 41580 . 41836) (
+\LAFITE.DELETE.FORM.INTERNAL 41838 . 42387) (\LAFITE.READ.FORM 42389 . 43796) (\LAFITE.FIND.TEMPLATE 
+43798 . 44284)) (44310 48519 (\LAFITE.ANSWER 44320 . 44588) (\LAFITE.ANSWER.PROC 44590 . 45435) (
+MAKEANSWERFORM 45437 . 46786) (LA.PRINT.COMMA.LIST 46788 . 47001) (LAFITE.FILL.IN.ANSWER.FORM 47003 . 
+48517)) (48544 51763 (\LAFITE.FORWARD 48554 . 48825) (\LAFITE.FORWARD.PROC 48827 . 49888) (
+MAKEFORWARDFORM 49890 . 51761)))))
+STOP

library/lafite/LAFITESORT

@@ -0,0 +1,19 @@
+(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
+
(FILECREATED " 7-Feb-95 13:10:22" {DSK}<lispcore>lafite>parc-94>LAFITESORT.;2
 12117  
+
+      changes to%:  (VARS LAFITESORTCOMS)
+
+      previous date%: " 7-Oct-89 14:07:49" {DSK}<lispcore>lafite>parc-94>LAFITESORT.;1)
+
+
+(* ; "
+Copyright (c) 1989, 1995 by Xerox Corporation.  All rights reserved.
+")
+
+(PRETTYCOMPRINT LAFITESORTCOMS)
+
+(RPAQQ LAFITESORTCOMS

+       [(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
+                                                LAFITEDECLS))
+        (FNS LAFITE.ASSURE.DATE.FIELDS LAFITE.PARSE.DATE.FIELD LAFITE.PARSE.DATE.FIELD.ONLY 
+             LAFITE.SORT.BY.DATE LAFITE.SORT.MESSAGES LAFITEMSG.DATE.ORDER 

library/lafite/LAFITESORT.~1~

@@ -0,0 +1,90 @@
+(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
+
(FILECREATED " 7-Oct-89 14:07:49" "{pooh/n}<pooh>lafite>sources>LAFITESORT;21"
 11104  
+
+      changes to%:  (FNS LAFITE.SORT.MESSAGES) (VARS LAFITESORTCOMS) (FILES LAFITEDECLS)
+
+      previous date%: " 5-May-89 15:55:45" "{pooh/n}<pooh>lafite>sources>LAFITESORT;19")
+
+
+(* "
+Copyright (c) 1989 by Xerox Corporation.  All rights reserved.
+")
+
+(PRETTYCOMPRINT LAFITESORTCOMS)
+
+(RPAQQ LAFITESORTCOMS ((DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE) LAFITEDECLS)) (FNS LAFITE.ASSURE.DATE.FIELDS LAFITE.PARSE.DATE.FIELD LAFITE.PARSE.DATE.FIELD.ONLY LAFITE.SORT.BY.DATE LAFITE.SORT.MESSAGES LAFITEMSG.DATE.ORDER \LAFITE.SORT.BY.DATE.INTERACTIVE \LAFITE.SORT.BY.DATE.REGION) (APPENDVARS (LAFITEEXTRAMENUITEMS ("Sort by Date" (QUOTE \LAFITE.SORT.BY.DATE.INTERACTIVE) "Sort all the messages in this folder by their Date: fields." (SUBITEMS ("Sort Entire Folder" (QUOTE \LAFITE.SORT.BY.DATE.INTERACTIVE) "Sort all the messages in this folder by their Date: fields.") ("Sort Selected Range" (QUOTE \LAFITE.SORT.BY.DATE.REGION) "Sort only the messages between the first and last selected messages."))))) (COMS (* ; "Date hax") (FNS GDATE1-6) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS \4YearsDays) (GLOBALVARS \TimeZoneComp \DayLightSavings))) (FILES (SYSLOAD) DATEPATCH)))
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+
+(FILESLOAD (SOURCE) LAFITEDECLS)
+)
+(DEFINEQ
+
+(LAFITE.ASSURE.DATE.FIELDS

+(LAMBDA (FOLDER FIRST# LAST#) (* ; "Edited  5-May-89 15:46 by bvm") (* ;; "Assure that messages FIRST# thru LAST# have IDATE fields.  FIRST# & LAST# default.") (for I from (OR FIRST# 1) to (OR LAST# (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER)) bind (STREAM _ (\LAFITE.OPEN.FOLDER FOLDER (QUOTE INPUT) :ABORT)) (MESSAGES _ (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER)) (FAILURECNT _ 0) (MISSING _ 0) MSG ID PREV DATEFAILURE DATEFETCHED BABBLED do (if (fetch (LAFITEMSG DATEFETCHED?) of (SETQ MSG (NTHMESSAGE MESSAGES I))) then (* ; "Ok") (if (NOT (fetch (LAFITEMSG DATEKNOWN?) of MSG)) then (add FAILURECNT 1)) else (if (NOT BABBLED) then (* ; "Tell user what's taking so long") (LAB.PROMPTPRINT FOLDER "Collecting dates... ") (SETQ BABBLED T)) (if (FIXP (SETQ ID (LAFITE.PARSE.HEADER STREAM \LAPARSE.DATEFIELD (fetch (LAFITEMSG START) of MSG) (fetch (LAFITEMSG END) of MSG) T))) then (replace (LAFITEMSG IDATE) of MSG with ID) (replace (LAFITEMSG DATEKNOWN?) of MSG with T) (replace (LAFITEMSG DATEFETCHED?) of MSG with T) (replace (LAFITEMSG DATE) of MSG with NIL) (* ; "So it will be regenerated in canonical form") (OR DATEFETCHED (SETQ DATEFETCHED I)) else (replace (LAFITEMSG DATEKNOWN?) of MSG with NIL) (if LAFITEDEBUGFLG then (LAB.FORMAT FOLDER " ~:[Date missing for~;Could not parse date of~] msg ~D. " ID I)) (add FAILURECNT 1) (if (NULL ID) then (add MISSING 1)) (if (AND (> I 1) (fetch (LAFITEMSG DATEFETCHED?) of (SETQ PREV (NTHMESSAGE MESSAGES (SUB1 I))))) then (* ; "Guess that message i has date just after i-1") (replace (LAFITEMSG IDATE) of MSG with (ADD1 (fetch (LAFITEMSG IDATE) of PREV))) (replace (LAFITEMSG DATEFETCHED?) of MSG with T) else (SETQ DATEFAILURE I)))) finally (if (AND DATEFETCHED (< DATEFETCHED (fetch (MAILFOLDER TOCLASTMESSAGE#) of FOLDER))) then (* ; "Assure that the toc will be rewritten at least this far back so that we save the dates.") (replace (MAILFOLDER TOCLASTMESSAGE#) of FOLDER with DATEFETCHED)) (COND ((AND DATEFAILURE (NOT (for I from (ADD1 (OR FIRST# 1)) to (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER) when (fetch (LAFITEMSG DATEFETCHED?) of (SETQ MSG (NTHMESSAGE MESSAGES I))) do (* ; "Got a date later on") (SETQ ID (fetch (LAFITEMSG IDATE) of MSG)) (for J from DATEFAILURE to (OR FIRST# 1) by -1 do (* ; "Store guess dates for first message(s)") (replace (LAFITEMSG IDATE) of (SETQ MSG (NTHMESSAGE MESSAGES J)) with (add ID -1)) (replace (LAFITEMSG DATEFETCHED?) of MSG with T)) (RETURN T)))) (LAB.PROMPTPRINT FOLDER "Could not parse dates of ANY messages in this file.")) ((> FAILURECNT 0) (LAB.FORMAT FOLDER (if (< MISSING FAILURECNT) then " Note: Could not parse date field of ~D of these messages." else " Note: Missing date field for ~D of these messages.") FAILURECNT)))))
+)
+
+(LAFITE.PARSE.DATE.FIELD

+(LAMBDA (STREAM) (* ; "Edited  5-May-89 12:52 by bvm") (LET* ((DATESTR (LAFITE.READ.TO.EOL STREAM)) (ID (IDATE DATESTR))) (if (AND ID (> ID (CONSTANT (IDATE "1-jan-70 1200")))) then (* ; "Plausible date.  Test is for those silly senders who didn't get the date set and have messages reading %"31-dec-00 ...%"") ID else (CONCAT (OR (SUBSTRING DATESTR 1 6 DATESTR) DATESTR) "?"))))
+)
+
+(LAFITE.PARSE.DATE.FIELD.ONLY

+(LAMBDA (STREAM) (DECLARE (USEDFREE PARSERESULT)) (* ; "Edited 26-Apr-89 14:35 by bvm") (SETQ PARSERESULT (LAFITE.PARSE.DATE.FIELD STREAM)))
+)
+
+(LAFITE.SORT.BY.DATE

+(LAMBDA (FOLDER FIRST# LAST#) (* ; "Edited 26-Apr-89 15:32 by bvm") (WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of FOLDER) (LAFITE.ASSURE.DATE.FIELDS FOLDER FIRST# LAST#) (LAFITE.SORT.MESSAGES FOLDER (FUNCTION LAFITEMSG.DATE.ORDER) FIRST# LAST#)))
+)
+
+(LAFITE.SORT.MESSAGES

+(LAMBDA (FOLDER COMPAREFN FIRST# LAST#) (* ; "Edited  7-Oct-89 14:03 by bvm") (WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of FOLDER) (OR FIRST# (SETQ FIRST# 1)) (OR LAST# (SETQ LAST# (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER))) (LAB.PROMPTPRINT FOLDER "Sorting... ") (LET* ((MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER)) (SORTED (CL:STABLE-SORT (for I from FIRST# to LAST# collect (NTHMESSAGE MESSAGES I)) COMPAREFN))) (while (AND SORTED (EQ (fetch (LAFITEMSG %#) of (CAR SORTED)) FIRST#)) do (* ; "Skip over the initial prefix of in-order messages") (add FIRST# 1) (SETQ SORTED (CDR SORTED))) (if (NULL SORTED) then (LAB.PROMPTPRINT FOLDER "already in order") else (replace (MAILFOLDER FOLDEROUTOFORDER) of FOLDER with T) (if (< FIRST# (fetch (MAILFOLDER FIRSTCHANGEDMESSAGE) of FOLDER)) then (replace (MAILFOLDER FIRSTCHANGEDMESSAGE) of FOLDER with FIRST#)) (UNINTERRUPTABLY (for MSG in SORTED as I from FIRST# do (replace (LAFITEMSG %#) of MSG with I) (SETA MESSAGES I MSG))) (LET ((FIRSTSEL (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of FOLDER)) (LASTSEL (fetch (MAILFOLDER LASTSELECTEDMESSAGE) of FOLDER))) (if (>= LASTSEL FIRSTSEL) then (if (AND (>= FIRSTSEL FIRST#) (<= FIRSTSEL LAST#)) then (* ; "Start of selection was inside here, have to recompute its number") (replace (MAILFOLDER FIRSTSELECTEDMESSAGE) of FOLDER with (LAB.FIND.SELECTED.MSG FOLDER FIRST# LAST#))) (if (AND (>= LASTSEL FIRST#) (<= LASTSEL LAST#)) then (* ; "End of selection was inside here, have to recompute its number") (replace (MAILFOLDER LASTSELECTEDMESSAGE) of FOLDER with (LAB.REV.FIND.SELECTED.MSG FOLDER FIRST# LAST#))))) (LAB.DISPLAYLINES FOLDER FIRST# LAST# NIL T) (LAB.PROMPTPRINT FOLDER "done")))))
+)
+
+(LAFITEMSG.DATE.ORDER

+(LAMBDA (X Y) (* ; "Edited 26-Apr-89 14:53 by bvm") (* ;; "True if msg X has older date than msg Y.  Since date field is stored as an unboxed 32-bit integer, we open code %"<%" here to avoid boxing.") (LET ((HIDIFF (- (LOGXOR (fetch (LAFITEMSG IDATEHI) of X) 32768) (LOGXOR (fetch (LAFITEMSG IDATEHI) of Y) 32768)))) (* ;; "HIDIFF is unsigned difference of high words") (OR (< HIDIFF 0) (AND (EQ HIDIFF 0) (< (fetch (LAFITEMSG IDATELO) of X) (fetch (LAFITEMSG IDATELO) of Y))))))
+)
+
+(\LAFITE.SORT.BY.DATE.INTERACTIVE

+(LAMBDA (FOLDER FIRST# LAST#) (* ; "Edited  3-May-89 18:38 by bvm") (if (LAB.MOUSECONFIRM FOLDER "Click LEFT to confirm sorting ~D messages by date" (if LAST# then (ADD1 (- LAST# FIRST#)) else (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER))) then (\LAFITE.PROCESS (BQUOTE ((\, (FUNCTION LAFITE.SORT.BY.DATE)) (QUOTE (\, FOLDER)) (QUOTE (\, FIRST#)) (QUOTE (\, LAST#)))) "LafiteSort")))
+)
+
+(\LAFITE.SORT.BY.DATE.REGION

+(LAMBDA (FOLDER) (* ; "Edited 28-Apr-89 16:23 by bvm") (LET ((FIRST# (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of FOLDER)) (LAST# (fetch (MAILFOLDER LASTSELECTEDMESSAGE) of FOLDER))) (if (> LAST# FIRST#) then (\LAFITE.SORT.BY.DATE.INTERACTIVE FOLDER FIRST# LAST#) else (LAB.FORMAT FOLDER "There is ~:[no~;only one~] message selected." (EQ LAST# FIRST#)))))
+)
+)
+
+(APPENDTOVAR LAFITEEXTRAMENUITEMS
 ("Sort by Date" (QUOTE \LAFITE.SORT.BY.DATE.INTERACTIVE) "Sort all the messages in this folder by their Date: fields." (SUBITEMS ("Sort Entire Folder" (QUOTE \LAFITE.SORT.BY.DATE.INTERACTIVE) "Sort all the messages in this folder by their Date: fields.") ("Sort Selected Range" (QUOTE \LAFITE.SORT.BY.DATE.REGION) "Sort only the messages between the first and last selected messages.")))
+)
+
+
+
+(* ; "Date hax")

+
+(DEFINEQ
+
+(GDATE1-6

+(LAMBDA (D) (* ; "Edited 26-Apr-89 15:24 by bvm") (* ;; "Return a string containing the day and month given in internal date D.") (* ;; "This is an optimization by source code simplification of (SUBSTRING (GDATE IDT) 1 6)") (PROG ((CHECKDLS \DayLightSavings) (DQ (IQUOTIENT (LRSH (LISP.TO.ALTO.DATE D) 1) (CONSTANT (IQUOTIENT (TIMES 60 60) 2)))) HR DAY4 YDAY WDAY YEAR4 TOTALDAYS DLS) (* ; "DQ is number of hours since day 0, getting us past the sign bit problem.") (* ;; "Now we can adjust to the current time zone.  Since this might cause DQ to go negative, first add in 4 years worth of hours, making the base date be Jan 1, 1897") (SETQ HR (IREMAINDER (SETQ DQ (- (+ DQ (CONSTANT (ITIMES 24 \4YearsDays))) \TimeZoneComp)) 24)) (SETQ TOTALDAYS (IQUOTIENT DQ 24)) DTLOOP (SETQ DAY4 (IREMAINDER TOTALDAYS \4YearsDays)) (* ; "DAY4 = number of days since last leap year day 0") (SETQ DAY4 (+ DAY4 (CDR (\DTSCAN DAY4 (QUOTE ((789 . 3) (424 . 2) (59 . 1) (0 . 0))))))) (* ; "pretend every year is a leap year, adding one for days after Feb 28") (SETQ YEAR4 (IQUOTIENT TOTALDAYS \4YearsDays)) (* ; "YEAR4 = number of years til that last leap year / 4") (SETQ YDAY (IREMAINDER DAY4 366)) (* ; "YDAY is the ordinal day in the year (jan 1 = zero)") (SETQ WDAY (IREMAINDER (+ TOTALDAYS 3) 7)) (COND ((AND CHECKDLS (SETQ DLS (\ISDST? YDAY HR WDAY))) (* ;; "This date is during daylight savings, so add 1 hour.  Third arg is day of the week, which we determine by taking days mod 7 plus offset.  Monday = zero in this scheme.  Jan 1 1897 was actually a Friday (not Thursday=3), but we're cheating--1900 was not a leap year") (COND ((> (SETQ HR (ADD1 HR)) 23) (* ;; "overflowed into the next day.  This case is too hard (we might have overflowed the month, for example), so just go back and recompute") (SETQ TOTALDAYS (ADD1 TOTALDAYS)) (SETQ HR 0) (SETQ CHECKDLS NIL) (GO DTLOOP))))) (RETURN (LET* ((MONTH (\DTSCAN YDAY (QUOTE ((335 . "Dec") (305 . "Nov") (274 . "Oct") (244 . "Sep") (213 . "Aug") (182 . "Jul") (152 . "Jun") (121 . "May") (91 . "Apr") (60 . "Mar") (31 . "Feb") (0 . "Jan"))))) (DAY (ADD1 (- YDAY (CAR MONTH)))) (RESULT (CONCAT "   " (CDR MONTH)))) (\RPLRIGHT RESULT 2 DAY 1) RESULT))))
+)
+)
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+(DECLARE%: EVAL@COMPILE 
+
+(RPAQQ \4YearsDays 1461)
+
+
+(CONSTANTS \4YearsDays)
+)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS \TimeZoneComp \DayLightSavings)
+)
+)
+
+(FILESLOAD (SYSLOAD) DATEPATCH)
+(PUTPROPS LAFITESORT COPYRIGHT ("Xerox Corporation" 1989))
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (1402 8115 (LAFITE.ASSURE.DATE.FIELDS 1412 . 4187) (LAFITE.PARSE.DATE.FIELD 4189 . 4599)
+ (LAFITE.PARSE.DATE.FIELD.ONLY 4601 . 4777) (LAFITE.SORT.BY.DATE 4779 . 5054) (LAFITE.SORT.MESSAGES 
+5056 . 6788) (LAFITEMSG.DATE.ORDER 6790 . 7297) (\LAFITE.SORT.BY.DATE.INTERACTIVE 7299 . 7721) (
+\LAFITE.SORT.BY.DATE.REGION 7723 . 8113)) (8570 10791 (GDATE1-6 8580 . 10789)))))
+STOP

library/lafite/LAFITETEDIT

@@ -0,0 +1,206 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
(FILECREATED "20-May-92 11:28:47" {DSK}<project>medley2.0>library>lafitetedit.;7
 12308  
+
+      changes to%:  (FNS TEDIT.ASSURE.NO.BACKING.FILE)
+                    (VARS LAFITETEDITCOMS)
+
+      previous date%: "29-Apr-92 13:30:23" {DSK}<project>medley2.0>library>lafitetedit.;5)
+
+
+(* ; "
+Copyright (c) 1988, 1990, 1992 by Xerox Corporation.  All rights reserved.
+")
+
+(PRETTYCOMPRINT LAFITETEDITCOMS)
+
+(RPAQQ LAFITETEDITCOMS

+       (
+        (* ;; "Lafite's more explicit dependencies on %"internals%" of TEDIT")

+
+        (FNS LA.ADJUST.FORMATTING LA.SKIP.LOOKS.LIST LA.DETACH.TEDIT LA.TEDIT.INCLUDE 
+             LA.WINDOW.FROM.TEXTSTREAM TEDIT.ASSURE.NO.BACKING.FILE)
+        (DECLARE%: EVAL@COMPILE DONTCOPY 
+
+               (* ;; "Need TEDIT internal declarations for LA.ADJUST.FORMATTING.  Can't just do (FILES (SOURCE) TEDITDECLS), because there is a compiled version that is already loaded that isn't enough.")

+
+               (P (CL:UNLESS (GET 'TEDITDECLS 'FILE)
+                         (FILESLOAD TEDITDECLS)))
+               (FILES (SOURCE)
+                      LAFITEDECLS)
+               (GLOBALVARS *TEDIT-FILE-READTABLE*)
+               (LOCALVARS . T))))
+
+
+
+(* ;; "Lafite's more explicit dependencies on %"internals%" of TEDIT")

+
+(DEFINEQ
+
+(LA.ADJUST.FORMATTING

+  [LAMBDA (FORMATSTREAM OUTSTREAM BYTE-LENGTHS)
          (* ; "Edited  3-Jun-88 18:24 by bvm")

+
+    (* ;; "Adjusts the formatting info FORMATSTREAM to account for the prepending of one or more %"paragraphs%" of default looking text, whose lengths are given by BYTE-LENGTHS (or a single number if just one piece).  It then writes the resulting formatting to OUTSTREAM.")

+
+    (PROG ((END (GETEOFPTR FORMATSTREAM))
+           NPIECES PIECEINFOCH# TYPECODE PCLEN PREFIXEND LOOKSINDEX)
+          (COND
+             ((<= END 8)                                     (* ; "This can't be formatting.")

+              (RETURN NIL)))
+          (SETFILEPTR FORMATSTREAM (- END 8))
+          (SETQ PIECEINFOCH# (\DWIN FORMATSTREAM))           (* ; "Where the piece table starts relative to the whole file.  Since in our case TEXT is only the formatting, it will start at zero.")

+          (SETQ NPIECES (\SMALLPIN FORMATSTREAM))            (* ; "Total number of pieces")

+          (if
 (NEQ (\SMALLPIN FORMATSTREAM)
+                       31418)
+              then
                                       (* ; 
+
                                "Not the version of TEdit formatting we understand.  Throw it out.")

+                    (RETURN NIL))
+          (SETFILEPTR FORMATSTREAM 0)
+          [do
 (SETQ PCLEN (\DWIN FORMATSTREAM))
+                 (SETQ TYPECODE (\SMALLPIN FORMATSTREAM))    (* ; "What kind of piece is it?")

+                 (SELECTC TYPECODE
+                     (\PieceDescriptorPAGEFRAME              (* ; 
+
                           "This is page layout info for the file, whose format is an s-expression")

+                          (SKREAD FORMATSTREAM NIL *TEDIT-FILE-READTABLE*))
+                     (\PieceDescriptorCHARLOOKSLIST          (* ; 
+
         "This is the list of CHARLOOKSs used in this document.  This is a sequence of charlooks, ")

+                          (LA.SKIP.LOOKS.LIST
 FORMATSTREAM))
+                     (\PieceDescriptorPARALOOKSLIST          (* ; 
+
                     "This is the list of PARALOOKSs used in this document.  Similar to CHARLOOKS.")

+                          (LA.SKIP.LOOKS.LIST
 FORMATSTREAM))
+                     (\PieceDescriptorPARA                   (* ; 
+
   "Start a new paragraph with different looks.  We will want to insert our new piece before this.")

+                          (OR PREFIXEND (SETQ PREFIXEND (- (GETFILEPTR FORMATSTREAM)
+                                                           6)))
+                                                             (* ; 
+
                                                         "Representation is just a paralooks index")

+                          (\SMALLPIN FORMATSTREAM))
+                     (\PieceDescriptorLOOKS                  (* ; "Character looks for a new piece.  The piece is PCLEN bytes long, which means half that many chars if fat.")

+                          (OR PREFIXEND (SETQ PREFIXEND (- (GETFILEPTR FORMATSTREAM)
+                                                           6)))
+                                                             (* ; 
+
                                      "Peek ahead to see what the charlooks of the first piece are")

+                          (\BIN FORMATSTREAM)                (* ; "FLAG byte.  1=NEW; 2 = FAT")

+                          (SETQ LOOKSINDEX (\SMALLPIN FORMATSTREAM))
+                                                             (* ; "Charlooks index")

+                          (RETURN))
+                     (PROGN                                  (* ; 
+
                                     "Either imageobj or unknown type piece--I hope we're finished")

+                            (RETURN]
+
+     (* ;; "At this point we have read enough format info to know what to do.  Everything up to PREFIXEND is the preamble, which we can copy intact.  Then we insert our own first piece, consisting of the prepended text in a single piece.")

+
+          [COPYBYTES FORMATSTREAM OUTSTREAM 0 (OR PREFIXEND (SETQ PREFIXEND (- (GETFILEPTR 
+                                                                                      FORMATSTREAM)
+                                                                               6]
+          (for
 PIECELEN inside
 BYTE-LENGTHS do
 
+
+                                 (* ;; "This code is generalized to allow multiple inserted pieces, but unfortunately if the textstream already has any paragraph formatting, we can't make the pieces be different paragraphs without making them also have non-default paralooks.")

+
+                                                          (\DWOUT OUTSTREAM PIECELEN)
+                                                          (\SMALLPOUT OUTSTREAM \PieceDescriptorLOOKS
+                                                                 )
+                                                          (BOUT OUTSTREAM 0) 
+                                                             (* ; "Flag byte")

+                                                          (\SMALLPOUT OUTSTREAM (OR LOOKSINDEX 1)) 
+                                                             (* ; "Char looks index--make it look like the first piece, or arbitrarily choose the first looks if the text started with an imageobj or some other ugliness")

+                                                          (add
 PIECEINFOCH# PIECELEN)
+                                                          (add
 NPIECES 1))
+          (COPYBYTES FORMATSTREAM OUTSTREAM PREFIXEND (- END 8))
+                                                             (* ; "Copy rest of piece info")

+          (\DWOUT OUTSTREAM PIECEINFOCH#)                    (* ; 
+
                                                           "New offset of start of formatting")

+          (\SMALLPOUT OUTSTREAM NPIECES)                     (* ; "More pieces now")

+          (\SMALLPOUT OUTSTREAM 31418)                       (* ; "Finally, the password")

+          (RETURN OUTSTREAM])
+
+(LA.SKIP.LOOKS.LIST

+  [LAMBDA (FORMATSTREAM)
                                 (* ; "Edited  3-Jun-88 16:52 by bvm")

+
+    (* ;; "Advance FORMATSTREAM past a sequence of CHAR/PARALOOKS.  Each elements starts with a word giving its byte length, so we can skip over it")

+
+    (for
 I from
 1 to
 (\SMALLPIN FORMATSTREAM) do
 (SETFILEPTR FORMATSTREAM
+                                                                        (+ (GETFILEPTR FORMATSTREAM)
+                                                                           (\SMALLPIN FORMATSTREAM])
+
+(LA.DETACH.TEDIT

+  [LAMBDA (TEXTSTREAM)
                                   (* ; "Edited  3-Jun-88 17:27 by bvm")

+
+    (* ;; "Removes the TEXTSTREAM from the window, if any, it is being edited in.")

+
+    (* ;; "Yecch, TEdit ought to have a proper interface for this.")

+
+    (replace
 (TEXTOBJ \WINDOW) of
 (TEXTOBJ TEXTSTREAM) with
 NIL])
+
+(LA.TEDIT.INCLUDE

+  [LAMBDA (TEXTSTREAM FILE CH#)
                          (* ; "Edited  3-Jun-88 17:49 by bvm")

+
+    (* ;; "Do an Include of FILE into TEXTSTREAM at (i.e., in front of) character CH#.  Returns the length of the insertion.")

+
+    (* ;; "This code assumes that TEDIT.INCLUDE makes selection be the insertion")

+
+    (TEDIT.SETSEL TEXTSTREAM CH# 0 'RIGHT)
+    (TEDIT.INCLUDE TEXTSTREAM FILE)
+    (fetch
 (SELECTION DCH) of
 (TEDIT.GETSEL TEXTSTREAM])
+
+(LA.WINDOW.FROM.TEXTSTREAM

+  [LAMBDA (TEXTSTREAM)
                                   (* ; "Edited 23-Sep-87 15:36 by bvm:")

+    (for
 W in
 (fetch
 (TEXTOBJ \WINDOW) of
 (TEXTOBJ TEXTSTREAM))
+       when
 (WINDOWPROP W 'TITLE) do
                 (* ; 
+
                                                     "Hairy loop because the window could be split")

+                                            (RETURN W])
+
+(TEDIT.ASSURE.NO.BACKING.FILE

+  [LAMBDA (TEXTSTREAM)
                                   (* ; "Edited 20-May-92 11:25 by rmk:")

+    (LET* ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
+           (OFILE (FETCH
 (TEXTOBJ TXTFILE) OF
 TEXTOBJ)))
+          (IF
 (AND (TYPE?
 STREAM OFILE)
+                       (NEQ (FETCH
 (STREAM DEVICE) OF
 OFILE)
+                            'NODIRCORE))
+              THEN
 (LET* [(NEWFILE (OPENSTREAM '{NODIRCORE} 'BOTH))
+                              (CH#S (REVERSE (CDR (TEDIT.PUT.PCTB TEXTOBJ NEWFILE]
+
+                             (* ;; "TEDIT.PUT.PCTB has the effect of copying the whole document to NEWFILE.  There are still multiple pieces, because each looks-run is a piece.  Value gives the byte pointers within the resulting file where each real piece of text starts.  Run thru the pieces in the PCTB, pointing them to the new file and their new locations.  We do the cleanup copied from TEDIT.PUT; don't call TEDIT.PUT itself because we want it to think that we are still editing the original source.")

+
+                             [TEDIT.MAPPIECES TEXTOBJ (FUNCTION (LAMBDA (CH# PC)
+                                                                  (COND
+                                                                     ((FETCH
 POBJ OF
 PC))
+                                                                     (T (REPLACE
 PFPOS
+                                                                           OF
 PC
+                                                                           WITH
 (POP
 CH#S))
+                                                                        (CLOSEF? (FETCH
 PFILE
+                                                                                    OF
 PC))
+                                                             (* ; 
+
     "If this is a piece on an open file, close it, since we're never going to read from it again.")

+                                                                        (REPLACE
 PFILE
+                                                                           OF
 PC WITH
 NEWFILE
+                                                                               )
+                                                                        (REPLACE
 PSTR
+                                                                           OF
 PC WITH
 NIL]
+                             (CLOSEF? OFILE)
+                             (REPLACE
 (TEXTOBJ TXTFILE) OF
 TEXTOBJ WITH
 NIL])
+)
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+
+(CL:UNLESS (GET 'TEDITDECLS 'FILE)
+       (FILESLOAD TEDITDECLS))
+
+
+(FILESLOAD (SOURCE)
+       LAFITEDECLS)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS *TEDIT-FILE-READTABLE*)
+)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(LOCALVARS . T)
+)
+)
+(PUTPROPS LAFITETEDIT COPYRIGHT ("Xerox Corporation" 1988 1990 1992))
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (1342 11940 (LA.ADJUST.FORMATTING 1352 . 7488) (LA.SKIP.LOOKS.LIST 7490 . 8064) (
+LA.DETACH.TEDIT 8066 . 8431) (LA.TEDIT.INCLUDE 8433 . 8922) (LA.WINDOW.FROM.TEXTSTREAM 8924 . 9370) (
+TEDIT.ASSURE.NO.BACKING.FILE 9372 . 11938)))))
+STOP

library/lafite/NSMAIL

@@ -0,0 +1,384 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
(FILECREATED " 6-Aug-93 17:14:21" {DSK}<archive>lafite>sources>nsmail.;34
 48519  
+
+      changes to%:  (VARS NSMAILCOMS) (FILES LLNSDECLS) (FNS \NSMAIL.MESSAGE.FROM.SELF.P \NSMAIL.PARSE1 \NSMAIL.MAKE.MAILSERVERS)
+
+      previous date%: "26-May-92 11:56:11" {DSK}<archive>lafite>sources>nsmail.;30)
+
+
+(* ; "
+Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1992, 1993 by Xerox Corporation.  All rights reserved.
+")
+
+(PRETTYCOMPRINT NSMAILCOMS)
+
+(RPAQQ NSMAILCOMS ((* ;; "Stuff used by both NEWNSMAIL & OLDNSMAIL") (COMS (* ; "Support of authentication") (FNS \NSMAIL.LOGIN NS.FINDMAILBOXES \NSMAIL.MAKE.MAILSERVERS \NSMAIL.FIX.MAILBOX.LOCATIONS)) (COMS (* ; "Utilities") (FNS \NSMAIL.CHECK.SERIALIZED.VERSION \NSMAIL.READ.SERIALIZED.CONTENT \NSMAIL.DISCARD.SERIALIZED.CONTENT \NSMAIL.READ.STRING.AS.STREAM) (* ; "Error handling") (FNS \NSMAIL.COURIER.OPEN \NSMAIL.ERRORHANDLER \NSMAIL.SIGNAL.ERROR) (INITVARS (NSMAILDEBUGFLG) (NSMAIL.HEADER.ORDER (QUOTE (Date Sender From Subject In-Reply-to To cc Message-ID Reply-to))))) (COMS (* ; "Handling attachments as a special kind of image object") (FNS \MAILOBJ.CREATE \MAILOBJ.TYPE.NAME \MAILOBJ.NS.TO.LISP.NAME \MAILOBJ.DISPLAY \MAILOBJ.GET \MAILOBJ.IMAGEBOX \MAILOBJ.PUT \MAILOBJ.INIT) (FNS \MAILOBJ.BUTTONEVENTFN \MAILOBJ.DO.COMMAND \MAILOBJ.HARDCOPY \MAILOBJ.FB \MAILOBJ.PUT.FILE \MAILOBJ.VIEW \MAILOBJ.MUNGE.NAME \MAILOBJ.COPY.BODY \MAILOBJ.EXPAND \MAILOBJ.COPY.CHILD \MAILOBJ.COPY.SEQUENCE \MAILOBJ.EXTRACT.TEXT \MAILOBJ.PARSE.ATTRIBUTES) (ADDVARS (FILING.TYPES (VIEWPOINT 4353) (RES 4428) (XEROX860 5120) (REFERENCE 4427) (MAILFOLDER 4417))) (VARS MAILOBJ.REFERENCE.FIELD) (INITVARS (MAILOBJ.WINDOWOFFSET 16) (MAILOBJ.SKIPCHAR (CHARCODE "."))) (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS MAILOBJ) (CONSTANTS \MAILOBJ.REFERENCE.LAST.FILED)) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\MAILOBJ.INIT) (AND (EQ MAKESYSNAME :LYRIC) (FILESLOAD (SYSLOAD) NSRANDOM))))) (COMS (FNS \NSMAIL.WRITE.ATTRIBUTE) (DECLARE%: EVAL@COMPILE DOCOPY (VARS \NSMAIL.ATTRIBUTES))) (COMS (* ; "sending mail") (FNS \NSMAIL.PARSE.REFERENCE \NSMAIL.EXPAND.DL \NSMAIL.PARSE \NSMAIL.PARSE1 NS.REMOVEDUPLICATES \NSMAIL.GUESS.FILE.TYPE COURIER.WRITE.STREAM.UNSPECIFIED \NSMAIL.SEND.STREAM.AS.STRING) (FILES LAFITEMAIL) (* ; "for LAFITE.MAKE.PARSE.TABLE") (VARS NSMAIL.PARSEFIELDS (\LAPARSE.NSMAIL (LAFITE.MAKE.PARSE.TABLE NSMAIL.PARSEFIELDS))) (GLOBALVARS \LAPARSE.NSMAIL) (INITVARS (NSMAIL.NET.HINT) (*NSMAIL-MAX-NOTE-LENGTH* 8000) (*NSMAIL-CACHE-TIMEOUT* 14400000) (*NSMAIL-GENEROUS-SELF-TEST* T) (LAFITEDL.EXT "DL")) (P (CL:PROCLAIM (QUOTE (GLOBAL NSMAIL.NET.HINT *NSMAIL-MAX-NOTE-LENGTH* *NSMAIL-CACHE-TIMEOUT* *NSMAIL-GENEROUS-SELF-TEST*)))) (FNS \NSMAIL.MESSAGE.P \NSMAIL.MESSAGE.FROM.SELF.P \NSMAIL.MAKEANSWERFORM \NSMAIL.PRINT.NAMES)) (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS NSMAILBOX NSMAILSTATE NSMAILPARSE) (CONSTANTS \NSMAIL.SOCKET \SERIALIZED.FILE.VERSION \SERIALIZED.FILE.VERSIONS \NSMAIL.TEXT.BODYTYPE \NSMAIL.EMPTY.BODYTYPE \NSMAIL.REFERENCE.BODYTYPE MAX.BULK.SEGMENT.LENGTH) (MACROS \NSMAIL.ATTRIBUTE.TYPE \NSMAIL.WRITE.ATTRIBUTE \NSMAIL.WRITE.ATTRIBUTE.MACRO) (PROP INFO \NSMAIL.ATTRIBUTE.TYPE) (GLOBALVARS *NSMAIL-OP-VECTOR* DEFAULTICONFONT FILING.TYPES MAILOBJ.REFERENCE.FIELD MAILOBJ.SKIPCHAR MAILOBJ.WINDOWOFFSET NSMAIL.HEADER.ORDER NSMAIL.NET.HINT NSMAILDEBUGFLG NSPRINT.WATCHERFLG NSWIZARDFLG \MAILOBJ.IMAGEFNS \NSFILING.ATTRIBUTES \NSMAIL.ATTRIBUTES) (FILES (SOURCE) LAFITEDECLS LLNSDECLS) (* ;; "LLNSDECLS to get NSADDRESS, needed by \NSMAIL.SIGNAL.ERROR") (LOCALVARS . T))))
+
+
+
+(* ;; "Stuff used by both NEWNSMAIL & OLDNSMAIL")

+
+
+
+
+(* ; "Support of authentication")

+
+(DEFINEQ
+
+(\NSMAIL.LOGIN

+(LAMBDA NIL (* ; "Edited  7-Jun-88 19:37 by bvm") (if (LAFITE.PROMPT.FOR.LOGIN (QUOTE |NS::|)) then (* ; "Got the login, now authenticate") (\LAFITE.GET.USER.DATA (QUOTE NS) NIL T) (\LAFITE.WAKE.WATCHER)))
+)
+
+(NS.FINDMAILBOXES

+(LAMBDA (USERNAME) (* ; "Edited 18-Jul-88 12:55 by bvm") (LET ((MAILBOXENTRY (CH.RETRIEVE.ITEM (PARSE.NSNAME USERNAME) (CH.PROPERTY (QUOTE MAILBOXES)) (QUOTE MAILBOX.VALUES)))) (AND MAILBOXENTRY (for MB in (COURIER.FETCH (CLEARINGHOUSE . MAILBOX.VALUES) MAIL.SERVICE of (CADR MAILBOXENTRY)) when (SETQ MB (COND ((LOOKUP.NS.SERVER MB NIL T)) (T (PRINTOUT PROMPTWINDOW T "Cannot find address for mail server " MB) NIL))) collect MB))))
+)
+
+(\NSMAIL.MAKE.MAILSERVERS

+(LAMBDA (SERVERS FULLNAME CREDENTIALS) (* ; "Edited 16-Aug-89 16:05 by bvm") (* ;; "Return a list of mail server info for insertion in the MAILSERVERS slot of NS mode.  Each element of SERVERS is of the form (name . addresses)") (if (NULL SERVERS) then (printout PROMPTWINDOW T "There are no mail servers for user " (NSNAME.TO.STRING FULLNAME T)) NIL else (for PAIR in SERVERS bind (FIRSTTIME _ T) collect (create MAILSERVER MAILPORT _ (CADR PAIR) MAILSERVERNAME _ (CAR PAIR) MAILSERVEROPS _ *NSMAIL-OP-VECTOR* MAILSTATE _ (create NSMAILSTATE STATENAME _ FULLNAME STATEADDRESS _ (CADR PAIR) STATECREDENTIALS _ CREDENTIALS STATETIMER _ (if FIRSTTIME then (* ; "Only need a timer on the first server") (SETQ FIRSTTIME NIL) (SETUPTIMER *NSMAIL-CACHE-TIMEOUT*)))))))
+)
+
+(\NSMAIL.FIX.MAILBOX.LOCATIONS

+(LAMBDA NIL (* ; "Edited 16-Aug-89 16:21 by bvm") (* ;; "Called when we think user's mailboxes may have moved.  If they have, sets new info into NS mode and returns T.") (LET ((OLDDATA (\LAFITE.GET.USER.DATA (QUOTE NS))) OLDSERVERS NEWSERVERS FULLNAME) (if (AND OLDDATA (SETQ OLDSERVERS (fetch (LAFITEMODEDATA MAILSERVERS) of OLDDATA))) then (* ; "Actually, if we got here at all, OLDSERVERS surely is non-NIL.  The check is for sanity.") (SETQ NEWSERVERS (NS.FINDMAILBOXES (SETQ FULLNAME (fetch (LAFITEMODEDATA UNPACKEDUSERNAME) of OLDDATA)))) (LET ((STATE (fetch (MAILSERVER MAILSTATE) of (CAR OLDSERVERS)))) (* ; "Reset the timer that tells us when next to check on location.") (replace STATETIMER of STATE with (SETUPTIMER (if NEWSERVERS then *NSMAIL-CACHE-TIMEOUT* else (* ; "Couldn't find servers?  Try again soon") 60000) (fetch STATETIMER of STATE)))) (if (AND NEWSERVERS (OR (NOT (EQ (LENGTH NEWSERVERS) (LENGTH OLDSERVERS))) (for SERVER in OLDSERVERS as PAIR in NEWSERVERS thereis (OR (NOT (EQUAL.CH.NAMES (CAR PAIR) (fetch MAILSERVERNAME of SERVER))) (NOT (for I from 0 to 4 bind (SERVERADDR _ (fetch MAILPORT of SERVER)) (PAIRADDR _ (CADR PAIR)) always (EQ (\GETBASE SERVERADDR I) (\GETBASE PAIRADDR I)))))))) then (* ;; "Yes, mailbox info is different.  Fix it up.  Note that we do nothing if no mail servers were found.  This is to avoid screwing up when we failed to talk to a clearinghouse (since otherwise we would find ourselves with no servers, hence nobody to wake up periodically and find out where the servers have moved to).  If only CH.RETRIEVE.ITEM could give us an error return in that case...") (replace (LAFITEMODEDATA MAILSERVERS) of OLDDATA with (\NSMAIL.MAKE.MAILSERVERS NEWSERVERS FULLNAME (fetch (LAFITEMODEDATA CREDENTIALS) of OLDDATA))) T))))
+)
+)
+
+
+
+(* ; "Utilities")

+
+(DEFINEQ
+
+(\NSMAIL.CHECK.SERIALIZED.VERSION

+(LAMBDA (STREAM) (* ; "Edited  5-May-89 14:47 by bvm") (LET ((V (COURIER.READ STREAM NIL (QUOTE LONGCARDINAL)))) (SELECTC V (\SERIALIZED.FILE.VERSIONS T) (HELP (CL:FORMAT NIL "Lafite does not understand serialized file version ~D.
+RETURN to attempt retrieval anyway." V))))))
+
+(\NSMAIL.READ.SERIALIZED.CONTENT

+(LAMBDA (INSTREAM OUTSTREAM) (* ; "Edited 17-Jan-89 17:14 by bvm") (* ;;; "Interprets INSTREAM as SerializedTree.Content, i.e., as a Bulkdata.StreamOfUnspecified followed by the lastByteIsSignificant flag.  Copies the raw data therein to OUTSTREAM") (bind LASTSEGMENT? BYTE BYTECOUNT do (SETQ LASTSEGMENT? (NEQ (\WIN INSTREAM) 0)) (COND ((NEQ (SETQ BYTECOUNT (UNFOLD (\WIN INSTREAM) BYTESPERWORD)) 0) (RPTQ (SUB1 BYTECOUNT) (\BOUT OUTSTREAM (\BIN INSTREAM))) (SETQ BYTE (\BIN INSTREAM)) (* ; "Final byte of this segment.  Don't copy until we know whether it's significant") (COND ((OR (NULL LASTSEGMENT?) (NEQ (\WIN INSTREAM) 0)) (* ; "Not last segment, or the word after says the final byte was significant") (\BOUT OUTSTREAM BYTE)))) (LASTSEGMENT? (* ; "Null body.  Throw out the lastByteIsSignificant flag") (\WIN INSTREAM))) repeatuntil LASTSEGMENT?))
+)
+
+(\NSMAIL.DISCARD.SERIALIZED.CONTENT

+(LAMBDA (INSTREAM) (* ; "Edited 17-Jan-89 17:17 by bvm") (* ;;; "Interprets INSTREAM as SerializedTree.Content, i.e., as a Bulkdata.StreamOfUnspecified followed by the lastByteIsSignificant flag and discards it all") (do (if (NEQ (PROG1 (\WIN INSTREAM) (RPTQ (UNFOLD (\WIN INSTREAM) BYTESPERWORD) (\BIN INSTREAM))) 0) then (* ; "Finished.  Read the lastByteIsSignificant flag") (\WIN INSTREAM) (RETURN))))
+)
+
+(\NSMAIL.READ.STRING.AS.STREAM

+(LAMBDA (INSTREAM OUTSTREAM) (* bvm%: "30-Jul-84 16:13") (* ;; "Considers INSTREAM to be positioned at a sequence of unspecified, and reads it as if its datatype were string, and copies said bytes to OUTSTREAM") (PROG (LENGTH) (\WIN INSTREAM) (* ; "Skip sequence count") (COPYBYTES INSTREAM OUTSTREAM (SETQ LENGTH (\WIN INSTREAM))) (COND ((ODDP LENGTH) (\BIN INSTREAM)))))
+)
+)
+
+
+
+(* ; "Error handling")

+
+(DEFINEQ
+
+(\NSMAIL.COURIER.OPEN

+(LAMBDA (ADDRESS) (* ; "Edited  9-Sep-88 12:06 by bvm") (COURIER.OPEN ADDRESS NIL T (QUOTE NSMAIL) NIL (CONSTANT (LIST (QUOTE ERRORHANDLER) (FUNCTION \NSMAIL.ERRORHANDLER)))))
+)
+
+(\NSMAIL.ERRORHANDLER

+(LAMBDA (STREAM ERRCODE) (* ; "Edited  9-Sep-88 12:35 by bvm") (* ;; "Called when SPP error occurs on NS mail courier connection STREAM.  Fakes an error return from the courier.call.") (LET (POS) (if (AND (EQ ERRCODE (QUOTE STREAM.LOST)) (SETQ POS (STKPOS (FUNCTION COURIER.CALL)))) then (BLOCK 500) (RETFROM POS (QUOTE (ERROR STREAM.LOST)) T) else (\SPP.DEFAULT.ERRORHANDLER STREAM ERRCODE))))
+)
+
+(\NSMAIL.SIGNAL.ERROR

+(LAMBDA (ERROR MAILBOX PROGRAM PROCEDURE) (* ; "Edited  9-Sep-88 12:37 by bvm") (* ;; "Called when we get an error on an NS mail courier call.  If stream lost, then tries to reestablish the connection, returning a new stream on success.") (if (EQ (CADR ERROR) (QUOTE STREAM.LOST)) then (PRINTOUT PROMPTWINDOW T "Lost NS mail connection, trying to reestablish...") (LET ((STREAM (\NSMAIL.COURIER.OPEN (create NSADDRESS using (SPP.DESTADDRESS (fetch NSMAILSTREAM of MAILBOX)) NSSOCKET _ 0)))) (if STREAM then (PRINTOUT PROMPTWINDOW "done.") (replace NSMAILSTREAM of MAILBOX with STREAM) else (PRINTOUT PROMPTWINDOW "failed.") (ERROR "NS mail connection lost, can't reestablish"))) else (COURIER.SIGNAL.ERROR PROGRAM PROCEDURE ERROR)))
+)
+)
+
+(RPAQ? NSMAILDEBUGFLG)
+
+(RPAQ? NSMAIL.HEADER.ORDER (QUOTE (Date Sender From Subject In-Reply-to To cc Message-ID Reply-to)))
+
+
+
+(* ; "Handling attachments as a special kind of image object")

+
+(DEFINEQ
+
+(\MAILOBJ.CREATE

+(LAMBDA (DATA TYPE ATTR.LENGTH NAME MORE.INFO START) (* ; "Edited 14-Feb-90 16:59 by bvm") (* ;; "Create a mail object encapsulating data (a core file in serialized file format).  TYPE is the type of the serialized data.") (OR START (SETQ START 0)) (LET* ((TITLE (SELECTQ TYPE (REFERENCE (* ; "Reference to a file.") (if (NOT MORE.INFO) then (* ; "Try parsing the reference info--returns (REFERENCE info)") (LET* ((INFO (CADR (\MAILOBJ.PARSE.ATTRIBUTES DATA (LIST MAILOBJ.REFERENCE.FIELD) START))) (TYPE (\TYPE.FROM.FILETYPE (CADR (ASSOC (QUOTE TYPE) INFO))))) (SETQ NAME (\MAILOBJ.NS.TO.LISP.NAME (CADR (ASSOC (QUOTE HOST) INFO)) (CADR (ASSOC (QUOTE DIRECTORY) INFO)) (CADR (ASSOC (QUOTE NAME) INFO)) (AND (NEQ (CADR (ASSOC (QUOTE FLAGS) INFO)) \MAILOBJ.REFERENCE.LAST.FILED) (CADR (ASSOC (QUOTE VERSION) INFO))) (EQ TYPE (QUOTE DIRECTORY)))) (SETQ MORE.INFO (BQUOTE (FILE.ID (\, (CADR (ASSOC (QUOTE FILE.ID) INFO))) TYPE (\, TYPE)))))) (CL:FORMAT NIL "Reference to ~A ~A" (\MAILOBJ.TYPE.NAME (LISTGET MORE.INFO (QUOTE TYPE))) NAME)) (if NAME then (CONCAT NAME " (" (\MAILOBJ.TYPE.NAME TYPE T) ")") else (\MAILOBJ.TYPE.NAME TYPE)))) (TITLELEN (NCHARS TITLE)) (FONT (AND (> TITLELEN 20) (LET* ((FONT DEFAULTICONFONT) (SIZE (FONTPROP FONT (QUOTE SIZE)))) (* ; "Use a smaller font if available") (if (> TITLELEN 30) then (* ; "This is really getting out of hand...") (SETQ TITLE (CONCAT (SUBSTRING TITLE 1 25) "..."))) (AND (> SIZE 8) (CAR (NLSETQ (FONTCOPY FONT (QUOTE SIZE) (- SIZE 2)))))))) (IMAGE (WINDOWPROP (TITLEDICONW NIL TITLE FONT (QUOTE (0 . 0)) T NIL (QUOTE FILE)) (QUOTE ICONIMAGE)))) (* ; "Crude way of getting a bitmap with some text printed on it nicely") (IMAGEOBJCREATE (create MAILOBJ MAILOBJ.IMAGE _ IMAGE MAILOBJ.BOX _ (create IMAGEBOX XSIZE _ (BITMAPWIDTH IMAGE) YSIZE _ (BITMAPHEIGHT IMAGE) YDESC _ (LRSH (BITMAPHEIGHT IMAGE) 1) XKERN _ 0) MAILOBJ.TYPE _ TYPE MAILOBJ.DATA _ DATA MAILOBJ.ATTR.LENGTH _ ATTR.LENGTH MAILOBJ.START _ START MAILOBJ.NAME _ NAME MAILOBJ.INFO _ MORE.INFO MAILOBJ.EXPANDABLE _ (PROGN (* ; "True if object has children") (CADR (\MAILOBJ.PARSE.ATTRIBUTES DATA (CONSTANT (LIST (ASSOC (QUOTE IS.DIRECTORY) \NSFILING.ATTRIBUTES))) START)))) \MAILOBJ.IMAGEFNS)))
+)
+
+(\MAILOBJ.TYPE.NAME

+(LAMBDA (TYPE SHORT) (* ; "Edited 29-Sep-87 14:21 by bvm:") (* ;; "Translate filing TYPE into a descriptive string, e.g., %"Interpress Document%".  If SHORT is true, leave out %"Document%".  If TYPE is numeric, it is rendered as %"Type nnn Document%".") (if (EQ TYPE (QUOTE DIRECTORY)) then (* ; "Viewpoint calls these %"folders%"") "Viewpoint Folder" else (CL:FORMAT NIL "~:[~:(~A~)~;Type ~D~]~@[ Document~]" (FIXP TYPE) TYPE (NOT SHORT))))
+)
+
+(\MAILOBJ.NS.TO.LISP.NAME

+(LAMBDA (HOST DIRECTORY NAME VERSION DIRECTORYFLG) (* ; "Edited 29-Sep-87 17:54 by bvm:") (* ;; "Turn these pieces parsed out of a reference icon into a Lisp-style file name.  Mainly this means turning the slashes into angles.  This code is stolen from \NSFILING.FULLNAME, which is what we would use if it didn't require a filing session arg.") (LET ((PATHNAME (if DIRECTORYFLG then (CONCAT DIRECTORY "/" NAME (if (AND VERSION (NEQ VERSION 1)) then (CONCAT "!" VERSION) else "")) else DIRECTORY)) FILENAME DIRLST FULLNAME FUNNYCHAR DOTSEEN QUOTEDDIRS) (for I from 1 bind CH (START _ 1) while (SETQ CH (NTHCHARCODE PATHNAME I)) do (SELCHARQ CH (%' (* ; "quote mark, skip it and next char") (add I 1)) (/ (* ; "Directory marker") (push DIRLST (SUBSTRING PATHNAME START (SUB1 I))) (SETQ START (ADD1 I))) ((; %: < > } %]) (* ; "Funny characters that filing doesn't care about but we do -- need to quote these") (SETQ FUNNYCHAR T)) NIL) finally (push DIRLST (SUBSTRING PATHNAME START))) (* ;; "DIRLST is in reverse order now.") (for DIR in DIRLST do (push QUOTEDDIRS (COND (FUNNYCHAR (\NSFILING.ADDQUOTES DIR T)) (T DIR)) (QUOTE >))) (CONCATLIST (NCONC (LIST (QUOTE {) HOST "}<") QUOTEDDIRS (AND (NOT DIRECTORYFLG) (CONS (\NSFILING.ADDQUOTES NAME) (AND VERSION (LIST (if (STRPOS "." NAME) then ";" else ".;") VERSION))))))))
+)
+
+(\MAILOBJ.DISPLAY

+(LAMBDA (OBJ STREAM) (* ; "Edited 29-Jun-87 17:34 by bvm:") (LET ((IMAGE (fetch MAILOBJ.IMAGE of (fetch OBJECTDATUM of OBJ)))) (* ; "Display the image, centered on the baseline") (BITBLT IMAGE NIL NIL STREAM (DSPXPOSITION NIL STREAM) (- (DSPYPOSITION NIL STREAM) (LRSH (BITMAPHEIGHT IMAGE) 1)))))
+)
+
+(\MAILOBJ.GET

+(LAMBDA (STREAM TEXTSTREAM) (* ; "Edited 14-Feb-90 16:50 by bvm") (DESTRUCTURING-BIND (LEN TYPE ATTR.LEN NAME . INFO) (READ STREAM FILERDTBL) (LET (DATASTREAM START) (if (EQ (fetch DEVICENAME of (fetch (STREAM DEVICE) of STREAM)) (QUOTE NODIRCORE)) then (* ; "No need to copy the data, just copy the cover") (SETQ DATASTREAM (NCREATE (QUOTE STREAM) STREAM)) (SETQ START (GETFILEPTR STREAM)) (LET ((EOF (+ START LEN))) (* ; "Fix the eof so we don't have to carry around the length") (replace (STREAM EPAGE) of DATASTREAM with (FOLDLO EOF BYTESPERPAGE)) (replace (STREAM EOFFSET) of DATASTREAM with (IMOD EOF BYTESPERPAGE))) else (SETQ DATASTREAM (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH))) (COPYBYTES STREAM DATASTREAM LEN) (SETQ START 0)) (\MAILOBJ.CREATE DATASTREAM TYPE ATTR.LEN NAME INFO START))))
+)
+
+(\MAILOBJ.IMAGEBOX

+(LAMBDA (OBJ) (* ; "Edited 29-Jun-87 16:57 by bvm:") (fetch MAILOBJ.BOX of (fetch OBJECTDATUM of OBJ)))
+)
+
+(\MAILOBJ.PUT

+(LAMBDA (OBJ STREAM) (* ; "Edited 14-Feb-90 16:16 by bvm") (LET* ((MAILOBJ (fetch OBJECTDATUM of OBJ)) (COREFILE (fetch MAILOBJ.DATA of MAILOBJ)) (END (GETEOFPTR COREFILE)) (START (fetch MAILOBJ.START of MAILOBJ))) (LET ((*PRINT-BASE* 10) (*READTABLE FILERDTBL) (NAME (fetch MAILOBJ.NAME of MAILOBJ)) (INFO (fetch MAILOBJ.INFO of MAILOBJ))) (* ; "Make sure we can read it back.") (PRIN4 (LIST* (- END START) (fetch MAILOBJ.TYPE of MAILOBJ) (fetch MAILOBJ.ATTR.LENGTH of MAILOBJ) (AND (OR NAME INFO) (CONS NAME INFO))) STREAM)) (COPYBYTES COREFILE STREAM START END)))
+)
+
+(\MAILOBJ.INIT

+(LAMBDA NIL (* ; "Edited 29-Jun-87 16:36 by bvm:") (SETQ \MAILOBJ.IMAGEFNS (IMAGEFNSCREATE (FUNCTION \MAILOBJ.DISPLAY) (FUNCTION \MAILOBJ.IMAGEBOX) (FUNCTION \MAILOBJ.PUT) (FUNCTION \MAILOBJ.GET) (FUNCTION CL:IDENTITY) (FUNCTION \MAILOBJ.BUTTONEVENTFN))))
+)
+)
+(DEFINEQ
+
+(\MAILOBJ.BUTTONEVENTFN

+(LAMBDA (OBJ WINDOWSTREAM SELECTION RELX RELY WINDOW TEXTSTREAM BUTTON) (* ; "Edited 15-Aug-89 17:44 by bvm") (if (.COPYKEYDOWNP.) then (* ; "There's more to copy selection than this") (AND NIL (LET ((NAME (fetch MAILOBJ.NAME of (IMAGEOBJPROP OBJ (QUOTE OBJECTDATUM))))) (AND NAME (BKSYSBUF NAME)))) elseif (IMAGEOBJPROP OBJ (QUOTE BUSY)) then (* ; "Busy") (PRINTOUT PROMPTWINDOW T "Attachment is busy") else (LET* ((MAILOBJ (IMAGEOBJPROP OBJ (QUOTE OBJECTDATUM))) (TYPE (fetch MAILOBJ.TYPE of MAILOBJ)) (REAL.TYPE (if (EQ TYPE (QUOTE REFERENCE)) then (LISTGET (fetch MAILOBJ.INFO of MAILOBJ) (QUOTE TYPE)) else TYPE)) (CMD (MENU (create MENU ITEMS _ (BQUOTE (("View as text" (QUOTE \MAILOBJ.VIEW) "View the attachment as raw text, using TEdit") ((\, (if (EQ TYPE (QUOTE REFERENCE)) then (* ; "Note that we are storing the reference itself, not the referenced file") "Store reference" else "Put to file")) (QUOTE \MAILOBJ.PUT.FILE) "Store the attachment in a file.  This operation loses information unless the file is on an NS File Server.") (\,@ (AND (EQ REAL.TYPE (QUOTE INTERPRESS)) (QUOTE (("Send to Printer" (QUOTE \MAILOBJ.HARDCOPY) "Send the document to the printer of your choice."))))) (\,@ (AND (fetch MAILOBJ.EXPANDABLE of MAILOBJ) (QUOTE (("Expand folder" (QUOTE \MAILOBJ.EXPAND) "Extract the first-level subparts of the folder"))))) (\,@ (SELECTQ TYPE (REFERENCE (AND (GETD (QUOTE FILEBROWSER)) (EQ (NTHCHARCODE (fetch MAILOBJ.NAME of MAILOBJ) -1) (CHARCODE >)) (BQUOTE (("FileBrowse" (QUOTE \MAILOBJ.FB) "Invoke the File Browser on the referenced object"))))) NIL)))) CENTERFLG _ T)))) (if (NULL CMD) then (* ; "Nothing selected; allow TEdit to select") T else (* ; "Do the command in its own process so that the window can return to its more natural state (instead of severely clipped)") (ADD.PROCESS (LIST (FUNCTION \MAILOBJ.DO.COMMAND) (KWOTE CMD) (KWOTE OBJ) (KWOTE WINDOW) (KWOTE TEXTSTREAM)) (QUOTE NAME) (QUOTE MAILOBJ) (QUOTE RESTARTABLE) (QUOTE HARDRESET) (QUOTE BEFOREEXIT) (QUOTE DON'T)) (* ; "Return DON'T so that the window doesn't pop on top to select") (QUOTE DON'T)))))
+)
+
+(\MAILOBJ.DO.COMMAND

+(LAMBDA (CMD OBJ WINDOW TEXTSTREAM) (* ; "Edited  3-Jul-87 17:51 by bvm:") (RESETLST (RESETSAVE (IMAGEOBJPROP OBJ (QUOTE BUSY) T) (LIST (QUOTE IMAGEOBJPROP) OBJ (QUOTE BUSY) NIL)) (CL:FUNCALL CMD OBJ WINDOW TEXTSTREAM)))
+)
+
+(\MAILOBJ.HARDCOPY

+(LAMBDA (OBJ WINDOW) (* ; "Edited 14-Feb-90 17:08 by bvm") (* ;; "Hardcopy the attachment in MAILOBJ.  WINDOW is the window in which we are viewing it (not currently used).") (LET* ((*UPPER-CASE-FILE-NAMES* NIL) (PRINTER (GetPrinterName)) (MAILOBJ (IMAGEOBJPROP OBJ (QUOTE OBJECTDATUM))) (REFP (EQ (fetch MAILOBJ.TYPE of MAILOBJ) (QUOTE REFERENCE))) ATTRIBUTES PRINTRESULTS NAME DATA START) (if (NULL PRINTER) then (* ; "abort") NIL elseif (NOT (STRPOS ":" PRINTER)) then (* ; "not ns") (PRINTOUT PROMPTWINDOW T PRINTER " is not an Interpress printer") else (SETQ PRINTER (GETNSPRINTER PRINTER)) (if REFP then (NSPRINT PRINTER (SETQ NAME (fetch MAILOBJ.NAME of MAILOBJ))) else (* ; "Have to do this by hand, since we don't have a nice standalone stream") (SETQ ATTRIBUTES (\MAILOBJ.PARSE.ATTRIBUTES (SETQ DATA (fetch MAILOBJ.DATA of MAILOBJ)) (CONSTANT (BQUOTE ((DOCUMENT.NAME (\,@ (CDR (ASSOC (QUOTE NAME) \NSFILING.ATTRIBUTES)))) (DOCUMENT.CREATION.DATE (\,@ (CDR (ASSOC (QUOTE CREATED.ON) \NSFILING.ATTRIBUTES))))))) (SETQ START (fetch MAILOBJ.START of MAILOBJ)))) (* ; "Parse out the name and creation date, and use them for the document name/date") (if (SETQ NAME (LISTGET ATTRIBUTES (QUOTE DOCUMENT.NAME))) then (* ; "Fix up any wayward subject") (LISTPUT ATTRIBUTES (QUOTE DOCUMENT.NAME) (SETQ NAME (\MAILOBJ.MUNGE.NAME NAME)))) (SETQ PRINTRESULTS (\NSPRINT.INTERNAL PRINTER ATTRIBUTES (FUNCTION (LAMBDA (DATASTREAM) (\MAILOBJ.COPY.BODY DATA DATASTREAM (+ START (fetch MAILOBJ.ATTR.LENGTH of MAILOBJ))) NIL)))) (if (AND PRINTRESULTS NSPRINT.WATCHERFLG) then (* ; "Set up a 'watchdog' process to keep the guy informed of the print job's status.") (\NSPRINT.WATCH.JOB PRINTRESULTS PRINTER NAME))) (PRINTOUT PROMPTWINDOW T NAME " sent to " (fetch NSOBJECT of (CAR PRINTER))))))
+)
+
+(\MAILOBJ.FB

+(LAMBDA (OBJ WINDOW) (* ; "Edited 29-Sep-87 17:33 by bvm:") (* ;; "Invoke the File Browser on the referenced object") (FILEBROWSER (fetch MAILOBJ.NAME of (IMAGEOBJPROP OBJ (QUOTE OBJECTDATUM)))))
+)
+
+(\MAILOBJ.PUT.FILE

+(LAMBDA (OBJ WINDOW) (* ; "Edited 14-Feb-90 16:20 by bvm") (* ;; "Store the attachment of MAILOBJ as file of user's choosing.  Prompt for file name.  If it's on an NS directory, we can deserialize and thus preserve the whole thing.") (LET* ((MAILOBJ (IMAGEOBJPROP OBJ (QUOTE OBJECTDATUM))) (DATA (fetch MAILOBJ.DATA of MAILOBJ)) (START (fetch MAILOBJ.START of MAILOBJ)) (PW (CREATEW (create REGION LEFT _ LASTMOUSEX BOTTOM _ LASTMOUSEY WIDTH _ (WINDOWPROP WINDOW (QUOTE WIDTH)) HEIGHT _ (HEIGHTIFWINDOW (TIMES 4 (FONTPROP DEFAULTFONT (QUOTE HEIGHT))) NIL 8)) NIL 8)) FILE DEVICE CONDITION) (if (NULL (SETQ FILE (TTYINPROMPTFORWORD "Put attachment to file: " NIL NIL PW NIL (QUOTE TTY) (CHARCODE (CR))))) then (PRINTOUT PW "...aborted") elseif (NULL (SETQ DEVICE (\GETDEVICEFROMNAME (SETQ FILE (\ADD.CONNECTED.DIR FILE)) T))) then (PRINTOUT PW T "No such server/device") else (ALLOW.BUTTON.EVENTS) (PRINTOUT PW " ... ") (if (CL:MULTIPLE-VALUE-SETQ (FILE CONDITION) (IGNORE-ERRORS (if (EQ (fetch OPENFILE of DEVICE) (FUNCTION \NSFILING.OPENFILE)) then (* ; "NS device.  Really need better test than this.") (SETFILEPTR DATA START) (LET ((*UPPER-CASE-FILE-NAMES* NIL)) (DECLARE (CL:SPECIAL *UPPER-CASE-FILE-NAMES*)) (* ; "Get name pretty") (\NSFILING.DESERIALIZE FILE DATA DEVICE)) else (SETQ FILE (OPENSTREAM FILE (QUOTE OUTPUT) (QUOTE NEW) (BQUOTE ((TYPE (\, (fetch MAILOBJ.TYPE of MAILOBJ))) (SEQUENTIAL T))))) (PRINTOUT PW "(some attributes will be lost) ") (\MAILOBJ.COPY.BODY DATA FILE (+ START (fetch MAILOBJ.ATTR.LENGTH of MAILOBJ)) PW) (CLOSEF FILE)))) then (PRINTOUT PW T FILE " written.") else (PRINTOUT PW "failed: " CONDITION)))))
+)
+
+(\MAILOBJ.VIEW

+(LAMBDA (OBJ WINDOW) (* ; "Edited 14-Feb-90 16:24 by bvm") (* ;; "View the text of the attachment.   This is often enough to tell you whether you want to bother doing something more exciting with it.") (RESETLST (LET* ((MAILOBJ (IMAGEOBJPROP OBJ (QUOTE OBJECTDATUM))) (TYPE (fetch MAILOBJ.TYPE of MAILOBJ)) (REFP (EQ TYPE (QUOTE REFERENCE))) (WREG (WINDOWREGION (OR (CAR (WINDOWPROP WINDOW (QUOTE EXTRAWINDOWS))) WINDOW))) PROPS W SUBJECT START DATA DATASTART) (if REFP then (SETQ SUBJECT (fetch MAILOBJ.NAME of MAILOBJ)) (SETQ TYPE (LISTGET (fetch MAILOBJ.INFO of MAILOBJ) (QUOTE TYPE))) (SETQ START NIL) else (SETQ DATA (fetch MAILOBJ.DATA of MAILOBJ)) (SETQ SUBJECT (CADR (\MAILOBJ.PARSE.ATTRIBUTES DATA (CONSTANT (LIST (ASSOC (QUOTE NAME) \NSFILING.ATTRIBUTES))) (SETQ DATASTART (fetch MAILOBJ.START of MAILOBJ))))) (SETQ START (+ DATASTART (fetch MAILOBJ.ATTR.LENGTH of MAILOBJ)))) (SETQ W (CREATEW (create REGION using WREG LEFT _ (+ (fetch (REGION LEFT) of WREG) (if (> (+ (fetch (REGION LEFT) of WREG) (fetch (REGION WIDTH) of WREG) MAILOBJ.WINDOWOFFSET) SCREENWIDTH) then (- MAILOBJ.WINDOWOFFSET) else MAILOBJ.WINDOWOFFSET)) BOTTOM _ (- (fetch (REGION BOTTOM) of WREG) (if (< (- (fetch (REGION BOTTOM) of WREG) MAILOBJ.WINDOWOFFSET) 0) then (- MAILOBJ.WINDOWOFFSET) else MAILOBJ.WINDOWOFFSET))) (CONCAT "Attachment: " (\MAILOBJ.MUNGE.NAME SUBJECT)))) (* ; "Make window slightly overlapping display window") (WINDOWADDPROP WINDOW (QUOTE EXTRAWINDOWS) W T) (if (NEQ TYPE (QUOTE TEDIT)) then (* ; "TEdit's not so good on binary files, so just pull out the text.") (LET ((COMPACTDATA (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH)))) (if REFP then (RESETSAVE NIL (LIST (QUOTE CLOSEF) (SETQ DATA (OPENSTREAM SUBJECT (QUOTE INPUT) NIL (QUOTE ((SEQUENTIAL T))))))) else (SETFILEPTR DATA (+ DATASTART 4)) (* ; "Skip the version number (LONGCARDINAL).  Next comes SEQUENCE Filing.Attribute") (if NIL then (* ;; "First extract possible text from unknown attributes.  This is not really worth much, other than it skips the mail note, and it is completely the wrong thing on sub-mailobjs, for which none of the fields (except the subject) has been exposed.") (to (\WIN DATA) bind X TYPE do (SETQ TYPE (COURIER.READ DATA NIL (QUOTE LONGCARDINAL))) (if (find X in \NSMAIL.ATTRIBUTES suchthat (EQ (CADR X) TYPE)) then (* ; "Something of known type--it's probably in the message header.  Just skip it") (COURIER.SKIP.SEQUENCE DATA NIL (QUOTE UNSPECIFIED)) else (* ; "Unknown attribute--extract text from it in case it's interesting.  Next word is a count of words") (\MAILOBJ.EXTRACT.TEXT DATA COMPACTDATA (UNFOLD (\WIN DATA) BYTESPERWORD)))))) (\MAILOBJ.EXTRACT.TEXT DATA COMPACTDATA (- (\GETEOFPTR DATA) (GETFILEPTR DATA))) (SETQ DATA COMPACTDATA) (SETQ START NIL) (SETQ PROPS (LIST (QUOTE FONT) LAFITEDISPLAYFONT)))) (OPENTEXTSTREAM DATA W START (AND START (GETEOFPTR DATA)) (APPEND PROPS (QUOTE (PROMPTWINDOW DON'T)))))))
+)
+
+(\MAILOBJ.MUNGE.NAME

+(LAMBDA (STRING) (* ; "Edited 15-Aug-89 17:03 by bvm") (* ;; "Get rid of the CR's in string, substituting something more innocuous.") (if (OR (NULL STRING) (NOT (STRPOS "
+" STRING))) then STRING else (CL:SUBSTITUTE #\\ #\Newline STRING))))
+
+(\MAILOBJ.COPY.BODY

+(LAMBDA (INSTREAM OUTSTREAM START PW) (* ; "Edited  6-Jul-87 12:47 by bvm:") (SETFILEPTR INSTREAM START) (\NSMAIL.READ.SERIALIZED.CONTENT INSTREAM OUTSTREAM) (if (NEQ (\WIN INSTREAM) 0) then (PRINTOUT (OR PW PROMPTWINDOW) T "Warning: Attachment had children, which were not processed.")))
+)
+
+(\MAILOBJ.EXPAND

+(LAMBDA (OBJ WINDOW TEXTSTREAM) (* ; "Edited 14-Feb-90 17:19 by bvm") (LET* ((MAILOBJ (IMAGEOBJPROP OBJ (QUOTE OBJECTDATUM))) (DATA (fetch MAILOBJ.DATA of MAILOBJ)) (IMAGEPOS (TEDIT.FIND.OBJECT TEXTSTREAM OBJ)) NUMCHILDREN CHILDREN SUBDATA SUBSTART TYPE PARSE) (SETFILEPTR DATA (+ (fetch MAILOBJ.START of MAILOBJ) (fetch MAILOBJ.ATTR.LENGTH of MAILOBJ))) (\NSMAIL.DISCARD.SERIALIZED.CONTENT DATA) (* ; "Skip over the body of the folder (should be empty, actually)") (if (EQ (SETQ NUMCHILDREN (\WIN DATA)) 0) then (* ; "Why did it say it was a directory?") (PRINTOUT PROMPTWINDOW T "There is nothing in that 'folder' to expand!") else (to NUMCHILDREN do (* ; "copy each child into its own image obj") (SETQ SUBDATA (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH))) (COURIER.WRITE SUBDATA \SERIALIZED.FILE.VERSION NIL (QUOTE LONGCARDINAL)) (SETQ SUBSTART (\MAILOBJ.COPY.CHILD DATA SUBDATA)) (* ; "Copy recursive part") (SETQ PARSE (\MAILOBJ.PARSE.ATTRIBUTES SUBDATA (CONSTANT (LIST (ASSOC (QUOTE FILE.TYPE) \NSFILING.ATTRIBUTES) (ASSOC (QUOTE NAME) \NSFILING.ATTRIBUTES))) 0)) (SETQ TYPE (LISTGET PARSE (QUOTE FILE.TYPE))) (push CHILDREN (\MAILOBJ.CREATE SUBDATA (AND TYPE (\TYPE.FROM.FILETYPE TYPE)) SUBSTART (LISTGET PARSE (QUOTE NAME)))) (* ; "Create object, parsing the type field out of the raw data")) (add IMAGEPOS 1) (TEXTPROP TEXTSTREAM (QUOTE READONLY) (PROG1 (TEXTPROP TEXTSTREAM (QUOTE READONLY)) (TEXTPROP TEXTSTREAM (QUOTE READONLY) NIL) (* ; "This ought to be one call, but the macro does not expand properly") (for C in CHILDREN do (* ; "Insert the objects following obj in reverse order of creation, so they come out right in the end.") (TEDIT.INSERT.OBJECT C TEXTSTREAM IMAGEPOS)))))))
+)
+
+(\MAILOBJ.COPY.CHILD

+(LAMBDA (INSTREAM OUTSTREAM) (* ; "Edited  6-Jul-87 14:41 by bvm:") (* ;; "This is the counterpart to \nsmail.read.serialized.tree, except that it copies the data as it parses it, rather than interpreting it.  Returns file pointer of the start of the main child's data section.") (* ;; "We are parsing here the recursive part of Filing.SerializedFile: SerializedTree, which consists of: Sequence of Attribute;  Content;  children = Sequence of SerializedTree") (LET (ATTRLENGTH SUBSTART NCHILDREN LASTSEGMENT?) (\WOUT OUTSTREAM (SETQ ATTRLENGTH (\WIN INSTREAM))) (* ; "number of attributes") (to ATTRLENGTH do (RPTQ 4 (\BOUT OUTSTREAM (\BIN INSTREAM))) (* ; "Copy attribute type (longcardinal)") (\MAILOBJ.COPY.SEQUENCE INSTREAM OUTSTREAM) (* ; "Copy attribute value (sequence unspecified)")) (SETQ SUBSTART (GETFILEPTR OUTSTREAM)) (* ;; "Now copy the body, which is StreamOfUnspecified followed by lastByteIsSignficant boolean") (do (\WOUT OUTSTREAM (SETQ LASTSEGMENT? (\WIN INSTREAM))) (* ; "1 => this is last segment") (\MAILOBJ.COPY.SEQUENCE INSTREAM OUTSTREAM) (* ; "Copy the sequence") repeatuntil (NEQ LASTSEGMENT? 0) finally (\WOUT OUTSTREAM (\WIN INSTREAM)) (* ; "Copy lastByteIsSignficant boolean")) (\WOUT OUTSTREAM (SETQ NCHILDREN (\WIN INSTREAM))) (to NCHILDREN do (\MAILOBJ.COPY.CHILD INSTREAM OUTSTREAM)) SUBSTART))
+)
+
+(\MAILOBJ.COPY.SEQUENCE

+(LAMBDA (INSTREAM OUTSTREAM) (* ; "Edited  6-Jul-87 14:37 by bvm:") (* ;; "Copy a Sequence of Unspecified from in to out.") (LET ((SEQLENGTH (\WIN INSTREAM))) (\WOUT OUTSTREAM SEQLENGTH) (* ; "Representation is sequence length (word) followed by that many words") (RPTQ (UNFOLD SEQLENGTH BYTESPERWORD) (\BOUT OUTSTREAM (\BIN INSTREAM)))))
+)
+
+(\MAILOBJ.EXTRACT.TEXT

+(LAMBDA (DATA OUTSTREAM LEN) (* ; "Edited 15-Aug-89 16:38 by bvm") (* ;; "Copy LEN bytes from the stream DATA to OUTSTREAM, where all the runs of non-printing characters are replaced by some small number of ugly characters that won't upset tedit.") (to LEN bind CH HELDCH (SKIPPING _ -1) do (if (OR (>= (SETQ CH (\BIN DATA)) 127) (AND (< CH (CHARCODE SPACE)) (SELCHARQ CH ((TAB CR) NIL) ( (* ; "VP eol") (SETQ CH (CHARCODE CR)) NIL) T))) then (* ; "Junk") (SETQ HELDCH NIL) (* ; "I don't care if the previous byte was accidentally ascii") (if (EVENP (add SKIPPING 1) 16) then (BOUT OUTSTREAM MAILOBJ.SKIPCHAR)) elseif (< SKIPPING 0) then (* ; "in a nice ascii section") (BOUT OUTSTREAM CH) elseif HELDCH then (* ; "We were just waiting to see...") (BOUT OUTSTREAM HELDCH) (SETQ HELDCH NIL) (SETQ SKIPPING -1) (BOUT OUTSTREAM CH) else (* ; "We had been skipping.  Don't print this byte until we see the next byte is nice, too, so as to reduce the gibberish of accidental ascii in the middle of binary") (SETQ HELDCH CH))) OUTSTREAM)
+)
+
+(\MAILOBJ.PARSE.ATTRIBUTES

+(LAMBDA (DATA FIELDS START) (* ; "Edited 14-Feb-90 16:26 by bvm") (* ;; "Parse the SUBJECT field out of the serialized stream DATA beginning at START.  FIELDS is in the format of \nsfiling.attributes entries") (SETFILEPTR DATA (+ START 4)) (* ; "Skip the version number (LONGCARDINAL).  Next comes SEQUENCE Filing.Attribute") (to (\WIN DATA) bind (CNT _ (LENGTH FIELDS)) X TYPE do (SETQ TYPE (COURIER.READ DATA NIL (QUOTE LONGCARDINAL))) (if (find old X in FIELDS suchthat (EQ (CADR X) TYPE)) then (* ; "X = (type number interpretation)") (\WIN DATA) (push $$VAL (CAR X) (COURIER.READ DATA NIL (CADDR X))) (if (<= (SETQ CNT (SUB1 CNT)) 0) then (* ;; "Found them all") (RETURN $$VAL)) else (COURIER.SKIP.SEQUENCE DATA NIL (QUOTE UNSPECIFIED)))))
+)
+)
+
+(ADDTOVAR FILING.TYPES (VIEWPOINT 4353) (RES 4428) (XEROX860 5120) (REFERENCE 4427) (MAILFOLDER 4417))
+
+(RPAQQ MAILOBJ.REFERENCE.FIELD (REFERENCE 4421 (NAMEDRECORD (FILE.ID (FILING . FILE.ID)) (SERVICE NSNAME) (ADDRESS NSADDRESS) (HOST STRING) (DIRECTORY STRING) (NAME STRING) (TYPE (FILING . ATTRIBUTE.TYPE)) (NIL UNSPECIFIED) (PAGES CARDINAL) (VERSION CARDINAL) (FLAGS CARDINAL))))
+
+(RPAQ? MAILOBJ.WINDOWOFFSET 16)
+
+(RPAQ? MAILOBJ.SKIPCHAR (CHARCODE "."))
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+(DECLARE%: EVAL@COMPILE
+
+(RECORD MAILOBJ
 (MAILOBJ.IMAGE MAILOBJ.BOX MAILOBJ.TYPE MAILOBJ.DATA MAILOBJ.ATTR.LENGTH MAILOBJ.START MAILOBJ.NAME MAILOBJ.EXPANDABLE . MAILOBJ.INFO)
+)
+)
+
+(DECLARE%: EVAL@COMPILE 
+
+(RPAQQ \MAILOBJ.REFERENCE.LAST.FILED 8192)
+
+
+(CONSTANTS \MAILOBJ.REFERENCE.LAST.FILED)
+)
+)
+(DECLARE%: DONTEVAL@LOAD DOCOPY 
+
+(\MAILOBJ.INIT)
+
+(AND (EQ MAKESYSNAME :LYRIC) (FILESLOAD (SYSLOAD) NSRANDOM))
+)
+(DEFINEQ
+
+(\NSMAIL.WRITE.ATTRIBUTE

+(LAMBDA (STREAM TYPE VALUE) (* ; "Edited 17-Jan-89 16:39 by bvm") (LET* (FILINGP (TYPEINFO (if (EQ TYPE (QUOTE REFERENCE)) then (* ; "This is handled specially so that we don't read references on input") MAILOBJ.REFERENCE.FIELD else (OR (ASSOC TYPE \NSMAIL.ATTRIBUTES) (SETQ FILINGP (ASSOC TYPE \NSFILING.ATTRIBUTES)))))) (if TYPEINFO then (COURIER.WRITE STREAM (CADR TYPEINFO) NIL (QUOTE LONGCARDINAL)) (* ; "Type code") (COURIER.WRITE.SEQUENCE.UNSPECIFIED STREAM VALUE (if FILINGP then (QUOTE FILING) else (QUOTE MAILTRANSPORT)) (CADDR TYPEINFO)) else (ERROR "Unknown mail attribute" TYPE))))
+)
+)
+(DECLARE%: EVAL@COMPILE DOCOPY 
+
+(RPAQQ \NSMAIL.ATTRIBUTES ((From 4672 NAME.LIST) (Date 4673 TIME) (Reply-to 4674 NAME.LIST) (To 4676 NAME.LIST) (cc 4677 NAME.LIST) (Subject 9 STRING) (Message-ID 4693 MESSAGEID) (Sender 4705 NAME) (BodySize 16 LONGCARDINAL) (BodyType 17 LONGCARDINAL) (Note 4687 STRING) (OldLispFormatting 4910 STRING) (LispFormatting 4911 STRING) (In-Reply-to 4690 STRING)))
+)
+
+
+
+(* ; "sending mail")

+
+(DEFINEQ
+
+(\NSMAIL.PARSE.REFERENCE

+(LAMBDA (FILENAME EDITWINDOW) (* ; "Edited 17-Jan-89 15:55 by bvm") (LET* ((*UPPER-CASE-FILE-NAMES* NIL) (FULLNAME (FINDFILE FILENAME T))) (COND ((NULL FULLNAME) (\SENDMESSAGEFAIL EDITWINDOW "Can't find reference file " FILENAME)) (T (LET* ((FIELDS (UNPACKFILENAME.STRING FULLNAME)) (HOST (LISTGET FIELDS (QUOTE HOST))) (NSHOST (PARSE.NSNAME HOST)) (ADDRESS (LOOKUP.NS.SERVER NSHOST)) (NAME (LISTGET FIELDS (QUOTE NAME))) (EXT (LISTGET FIELDS (QUOTE EXTENSION))) (VERSION (LISTGET FIELDS (QUOTE VERSION))) (ID (GETFILEINFO FULLNAME (QUOTE FILE.ID))) (TYPE (GETFILEINFO FULLNAME (QUOTE FILE.TYPE))) (SIZE (GETFILEINFO FULLNAME (QUOTE SIZE)))) (COND ((NOT (AND (STRPOS ":" HOST) ADDRESS)) (\SENDMESSAGEFAIL EDITWINDOW "Reference file must be on NS server")) ((NOT (AND ID TYPE SIZE)) (\SENDMESSAGEFAIL EDITWINDOW "Can't lookup info on " FULLNAME)) (T (BQUOTE ((FILE.ID (\, ID)) (SERVICE (\, NSHOST)) (ADDRESS (\, ADDRESS)) (HOST (\, HOST)) (DIRECTORY (\, (CL:SUBSTITUTE #\/ #\> (UNPACKFILENAME.STRING FULLNAME (QUOTE DIRECTORY))))) (NAME (\, (if EXT then (SETQ NAME (CONCAT NAME "." EXT)) else NAME))) (TYPE (\, (if (OR (NEQ TYPE 0) (NULL EXT)) then (* ; "Interesting type, or no clue from extension") TYPE elseif (AND (SETQ TYPE (\NSMAIL.GUESS.FILE.TYPE NAME EXT)) (SELECTQ (\SENDMESSAGE.MENUPROMPT EDITWINDOW (\LAFITE.CREATE.MENU (BQUOTE (((\, (CONCAT "Change file type to " TYPE)) T) ("Leave as type BINARY" NIL) ("Abort" (QUOTE ABORT)))) "Fix type of reference file?") "Referenced document is of type BINARY; some mail clients will not understand.") (NIL NIL) (ABORT (ERROR!)) (if (SETFILEINFO FULLNAME (QUOTE TYPE) (SETQ TYPE (\FILETYPE.FROM.TYPE TYPE))) then TYPE else (\SENDMESSAGEFAIL EDITWINDOW "Could not set the file type")))) else (* ; "Oh, give up, leave it binary") 0))) (NIL 0) (PAGES (\, (ADD1 SIZE))) (VERSION (\, (OR (AND VERSION (MKATOM VERSION)) 0))) (FLAGS 0))))))))))
+)
+
+(\NSMAIL.EXPAND.DL

+(LAMBDA (DL SENDER EDITWINDOW) (* ; "Edited 16-Jan-89 14:04 by bvm") (LET ((FILENAME (PACKFILENAME.STRING (QUOTE BODY) (if (EQL (CL:CHAR DL 0) #\") then (* ; "quoted file name, take off the quotes first") (CL:SUBSEQ DL 1 (- (CL:LENGTH DL) 1)) else DL) (QUOTE EXTENSION) LAFITEDL.EXT)) STREAM) (if (NULL (SETQ FILENAME (if (OR (UNPACKFILENAME.STRING FILENAME (QUOTE HOST)) (UNPACKFILENAME.STRING FILENAME (QUOTE DIRECTORY))) then (INFILEP FILENAME) else (* ; "Search default directories") (FINDFILE FILENAME T (CONS LAFITEDEFAULTHOST&DIR LAFITEDLDIRECTORIES))))) then (\SENDMESSAGEFAIL EDITWINDOW "Can't find file named " DL) elseif (NULL (SETQ STREAM (CAR (NLSETQ (OPENTEXTSTREAM (MKATOM FILENAME)))))) then (\SENDMESSAGEFAIL EDITWINDOW "Can't open " DL) else (RESETLST (RESETSAVE NIL (LIST (QUOTE CLOSEF) STREAM)) (* ; "I hope this closes the file.  We used OPENTEXTSTREAM instead of OPEN so that file can contain tedit formatting.") (bind LINE while (SETQ LINE (CL:READ-LINE STREAM NIL NIL)) join (\NSMAIL.PARSE LINE SENDER EDITWINDOW))))))
+)
+
+(\NSMAIL.PARSE

+(LAMBDA (FIELD DEFAULTDOMAIN EDITWINDOW) (* bvm%: " 3-Jul-84 16:21") (NS.REMOVEDUPLICATES (COND ((LISTP FIELD) (for PIECE in FIELD join (\NSMAIL.PARSE1 PIECE DEFAULTDOMAIN EDITWINDOW))) (T (\NSMAIL.PARSE1 FIELD DEFAULTDOMAIN EDITWINDOW)))))
+)
+
+(\NSMAIL.PARSE1

+(LAMBDA (FIELD DEFAULTDOMAIN EDITWINDOW) (* ; "Edited 26-Feb-93 14:34 by bvm") (COND (FIELD (bind ADDR (START _ 1) COMMA DOT when (PROGN (SETQ ADDR (SUBSTRING FIELD START (AND (SETQ COMMA (STRPOS (QUOTE %,) FIELD START)) (SUB1 COMMA)))) (do (* ; "Strip leading blanks") (SELCHARQ (CHCON1 ADDR) ((SPACE TAB) (GNC ADDR)) (RETURN))) (do (* ; "Strip trailing blanks") (SELCHARQ (NTHCHARCODE ADDR -1) ((SPACE TAB) (GLC ADDR)) (RETURN))) (NEQ (NCHARS ADDR) 0)) collect (if (AND (STRPOS (QUOTE @) ADDR) (NOT (STRPOS (QUOTE %:) ADDR)) (EQ DEFAULTDOMAIN (fetch (LAFITEMODEDATA UNPACKEDUSERNAME) of *LAFITE-MODE-DATA*)) (SETQ DOT (STRPOS (QUOTE %.) ADDR NIL NIL NIL NIL NIL T))) then (* ;; "It's an Internet address--turn the last dot into a colon.  Don't do this if we're not being called from the places that parse with respect to the user's own name.  E.g., when building an answer form, there are often names that are abbreviated relative to the message sender's name.") (create NSNAME NSOBJECT _ (SUBSTRING ADDR 1 (SUB1 DOT)) NSDOMAIN _ (SUBSTRING ADDR (ADD1 DOT)) NSORGANIZATION _ "Xerox") else (PARSE.NSNAME ADDR NIL DEFAULTDOMAIN)) repeatwhile (COND (COMMA (SETQ START (ADD1 COMMA))))))))
+)
+
+(NS.REMOVEDUPLICATES

+(LAMBDA (LST) (* ; "Edited  6-Jun-88 13:38 by bvm") (CL:REMOVE-DUPLICATES LST :TEST (FUNCTION EQUAL.CH.NAMES)))
+)
+
+(\NSMAIL.GUESS.FILE.TYPE

+(LAMBDA (FILENAME EXT) (* ; "Edited 17-Jan-89 15:42 by bvm") (* ;; "Given a file name, try to guess what type it is from the extension, since file's TYPE property was boring.  EXT is computed from FILENAME if omitted.") (OR (CAR (CL:ASSOC (OR EXT (UNPACKFILENAME.STRING FILENAME (QUOTE EXTENSION))) FILING.TYPES :TEST (QUOTE STRING-EQUAL))) (LET ((TYPE (PRINTFILETYPE.FROM.EXTENSION FILENAME))) (AND TYPE (CAR (CL:ASSOC TYPE FILING.TYPES :TEST (QUOTE STRING-EQUAL)))))))
+)
+
+(COURIER.WRITE.STREAM.UNSPECIFIED

+(LAMBDA (OUTSTREAM INSTREAM START END) (* bvm%: "16-May-85 14:24") (* ;;; "Copies INSTREAM from START to END onto OUTSTREAM in the form of Bulkdata.StreamOfUnspecified --- format is one or more concatenations of {lastSegmentP,SequenceUnspecified} --- returns T if even number of bytes written, NIL if odd") (LET (LENGTH) (COND (END (SETFILEPTR INSTREAM START) (SETQ LENGTH (IDIFFERENCE (COND ((EQ END -1) (GETEOFPTR INSTREAM)) (T END)) START))) (START (SETQ LENGTH START)) (T (SETQ LENGTH (IDIFFERENCE (GETEOFPTR INSTREAM) (GETFILEPTR INSTREAM))))) (while (GREATERP LENGTH MAX.BULK.SEGMENT.LENGTH) do (\WOUT OUTSTREAM 0) (* ; "Not last segment") (\WOUT OUTSTREAM (FOLDHI MAX.BULK.SEGMENT.LENGTH BYTESPERWORD)) (* ; "Word length of this segment") (COPYBYTES INSTREAM OUTSTREAM MAX.BULK.SEGMENT.LENGTH) (SETQ LENGTH (IDIFFERENCE LENGTH MAX.BULK.SEGMENT.LENGTH))) (\WOUT OUTSTREAM 1) (* ; "Last segment") (\WOUT OUTSTREAM (FOLDHI LENGTH BYTESPERWORD)) (* ; "Word length of this segment") (COPYBYTES INSTREAM OUTSTREAM LENGTH) (COND ((EVENP LENGTH) T) (T (* ; "Garbage last byte") (\BOUT OUTSTREAM 0) NIL))))
+)
+
+(\NSMAIL.SEND.STREAM.AS.STRING

+(LAMBDA (INSTREAM OUTSTREAM START ATTRIBUTE) (* bvm%: "30-Jul-84 15:31") (* ;; "Writes the contents of INSTREAM, beginning at byte START, to OUTSTREAM in the form of a Filing Attribute whose type is ATTRIBUTE and whose value is a string") (PROG ((EOF (GETEOFPTR INSTREAM)) LENGTH) (COURIER.WRITE OUTSTREAM ATTRIBUTE NIL (QUOTE LONGCARDINAL)) (\WOUT OUTSTREAM (ADD1 (FOLDHI (SETQ LENGTH (IDIFFERENCE EOF START)) BYTESPERWORD))) (* ; "Sequence length") (\WOUT OUTSTREAM LENGTH) (* ; "String length") (COPYBYTES INSTREAM OUTSTREAM START EOF) (COND ((ODDP LENGTH) (\BOUT OUTSTREAM 0)))))
+)
+)
+
+(FILESLOAD LAFITEMAIL)
+
+
+
+(* ; "for LAFITE.MAKE.PARSE.TABLE")

+
+
+(RPAQQ NSMAIL.PARSEFIELDS (("DATE:" LAFITE.READ.LINE.FOR.TOC Date) ("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject) ("SENDER:" LAFITE.READ.NAME.FIELD Sender) ("FROM:" LAFITE.READ.NAME.FIELD From) ("REPLY-TO:" LAFITE.READ.NAME.FIELD Reply-to) ("IN-REPLY-TO:" LAFITE.READ.LINE.FOR.TOC In-Reply-to) ("TO:" LAFITE.READ.NAME.FIELD To) ("CC:" LAFITE.READ.NAME.FIELD cc) ("FORMAT:" LAFITE.READ.FORMAT) ("ATTACHED-REFERENCE:" LAFITE.READ.LINE.FOR.TOC REFERENCE) ("ATTACHED-FILE:" LAFITE.READ.LINE.FOR.TOC ATTACHMENT) ("Importance:" LAFITE.READ.LINE.FOR.TOC Importance) ("Sensitivity:" LAFITE.READ.LINE.FOR.TOC Sensitivity) ("Immutable:" LAFITE.READ.LINE.FOR.TOC Immutable)))
+
+(RPAQ \LAPARSE.NSMAIL (LAFITE.MAKE.PARSE.TABLE NSMAIL.PARSEFIELDS))
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS \LAPARSE.NSMAIL)
+)
+
+(RPAQ? NSMAIL.NET.HINT)
+
+(RPAQ? *NSMAIL-MAX-NOTE-LENGTH* 8000)
+
+(RPAQ? *NSMAIL-CACHE-TIMEOUT* 14400000)
+
+(RPAQ? *NSMAIL-GENEROUS-SELF-TEST* T)
+
+(RPAQ? LAFITEDL.EXT "DL")
+
+(CL:PROCLAIM (QUOTE (GLOBAL NSMAIL.NET.HINT *NSMAIL-MAX-NOTE-LENGTH* *NSMAIL-CACHE-TIMEOUT* *NSMAIL-GENEROUS-SELF-TEST*)))
+(DEFINEQ
+
+(\NSMAIL.MESSAGE.P

+(LAMBDA (MSG) (* ; "Edited  6-May-88 13:58 by bvm") (AND (STRPOS ":" (fetch (LAFITEMSG FROM) of MSG)) (QUOTE ?)))
+)
+
+(\NSMAIL.MESSAGE.FROM.SELF.P

+(LAMBDA (MSG) (* ; "Edited  6-Aug-93 17:03 by bvm") (* ;; "True if message is from current user.  Easy in NS case because we always make the From field be exactly our full name.  However, the from field might already be munged to be a %"pretty%" name, so first check that from is a prefix of the full name, and if so, see if it's a valid abbreviation.") (LET* ((FROM (fetch (LAFITEMSG FROM) of MSG)) (FROMLEN (NCHARS FROM)) (FULL (fetch (LAFITEMODEDATA FULLUSERNAME) of *LAFITE-MODE-DATA*)) (FULEN (NCHARS FULL))) (* ;; "All sorts of checking so that STRING-EQUAL doesn't barf...") (AND (>= FULEN FROMLEN) (STRING-EQUAL FROM FULL :END2 FROMLEN) (COND ((= FULEN FROMLEN) (* ; "completely identical") T) ((AND *NSMAIL-GENEROUS-SELF-TEST* (EQL (CL:CHAR FULL FROMLEN) #\:) (NOT (STRPOS ":" FROM))) (* ;; "From is and rfc822 'real name' identical to the name component of my ns name.  We generously assume that this is an smtp alter ego of self, though we could be confused by someone out on the net with a name identical to mine, which is why this is under a flag.") T) (T (LET ((UP (fetch (LAFITEMODEDATA UNPACKEDUSERNAME) of *LAFITE-MODE-DATA*))) (* ;; "From is shorter than my full nsname.  Following is a non-consy way of writing (= FROMLEN (NCHARS (NSNAME.TO.STRING UP))), slightly optimized by noting that if the org is not the default, then the abbreviated name is the same as the full name, which we've already checked for.") (AND (STRING-EQUAL (fetch NSORGANIZATION of UP) CH.DEFAULT.ORGANIZATION) (= FROMLEN (+ (NCHARS (fetch NSOBJECT of UP)) 1 (if (STRING-EQUAL (fetch NSDOMAIN of UP) CH.DEFAULT.DOMAIN) then 0 else (NCHARS (fetch NSDOMAIN of UP))))))))))))
+)
+
+(\NSMAIL.MAKEANSWERFORM

+(LAMBDA (MSGDESCRIPTORS MAILFOLDER) (* ; "Edited  6-Jun-88 14:09 by bvm") (LET ((MSGFIELDS (\LAFITE.PARSE.MESSAGE MAILFOLDER (OR (CAR (LISTP MSGDESCRIPTORS)) MSGDESCRIPTORS))) SUBJECT FROM DATE SENDER REPLYTO TO CC ORIGINALREGISTRY OLDFROM NEWTO) (* ; "get the fields from the file") (for PAIR in MSGFIELDS do (SELECTQ (CAR PAIR) (Subject (SETQ SUBJECT (CADR PAIR))) (Sender (SETQ SENDER (CADR PAIR))) (From (SETQ FROM (CADR PAIR))) (Date (SETQ DATE (CADR PAIR))) (Reply-to (SETQ REPLYTO (CDR PAIR))) (To (SETQ TO (CDR PAIR))) (cc (SETQ CC (CDR PAIR))) NIL)) (* ; "first parse the strings into recipients") (COND (SENDER (* ; "Sender is a mail address, and has the official registry") (SETQ ORIGINALREGISTRY (PARSE.NSNAME SENDER)) (SETQ OLDFROM (AND FROM (\NSMAIL.PARSE FROM ORIGINALREGISTRY)))) (FROM (* ; "Have to parse the From field before we can get its registry") (SETQ ORIGINALREGISTRY (CAR (SETQ OLDFROM (\NSMAIL.PARSE FROM))))) (T (LAB.PROMPTPRINT MAILFOLDER T "Can't reply--no FROM or SENDER field"))) (SETQ NEWTO (OR (AND REPLYTO (SETQ REPLYTO (\NSMAIL.PARSE REPLYTO ORIGINALREGISTRY))) OLDFROM)) (LAFITE.FILL.IN.ANSWER.FORM SUBJECT FROM DATE NEWTO (CL:SET-DIFFERENCE (COND (REPLYTO (* ; "Only this address, so can only cc to self now") (LIST (fetch (LAFITEMODEDATA UNPACKEDUSERNAME) of *LAFITE-MODE-DATA*))) (T (* ; "Take everyone who got the original, removing duplicates, of course.") (NS.REMOVEDUPLICATES (APPEND (AND TO (\NSMAIL.PARSE TO ORIGINALREGISTRY)) (AND CC (\NSMAIL.PARSE CC ORIGINALREGISTRY)))))) NEWTO :TEST (FUNCTION EQUAL.CH.NAMES)) (FUNCTION \NSMAIL.PRINT.NAMES))))
+)
+
+(\NSMAIL.PRINT.NAMES

+(LAMBDA (NSNAMES OUTSTREAM DEFAULTNAME) (* ; "Edited  5-Jan-90 18:30 by bvm") (for NAME in NSNAMES bind (FIRSTTIME _ T) ORGDIFFERS do (COND (FIRSTTIME (SETQ FIRSTTIME NIL)) (T (PRIN3 ", " OUTSTREAM))) (PRIN3 (fetch NSOBJECT of NAME) OUTSTREAM) (LET ((ORG (fetch NSORGANIZATION of NAME)) (DOM (fetch NSDOMAIN of NAME))) (if (OR (SETQ ORGDIFFERS (NOT (AND DEFAULTNAME (OR (STRING-EQUAL ORG (fetch NSORGANIZATION of DEFAULTNAME)) (EQ (NCHARS ORG) 0))))) (NOT (OR (STRING-EQUAL DOM (fetch NSDOMAIN of DEFAULTNAME)) (EQ (NCHARS DOM) 0)))) then (* ;; "Have to print the domain.  The null string tests are because there exists buggy software that doesn't fill in the domain and org--we want them to default correctly eventually.") (PRIN3 ":" OUTSTREAM) (PRIN3 DOM OUTSTREAM) (if ORGDIFFERS then (* ; "Have to print the org, too") (PRIN3 ":" OUTSTREAM) (PRIN3 ORG OUTSTREAM))))))
+)
+)
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+(DECLARE%: EVAL@COMPILE
+
+(RECORD NSMAILBOX
 (NSMAILSTREAM NSMAILENVTAIL NSMAILENVELOPES NSMAILLASTINDEX . NSMAILSTATE) (ACCESSFNS NSMAILBOX ((NSMAILSESSION (fetch STATESESSION of (fetch NSMAILSTATE of DATUM))) (NSMAILFIRSTINDEX (fetch STATEFIRSTNEW of (fetch NSMAILSTATE of DATUM)))))
+)
+
+(RECORD NSMAILSTATE
 (STATESESSION STATEFIRSTNEW STATEOLDLAST STATENAME STATECREDENTIALS STATEADDRESS STATELASTERROR STATETIMER)
+)
+
+(RECORD NSMAILPARSE
 (NSPSUBJECT NSPRECIPIENTS NSPSTART NSPFORMATTED . NSPFIELDS))
+)
+
+(DECLARE%: EVAL@COMPILE 
+
+(RPAQQ \NSMAIL.SOCKET 26)
+
+(RPAQQ \SERIALIZED.FILE.VERSION 2)
+
+(RPAQQ \SERIALIZED.FILE.VERSIONS (2 3))
+
+(RPAQQ \NSMAIL.TEXT.BODYTYPE 2)
+
+(RPAQQ \NSMAIL.EMPTY.BODYTYPE 4)
+
+(RPAQQ \NSMAIL.REFERENCE.BODYTYPE 4427)
+
+(RPAQQ MAX.BULK.SEGMENT.LENGTH 32768)
+
+
+(CONSTANTS \NSMAIL.SOCKET \SERIALIZED.FILE.VERSION \SERIALIZED.FILE.VERSIONS \NSMAIL.TEXT.BODYTYPE \NSMAIL.EMPTY.BODYTYPE \NSMAIL.REFERENCE.BODYTYPE MAX.BULK.SEGMENT.LENGTH)
+)
+
+(DECLARE%: EVAL@COMPILE 
+
+(PUTPROPS \NSMAIL.ATTRIBUTE.TYPE MACRO (ARGS (COND ((CADR (ASSOC (CAR ARGS) \NSMAIL.ATTRIBUTES))) (T (ERROR "Unknown mail attribute" (CAR ARGS)) (QUOTE IGNOREMACRO)))))
+
+(PUTPROPS \NSMAIL.WRITE.ATTRIBUTE MACRO (ARGS (LET ((INFO (CDR (ASSOC (CAR (CONSTANTEXPRESSIONP (CADR ARGS))) \NSMAIL.ATTRIBUTES)))) (COND (INFO (LIST (QUOTE \NSMAIL.WRITE.ATTRIBUTE.MACRO) (CAR ARGS) (CAR INFO) (CADDR ARGS) (KWOTE (CADR INFO)))) (T (QUOTE IGNOREMACRO))))))
+
+(PUTPROPS \NSMAIL.WRITE.ATTRIBUTE.MACRO MACRO (OPENLAMBDA (STREAM TYPENO VALUE VALUETYPE) (COURIER.WRITE STREAM TYPENO NIL (QUOTE LONGCARDINAL)) (COURIER.WRITE.SEQUENCE.UNSPECIFIED STREAM VALUE (QUOTE MAILTRANSPORT) VALUETYPE)))
+)
+
+
+(PUTPROPS \NSMAIL.ATTRIBUTE.TYPE INFO NOEVAL)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS *NSMAIL-OP-VECTOR* DEFAULTICONFONT FILING.TYPES MAILOBJ.REFERENCE.FIELD MAILOBJ.SKIPCHAR MAILOBJ.WINDOWOFFSET NSMAIL.HEADER.ORDER NSMAIL.NET.HINT NSMAILDEBUGFLG NSPRINT.WATCHERFLG NSWIZARDFLG \MAILOBJ.IMAGEFNS \NSFILING.ATTRIBUTES \NSMAIL.ATTRIBUTES)
+)
+
+
+(FILESLOAD (SOURCE) LAFITEDECLS LLNSDECLS)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(LOCALVARS . T)
+)
+)
+(PUTPROPS NSMAIL COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1992 1993))
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (3699 7008 (\NSMAIL.LOGIN 3709 . 3935) (NS.FINDMAILBOXES 3937 . 4394) (
+\NSMAIL.MAKE.MAILSERVERS 4396 . 5190) (\NSMAIL.FIX.MAILBOX.LOCATIONS 5192 . 7006)) (7035 9116 (
+\NSMAIL.CHECK.SERIALIZED.VERSION 7045 . 7358) (\NSMAIL.READ.SERIALIZED.CONTENT 7360 . 8254) (
+\NSMAIL.DISCARD.SERIALIZED.CONTENT 8256 . 8703) (\NSMAIL.READ.STRING.AS.STREAM 8705 . 9114)) (9148 
+10549 (\NSMAIL.COURIER.OPEN 9158 . 9361) (\NSMAIL.ERRORHANDLER 9363 . 9785) (\NSMAIL.SIGNAL.ERROR 9787
+ . 10547)) (10747 16949 (\MAILOBJ.CREATE 10757 . 12982) (\MAILOBJ.TYPE.NAME 12984 . 13451) (
+\MAILOBJ.NS.TO.LISP.NAME 13453 . 14804) (\MAILOBJ.DISPLAY 14806 . 15126) (\MAILOBJ.GET 15128 . 15951) 
+(\MAILOBJ.IMAGEBOX 15953 . 16081) (\MAILOBJ.PUT 16083 . 16669) (\MAILOBJ.INIT 16671 . 16947)) (16950 
+31846 (\MAILOBJ.BUTTONEVENTFN 16960 . 19089) (\MAILOBJ.DO.COMMAND 19091 . 19338) (\MAILOBJ.HARDCOPY 
+19340 . 21146) (\MAILOBJ.FB 21148 . 21362) (\MAILOBJ.PUT.FILE 21364 . 23029) (\MAILOBJ.VIEW 23031 . 
+25968) (\MAILOBJ.MUNGE.NAME 25970 . 26234) (\MAILOBJ.COPY.BODY 26236 . 26550) (\MAILOBJ.EXPAND 26552
+ . 28273) (\MAILOBJ.COPY.CHILD 28275 . 29632) (\MAILOBJ.COPY.SEQUENCE 29634 . 30002) (
+\MAILOBJ.EXTRACT.TEXT 30004 . 31065) (\MAILOBJ.PARSE.ATTRIBUTES 31067 . 31844)) (32756 33393 (
+\NSMAIL.WRITE.ATTRIBUTE 32766 . 33391)) (33818 40701 (\NSMAIL.PARSE.REFERENCE 33828 . 35746) (
+\NSMAIL.EXPAND.DL 35748 . 36815) (\NSMAIL.PARSE 36817 . 37078) (\NSMAIL.PARSE1 37080 . 38288) (
+NS.REMOVEDUPLICATES 38290 . 38428) (\NSMAIL.GUESS.FILE.TYPE 38430 . 38931) (
+COURIER.WRITE.STREAM.UNSPECIFIED 38933 . 40077) (\NSMAIL.SEND.STREAM.AS.STRING 40079 . 40699)) (41866 
+46243 (\NSMAIL.MESSAGE.P 41876 . 42014) (\NSMAIL.MESSAGE.FROM.SELF.P 42016 . 43715) (
+\NSMAIL.MAKEANSWERFORM 43717 . 45341) (\NSMAIL.PRINT.NAMES 45343 . 46241)))))
+STOP

library/new/PCTREE

@@ -0,0 +1,572 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
(FILECREATED "22-Mar-95 18:19:18" {DSK}<lispcore>library>new>PCTREE.;1
 28446  
+
+      changes to%:  (FNS \INSERTTREE \DELETETREE \SPLITTREE \TEDIT.UPDATETREE)
+
+      previous date%: " 7-Oct-94 17:44:31" {DSK}<lispcore>library>PCTREE.;5)
+
+
+(* ; "
+Copyright (c) 1990, 1991, 1993, 1994, 1995 by Venue & Xerox Corporation.  All rights reserved.
+")
+
+(PRETTYCOMPRINT PCTREECOMS)
+
+(RPAQQ PCTREECOMS

+       [
+        (* ;; "Balanced tree PIECE TABLE supporting functions")

+
+        (FILES TEDITDCL)
+        (DECLARE%: EVAL@COMPILE DONTCOPY 
+
+               (* ;; "\WORDSINBTREEMAIN = # of words in the child-pointers & offsets section of the node -- everything before SPARE5 (the overflow place).")

+
+               
+               (* ;; 
+
     "\BTREEMAXCOUNT = number of children in a full node = maximum value for a node's COUNT field.")

+
+               
+               (* ;; "\BTREELASTREALOFFSET = offset of last real space for a child entry in the node ( = \WORDSINBTREEMAIN - 4)")

+
+               (CONSTANTS (\BTREEMAXENTRIES 8)
+                      (\BTREEMAXCOUNT 8)
+                      (\BTREEWORDSPERENTRY 4)
+                      (\WORDSINBTREEMAIN (UNFOLD \BTREEMAXENTRIES 4))
+                      (\BTREELASTREALOFFSET (UNFOLD (SUB1 \BTREEMAXENTRIES)
+                                                   4))
+                      (\BTREETOPHALFOFFSET (UNFOLD (LRSH \BTREEMAXENTRIES 1)
+                                                  4)))
+               (FILES (LOADCOMP)
+                      TEDITDECLS))
+        (FNS UPDATEPCNODES FINDPCNODE \FIRSTNODE \DELETETREE \INSERTTREE \LASTNODE \MATCHPCS 
+             \SPLITTREE \TEDIT.UPDATETREE \TEDIT.PIECE-CHNO \TEDIT.SET-TOTLEN)
+        (FNS DISPTREE TREEGRAPHNODE)
+        (RECORDS BTREENODE)
+        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
+                                                                             (NLAML)
+                                                                             (LAMA])
+
+
+
+(* ;; "Balanced tree PIECE TABLE supporting functions")

+
+
+(FILESLOAD TEDITDCL)
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+(DECLARE%: EVAL@COMPILE 
+
+(RPAQQ \BTREEMAXENTRIES
 8)
+
+(RPAQQ \BTREEMAXCOUNT
 8)
+
+(RPAQQ \BTREEWORDSPERENTRY
 4)
+
+(RPAQ \WORDSINBTREEMAIN
 (UNFOLD \BTREEMAXENTRIES 4))
+
+(RPAQ \BTREELASTREALOFFSET
 (UNFOLD (SUB1 \BTREEMAXENTRIES)
+                                      4))
+
+(RPAQ \BTREETOPHALFOFFSET
 (UNFOLD (LRSH \BTREEMAXENTRIES 1)
+                                     4))
+
+
+(CONSTANTS (\BTREEMAXENTRIES 8)
+       (\BTREEMAXCOUNT 8)
+       (\BTREEWORDSPERENTRY 4)
+       (\WORDSINBTREEMAIN (UNFOLD \BTREEMAXENTRIES 4))
+       (\BTREELASTREALOFFSET (UNFOLD (SUB1 \BTREEMAXENTRIES)
+                                    4))
+       (\BTREETOPHALFOFFSET (UNFOLD (LRSH \BTREEMAXENTRIES 1)
+                                   4)))
+)
+
+
+(FILESLOAD (LOADCOMP)
+       TEDITDECLS)
+)
+(DEFINEQ
+
+(UPDATEPCNODES

+  [LAMBDA (PC DELTA)
                                     (* ; "Edited 21-Apr-93 16:09 by jds")

+
+    (* ;; "ADD DELTA TO CHNUM IN NEXTALL NODES OF TOPNODE.")

+
+    (LET ((UPWARD (fetch
 (PIECE PTREENODE) of
 PC)))
+         (while
 UPWARD do
 (for
 I from
 0 by
 4 as
 ITEM from
 1
+                                     to
 (fetch
 (BTREENODE COUNT) of
 UPWARD)
+                                     when
 (EQ PC (\GETBASEPTR UPWARD I))
+                                     do
 [\PUTBASEFIXP UPWARD (IPLUS I 2)
+                                                   (IPLUS DELTA (\GETBASEFIXP UPWARD (IPLUS I 2]
+                                           (add
 (fetch
 (BTREENODE TOTLEN) of
 UPWARD)
+                                                  DELTA)
+                                           (SETQ PC UPWARD)
+                                           (SETQ UPWARD (fetch
 (BTREENODE UPWARD) of
 PC))
+                                           (RETURN) finally
 (HELP "Piece not in its TREENODE"])
+
+(FINDPCNODE

+  [LAMBDA (PC PCTB)
                                      (* ; "Edited 13-Apr-93 15:00 by jds")

+
+    (* ;; "Given a piece and the pctb it's in, return pcnode")

+
+    (fetch
 (PIECE PTREENODE) of
 PC])
+
+(\FIRSTNODE

+  [LAMBDA (TREE)
                                         (* ; "Edited 14-Apr-93 02:06 by jds")

+    (LET ((COUNT
 (fetch
 (BTREENODE COUNT) of
 TREE))
+          CHILD)
+         (SETQ CHILD (\GETBASEPTR TREE 0))
+         (COND
+            ((type?
 BTREENODE CHILD)
+             (\FIRSTNODE
 CHILD))
+            (T TREE])
+
+(\DELETETREE

+  [LAMBDA (OLD
 PCNODE)
                    (* ; 
+
                                                "Edited 21-Mar-95 15:29 by sybalsky:mv:envos")

+
+    (* ;; "Removes OLD from PCNODE.  OLD is either a piece or tree node.")

+
+    (UNINTERRUPTABLY
+        (LET* ((OLDLEN (ffetch
 (BTREENODE TOTLEN) of
 PCNODE))
+               NEWLEN INCHNO AFTERFLG NODE-COUNT ITEM# BB)
+
+              (* ;; "NEW CODE")

+
+              (SETQ NODE-COUNT (fetch
 (BTREENODE COUNT) of
 PCNODE))
+
+              (* ;; "Find OLD, .")

+
+              (for
 old
 ITEM# from
 0 to
 (LLSH (SUB1 NODE-COUNT)
+                                                             2) by
 4
+                 when
 (EQ OLD (\GETBASEPTR PCNODE ITEM#)) do
 (RETURN)
+                 finally
 (HELP "Piece/node not in PCNODE"))
+
+              (* ;; "Update the previous piece's length, if appropriate:")

+
+              (SETQ BB (\ADDBASE PCNODE ITEM#))
+              (\RPLPTR BB 0 NIL)
+              [for
 I from
 0 to
 (IDIFFERENCE \BTREELASTREALOFFSET ITEM#) by
 4
+                 do
 (\PUTBASEPTR BB I (\GETBASEPTR BB (IPLUS I 4)))
+                       (\PUTBASEFIXP BB (IPLUS I 2)
+                              (\GETBASEFIXP BB (IPLUS I 6]
+              (\PUTBASEPTR PCNODE \BTREELASTREALOFFSET NIL)  (* ; 
+
                   "Because it's been copied, clear the old value before the refcnt-er gets to it.")

+
+              (* ;; " If adding this piece EMPTIES the tree node, DELETE it.")

+
+              (* ;; "FIXMI -- This should coalesce adjacent nodes that are too empty!")

+
+              [COND
+                 ((IEQP NODE-COUNT 1)
+                  (\DELETETREE
 PCNODE (fetch
 (BTREENODE UPWARD) of
 PCNODE)))
+                 (T                                          (* ; 
+
                                               "No split, so update upper nodes with delta-length.")

+                    [SETQ NEWLEN
+                     (replace
 (BTREENODE TOTLEN) of
 PCNODE
+                        with
 (for
 I from
 2 to
 NODE-COUNT as
 ITEM# from
 2
+                                    by
 4 sum
 (\GETBASEFIXP PCNODE ITEM#]
+                    (replace
 (BTREENODE COUNT) of
 PCNODE with
 (SUB1 NODE-COUNT))
+                    (\TEDIT.UPDATETREE
 PCNODE (IDIFFERENCE NEWLEN OLDLEN]
+
+              (* ;; "END NEW CODE")

+
+              1))])
+
+(\INSERTTREE

+  [LAMBDA (NEW OLD PCNODE NEW-PREVLEN NEW-OLDLEN PREV)

+                                                  (* ; 
+
                                                "Edited 22-Mar-95 15:37 by sybalsky:mv:envos")

+
+    (* ;; "inserts NEW in front of OLD in PCNODE.  NEW/OLD are either pieces or tree nodes.")

+
+    (* ;; "If NEWE-PREVLEN is non-NIL, it's a DELTA for updating parents of THE PIECE BEFORE OLD.  This is used by \SPLITPIECE to pass down the new shortened length for the original piece.")

+
+    (UNINTERRUPTABLY
+        (LET* ((OLDLEN (ffetch
 (BTREENODE TOTLEN) of
 PCNODE))
+               NEWLEN INCHNO AFTERFLG NODE-COUNT ITEM# BB)
+
+              (* ;; "NEW CODE")

+
+              (SETQ NODE-COUNT (fetch
 (BTREENODE COUNT) of
 PCNODE))
+
+              (* ;; "Find OLD, and insert the NEW piece (and length) in front of it.")

+
+              [for
 old
 ITEM# from
 0 to
 (LLSH (SUB1 NODE-COUNT)
+                                                             2) by
 4
+                 when
 (EQ OLD (\GETBASEPTR PCNODE ITEM#)) do
 (RETURN)
+                 finally
 (COND
+                                (OLD
 (HELP "Old piece not in this PCNODE."))
+                                (T                           (* ; "INSERTING FIRST PIECE")

+                                   (SETQ ITEM# 0]
+              (OR NEW (HELP "Inserting empty item"))
+
+              (* ;; "Update the previous piece's length, if appropriate:")

+
+              [AND NEW-PREVLEN (COND
+                                  ((ZEROP ITEM#)
+
+                                   (* ;; 
+
"The hard way -- the previous piece is in a prior btree node, so we have to go there to update it.")

+
+                                   (LET* ((NODE (fetch
 (PIECE PTREENODE) of
 PREV)))
+                                         (UPDATEPCNODES
 PREV NEW-PREVLEN)))
+                                  (T 
+                                     (* ;; "Easy way -- it's in this node.  Update it in place.")

+
+                                     (\PUTBASEFIXP PCNODE (IDIFFERENCE ITEM# 2)
+                                            (IPLUS NEW-PREVLEN (\GETBASEFIXP PCNODE (IDIFFERENCE
+                                                                                     ITEM# 2]
+              (COND
+                 (NEW-OLDLEN (\PUTBASEFIXP PCNODE (IPLUS ITEM# 2)
+                                    NEW-OLDLEN)))
+              (SETQ BB (\ADDBASE PCNODE ITEM#))
+              (\RPLPTR PCNODE \WORDSINBTREEMAIN NIL)         (* ; 
+
                                               "Clean out the slot that's about to be copied over.")

+              (\BLT (\ADDBASE BB 4)
+                    BB
+                    (IDIFFERENCE \WORDSINBTREEMAIN ITEM#))
+              (\PUTBASEPTR PCNODE ITEM# NIL)                 (* ; 
+
                   "Because it's been copied, clear the old value before the refcnt-er gets to it.")

+              (\RPLPTR PCNODE ITEM# NEW)
+              (COND
+                 ((type?
 PIECE NEW)
+                  (\PUTBASEFIXP PCNODE (IPLUS ITEM# 2)
+                         (fetch
 (PIECE PLEN) of
 NEW))
+                  (replace
 (PIECE PTREENODE) of
 NEW with
 PCNODE))
+                 ((type?
 BTREENODE NEW)                  (* ; "Inserting a NODE")

+                  (\PUTBASEFIXP PCNODE (IPLUS ITEM# 2)
+                         (fetch
 (BTREENODE TOTLEN) of
 NEW))
+                  (replace
 (BTREENODE UPWARD) of
 NEW with
 PCNODE))
+                 (T (\ILLEGAL.ARG NEW)))
+              [SETQ NEWLEN (replace
 (BTREENODE TOTLEN) of
 PCNODE
+                              with
 (for
 I from
 0 to
 NODE-COUNT as
 ITEM#
+                                          from
 2 by
 4 sum
 (\GETBASEFIXP PCNODE ITEM#]
+
+              (* ;; " If adding this piece overflows the tree node, split it.")

+
+              [COND
+                 ((IEQP NODE-COUNT \BTREEMAXCOUNT)           (* ; 
+
                                                           "Tree node is full, so have to split.")

+                  (\SPLITTREE
 PCNODE OLD NEW))
+                 (T                                          (* ; 
+
                                               "No split, so update upper nodes with delta-length.")

+                    (replace
 (BTREENODE COUNT) of
 PCNODE with
 (ADD1 NODE-COUNT))
+                    (\TEDIT.UPDATETREE
 PCNODE (IDIFFERENCE NEWLEN OLDLEN]
+
+              (* ;; "END NEW CODE")

+
+              1))])
+
+(\LASTNODE

+  [LAMBDA (TREE)
                                         (* ; "Edited 14-Apr-93 16:29 by jds")

+    (LET ((COUNT
 (fetch
 (BTREENODE COUNT) of
 TREE))
+          CHILD)
+         (for
 ITEM# from
 (LLSH (IDIFFERENCE COUNT 1)
+                                       2) to
 0 by
 -4 when
 (SETQ CHILD (\GETBASEPTR TREE 
+                                                                                         ITEM#))
+            do
 (RETURN (COND
+                              ((type?
 BTREENODE CHILD)
+                               (\LASTNODE
 CHILD))
+                              (T TREE])
+
+(\MATCHPCS

+  [LAMBDA (PCNODE)
                                       (* ; "Edited  5-May-93 17:57 by jds")

+
+    (* ;; "Make sure that any pieces pointed to this node point back to this node.")

+
+    (bind
 PC for
 OFFSET from
 0 to
 \WORDSINBTREEMAIN by
 4 as
 I from
 1
+       to
 (fetch
 (BTREENODE COUNT) of
 PCNODE) do
 (SETQ PC (\GETBASEPTR PCNODE OFFSET)
+                                                                  )
+                                                                (COND
+                                                                   ((type?
 PIECE PC)
+                                                                    (replace
 (PIECE PTREENODE)
+                                                                       of
 PC with
 PCNODE))
+                                                                   ((type?
 BTREENODE PC)
+                                                                    (replace
 (BTREENODE UPWARD)
+                                                                       of
 PC with
 PCNODE])
+
+(\SPLITTREE

+  [LAMBDA (PCNODE)
                            (* ; 
+
                                                "Edited 21-Mar-95 15:26 by sybalsky:mv:envos")

+
+    (* ;; "We're adding piece NEW in front of OLD.  OLD is represented in the B-tree node PCNODE, which is full.")

+
+    (* ;; "Split PCNODE in two and propogate any changes upward.")

+
+    (UNINTERRUPTABLY
+        [LET ((UPWARD (fetch
 (BTREENODE UPWARD) of
 PCNODE))
+              COUNT ITEM# NEW1 NEW2)
+             (COND
+                (UPWARD 
+
+                       (* ;; 
+
                     "Easy case:  This is not the root node, so split the node and propogate up.")

+
+                       (SETQ NEW1 (create
 BTREENODE using
 PCNODE))
+
+                       (* ;; "Clean out upper 3 child entries, leaving only the lower 2.  Have to tell GC about actual child slots being set to NIL (hence \RPLPTRs):")

+
+                       (for
 OFST from
 \BTREETOPHALFOFFSET to
 \WORDSINBTREEMAIN
+                          by
 4 do
 (\RPLPTR NEW1 OFST NIL)
+                                         (\PUTBASEFIXP NEW1 (IPLUS OFST 2)
+                                                0))
+                       (replace
 (BTREENODE COUNT) of
 NEW1 with
 (LRSH \BTREEMAXENTRIES 1))
+                       (\TEDIT.SET-TOTLEN
 NEW1)
+                       (\MATCHPCS
 NEW1)
+
+                       (* ;; 
+
                     "Now clean up the old piece, to contain only the upper 3 original children:")

+
+                       (for
 OFST from
 0 to
 (SUB1 \BTREETOPHALFOFFSET) by
 4
+                          do
                             (* ; 
+
                               "For GC, have to tell it we've dropped pointers to first N/2 pieces")

+                                (\RPLPTR PCNODE OFST NIL))
+
+                       (* ;; "Move upper N/2+1 down")

+
+                       [for
 OFST from
 0 to
 \BTREETOPHALFOFFSET by
 4 as
 UPPEROFST
+                          from
 \BTREETOPHALFOFFSET by
 4
+                          do
 (\PUTBASEPTR PCNODE OFST (\GETBASEPTR PCNODE UPPEROFST))
+                                (\PUTBASEFIXP PCNODE (IPLUS 2 OFST)
+                                       (\GETBASEFIXP PCNODE (IPLUS 2 UPPEROFST]
+
+                       (* ;; "And clean out upper 2 slots, without the GC seeing it:")

+
+                       (for
 OFST from
 (IPLUS \BTREEWORDSPERENTRY \BTREETOPHALFOFFSET)
+                          to
 \WORDSINBTREEMAIN by
 \BTREEWORDSPERENTRY
+                          do
 (\PUTBASEPTR PCNODE OFST NIL)
+                                (\PUTBASEFIXP PCNODE (IPLUS OFST 2)
+                                       0))
+                       (replace
 (BTREENODE COUNT) of
 PCNODE with
 (ADD1 (LRSH 
+                                                                                     \BTREEMAXENTRIES
+                                                                                         1)))
+                       (\TEDIT.SET-TOTLEN
 PCNODE)
+                       (SETQ COUNT (fetch
 (BTREENODE COUNT) of
 UPWARD))
+                       (\INSERTTREE
 NEW1 PCNODE UPWARD NIL (fetch
 (BTREENODE TOTLEN)
+                                                                  of
 PCNODE)))
+                (T 
+                   (* ;; "Hard case:  This is the root node.  We need to create 2 new nodes, put the split parts there, and re-use this node as the root.")

+
+                   (SETQ NEW1 (create
 BTREENODE using
 PCNODE))
+                   (for
 OFST from
 \BTREETOPHALFOFFSET to
 \WORDSINBTREEMAIN by
 4
+                      do
 (\RPLPTR NEW1 OFST NIL)
+                            (\PUTBASEFIXP NEW1 (IPLUS OFST 2)
+                                   0))
+                   (replace
 (BTREENODE UPWARD) of
 NEW1 with
 PCNODE)
+                   (replace
 (BTREENODE COUNT) of
 NEW1 with
 (LRSH \BTREEMAXENTRIES 1))
+                   (\TEDIT.SET-TOTLEN
 NEW1)
+                   (\MATCHPCS
 NEW1)
+
+                   (* ;; "--")

+
+                   (SETQ NEW2 (create
 BTREENODE using
 PCNODE))
+                   (for
 OFST from
 0 to
 (SUB1 \BTREETOPHALFOFFSET) by
 4
+                      do
                                 (* ; 
+
                               "For GC, have to tell it we've dropped pointers to first N/2 pieces")

+                            (\RPLPTR NEW2 OFST NIL))
+                   [for
 OFST from
 0 to
 \BTREETOPHALFOFFSET by
 4 as
 UPPEROFST
+                      from
 \BTREETOPHALFOFFSET by
 4
+                      do
 (\PUTBASEPTR NEW2 OFST (\GETBASEPTR NEW2 UPPEROFST))
+                            (\PUTBASEFIXP NEW2 (IPLUS 2 OFST)
+                                   (\GETBASEFIXP NEW2 (IPLUS 2 UPPEROFST]
+                   (for
 OFST from
 (IPLUS \BTREEWORDSPERENTRY \BTREETOPHALFOFFSET)
+                      to
 \WORDSINBTREEMAIN by
 \BTREEWORDSPERENTRY
+                      do
 (\PUTBASEPTR NEW2 OFST NIL)
+                            (\PUTBASEFIXP NEW2 (IPLUS OFST 2)
+                                   0))
+                   (replace
 (BTREENODE UPWARD) of
 NEW2 with
 PCNODE)
+                   (replace
 (BTREENODE COUNT) of
 NEW2 with
 (ADD1 (LRSH \BTREEMAXENTRIES 1
+                                                                                   )))
+                   (\TEDIT.SET-TOTLEN
 NEW2)
+                   (\MATCHPCS
 NEW2)
+
+                   (* ;; "Now clean out the top-level node, and fill it in with its new children.")

+
+                   (for
 OFST from
 0 to
 \WORDSINBTREEMAIN by
 \BTREEWORDSPERENTRY
+                      do
 
+
+                            (* ;; "Clean out the entries in the node, so we don't over-write them by mistake, thus losing refcount sync.")

+
+                            (\RPLPTR PCNODE OFST NIL)
+                            (\PUTBASEFIXP PCNODE (IPLUS 2 OFST)
+                                   0))
+                   (\RPLPTR PCNODE 0 NEW1)                   (* ; "Add first new node")

+                   (\PUTBASEFIXP PCNODE 2 (ffetch
 (BTREENODE TOTLEN) of
 NEW1))
+                   (\RPLPTR PCNODE 4 NEW2)                   (* ; "And the second....")

+                   (\PUTBASEFIXP PCNODE 6 (ffetch
 (BTREENODE TOTLEN) of
 NEW2))
+                   (freplace
 (BTREENODE COUNT) of
 PCNODE with
 2)
+                   (freplace
 (BTREENODE TOTLEN) of
 PCNODE with
 (IPLUS (ffetch

+                                                                                   (BTREENODE TOTLEN)
+                                                                                     of
 NEW1)
+                                                                                  (ffetch

+                                                                                   (BTREENODE TOTLEN)
+                                                                                     of
 NEW2])])
+
+(\TEDIT.UPDATETREE

+  [LAMBDA (PCNODE DELTA)
                      (* ; 
+
                                                "Edited 21-Mar-95 14:40 by sybalsky:mv:envos")

+
+    (* ;; "The size of the text represented by PCNODE has grown by DELTA.  Update all of PCNODE's parents to reflect the change in length.")

+
+    (LET ((UPWARD (fetch
 (BTREENODE UPWARD) of
 PCNODE)))
+         (while
 UPWARD do
 
+
+                                 (* ;; "Keep going up in the tree til we hit the top.")

+
+                                 (for
 old
 ITEM# from
 0 by
 4 as
 I from
 1
+                                    to
 (ffetch
 (BTREENODE COUNT) of
 UPWARD)
+                                    when
 (EQ (\GETBASEPTR UPWARD ITEM#)
+                                                 PCNODE)
+                                    do
 (\PUTBASEFIXP UPWARD (IPLUS ITEM# 2)
+                                                  (IPLUS (\GETBASEFIXP UPWARD (IPLUS ITEM# 2))
+                                                         DELTA))
+                                          (add
 (fetch
 (BTREENODE TOTLEN) of
 UPWARD)
+                                                 DELTA)
+                                          (RETURN) FINALLY
 (HELP "PCNODE not in upward node."))
+                                 (SETQ PCNODE UPWARD)
+                                 (SETQ UPWARD (fetch
 (BTREENODE UPWARD) of
 PCNODE])
+
+(\TEDIT.PIECE-CHNO

+  [LAMBDA (PC)
+    (LET ((PCNODE (fetch
 (PIECE PTREENODE) of
 PC))
+          (CHARCOUNT 0))
+         (while
 PCNODE do
 [add
 CHARCOUNT (for
 OFST from
 0 by
 4
+                                                        while
 (NEQ PC (\GETBASEPTR PCNODE OFST))
+                                                        sum
 (\GETBASEFIXP PCNODE (IPLUS OFST 2]
+                                 (SETQ PC PCNODE)
+                                 (SETQ PCNODE (fetch
 (BTREENODE UPWARD) of
 PCNODE)))
+         (ADD1 CHARCOUNT])
+
+(\TEDIT.SET-TOTLEN

+  [LAMBDA (PCNODE)
                                       (* ; "Edited  9-May-93 15:40 by jds")

+
+    (* ;; "Fix the TOTLEN field of a node to match the sum of its childrens' lengths")

+
+    (replace
 (BTREENODE TOTLEN) of
 PCNODE with
 (for
 I from
 1
+                                                              to
 (fetch
 (BTREENODE COUNT)
+                                                                        of
 PCNODE) as
 ITEM#
+                                                              from
 2 by
 4
+                                                              sum
 (\GETBASEFIXP PCNODE ITEM#])
+)
+(DEFINEQ
+
+(DISPTREE

+  [LAMBDA (TREE DEPTH)
                                   (* ; "Edited 13-Apr-90 15:00 by ON")

+    (LET [(G (TREEGRAPHNODE
 TREE NIL (OR (NUMBERP DEPTH)
+                                             T]
+         (SHOWGRAPH (LAYOUTGRAPH (CADR G)
+                           (LIST (CAR G))
+                           '(VERTICAL))
+                NIL
+                #'(LAMBDA (X)
+                    (INSPECT (fetch
 NODEID of
 X])
+
+(TREEGRAPHNODE

+  [LAMBDA (TREE PARENT DEPTH)
                           (* ; "Edited 12-Jun-90 10:33 by mitani")

+    (LET (THISNODE NEWDEPTH NODEID LONODES HINODES BFNODE BFNODEID RANKNODE RANKNODEID)
+         (COND
+            ((ATOM TREE)
+             (LIST [fetch
 NODEID of
 (SETQ THISNODE (NODECREATE (CONS)
+                                                                  TREE NIL NIL (LIST PARENT]
+                   (LIST THISNODE)))
+            ((OR (EQ DEPTH T)
+                 (AND (NUMBERP DEPTH)
+                      (>= DEPTH 0)))
+             (SETQ NEWDEPTH (COND
+                               ((NUMBERP DEPTH)
+                                (SUB1 DEPTH))
+                               (T DEPTH)))
+             (SETQ NODEID (fetch
 (PCTNODE PCE) of
 TREE))
+             (SETQ LONODES (TREEGRAPHNODE
 (fetch
 (PCTNODE LO) of
 TREE)
+                                  NODEID NEWDEPTH))
+             (SETQ HINODES (TREEGRAPHNODE
 (fetch
 (PCTNODE HI) of
 TREE)
+                                  NODEID NEWDEPTH))
+             (SETQ BFNODE (NODECREATE (SETQ BFNODEID (CONS))
+                                 (fetch
 (PCTNODE BF) of
 TREE)
+                                 NIL NIL (LIST NODEID)))
+             (SETQ RANKNODE (NODECREATE (SETQ RANKNODEID (CONS))
+                                   (fetch
 (PCTNODE RANK) of
 TREE)
+                                   NIL NIL (LIST NODEID)))
+             [SETQ THISNODE (NODECREATE NODEID (fetch
 (PCTNODE CHNUM) of
 TREE)
+                                   NIL
+                                   (LIST (CAR LONODES)
+                                         BFNODEID RANKNODEID (CAR HINODES))
+                                   (AND PARENT (LIST PARENT]
+             (LIST (fetch
 NODEID of
 THISNODE)
+                   (APPEND (LIST THISNODE BFNODE RANKNODE)
+                          (CADR LONODES)
+                          (CADR HINODES])
+)
+(DECLARE%: EVAL@COMPILE
+
+(DATATYPE BTREENODE
 (
+                         (* ;; "An order-4 BTREE node for representing the piece table for TEdit.")

+
+                         DOWN1
+                         (DLEN1 FIXP)
+                         DOWN2
+                         (DLEN2 FIXP)
+                         DOWN3
+                         (DLEN3 FIXP)
+                         DOWN4
+                         (DLEN4 FIXP)
+                         DOWN5
+                         (DLEN5 FIXP)
+                         DOWN6
+                         (DLEN6 FIXP)
+                         DOWN7
+                         (DLEN7 FIXP)
+                         DOWN8
+                         (DLEN8 FIXP)
+                         SPARE5                              (* ; 
+
                                         "Used only to hold the extra piece when we're overflowing")

+                         (SPARELEN FIXP)                     (* ; "So the code is easy and fast.")

+                         (COUNT
 BITS 4)                  (* ; "# of children of this node")

+                         (UPWARD XPOINTER)                   (* ; "Parent of this node, if any.")

+                         (TOTLEN FIXP)                       (* ; 
+
                                                           "Total length of this tree and subtrees")

+                         ))
+)
+
+(/DECLAREDATATYPE 'BTREENODE
+       '(POINTER FIXP POINTER FIXP POINTER FIXP POINTER FIXP POINTER FIXP POINTER FIXP POINTER FIXP 
+               POINTER FIXP POINTER FIXP (BITS 4)
+               XPOINTER FIXP)
+       '((BTREENODE 0 POINTER)
+         (BTREENODE 2 FIXP)
+         (BTREENODE 4 POINTER)
+         (BTREENODE 6 FIXP)
+         (BTREENODE 8 POINTER)
+         (BTREENODE 10 FIXP)
+         (BTREENODE 12 POINTER)
+         (BTREENODE 14 FIXP)
+         (BTREENODE 16 POINTER)
+         (BTREENODE 18 FIXP)
+         (BTREENODE 20 POINTER)
+         (BTREENODE 22 FIXP)
+         (BTREENODE 24 POINTER)
+         (BTREENODE 26 FIXP)
+         (BTREENODE 28 POINTER)
+         (BTREENODE 30 FIXP)
+         (BTREENODE 32 POINTER)
+         (BTREENODE 34 FIXP)
+         (BTREENODE 32 (BITS . 3))
+         (BTREENODE 36 XPOINTER)
+         (BTREENODE 38 FIXP))
+       '40)
+(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
+
+(ADDTOVAR NLAMA
 )
+
+(ADDTOVAR NLAML
 )
+
+(ADDTOVAR LAMA
 )
+)
+(PUTPROPS PCTREE COPYRIGHT ("Venue & Xerox Corporation" 1990 1991 1993 1994 1995))
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (3019 23506 (UPDATEPCNODES 3029 . 4116) (FINDPCNODE 4118 . 4350) (\FIRSTNODE 4352 . 4709
+) (\DELETETREE 4711 . 7192) (\INSERTTREE 7194 . 11815) (\LASTNODE 11817 . 12460) (\MATCHPCS 12462 . 
+13586) (\SPLITTREE 13588 . 20764) (\TEDIT.UPDATETREE 20766 . 22243) (\TEDIT.PIECE-CHNO 22245 . 22824) 
+(\TEDIT.SET-TOTLEN 22826 . 23504)) (23507 25947 (DISPTREE 23517 . 23973) (TREEGRAPHNODE 23975 . 25945)
+))))
+STOP

library/new/TEDITHISTORY

@@ -0,0 +1,622 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
(FILECREATED " 4-May-95 10:38:22" {DSK}<lispcore>library>new>TEDITHISTORY.;3
 38709  
+
+      changes to%:  (FNS TEDIT.REDO.INSERTION \TEDIT.CUMULATE.EVENTS TEDIT.UNDO TEDIT.UNDO.REPLACE)
+
+      previous date%: "22-Mar-95 18:20:17" {DSK}<lispcore>library>new>TEDITHISTORY.;1)
+
+
+(* ; "
+Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1995 by Venue & Xerox Corporation.  All rights reserved.
+")
+
+(PRETTYCOMPRINT TEDITHISTORYCOMS)
+
+(RPAQQ TEDITHISTORYCOMS

+       ((FILES TEDITDECLS)
+        (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))
+               (FILES (LOADCOMP)
+                      TEDITDECLS))
+        (GLOBALVARS TEDIT.HISTORY.TYPELST TEDIT.HISTORYLST)
+        (INITVARS (TEDIT.HISTORY.TYPELST NIL)
+               (TEDIT.HISTORYLST NIL))
+        (COMS 
+              (* ;; "History-list maintenance functions")

+
+              (FNS \TEDIT.HISTORYADD \TEDIT.CUMULATE.EVENTS))
+        (COMS 
+              (* ;; "Specialized UNDO & REDO functions.")

+
+              (FNS TEDIT.UNDO TEDIT.UNDO.INSERTION TEDIT.UNDO.DELETION TEDIT.REDO 
+                   TEDIT.REDO.INSERTION TEDIT.UNDO.MOVE TEDIT.UNDO.REPLACE TEDIT.REDO.REPLACE 
+                   TEDIT.REDO.MOVE))))
+
+(FILESLOAD TEDITDECLS)
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+(DECLARE%: EVAL@COMPILE 
+
+(RPAQQ \SCRATCHLEN
 64)
+
+
+(CONSTANTS (\SCRATCHLEN 64))
+)
+
+
+(FILESLOAD (LOADCOMP)
+       TEDITDECLS)
+)
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS TEDIT.HISTORY.TYPELST TEDIT.HISTORYLST)
+)
+
+(RPAQ? TEDIT.HISTORY.TYPELST
 NIL)
+
+(RPAQ? TEDIT.HISTORYLST
 NIL)
+
+
+
+(* ;; "History-list maintenance functions")

+
+(DEFINEQ
+
+(\TEDIT.HISTORYADD

+  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited  3-Sep-87 10:36 by jds")

+          
+          (* ;; "Add a new event to the history list.  For now, this just re-sets the whole list to be the one event...")

+          
+          (* ;; 
+
          "This function also takes care of cumulating cumulative events, like successive deletions.")

+
+    (LET* ((OLDEVENT (fetch
 (TEXTOBJ TXTHISTORY) of
 TEXTOBJ))
+           (ETYPE (fetch
 (TEDITHISTORYEVENT THACTION) of
 EVENT))
+           (OETYPE (fetch
 (TEDITHISTORYEVENT THACTION) of
 OLDEVENT))
+           (REALEVENT EVENT))
+          [COND
+             ((AND OLDEVENT (EQ OETYPE ETYPE)
+                   (EQ ETYPE 'Delete))                       (* ; 
+
                                        "Repeated successive deletions.  See if we can combine them.")

+
+              (LET* [(OSTART (fetch
 (TEDITHISTORYEVENT THCH#) of
 OLDEVENT))
+                     (NSTART (fetch
 (TEDITHISTORYEVENT THCH#) of
 EVENT))
+                     (OLDEND (+ OSTART (fetch
 (TEDITHISTORYEVENT THLEN) of
 OLDEVENT)))
+                     (NEWEND (+ NSTART (fetch
 (TEDITHISTORYEVENT THLEN) of
 EVENT]
+                    (COND
+                       ((IEQP OLDEND NSTART)                 (* ; 
+
                              "The old deletion was just in front of the current one; cumulate them.")

+
+                        (SETQ REALEVENT (\TEDIT.CUMULATE.EVENTS
 OLDEVENT EVENT T)))
+                       ((IEQP NEWEND OSTART)                 (* ; 
+
                                  "The new deletion was just in front of the old one; cumulate them.")

+
+                        (SETQ REALEVENT (\TEDIT.CUMULATE.EVENTS
 EVENT OLDEVENT T]
+          (replace
 (TEXTOBJ TXTHISTORY) of
 TEXTOBJ with
 REALEVENT])
+
+(\TEDIT.CUMULATE.EVENTS

+  [LAMBDA (EVENT1 EVENT2 PIECES-TO-SAVE?)
     (* ; 
+
                                                "Edited  3-Apr-95 12:23 by sybalsky:mv:envos")

+
+    (* ;; "Accumulate history events that should really be combined into a single event.")

+
+    (* ;; "For now, this assumes they're events of the same type.  Actually, this should be able to cumulate a delete/insert pair into a replacement, etc.")

+
+    (LET* [(OLDLEN (fetch
 (TEDITHISTORYEVENT THLEN) of
 EVENT1))
+           (NEWPC1 (CAR (fetch
 (TEDITHISTORYEVENT THFIRSTPIECE) of
 EVENT2)))
+           (REALEVENT (create
 TEDITHISTORYEVENT using
 EVENT1 THLEN _
+                                                          (+ OLDLEN (fetch
 (TEDITHISTORYEVENT
+                                                                                THLEN) of
 EVENT2]
+          (bind
 (PC _ (CAR (fetch
 (TEDITHISTORYEVENT THFIRSTPIECE) of
 EVENT1)))
+                 (CHCOUNT _ 0) while
 (< (SETQ CHCOUNT (+ CHCOUNT (fetch
 (PIECE PLEN)
+                                                                        of
 PC)))
+                                            OLDLEN) do
 (SETQ PC (fetch
 (PIECE NEXTPIECE)
+                                                                       of
 PC))
+             finally
 (replace
 (PIECE NEXTPIECE) of
 PC with
 NEWPC1)
+                   (replace
 (PIECE PREVPIECE) of
 NEWPC1 with
 PC)
+                   (RETURN))
+          REALEVENT])
+)
+
+
+
+(* ;; "Specialized UNDO & REDO functions.")

+
+(DEFINEQ
+
+(TEDIT.UNDO

+  [LAMBDA (TEXTOBJ)
                           (* ; 
+
                                                "Edited 22-Mar-95 16:48 by sybalsky:mv:envos")

+
+    (* ;; "Undo the last thing this guy did.")

+
+    (COND
+       ((NOT (fetch
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ))
+
+        (* ;; "Only undo things if the document is allowed to change.")

+
+        (PROG ((SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
+               EVENT CH# LEN FIRSTPIECE)
+              (COND
+                 ((SETQ EVENT (fetch
 (TEXTOBJ TXTHISTORY) of
 TEXTOBJ))
+                                                             (* ; 
+
                                       "There really is something to UNDO.  Decide what, & fix it.")

+                  (SETQ LEN (fetch
 THLEN of
 EVENT))  (* ; 
+
                                             "Length of the text that was inserted/deleted/changed")

+                  (SETQ CH# (fetch
 THCH# of
 EVENT))  (* ; "Starting CH# of the change")

+                  (SETQ FIRSTPIECE (CAR (fetch
 THFIRSTPIECE of
 EVENT)))
+                                                             (* ; 
+
                                                           "First piece affected by the change")

+                  (RESETLST
+                      (RESETSAVE (CURSOR WAITINGCURSOR))
+                      (\SHOWSEL SEL NIL NIL)
+                      [SELECTQ (fetch
 THACTION of
 EVENT)
+                          ((Insert Copy Include)             (* ; "It was an insertion")

+                               (TEDIT.UNDO.INSERTION
 TEXTOBJ EVENT LEN CH# FIRSTPIECE))
+                          (Delete                            (* ; "It was a deletion")

+                                  (TEDIT.UNDO.DELETION
 TEXTOBJ EVENT LEN CH# FIRSTPIECE))
+                          (Looks                             (* ; "It was a character-looks change")

+                                 (TEDIT.UNDO.LOOKS TEXTOBJ EVENT LEN CH# FIRSTPIECE))
+                          (ParaLooks                         (* ; "It was a PARA looks change")

+                                     (TEDIT.UNDO.PARALOOKS TEXTOBJ EVENT LEN CH# FIRSTPIECE))
+                          (Move (TEDIT.UNDO.MOVE
 TEXTOBJ EVENT LEN CH# FIRSTPIECE)
+                                                             (* ; "He moved some text")

+                                )
+                          ((Replace LowerCase UpperCase) 
+
+                                                 (* ;; "He replaced one piece of text with another ; Lower-casing and upper-casing have the same undo event.")

+
+                               (TEDIT.UNDO.REPLACE
 TEXTOBJ EVENT LEN CH# FIRSTPIECE))
+                          (Get                               (* ; "He did a GET -- not undoable.")

+                               (TEDIT.PROMPTPRINT TEXTOBJ "You can't UNDO a GET." T))
+                          (Put                               (* ; "He did a PUT -- not undoable.")

+                               (TEDIT.PROMPTPRINT TEXTOBJ "You can't UNDO a Put." T))
+                          (COND
+                             ((AND (SETQ UNDOFN (ASSOC (fetch
 THACTION of
 EVENT)
+                                                       TEDIT.HISTORY.TYPELST))
+                                   (SETQ UNDOFN (CADDR UNDOFN)))
+                                                             (* ; 
+
                                    "TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)")

+                              (APPLY* UNDOFN TEXTOBJ EVENT LEN CH# FIRSTPIECE))
+                             (T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "UNDO not implemented for "
+                                                                  (fetch
 THACTION of
 EVENT))
+                                       T]
+                      (\SHOWSEL SEL NIL T)))
+                 (T (TEDIT.PROMPTPRINT TEXTOBJ "Nothing to UNDO." T])
+
+(TEDIT.UNDO.INSERTION

+  [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE)
             (* ; "Edited 21-Apr-93 01:33 by jds")

+
+    (* ;; "UNDO a prior Insert, Copy, or Include.")

+
+    (PROG (OBJ DELETEFN)
+          (replace
 (TEXTOBJ \INSERTPCVALID) of
 TEXTOBJ with
 NIL)
+                                                             (* ; 
+
          "Keep TEdit from reusing the current cache piece in the future -- it is probably invalid")

+          (\DELETECH CH# (IPLUS CH# LEN)
+                 LEN TEXTOBJ)
+          (\FIXDLINES (fetch
 (TEXTOBJ LINES) of
 TEXTOBJ)
+                 (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
+                 CH#
+                 (IPLUS CH# LEN)
+                 TEXTOBJ)                                    (* ; 
+
                                                           "Fix the line descriptors & selection")

+          (TEDIT.UPDATE.SCREEN TEXTOBJ)                      (* ; 
+
                                                         "Fix up the display for all this foofaraw")

+          (replace
 (SELECTION POINT) of
 (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
+             with
 'LEFT)
+          (\FIXSEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
+                 TEXTOBJ)                                    (* ; "Really fix the selection")

+          (replace
 THACTION of
 EVENT with
 'Delete)
+                                                             (* ; 
+
                                  "Make the UNDO be UNDOable, by changing the event to a deletion.")

+      ])
+
+(TEDIT.UNDO.DELETION

+  [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE)
             (* ; "Edited 21-Apr-93 12:01 by jds")

+
+    (* ;; "UNDO a prior Deletion of text.")

+
+    (PROG ((NPC (fetch
 (PIECE NEXTPIECE) of
 FIRSTPIECE))
+           (PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
+           (SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
+           (OTEXTLEN (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ))
+           NEWPIECE INSPC OBJECT INSERTFN START-OF-PIECE)
+          (SETQ INSPC (\CHTOPC CH# PCTB T))
+          (replace
 (TEXTOBJ \INSERTPCVALID) of
 TEXTOBJ with
 NIL)
+                                                             (* ; 
+
  "Keep future people from stepping on the current cache piece, which is probably no longer valid.")

+          (COND
+             ((fetch
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ)
+                                                             (* ; 
+
                                                           "Don't change read-only documents.")

+              (RETURN)))
+          [COND
+             ((IGREATERP CH# START-OF-PIECE)
+              (SETQ INSPC (\SPLITPIECE INSPC (- CH# START-OF-PIECE)
+                                 TEXTOBJ INSPC#]
+          (SETQ NEWPIECE (create
 PIECE using
 FIRSTPIECE))
+          (replace
 THFIRSTPIECE of
 EVENT with
 NEWPIECE)
+          (bind
 (TL _ 0) while
 (ILESSP TL LEN) do
 (\INSERTPIECE NEWPIECE INSPC TEXTOBJ) 
+                                                             (* ; "Insert the piece back in")

+                                                             [COND
+                                                                ([AND (SETQ OBJECT
+                                                                       (fetch
 (PIECE POBJ)
+                                                                          of
 NEWPIECE))
+                                                                      (SETQ INSERTFN
+                                                                       (IMAGEOBJPROP OBJECT
+                                                                              'WHENINSERTEDFN]
+                                                             (* ; 
+
                                      "If this is an imageobject, and it has an insertfn, call it.")

+                                                                 (APPLY* INSERTFN OBJECT (
+                                                                                      \TEDIT.PRIMARYW
+                                                                                          TEXTOBJ)
+                                                                        NIL
+                                                                        (TEXTSTREAM TEXTOBJ]
+                                                             (SETQ TL (IPLUS TL (fetch

+                                                                                 (PIECE PLEN)
+                                                                                   of
 FIRSTPIECE)
+                                                                             )) 
+                                                             (* ; 
+
                                                         "Keep track of how much we've re-inserted")

+                                                             (SETQ FIRSTPIECE NPC) 
+                                                             (* ; 
+
                                                           "Move to the next piece to insert")

+                                                             (AND NPC (SETQ NPC (fetch

+                                                                                 (PIECE NEXTPIECE)
+                                                                                   of
 NPC)))
+                                                             (SETQ NEWPIECE (create
 PIECE
+                                                                               using
 FIRSTPIECE))
+                 )                                           (* ; 
+
                                       "Done here because \INSERTPIECE creams the NEXTPIECE field.")

+          (replace
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ with
 (IPLUS (fetch
 (TEXTOBJ TEXTLEN)
+                                                                           of
 TEXTOBJ)
+                                                                        LEN))
+                                                             (* ; 
+
                                            "Reset the text length and EOF ptr of the text stream.")

+          (\FIXILINES TEXTOBJ SEL CH# LEN OTEXTLEN)          (* ; 
+
                                                           "Fix the line descriptors & selection")

+          (TEDIT.UPDATE.SCREEN TEXTOBJ)                      (* ; 
+
                                                         "Fix up the display for all this foofaraw")

+          (replace
 (SELECTION CH#) of
 SEL with
 CH#)
+                                                             (* ; 
+
                                                 "Make the selection point at the re-inserted text")

+          (replace
 (SELECTION CHLIM) of
 SEL with
 (IPLUS CH# LEN))
+          (replace
 (SELECTION DCH) of
 SEL with
 LEN)
+          (replace
 (SELECTION POINT) of
 SEL with
 (fetch
 THPOINT of
 EVENT))
+          (\TEDIT.SET.SEL.LOOKS SEL 'NORMAL)
+          (\FIXSEL SEL TEXTOBJ)                              (* ; "Really fix the selection")

+          (replace
 THACTION of
 EVENT with
 'Insert)
+                                                             (* ; 
+
                                 "Make the UNDO be UNDOable, by changing the event to a insertion.")

+      ])
+
+(TEDIT.REDO

+  [LAMBDA (TEXTOBJ)
                                      (* ; "Edited 30-May-91 21:27 by jds")

+
+    (* ;; "REDO the last thing this guy did.")

+
+    (PROG ((SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
+           EVENT CH)
+          (COND
+             ((FETCH
 (TEXTOBJ TXTREADONLY) OF
 TEXTOBJ)
+
+              (* ;; "The document is read-only; don't make any changes.")

+
+              NIL)
+             ((SETQ EVENT (fetch
 (TEXTOBJ TXTHISTORY) of
 TEXTOBJ))
+                                                             (* ; 
+
                                          "There really is something to REDO Decide what, & do it.")

+              (RESETLST
+                  (RESETSAVE (CURSOR WAITINGCURSOR))
+                  (\SHOWSEL SEL NIL NIL)
+                  (SELECTQ (fetch
 THACTION of
 EVENT)
+                      ((Insert Copy Include)                 (* ; "It was an insertion")

+                           (TEDIT.REDO.INSERTION
 TEXTOBJ EVENT
+                                  (IMAX 1 (SELECTQ (fetch
 (SELECTION POINT) of
 SEL)
+                                              (LEFT (fetch
 (SELECTION CH#) of
 SEL))
+                                              (RIGHT (fetch
 (SELECTION CHLIM) of
 SEL))
+                                              NIL))))
+                      (Delete                                (* ; "It was a deletion")

+                              (\TEDIT.DELETE SEL TEXTOBJ))
+                      (Replace                               (* ; 
+
                                                        "It was a replacement (a del/insert combo)")

+                               (TEDIT.REDO.REPLACE
 TEXTOBJ EVENT))
+                      (LowerCase                             (* ; "He lower-cased something")

+                                 (\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL))
+                      (UpperCase                             (* ; "He upper-cased something")

+                                 (\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL))
+                      (Looks                                 (* ; "It was a looks change")

+                             (TEDIT.REDO.LOOKS TEXTOBJ EVENT (IMAX 1
+                                                                   (SELECTQ (fetch
 (SELECTION
+                                                                                        POINT)
+                                                                               of
 SEL)
+                                                                       (LEFT (fetch
 (SELECTION
+                                                                                         CH#)
+                                                                                of
 SEL))
+                                                                       (RIGHT (fetch
 (SELECTION
+                                                                                          CHLIM)
+                                                                                 of
 SEL))
+                                                                       NIL))))
+                      (ParaLooks                             (* ; "It was a Paragraph looks change")

+                                 (TEDIT.REDO.PARALOOKS TEXTOBJ EVENT
+                                        (IMAX 1 (SELECTQ (fetch
 (SELECTION POINT) of
 SEL)
+                                                    (LEFT (fetch
 (SELECTION CH#) of
 SEL))
+                                                    (RIGHT (fetch
 (SELECTION CHLIM) of
 SEL))
+                                                    NIL))))
+                      (Find                                  (* ; "EXACT-MATCH SEARCH COMMAND")

+                            (RESETLST
+                                (RESETSAVE (CURSOR WAITINGCURSOR))
+                                (TEDIT.PROMPTPRINT TEXTOBJ "Searching..." T)
+                                (SETQ SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
+                                (\SHOWSEL SEL NIL NIL)
+                                (SETQ CH (TEDIT.FIND TEXTOBJ (fetch
 THAUXINFO of
 EVENT)))
+                                (COND
+                                   (CH (TEDIT.PROMPTPRINT TEXTOBJ "done.")
+                                       (replace
 (SELECTION CH#) of
 SEL with
 CH)
+                                       [replace
 (SELECTION CHLIM) of
 SEL
+                                          with
 (IPLUS CH (NCHARS (fetch
 THAUXINFO
+                                                                        of
 EVENT]
+                                       (replace
 (SELECTION DCH) of
 SEL
+                                          with
 (NCHARS (fetch
 THAUXINFO of
 EVENT)))
+                                       (replace
 (SELECTION POINT) of
 SEL with

+                                                                                 'RIGHT)
+                                       (\FIXSEL SEL TEXTOBJ)
+                                       (TEDIT.NORMALIZECARET TEXTOBJ)
+                                       (\SHOWSEL SEL NIL T))
+                                   (T (TEDIT.PROMPTPRINT TEXTOBJ "[Not found]"))))
+                            (replace
 (TEXTOBJ \INSERTPCVALID) of
 TEXTOBJ with
 NIL)
+                                                             (* ; "Drop the cached piece.  WHY??")

+                            )
+                      ((Move ReplaceMove)                    (* ; "He moved some text")

+                           (TEDIT.REDO.MOVE
 TEXTOBJ EVENT (fetch
 THLEN of
 EVENT)
+                                  (IMAX 1 (SELECTQ (fetch
 (SELECTION POINT) of
 SEL)
+                                              (LEFT (fetch
 (SELECTION CH#) of
 SEL))
+                                              (RIGHT (fetch
 (SELECTION CHLIM) of
 SEL))
+                                              NIL))
+                                  (fetch
 THFIRSTPIECE of
 EVENT)))
+                      (Get                                   (* ; "He did a GET -- not undoable.")

+                           (TEDIT.PROMPTPRINT TEXTOBJ "You can't REDO a GET." T))
+                      (Put                                   (* ; "He did a PUT -- not undoable.")

+                           (TEDIT.PROMPTPRINT TEXTOBJ "You can't REDO a PUT." T))
+                      (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "REDO of the action " (fetch
 THACTION
+                                                                                  of
 EVENT)
+                                                        " isn't implemented.")
+                             T))
+                  (\SHOWSEL SEL NIL T)))
+             (T (TEDIT.PROMPTPRINT TEXTOBJ "Nothing to REDO." T])
+
+(TEDIT.REDO.INSERTION

+  [LAMBDA (TEXTOBJ EVENT CH#)
                 (* ; 
+
                                                "Edited  3-Apr-95 15:55 by sybalsky:mv:envos")

+                                                             (* ; 
+
                                                        "REDO a prior Insert/Copy/Include of text.")

+    (PROG (INSPC INSPC# NPC (SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
+                 (PCTB (fetch
 (TEXTOBJ PCTB) of
 TEXTOBJ))
+                 (LEN (fetch
 THLEN of
 EVENT))
+                 (FIRSTPIECE (create
 PIECE using
 (CAR (fetch
 THFIRSTPIECE of
 EVENT))
+                                                     PNEW _ T))
+                 (OTEXTLEN (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ))
+                 OBJ COPYFN ORIGFIRSTPC)
+          (SETQ ORIGFIRSTPC FIRSTPIECE)
+          (replace
 THFIRSTPIECE of
 EVENT with
 (LIST FIRSTPIECE))
+                                                             (* ; 
+
                                         "So we can UNDO this, and remove the right set of pieces.")

+          (replace
 (TEXTOBJ \INSERTPCVALID) of
 TEXTOBJ with
 NIL)
+                                                             (* ; 
+
                                                 "Force any further insertions to make new pieces.")

+          (SETQ NPC (fetch
 (PIECE NEXTPIECE) of
 FIRSTPIECE))
+          (SETQ INSPC (\CHTOPC CH# PCTB T))
+          [SETQ INSPC (COND
+                         ((IEQP CH# START-OF-PIECE)          (* ; 
+
                                                    "We're inserting just before an existing piece")

+                          INSPC)
+                         (T                                  (* ; 
+
                                     "We must split this piece, and insert before the second part.")

+                            (\SPLITPIECE INSPC (- CH# START-OF-PIECE)
+                                   TEXTOBJ]
+          (bind
 (TL _ 0) while
 (ILESSP TL LEN)
+             do
 
+
+                   (* ;; "Loop thru the pieces of the prior insertion, inserting copies of enough of them to cover the length of the insertion.")

+
+                   [COND
+                      ((SETQ OBJ (fetch
 (PIECE POBJ) of
 FIRSTPIECE))
+                                                             (* ; "This piece describes an object")

+                       [COND
+                          [(SETQ COPYFN (IMAGEOBJPROP OBJ 'COPYFN))
+                           (SETQ OBJ (APPLY* COPYFN OBJ (fetch
 (TEXTOBJ STREAMHINT) of
 
+                                                                                              TEXTOBJ
+                                                               )
+                                            (fetch
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ)))
+                           (COND
+                              ((EQ OBJ 'DON'T)
+                               (TEDIT.PROMPTPRINT TEXTOBJ "COPY of this object not allowed." T)
+                               (RETFROM 'TEDIT.COPY))
+                              (T (replace
 (PIECE POBJ) of
 FIRSTPIECE with
 OBJ]
+                          (OBJ (replace
 (PIECE POBJ) of
 FIRSTPIECE with
 (COPY OBJ]
+                       (COND
+                          ((SETQ COPYFN (IMAGEOBJPROP OBJ 'WHENCOPIEDFN))
+                                                             (* ; 
+
                                                       "If there's an eventfn for copying, use it.")

+                           (APPLY* COPYFN OBJ (WINDOWPROP (CAR (fetch
 (TEXTOBJ \WINDOW)
+                                                                  of
 TEXTOBJ))
+                                                     'DSP)
+                                  (fetch
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ)
+                                  (fetch
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ]
+                   (\INSERTPIECE FIRSTPIECE INSPC TEXTOBJ)   (* ; "Insert the piece back in")

+                   (SETQ TL (IPLUS TL (fetch
 (PIECE PLEN) of
 FIRSTPIECE))) 
+                                                             (* ; 
+
                                                         "Keep track of how much we've re-inserted")

+                   (SETQ FIRSTPIECE (create
 PIECE using
 NPC PNEW _ T)) 
+                                                             (* ; 
+
                                                           "Move to the next piece to insert")

+                   (AND NPC (SETQ NPC (fetch
 (PIECE NEXTPIECE) of
 NPC))) 
+                                                             (* ; 
+
                                       "Done here because \INSERTPIECE creams the NEXTPIECE field.")

+                 )
+          (\TEDIT.DIFFUSE.PARALOOKS (fetch
 (PIECE PREVPIECE) of
 ORIGFIRSTPC)
+                 INSPC)                                      (* ; 
+
                                            "propagate paragraph formatting into the new insertion")

+          (replace
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ with
 (IPLUS (fetch
 (TEXTOBJ TEXTLEN)
+                                                                           of
 TEXTOBJ)
+                                                                        LEN))
+                                                             (* ; 
+
                                            "Reset the text length and EOF ptr of the text stream.")

+          (\FIXILINES TEXTOBJ SEL CH# LEN OTEXTLEN)          (* ; 
+
                                                           "Fix the line descriptors & selection")

+          (TEDIT.UPDATE.SCREEN TEXTOBJ)                      (* ; 
+
                                                         "Fix up the display for all this foofaraw")

+          (replace
 (SELECTION CH#) of
 SEL with
 CH#)
+                                                             (* ; 
+
                                                 "Make the selection point at the re-inserted text")

+          (replace
 (SELECTION CHLIM) of
 SEL with
 (IPLUS CH# LEN))
+          (replace
 (SELECTION DCH) of
 SEL with
 LEN)
+          (\TEDIT.SET.SEL.LOOKS SEL 'NORMAL)
+          (\FIXSEL SEL TEXTOBJ)                              (* ; "Really fix the selection")

+          (replace
 THACTION of
 EVENT with
 'Insert)
+                                                             (* ; 
+
                                 "Make the UNDO be UNDOable, by changing the event to a insertion.")

+      ])
+
+(TEDIT.UNDO.MOVE

+  [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE)
             (* ; "Edited 30-May-91 21:27 by jds")

+                                                             (* ; "UNDO a MOVE command")

+    (PROG ((TOOBJ (fetch
 THAUXINFO of
 EVENT))
+           (FROMOBJ (fetch
 THTEXTOBJ of
 EVENT))
+           (SOURCECH# (fetch
 THOLDINFO of
 EVENT))
+           (CH# (fetch
 THCH# of
 EVENT))
+           TOSEL TOTEXTLEN)
+          (\SHOWSEL (fetch
 (TEXTOBJ SEL) of
 TOOBJ)
+                 NIL NIL)                                    (* ; 
+
                                   "Turn off the selections in the old source and target documents")

+          (\SHOWSEL (fetch
 (TEXTOBJ SEL) of
 FROMOBJ)
+                 NIL NIL)
+          (\DELETECH CH# (IPLUS CH# LEN)
+                 LEN FROMOBJ)                                (* ; 
+
                                  "Delete the characters we moved, from the place we moved them to")

+          (\FIXDLINES (fetch
 (TEXTOBJ LINES) of
 FROMOBJ)
+                 (fetch
 (TEXTOBJ SEL) of
 FROMOBJ)
+                 CH#
+                 (IPLUS CH# LEN)
+                 FROMOBJ)
+          (replace
 (SELECTION CH#) of
 (fetch
 (TEXTOBJ SEL) of
 FROMOBJ)
+             with
 (replace
 (SELECTION CHLIM) of
 (fetch
 (TEXTOBJ SEL) of
 FROMOBJ)
+                         with
 CH#))                      (* ; 
+
                  "Make this document's selection be a point sel at the place the text used to be.")

+          (replace
 (SELECTION DCH) of
 (fetch
 (TEXTOBJ SEL) of
 FROMOBJ) with

+                                                                                       0)
+          (replace
 (SELECTION POINT) of
 (fetch
 (TEXTOBJ SEL) of
 FROMOBJ)
+             with
 'LEFT)                                 (* ; 
+
                                                     "Mark lines for update, and fix the selection")

+          (SETQ TOTEXTLEN (fetch
 (TEXTOBJ TEXTLEN) of
 TOOBJ))
+                                                             (* ; 
+
          "The pre-insertion len of the place the text is returning to, for the line udpater below")

+          (\TEDIT.INSERT.PIECES TOOBJ SOURCECH# (fetch
 THFIRSTPIECE of
 EVENT)
+                 LEN)
+
+     (* ;; "Put the pieces we moved back where they came from (no need to copy them, since we did that on the original move.)")

+
+          (\FIXILINES TOOBJ (fetch
 (TEXTOBJ SEL) of
 TOOBJ)
+                 SOURCECH# LEN TOTEXTLEN)                    (* ; 
+
                                          "Mark lines that need updating, and fix up the selection")

+          (add
 (fetch
 (TEXTOBJ TEXTLEN) of
 TOOBJ)
+                 LEN)                                        (* ; 
+
                                              "Update the text length of the erstwhile move source")

+          (TEDIT.UPDATE.SCREEN FROMOBJ)                      (* ; 
+
                                                      "Update the erstwhile text location's image.")

+          (COND
+             ((NEQ FROMOBJ TOOBJ)                            (* ; 
+
            "If they aren't the same document, we need to update the other document image as well.")

+              (TEDIT.UPDATE.SCREEN TOOBJ)))
+          (\FIXSEL (fetch
 (TEXTOBJ SEL) of
 TOOBJ)
+                 TOOBJ)                                      (* ; 
+
                                                 "Fix up the selections so their images will be OK")

+          (\FIXSEL (fetch
 (TEXTOBJ SEL) of
 FROMOBJ)
+                 FROMOBJ)
+          (\COPYSEL (fetch
 (TEXTOBJ SEL) of
 FROMOBJ)
+                 TEDIT.SELECTION)                            (* ; 
+
                                    "It's handy to think of this as the last selection made, also.")

+          (replace
 THACTION of
 EVENT with
 'Move)
+          (replace
 THTEXTOBJ of
 EVENT with
 TOOBJ)
+          (replace
 THAUXINFO of
 EVENT with
 FROMOBJ)
+          (replace
 THOLDINFO of
 EVENT with
 CH#)
+          (replace
 THCH# of
 EVENT with
 SOURCECH#)
+          (\SHOWSEL (fetch
 (TEXTOBJ SEL) of
 TOOBJ)
+                 NIL T)
+          (\SHOWSEL (fetch
 (TEXTOBJ SEL) of
 FROMOBJ)
+                 NIL T])
+
+(TEDIT.UNDO.REPLACE

+  [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE)
  (* ; 
+
                                                "Edited 22-Mar-95 16:47 by sybalsky:mv:envos")

+    (PROG ((OLDEVENT (fetch
 THOLDINFO of
 EVENT))
+           (CH# (fetch
 THCH# of
 EVENT))
+           (SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)))
+          (\SHOWSEL SEL NIL NIL)
+          (TEDIT.UNDO.INSERTION
 TEXTOBJ EVENT LEN CH# FIRSTPIECE)
+          (\SHOWSEL SEL NIL NIL)
+          (TEDIT.UNDO.DELETION
 TEXTOBJ OLDEVENT (fetch
 THLEN of
 OLDEVENT)
+                 CH#
+                 (CAR (fetch
 THFIRSTPIECE of
 OLDEVENT)))
+          (replace
 THOLDINFO of
 OLDEVENT with
 EVENT)
+          (replace
 THACTION of
 OLDEVENT with
 'Replace)
+          (replace
 THOLDINFO of
 EVENT with
 NIL)
+          (\TEDIT.HISTORYADD
 TEXTOBJ OLDEVENT)
+          (replace
 (SELECTION CH#) of
 SEL with
 CH#)
+          (replace
 (SELECTION CHLIM) of
 SEL with
 (IPLUS CH# (fetch
 THLEN of

+                                                                                         OLDEVENT)))
+          (replace
 (SELECTION DCH) of
 SEL with
 (fetch
 THLEN of
 OLDEVENT))
+          (replace
 (SELECTION POINT) of
 SEL with
 (fetch
 THPOINT of
 EVENT))
+          (replace
 THPOINT of
 OLDEVENT with
 (fetch
 THPOINT of
 EVENT))
+          (\FIXSEL SEL TEXTOBJ)
+          (\SHOWSEL SEL NIL T])
+
+(TEDIT.REDO.REPLACE

+  [LAMBDA (TEXTOBJ EVENT)
                                (* ; "Edited 30-May-91 21:28 by jds")

+    (PROG ((OLDEVENT (fetch
 THOLDINFO of
 EVENT))
+           (CH# (fetch
 (SELECTION CH#) of
 (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)))
+           (SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)))
+          (\SHOWSEL SEL NIL NIL)
+          (\DELETECH (fetch
 (SELECTION CH#) of
 SEL)
+                 (fetch
 (SELECTION CHLIM) of
 SEL)
+                 (IDIFFERENCE (fetch
 (SELECTION CHLIM) of
 SEL)
+                        (fetch
 (SELECTION CH#) of
 SEL))
+                 TEXTOBJ)
+          (\FIXDLINES (fetch
 (TEXTOBJ LINES) of
 TEXTOBJ)
+                 SEL
+                 (fetch
 (SELECTION CH#) of
 SEL)
+                 (fetch
 (SELECTION CHLIM) of
 SEL)
+                 TEXTOBJ)
+          (replace
 (SELECTION POINT) of
 SEL with
 'LEFT)
+          (TEDIT.REDO.INSERTION
 TEXTOBJ EVENT CH#)
+          (replace
 THOLDINFO of
 EVENT with
 (SETQ OLDEVENT (fetch
 (TEXTOBJ TXTHISTORY)
+                                                                         of
 TEXTOBJ)))
+          (replace
 THACTION of
 OLDEVENT with
 'Replace)
+          (replace
 THACTION of
 EVENT with
 'Replace)
+          (replace
 THCH# of
 EVENT with
 CH#)
+          (\TEDIT.HISTORYADD
 TEXTOBJ EVENT])
+
+(TEDIT.REDO.MOVE

+  [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE)
             (* ; "Edited 30-May-91 21:28 by jds")

+    (PROG ((FROMOBJ TEXTOBJ)
+           (SOURCECH# (fetch
 THOLDINFO of
 EVENT))
+           (OLDCH# (fetch
 THCH# of
 EVENT))
+           (SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
+           (MOVESEL (fetch
 (TEXTOBJ MOVESEL) of
 TEXTOBJ))
+           OLDCHLIM)
+          (replace
 (SELECTION CH#) of
 MOVESEL with
 OLDCH#)
+          (replace
 (SELECTION CHLIM) of
 MOVESEL with
 (IPLUS OLDCH# LEN))
+          (replace
 (SELECTION DCH) of
 MOVESEL with
 LEN)
+          (replace
 (SELECTION SET) of
 MOVESEL with
 T)
+          (\FIXSEL MOVESEL TEXTOBJ)
+          (\TEDIT.SET.SEL.LOOKS MOVESEL 'MOVE)
+          (TEDIT.MOVE MOVESEL SEL])
+)
+(PUTPROPS TEDITHISTORY COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1990 1991 1993 
+1995))
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (1696 5135 (\TEDIT.HISTORYADD 1706 . 3591) (\TEDIT.CUMULATE.EVENTS 3593 . 5133)) (5188 
+38576 (TEDIT.UNDO 5198 . 9210) (TEDIT.UNDO.INSERTION 9212 . 10798) (TEDIT.UNDO.DELETION 10800 . 16735)
+ (TEDIT.REDO 16737 . 23674) (TEDIT.REDO.INSERTION 23676 . 30392) (TEDIT.UNDO.MOVE 30394 . 34827) (
+TEDIT.UNDO.REPLACE 34829 . 36330) (TEDIT.REDO.REPLACE 36332 . 37757) (TEDIT.REDO.MOVE 37759 . 38574)))
+))
+STOP

lispusers/NEWCONTRACTENG.RTF

@@ -1,352 +0,0 @@
-{\rtf1\ansi\ansicpg1252\uc1 \deff63\deflang1033\deflangfe1030{\fonttbl{\f0\froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}{\f2\fmodern\fcharset0\fprq1{\*\panose 02070309020205020404}Courier New;}
-{\f3\froman\fcharset2\fprq2{\*\panose 05050102010706020507}Symbol;}{\f62\froman\fcharset0\fprq2{\*\panose 00000000000000000000}Serifa 55{\*\falt Times New Roman};}
-{\f63\froman\fcharset0\fprq2{\*\panose 00000000000000000000}Serifa 45{\*\falt Times New Roman};}{\f70\froman\fcharset238\fprq2 Times New Roman CE;}{\f71\froman\fcharset204\fprq2 Times New Roman Cyr;}{\f73\froman\fcharset161\fprq2 Times New Roman Greek;}
-{\f74\froman\fcharset162\fprq2 Times New Roman Tur;}{\f75\froman\fcharset186\fprq2 Times New Roman Baltic;}{\f82\fmodern\fcharset238\fprq1 Courier New CE;}{\f83\fmodern\fcharset204\fprq1 Courier New Cyr;}{\f85\fmodern\fcharset161\fprq1 Courier New Greek;}
-{\f86\fmodern\fcharset162\fprq1 Courier New Tur;}{\f87\fmodern\fcharset186\fprq1 Courier New Baltic;}}{\colortbl;\red0\green0\blue0;\red0\green0\blue255;\red0\green255\blue255;\red0\green255\blue0;\red255\green0\blue255;\red255\green0\blue0;
-\red255\green255\blue0;\red255\green255\blue255;\red0\green0\blue128;\red0\green128\blue128;\red0\green128\blue0;\red128\green0\blue128;\red128\green0\blue0;\red128\green128\blue0;\red128\green128\blue128;\red192\green192\blue192;}{\stylesheet{
-\widctlpar\adjustright \f63\lang1030 \snext0 Normal;}{\s1\fi-432\li432\sl-280\slmult0\keepn\widctlpar\jclisttab\tx432\adjustright \b\f62\fs32\lang1030\kerning28 \sbasedon0 \snext0 heading 1;}{\s2\fi-576\li576\sl-280\slmult0\keepn\widctlpar
-\jclisttab\tx576\ls1\ilvl1\adjustright \b\i\f62\lang1030 \sbasedon0 \snext0 heading 2;}{\s3\fi-720\li720\sl-280\slmult0\keepn\widctlpar\jclisttab\tx720\ls1\ilvl2\adjustright \f62\lang1030 \sbasedon0 \snext0 heading 3;}{\s4\fi-864\li864\sl-280\slmult0
-\keepn\widctlpar\jclisttab\tx864\ls1\ilvl3\adjustright \f62\lang1030 \sbasedon0 \snext0 heading 4;}{\s5\fi-1008\li1008\sl-280\slmult0\widctlpar\jclisttab\tx1008\ls1\ilvl4\adjustright \f62\lang1030 \sbasedon0 \snext0 heading 5;}{
-\s6\fi-1152\li1152\sl-280\slmult0\widctlpar\jclisttab\tx1152\ls1\ilvl5\adjustright \f62\lang1030 \sbasedon0 \snext0 heading 6;}{\s7\fi-1296\li1296\sb240\sa60\sl-280\slmult0\widctlpar\jclisttab\tx1296\ls1\ilvl6\adjustright \f63\fs20\lang1030 
-\sbasedon0 \snext0 heading 7;}{\s8\fi-1440\li1440\sb240\sa60\sl-280\slmult0\widctlpar\jclisttab\tx1440\ls1\ilvl7\adjustright \i\f63\fs20\lang1030 \sbasedon0 \snext0 heading 8;}{\s9\fi-1584\li1584\sb240\sa60\sl-280\slmult0\widctlpar
-\jclisttab\tx1584\ls1\ilvl8\adjustright \i\f63\fs18\lang1030 \sbasedon0 \snext0 heading 9;}{\*\cs10 \additive Default Paragraph Font;}{\s15\widctlpar\adjustright \i\f63\lang1030 \sbasedon0 \snext0 Resume;}{\s16\sl-200\slmult0\widctlpar\adjustright 
-\b\f63\fs16\lang1030 \sbasedon0 \snext16 Proveniensoplysninger;}{\s17\widctlpar\tqc\tx4819\tqr\tx9638\adjustright \f63\lang1030 \sbasedon0 \snext17 header;}{\s18\widctlpar\tqc\tx4819\tqr\tx9638\adjustright \f63\lang1030 \sbasedon0 \snext18 footer;}{\*
-\cs19 \additive \sbasedon10 page number;}{\s20\fi-432\li432\sl-280\slmult0\keepn\widctlpar\jclisttab\tx432{\*\pn \pnlvlbody\ilvl11\ls2047\pnrnot0\pndec }\ls2047\ilvl11\adjustright \b\f62\fs32\lang1030\kerning28 \sbasedon1 \snext0 Overskrift  uden nummer;}
-{\s21\widctlpar\adjustright \f63\fs20\lang1030 \sbasedon0 \snext21 footnote text;}{\*\cs22 \additive \super \sbasedon10 footnote reference;}{\s23\widctlpar\tx851\adjustright \b\f63\fs36\cf1\lang1030 \sbasedon0 \snext23 Body Text;}{\s24\sl1\slmult0
-\widctlpar\box\brdrs\brdrw15\brsp20\brdrcf16 \brdrbtw\brdrs\brdrw15\brsp20\brdrcf16 \tx0\tx7657\tx8508\adjustright \shading2500\cfpat7\cbpat8 \f63\expndtw-3\cf1\lang2057 \sbasedon0 \snext24 Body Text 2;}{\s25\widctlpar\tx0\tx7657\tx8508\adjustright 
-\f63\expndtw-3\cf1\lang1030 \sbasedon0 \snext25 Body Text 3;}{\s26\sb120\sa120\widctlpar\adjustright \b\caps\f63\fs20\lang1030 \sbasedon0 \snext0 \sautoupd toc 1;}{\s27\li240\widctlpar\adjustright \scaps\f63\fs20\lang1030 \sbasedon0 \snext0 \sautoupd 
-toc 2;}{\s28\li480\widctlpar\adjustright \i\f63\fs20\lang1030 \sbasedon0 \snext0 \sautoupd toc 3;}{\s29\li720\widctlpar\adjustright \f63\fs18\lang1030 \sbasedon0 \snext0 \sautoupd toc 4;}{\s30\li960\widctlpar\adjustright \f63\fs18\lang1030 
-\sbasedon0 \snext0 \sautoupd toc 5;}{\s31\li1200\widctlpar\adjustright \f63\fs18\lang1030 \sbasedon0 \snext0 \sautoupd toc 6;}{\s32\li1440\widctlpar\adjustright \f63\fs18\lang1030 \sbasedon0 \snext0 \sautoupd toc 7;}{\s33\li1680\widctlpar\adjustright 
-\f63\fs18\lang1030 \sbasedon0 \snext0 \sautoupd toc 8;}{\s34\li1920\widctlpar\adjustright \f63\fs18\lang1030 \sbasedon0 \snext0 \sautoupd toc 9;}{\*\cs35 \additive \v\f2\cf12\sub tw4winMark;}{\*\cs36 \additive \fs16 \sbasedon10 annotation reference;}{
-\s37\widctlpar\adjustright \f63\fs20\lang1030 \sbasedon0 \snext37 annotation text;}{\*\cs38 \additive \f2\fs40\cf4 tw4winError;}{\*\cs39 \additive \cf2 tw4winTerm;}{\*\cs40 \additive \f2\cf11\lang1024 tw4winPopup;}{\*\cs41 \additive \f2\cf10\lang1024 
-tw4winJump;}{\*\cs42 \additive \f2\cf15\lang1024 tw4winExternal;}{\*\cs43 \additive \f2\cf6\lang1024 tw4winInternal;}}{\*\listtable{\list\listtemplateid-1{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat1\levelspace120\levelindent432{\leveltext
-\'01\'00;}{\levelnumbers\'01;}\fi-432\li432 }{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat1\levelspace120\levelindent576{\leveltext\'03\'00.\'01;}{\levelnumbers\'01\'03;}\fi-576\li576 }{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat1
-\levelspace120\levelindent720{\leveltext\'05\'00.\'01.\'02;}{\levelnumbers\'01\'03\'05;}\fi-720\li720 }{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat1\levelspace120\levelindent864{\leveltext\'07\'00.\'01.\'02.\'03;}{\levelnumbers
-\'01\'03\'05\'07;}\fi-864\li864 }{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat1\levelspace120\levelindent1008{\leveltext\'09\'00.\'01.\'02.\'03.\'04;}{\levelnumbers\'01\'03\'05\'07\'09;}\fi-1008\li1008 }{\listlevel\levelnfc0\leveljc0
-\levelfollow0\levelstartat1\levelspace120\levelindent1152{\leveltext\'0b\'00.\'01.\'02.\'03..\'04.;}{\levelnumbers\'01\'03\'05\'07\'09\'0b;}\fi-1152\li1152 }{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat1\levelspace120\levelindent1296{\leveltext
-\'0d\'00.\'01.\'02.\'03.\'04.\'05.\'06;}{\levelnumbers\'01\'03\'05\'07\'09\'0b\'0d;}\fi-1296\li1296 }{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat1\levelspace120\levelindent1440{\leveltext
-\'0f\'00.\'01.\'02.\'03.\'04.\'05.\'06.\'07;}{\levelnumbers\'01\'03\'05\'07\'09\'0b\'0d\'0f;}\fi-1440\li1440 }{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat1\levelspace120\levelindent1584{\leveltext
-\'11\'00.\'01.\'02.\'03.\'04.\'05.\'06.\'07.\'08;}{\levelnumbers\'01\'03\'05\'07\'09\'0b\'0d\'0f\'11;}\s0\fi-1584\li1584 }{\listname ;}\listid-5}{\list\listtemplateid-1{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat0\levelspace0\levelindent0
-{\leveltext\'01*;}{\levelnumbers;}}{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat0\levelspace0\levelindent0{\leveltext\'00;}{\levelnumbers;}}{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat0\levelspace0\levelindent0{\leveltext
-\'00;}{\levelnumbers;}}{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat0\levelspace0\levelindent0{\leveltext\'00;}{\levelnumbers;}}{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat0\levelspace0\levelindent0{\leveltext\'00;}{\levelnumbers;}}
-{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat0\levelspace0\levelindent0{\leveltext\'00;}{\levelnumbers;}}{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat0\levelspace0\levelindent0{\leveltext\'00;}{\levelnumbers;}}{\listlevel\levelnfc0
-\leveljc0\levelfollow0\levelstartat0\levelspace0\levelindent0{\leveltext\'00;}{\levelnumbers;}}{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat0\levelspace0\levelindent0{\leveltext\'00;}{\levelnumbers;}}{\listname ;}\listid-2}
-{\list\listtemplateid824484218{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat1\levelspace0\levelindent0{\leveltext\'01\'00;}{\levelnumbers\'01;}\fbias0 \fi-600\li600\jclisttab\tx600 }{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat24
-\levelspace0\levelindent0{\leveltext\'03\'00.\'01;}{\levelnumbers\'01\'03;}\fbias0 \fi-600\li600\jclisttab\tx600 }{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat2\levelspace0\levelindent0{\leveltext\'05\'00.\'01.\'02;}{\levelnumbers\'01\'03\'05;}
-\fbias0 \fi-720\li720\jclisttab\tx720 }{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat1\levelspace0\levelindent0{\leveltext\'07\'00.\'01.\'02.\'03;}{\levelnumbers\'01\'03\'05\'07;}\fbias0 \fi-720\li720\jclisttab\tx720 }{\listlevel\levelnfc0
-\leveljc0\levelfollow0\levelstartat1\levelspace0\levelindent0{\leveltext\'09\'00.\'01.\'02.\'03.\'04;}{\levelnumbers\'01\'03\'05\'07\'09;}\fbias0 \fi-1080\li1080\jclisttab\tx1080 }{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat1\levelspace0
-\levelindent0{\leveltext\'0b\'00.\'01.\'02.\'03.\'04.\'05;}{\levelnumbers\'01\'03\'05\'07\'09\'0b;}\fbias0 \fi-1080\li1080\jclisttab\tx1080 }{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat1\levelspace0\levelindent0{\leveltext
-\'0d\'00.\'01.\'02.\'03.\'04.\'05.\'06;}{\levelnumbers\'01\'03\'05\'07\'09\'0b\'0d;}\fbias0 \fi-1440\li1440\jclisttab\tx1440 }{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat1\levelspace0\levelindent0{\leveltext
-\'0f\'00.\'01.\'02.\'03.\'04.\'05.\'06.\'07;}{\levelnumbers\'01\'03\'05\'07\'09\'0b\'0d\'0f;}\fbias0 \fi-1440\li1440\jclisttab\tx1440 }{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat1\levelspace0\levelindent0{\leveltext
-\'11\'00.\'01.\'02.\'03.\'04.\'05.\'06.\'07.\'08;}{\levelnumbers\'01\'03\'05\'07\'09\'0b\'0d\'0f\'11;}\fbias0 \fi-1800\li1800\jclisttab\tx1800 }{\listname ;}\listid177473106}{\list\listtemplateid67502095\listsimple{\listlevel\levelnfc0\leveljc0
-\levelfollow0\levelstartat1\levelspace0\levelindent0{\leveltext\'02\'00.;}{\levelnumbers\'01;}\fi-360\li360\jclisttab\tx360 }{\listname ;}\listid798230970}{\list\listtemplateid-586142842{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat1\levelspace0
-\levelindent0{\leveltext\'01\'00;}{\levelnumbers\'01;}\fbias0 \fi-600\li600\jclisttab\tx600 }{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat14\levelspace0\levelindent0{\leveltext\'03\'00.\'01;}{\levelnumbers\'01\'03;}\fbias0 \fi-600\li600
-\jclisttab\tx600 }{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat1\levelspace0\levelindent0{\leveltext\'05\'00.\'01.\'02;}{\levelnumbers\'01\'03\'05;}\fbias0 \fi-720\li720\jclisttab\tx720 }{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat1
-\levelspace0\levelindent0{\leveltext\'07\'00.\'01.\'02.\'03;}{\levelnumbers\'01\'03\'05\'07;}\fbias0 \fi-720\li720\jclisttab\tx720 }{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat1\levelspace0\levelindent0{\leveltext
-\'09\'00.\'01.\'02.\'03.\'04;}{\levelnumbers\'01\'03\'05\'07\'09;}\fbias0 \fi-1080\li1080\jclisttab\tx1080 }{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat1\levelspace0\levelindent0{\leveltext\'0b\'00.\'01.\'02.\'03.\'04.\'05;}{\levelnumbers
-\'01\'03\'05\'07\'09\'0b;}\fbias0 \fi-1080\li1080\jclisttab\tx1080 }{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat1\levelspace0\levelindent0{\leveltext\'0d\'00.\'01.\'02.\'03.\'04.\'05.\'06;}{\levelnumbers\'01\'03\'05\'07\'09\'0b\'0d;}\fbias0 
-\fi-1440\li1440\jclisttab\tx1440 }{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat1\levelspace0\levelindent0{\leveltext\'0f\'00.\'01.\'02.\'03.\'04.\'05.\'06.\'07;}{\levelnumbers\'01\'03\'05\'07\'09\'0b\'0d\'0f;}\fbias0 \fi-1440\li1440
-\jclisttab\tx1440 }{\listlevel\levelnfc0\leveljc0\levelfollow0\levelstartat1\levelspace0\levelindent0{\leveltext\'11\'00.\'01.\'02.\'03.\'04.\'05.\'06.\'07.\'08;}{\levelnumbers\'01\'03\'05\'07\'09\'0b\'0d\'0f\'11;}\fbias0 \fi-1800\li1800\jclisttab\tx1800 
-}{\listname ;}\listid1450468584}}{\*\listoverridetable{\listoverride\listid-5\listoverridecount0\ls1}{\listoverride\listid-2\listoverridecount1{\lfolevel\listoverrideformat{\listlevel\levelnfc23\leveljc0\levelfollow0\levelstartat1\levelspace0
-\levelindent360{\leveltext\'01\u-3913 ?;}{\levelnumbers;}\f3\fbias0 \fi-360\li360 }}\ls2}{\listoverride\listid-2\listoverridecount1{\lfolevel\listoverrideformat{\listlevel\levelnfc23\leveljc0\levelfollow0\levelstartat1\levelspace0\levelindent360
-{\leveltext\'01\u-3913 ?;}{\levelnumbers;}\f3\fbias0 \fi-360\li360 }}\ls3}{\listoverride\listid798230970\listoverridecount0\ls4}{\listoverride\listid1450468584\listoverridecount0\ls5}{\listoverride\listid177473106\listoverridecount0\ls6}}{\info{\title EN}
-{\author Pia Jensen}{\operator Bente Maegaard}{\creatim\yr2000\mo5\dy3\hr15\min25}{\revtim\yr2000\mo5\dy4\hr17\min26}{\printim\yr2000\mo5\dy3\hr11\min15}{\version3}{\edmins1}{\nofpages11}{\nofwords3415}{\nofchars19471}{\*\company English Ink}
-{\nofcharsws0}{\vern89}}\paperw11907\paperh16840\margl1134\margr2835\margt1701\margb1701 \deftab1304\widowctrl\ftnbj\aenddoc\hyphhotz425\lytprtmet\hyphcaps0\formshade\viewkind1\viewscale72\pgbrdrhead\pgbrdrfoot \fet0\sectd 
-\binfsxn2\binsxn2\psz9\linex0\headery567\footery709\colsx709\endnhere\titlepg\sectdefaultcl {\header \pard\plain \s17\qr\widctlpar\tqc\tx4819\tqr\tx9638\adjustright \f63\lang1030 {
-\par }}{\footer \pard\plain \s18\widctlpar\tqc\tx4819\tqr\tx9638\pvpara\phmrg\posxr\posy0\adjustright \f63\lang1030 {\field{\*\fldinst {\cs19 PAGE  }}{\fldrslt {\cs19\lang1024 2}}}{\cs19 
-\par }\pard \s18\ri360\widctlpar\tqc\tx4819\tqr\tx9638\adjustright {
-\par }}{\*\pnseclvl1\pnucrm\pnstart1\pnindent720\pnhang{\pntxta ..}}{\*\pnseclvl2\pnucltr\pnstart1\pnindent720\pnhang{\pntxta ..}}{\*\pnseclvl3\pndec\pnstart1\pnindent720\pnhang{\pntxta ..}}{\*\pnseclvl4\pnlcltr\pnstart1\pnindent720\pnhang{\pntxta )}}
-{\*\pnseclvl5\pndec\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}{\*\pnseclvl6\pnlcltr\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}{\*\pnseclvl7\pnlcrm\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}{\*\pnseclvl8
-\pnlcltr\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}{\*\pnseclvl9\pnlcrm\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}\pard\plain \s23\qr\widctlpar\tx851\adjustright \b\f63\fs36\cf1\lang1030 {\b0\fs20\lang2057 Doc. 1.1
-\par 
-\par Ministry of Research and Information Technology
-\par March 10, 1998}{\fs28\lang2057 
-\par }\pard \s23\qc\widctlpar\tx851\adjustright {\fs28\lang2057 
-\par 
-\par 
-\par DEVELOPMENT CONTRACT BETWEEN THE DANISH }{\caps\fs28\lang2057 Ministry of Research and Information Technology}{\fs28\lang2057 , AND THE }{\caps\fs28\lang2057 Centre for Language Technology, 
-\par for the period 1998\endash 2000}{\fs28\lang2057 
-\par }\pard\plain \fi-567\li567\widctlpar\tx851\adjustright \f63\lang1030 {\b\cf1\lang2057 
-\par }{\b\f62\fs32\cf1\lang2057 
-\par 
-\par }\pard \widctlpar\adjustright {\b\cf1\lang2057 
-\par }\pard \fi-567\li567\widctlpar\tx851\adjustright {\b\cf1\lang2057 
-\par 
-\par }\pard \widctlpar\tx851\adjustright {\b\cf1\lang2057 
-\par }\pard\plain \s1\fi-432\li432\sl-280\slmult0\keepn\widctlpar\outlinelevel0\adjustright \b\f62\fs32\lang1030\kerning28 {\lang2057 \page 1. Introduction
-\par }\pard\plain \widctlpar\tx851\adjustright \f63\lang1030 {\cf1\lang2057 
-\par This development contract expresses a shared understanding between the Danish Ministry of Research and Information Technology and the Centre for Language Technology (CST) concerning the Centre\rquote 
-s strategic goals and a number of concrete result objectives aimed at implementing the strategy. }{\lang2057 
-\par }{\cf1\lang2057 
-\par }\pard\plain \s24\widctlpar\tx851\adjustright \f63\expndtw-3\cf1\lang2057 {\expnd0\expndtw0 The goals of the contract relate to the scientific, financial and organisational development of the Centre. These goals will contain result objectives for CST
-\rquote s activities within the areas of research, development of language technology resources and tools, commercial activities, researcher training, information services and consultancy. }{\i\expnd0\expndtw0 Inter alia}{\expnd0\expndtw0 
-, the contract states that CST is to take the initiative for the development of a comprehensive Danish computational lexicon, and that the Centre is to enter into a working relationship with the University of Copenhagen concerning researcher training and 
-supervision. 
-\par 
-\par }\pard\plain \widctlpar\tx851\adjustright \f63\lang1030 {\cf1\lang2057 
-The development contract is aimed at fulfilling the overriding mission of CST, namely that the Centre must be a prime mover in assuring high-quality language technology for Danish users \endash  and other users of the Danish language.
-\par 
-\par 
-\par }\pard\plain \s1\fi-432\li432\sl-280\slmult0\keepn\widctlpar\outlinelevel0\adjustright \b\f62\fs32\lang1030\kerning28 {\lang2057 2. Presentation of CST
-\par }\pard\plain \widctlpar\tx851\adjustright \f63\lang1030 {\i\cf1\lang2057 
-\par }\pard \widctlpar\tx0\tx7657\tx8508\adjustright {\expnd0\expndtw-3\cf1\lang2057 
-CST is a Government Research Institute under the Ministry for Research and Information Technology. Its mission is to carry out and promote strategic research and commercial deve
-lopment in the areas of language technology and computational linguistics in Denmark. The Centre is run by a Board of Directors appointed by the Minister for Research and Information Technology. The Board comprises 6\endash 
-7 members from the University of Copenhagen, the Danish Research Councils, the business community and the research community in general; there is also an employee representative}{\cs22\expnd0\expndtw-3\cf1\lang2057\super \chftn {\footnote \pard\plain 
-\s21\widctlpar\adjustright \f63\fs20\lang1030 {\cs22\super \chftn }{\f0  }{\f0\cf2\lang2057 The Centre's purpose and its Board are detailed in the articles of association signed by the Danish Minister for Re
-search and Information Technology on 27 September 1996.}}}{\expnd0\expndtw-3\cf1\lang2057 .}{\lang2057 
-\par }{\expnd0\expndtw-3\cf1\lang2057 
-\par }\pard\plain \s25\widctlpar\tx0\tx7657\tx8508\adjustright \f63\expndtw-3\cf1\lang1030 {\lang2057 In the Danish National Budget for 1998, CST was awarded a total grant of DKK 3.7 million on account no. 19.35.09. The Centre\rquote 
-s commercial activities incur expenses totalling DKK 1 million, which are counterbalanced by income amounting to DKK 1 million. The Centre\rquote 
-s income-generating research activities incur expenses totalling DKK 3.6 million, which are also counterbalanced by corresponding income. On 1}{\lang2057\super st}{\lang2057   January 1998, CST employed 19 people, eq
-uivalent to 18 full-time employees. Of these 19, 17 had academic qualifications.
-\par }\pard\plain \widctlpar\tx851\adjustright \f63\lang1030 {\expnd0\expndtw-3\cf1\lang2057 
-\par Most of CST\rquote s activities are carried out in collaboration with Danish and international partners, primarily research institutions.
-\par 
-\par In spring 1994, CST was evaluated by an international panel. The evaluation was managed by the Board, which, after consultation with the research councils, set up the panel and laid down the terms of reference
-. The evaluation, which was positive, resulted in CST\rquote s temporary status being lifted in autumn 1994, and the Centre then became a Government Research Institute as from 1996.}{\lang2057 
-\par }{\expnd0\expndtw-3\cf1\lang2057 
-\par }\pard\plain \s25\widctlpar\tx851\adjustright \f63\expndtw-3\cf1\lang1030 {\lang2057 The evaluation report included analyses and recommendations concerning research, commercial activities, organisational structure, accounts, collaboratio
-n with the university, staff size, status, etc. Having changed status to a Government Research Institute, however, the Centre adopted new articles of association that reduced requirements on commercial activities. The basis for the recommenda
-tions in the evaluation report in this regard have therefore been altered. All other recommendations have already been followed or are integrated into this contract.
-\par }\pard\plain \widctlpar\tx851\adjustright \f63\lang1030 {\expnd0\expndtw-3\cf1\lang2057 
-\par }\pard \widctlpar\adjustright {\lang2057 
-\par }\pard\plain \s1\fi-432\li432\sl-280\slmult0\keepn\widctlpar\outlinelevel0\adjustright \b\f62\fs32\lang1030\kerning28 {\lang2057 3. Language technology
-\par }\pard\plain \widctlpar\tx0\tx7657\tx8508\adjustright \f63\lang1030 {\expnd0\expndtw-3\cf1\lang2057 
-\par Language technology products include programs for improving and increasing the efficiency of people\rquote s work with texts in natural language: spelling and grammar checkers, information retrieval
-, translation programs, electronic lexica, intelligent training programs, etc. }{\lang2057 
-\par }{\expnd0\expndtw-3\cf1\lang2057 
-\par Both specialist and general language are characterised by ambiguity: words have different meanings in different contexts, and even the meaning of sentence construction depends on the context. When conducting computational analyses of long sente
-nces, ambiguity gives rise to exponentially increasing use of time and space. The development of products that can process language correctly and efficiently thus requires an advanced knowledge that can only be achieved by research.}{\lang2057 
-\par }{\expnd0\expndtw-3\cf1\lang2057 
-\par }\pard \widctlpar\adjustright {\expnd0\expndtw-3\cf1\lang2057 High-quality language technology contributes to efficiency and quality in both the private business community and the public sector. }{\lang2057 
-Language technology products can contribute to the consistency and quality of document production in technical and administrative a
-reas by ensuring that language usage is consistent within a company or organisation, so that things and concepts are always referred to by the same words in the same types of document, irrespective of which employee is writing the document, and irrespecti
-ve of the kind of document that is being written. At the same time, the production of documents, and, possibly, their translation, can be optimised by using language technology, such as spell checker
-s, translation memories, electronic dictionaries and term databases, and machine translation \endash  all of which contribute to both consistency and efficiency.
-\par }\pard \widctlpar\tx0\tx7657\tx8508\adjustright {\expnd0\expndtw-3\cf1\lang2057 
-\par Language technology also involves cultural and democratic aspects: Language technology can help to ensure that texts continue to be written in the Danish language, and to help the language to develop by assimilating new words and concepts, thus keeping
- the language alive. If language technology tools are only available in other languages, this will considerably reduce the incentive to write in Danish. In the IT age, it is also important \endash 
- with regard to the younger generation and to less linguistically advanced Danes \endash  to ensure that computers can \ldblquote speak Danish\rdblquote .}{\cs22\expnd0\expndtw-3\cf1\lang2057\super  \chftn {\footnote \pard\plain \widctlpar
-\tx0\tx7657\tx8508\adjustright \f63\lang1030 {\cs22\f0\fs20\super \chftn }{\f0\fs20  }{\f0\fs20\expnd0\expndtw-3\cf2\lang2057 The role of language technology in the Information Society is one of the subjects discussed in the report }{
-\i\f0\fs20\expnd0\expndtw-3\cf2\lang2057 Dansk Sprogteknologi}{\f0\fs20\expnd0\expndtw-3\cf2\lang2057  (Danish Language Technology) produced by the Danish Technology Board, 1994.}}}{\lang2057 
-\par }{\expnd0\expndtw-3\cf1\lang2057 
-\par It is notable that the Danish language industry is limited to a few companies. The reason for this is that the market for Danish is too small to support the development costs for language technology products.}{\lang2057 
-\par }{\expnd0\expndtw-3\cf1\lang2057 
-\par 
-\par }\pard\plain \s1\fi-432\li432\sl-280\slmult0\keepn\widctlpar\outlinelevel0\adjustright \b\f62\fs32\lang1030\kerning28 {\lang2057 4. Professional strategy and result objectives
-\par }\pard\plain \widctlpar\tx0\tx7657\tx8508\adjustright \f63\lang1030 {\expnd0\expndtw-3\cf1\lang2057 
-\par }\pard\plain \s2\sl-280\slmult0\keepn\widctlpar\outlinelevel1\adjustright \b\i\f62\lang1030 {\lang2057 4.1 Overall goal
-\par }\pard\plain \fi-567\li567\widctlpar\tx851\adjustright \f63\lang1030 {\i\cf1\lang2057 
-\par }\pard \widctlpar\tx0\tx7657\tx8508\adjustright {\expnd0\expndtw-3\cf1\lang2057 A wide range of high-quality language technology produc
-ts are necessary for the private and public sectors as well as for ordinary citizens. That is why CST must be a prime mover }{\i\expnd0\expndtw-3\cf1\lang2057 in assuring high-quality language technology for Danish users \endash 
- and other users of the Danish language}{\expnd0\expndtw-3\cf1\lang2057 .}{\i\lang2057 
-\par }{\expnd0\expndtw-3\cf1\lang2057 
-\par }\pard\plain \s25\widctlpar\tx0\tx7657\tx8508\adjustright \f63\expndtw-3\cf1\lang1030 {\lang2057 CST\rquote s comprehensive collaboration network 
- must be maintained and developed, and special efforts must be made to strengthen the collaboration with the universities as regards researcher training and student supervision.
-\par }\pard\plain \widctlpar\tx0\tx7657\tx8508\adjustright \f63\lang1030 {\expnd0\expndtw-3\cf1\lang2057 
-\par The aim of providing high-quality language technology for Danish users is to be fulfilled via the following main activities:
-\par 
-\par }\pard\plain \s2\sl-280\slmult0\keepn\widctlpar\outlinelevel1\adjustright \b\i\f62\lang1030 {\lang2057 4.2 Research
-\par }\pard\plain \widctlpar\tx0\tx7657\tx8508\adjustright \f63\lang1030 {\expnd0\expndtw-3\cf1\lang2057 
-\par Research is to be carried out at a high international level, partly as basic computational linguistics research
-, which can contribute to an understanding of the structure of the language, and partly with regard to subjects that can contribute to a solution of specific problems to help Danish language technology to improve. During the period 
-of the contract, CST is to maintain and strengthen its international reputation in the areas of language technology and computational linguistics.}{\lang2057 
-\par }{\expnd0\expndtw-3\cf1\lang2057 
-\par }{\i\expnd0\expndtw-3\cf1\lang2057 Result objectives:}{\expnd0\expndtw-3\cf1\lang2057 
-\par 
-\par During the period, at least 22 articles are to be published in recognised reviewed scientific periodicals, or presentations at scientific congresses with a review system}{\cs22\expnd0\expndtw-3\cf1\lang2057\super \chftn {\footnote \pard\plain 
-\s21\widctlpar\adjustright \f63\fs20\lang1030 {\cs22\f0\super \chftn }{\f0  }{\f0\cf2\lang2057 I.e. an average of just over seven publications a year during the period 1998\endash 2000, compared to an average of six during the period 1995\endash 1997.}}}{
-\expnd0\expndtw-3\cf1\lang2057 .
-\par 
-\par }\pard\plain \s2\sl-280\slmult0\keepn\widctlpar\outlinelevel1\adjustright \b\i\f62\lang1030 {\i0\lang2057 
-\par 
-\par }{\lang2057 4.3 Development of language technology resources
-\par }\pard\plain \widctlpar\tx0\tx7657\tx8508\adjustright \f63\lang1030 {\expnd0\expndtw-3\cf1\lang2057 
-\par }\pard\plain \s25\widctlpar\tx0\tx7657\tx8508\adjustright \f63\expndtw-3\cf1\lang1030 {\lang2057 It is necessary to develop basic \ldblquote linguistic resources\rdblquote 
-, which are included in many different language technology products: computational lexica, grammars, natural language software, etc. The period will see the start of a special initiative: the development of a comprehensive Danish computational lexicon.
-
-\par }\pard\plain \widctlpar\tx0\tx7657\tx8508\adjustright \f63\lang1030 {\i\expnd0\expndtw-3\cf1\lang2057 
-\par Result objectives: }{\lang2057 
-\par }{\i\expnd0\expndtw-3\cf1\lang2057 
-\par }\pard \widctlpar\adjustright {\i\expnd0\expndtw-3\cf1\lang2057 Words and lexica:}{\expnd0\expndtw-3\cf1\lang2057  }{\lang2057 A computational lexicon with 30,000 entries with 
-morphological and syntactic information is to be developed. Around 10,000 of these entries will also feature semantic information, which will list approximately 20,000 meanings. }{\expnd0\expndtw-3\cf1\lang2057 
-The computational lexicon is to be based on principles, which, as far as possible, are to be independent of specific linguistic theories, and are to follow existing standards. In this way, it will be possible to ensur
-e that the lexicon, with as few changes as possible, can be used for a range of language technology purposes, such as machine translation, spelling and grammar checker
-s, speech synthesis and information systems. It must be possible to use this lexicon to automatically generate simpler dictionaries.}{\lang2057 
-\par 
-\par }{\i\lang2057 Special initiative: Danish language technology for Danish users \endash  a comprehensive Danish computational lexicon.}{\lang2057  CST will be taking the initiative for the compilation of a comprehensive Danish computational lexic
-on with approximately 50,000 entries with morphological and syntactic information, equivalent to around 100,000 entries at meaning level.}{\v\lang2057 
-\par }{\lang2057  The compilation and commercialisation of the lexicon are to be carried out in collaboration with resea
-rchers, publishers, and, if appropriate, word processing companies in Denmark. This project follows up on recommendations in the 1994 report from the Danish Technology Board concerning language technology in Denmark.
-\par }\pard \widctlpar\tx0\tx7657\tx8508\adjustright {\expnd0\expndtw-3\cf1\lang2057 
-\par }{\i\expnd0\expndtw-3\cf1\lang2057 Formal language description and grammars:}{\expnd0\expndtw-3\cf1\lang2057  CST has in its possession a language description and formalised grammar for the basic structures of the Danish language. This description and 
-the implemented
- grammar are to be further developed to include new facets of the Danish language. In the same way as the computational lexicon, it must be possible to use the grammar for a range of language technology purposes. The completion of this activity is depende
-nt on external funds. Therefore, the action plans for each individual year will include an assessment of which facets are to be concentrated on in that year.}{\lang2057 
-\par }{\expnd0\expndtw-3\cf1\lang2057 
-\par }\pard\plain \s2\sl-280\slmult0\keepn\widctlpar\outlinelevel1\adjustright \b\i\f62\lang1030 {\lang2057 4.4 Development and commercialisation of language technology tools
-\par }\pard\plain \widctlpar\tx0\tx7657\tx8508\adjustright \f63\lang1030 {\expnd0\expndtw-3\cf1\lang2057 
-\par CST is to use the results of its research to develop and sell language technology tools in areas such as machine translation and spelling and grammar checkers. }{\lang2057 
-\par }{\expnd0\expndtw-3\cf1\lang2057 
-\par 
-\par }{\i\expnd0\expndtw-3\cf1\lang2057 Result objectives:}{\expnd0\expndtw-3\cf1\lang2057  }{\lang2057 
-\par }{\expnd0\expndtw-3\cf1\lang2057 
-\par As regards machine translation, CST is to extend collaboration with its current customer to include new types of text, and is to analyse ways in which the market can be expanded. A program of the spelling, style and grammar checker type 
-is to be developed in collaboration with a commercial partner.}{\lang2057 
-\par }\pard \fi-567\li567\widctlpar\tx851\adjustright {\expnd0\expndtw-3\cf1\lang2057 
-\par }\pard\plain \s2\sl-280\slmult0\keepn\widctlpar\outlinelevel1\adjustright \b\i\f62\lang1030 {\lang2057 4.5 Researcher training
-\par }\pard\plain \widctlpar\tx0\tx7657\tx8508\adjustright \f63\lang1030 {\expnd0\expndtw-3\cf1\lang2057 
-\par CST is to collaborate with the universities on researcher training and the supervision of Masters and PhD students within the Centre\rquote s areas of expertise.
-\par 
-\par }{\i\expnd0\expndtw-3\cf1\lang2057 Result objectives:}{\expnd0\expndtw-3\cf1\lang2057  }{\lang2057 
-\par }{\expnd0\expndtw-3\cf1\lang2057 
-\par }\pard \widctlpar\adjustright {\expnd0\expndtw-3\cf1\lang2057 On average, at least two PhD students are to be affiliated with CST every year. Collaboration agreements are to be drawn up with the University of Copenhagen concerning researcher training and 
-supervision. In addition, an agreement is to be drawn up with the University of Copenhagen to allow CST to relocate closer to the university\rquote s }{\lang2057 Department of General and Applied Linguistics}{\expnd0\expndtw-3\cf1\lang2057  in order to 
-facilitate collaboration and to make it easier to attract students to CST. CST is to strive to collaborate with the Research Academy concerning PhD courses.}{\lang2057 
-\par }\pard \widctlpar\tx0\tx7657\tx8508\adjustright {\expnd0\expndtw-3\cf1\lang2057 
-\par }\pard\plain \s2\sl-280\slmult0\keepn\widctlpar\outlinelevel1\adjustright \b\i\f62\lang1030 {\lang2057 4.6 Dissemination \endash  scientific and general
-\par }\pard\plain \widctlpar\tx0\tx7657\tx8508\adjustright \f63\lang1030 {\expnd0\expndtw-3\cf1\lang2057 
-\par The Centre is to continue to organise and participate in seminars, meetings and congresses, both in Denmark an
-d abroad. The Centre is to be a knowledge centre for language technology products and their use, and to respond to enquiries in this regard. The Centre is to publish working papers.}{\lang2057 
-\par }{\expnd0\expndtw-3\cf1\lang2057 
-\par }{\i\expnd0\expndtw-3\cf1\lang2057 Result objectives:
-\par 
-\par }{\expnd0\expndtw-3\cf1\lang2057 The Centre is to organise 1\endash 2 events annually during the period. On average, at least four editions of working papers are to be published per year.}{\lang2057 
-\par }{\b\expnd0\expndtw-3\cf1\lang2057 
-\par }\pard\plain \s2\sl-280\slmult0\keepn\widctlpar\outlinelevel1\adjustright \b\i\f62\lang1030 {\lang2057 4.7 Consultancy
-\par }\pard\plain \widctlpar\tx0\tx7657\tx8508\adjustright \f63\lang1030 {\expnd0\expndtw-3\cf1\lang2057 
-\par CST is to use its knowledge about the availability and use of language technology products to sell consultancy services. However, it has proved
- to be difficult to penetrate the market. This may be due to the limited resources set aside by CST for this purpose, to the fact that the market is not yet ripe, or to the fact that the task has not been formulated correctly.}{\lang2057 
-\par }{\expnd0\expndtw-3\cf1\lang2057 
-\par }{\i\expnd0\expndtw-3\cf1\lang2057 Result objectives:}{\expnd0\expndtw-3\cf1\lang2057  }{\lang2057 
-\par }{\expnd0\expndtw-3\cf1\lang2057 
-\par }\pard \widctlpar\tx851\adjustright {\lang2057 During the first year of the period, the Centre is to prepare a report for the Board concerning its consultancy work as well as a plan for future initiatives in this area.
-\par }\pard\plain \s17\widctlpar\tx851\adjustright \f63\lang1030 {\f62\lang2057\kerning28 
-\par }\pard\plain \widctlpar\tx851\adjustright \f63\lang1030 {\f62\lang2057\kerning28 
-\par }\pard\plain \s1\fi-432\li432\sl-280\slmult0\keepn\widctlpar\outlinelevel0\adjustright \b\f62\fs32\lang1030\kerning28 {\lang2057 5. Strategy and result objectives for finance and administration
-\par }\pard\plain \fi-567\li567\widctlpar\tx851\adjustright \f63\lang1030 {\cf1\lang2057 
-\par }\pard\plain \s2\sl-280\slmult0\keepn\widctlpar\outlinelevel1\adjustright \b\i\f62\lang1030 {\lang2057 5.1 General comments
-\par }\pard\plain \widctlpar\tx0\tx7657\tx8508\adjustright \f63\lang1030 {\b\expnd0\expndtw-3\lang2057 
-\par The size and financing of the Centre:}{\expnd0\expndtw-3\lang2057  The Centre considers it important that external turnover in general does not become considerably larger than the basic grant. However, the Board may permit }{\lang2057 
-certain initiatives of particular strategic importance to be excluded from this model}{\expnd0\expndtw-3\lang2057 . In this contract, this applies to the initiative concerning the comprehensive computational lexicon.}{\lang2057 
-\par }\pard\plain \s17\widctlpar\tx0\tx7657\tx8508\adjustright \f63\lang1030 {\expnd0\expndtw-3\lang2057 
-\par }\pard\plain \s25\widctlpar\tx0\tx7657\tx8508\adjustright \f63\expndtw-3\cf1\lang1030 {\lang2057 The Board is of the opinion that the present size of the Centre (just below 20 employees) is not optima
-l. Firstly, the Centre does not possess sufficient flexibility to guarantee the delivery of contractual results. Secondly, capacity is not sufficient for completing national tasks that the Centre considers it important to complete for society in general, 
-cf. the goals detailed above. Therefore, one of the Centre\rquote s goals is to expand during the period. A size of around 30 employees \endash  with a rate of growth of approximately two employees annually \endash  is considered sufficient.}{
-\strike\lang2057 
-\par }{\lang2057 
-\par Expansion of the staff will require
- an increase in the basic grant, if the desired balance between basic grant and external turnover is to be maintained. However, as this contract does not contain scope for increasing the basic grant, cf. Chapter 7, the result objectives have been establis
-hed on the basis of an unchanged number of employees.
-\par  
-\par }\pard\plain \widctlpar\tx0\tx7657\tx8508\adjustright \f63\lang1030 {\expnd0\expndtw-3\lang2057 
-\par }{\b\expnd0\expndtw-3\lang2057 Organisational structure and management:}{\expnd0\expndtw-3\lang2057 
- The Centre operates with a flat structure involving a management group and a number of projects. This structure is well-suited to a small institution, but if t
-he Centre succeeds in growing as planned, a more formalised structure will be considered in accordance with the recommendations of the evaluation report.}{\lang2057 
-\par }{\expnd0\expndtw-3\lang2057 
-\par }{\b\expnd0\expndtw-3\lang2057 Wages, salaries and staff:}{\expnd0\expndtw-3\lang2057  As of 1 April 1997, a new career structure was introduced for scientific staff at Government Research Institutes. Within the first two years, the Centre\rquote 
-s employees can choose on an individual basis whether they wish to be transferred to the new structure.}{\lang2057 
-\par }\pard\plain \s17\widctlpar\tx0\tx7657\tx8508\adjustright \f63\lang1030 {\expnd0\expndtw-3\lang2057 
-\par }\pard\plain \widctlpar\tx0\tx7657\tx8508\adjustright \f63\lang1030 {\expnd0\expndtw-3\lang2057 As of 1 January 1998, the opportunity of swi
-tching to a new salary system is to be introduced in State organisations in general. The most important innovation of this new system is that a larger proportion of the salaries is determined locally. Employees are free to choose whether they wish to b
-e included in the new salary system. Transfer can take place on 1 January every year.}{\lang2057 
-\par }{\expnd0\expndtw-3\lang2057 
-\par }\pard\plain \s2\sl-280\slmult0\keepn\widctlpar\outlinelevel1\adjustright \b\i\f62\lang1030 {\i0\lang2057 {\*\bkmkstart Overskrift}{\*\bkmkstart Tekst}
-\par 
-\par 
-\par }{\lang2057 5.2 Financial management
-\par }\pard\plain \widctlpar\adjustright \f63\lang1030 {\b\i\lang2057 {\*\bkmkend Overskrift}{\*\bkmkend Tekst}
-\par }{\lang2057 Developments in the State grant system and demands on institutions\rquote  financial management continue to create new requirements for developing the Centre\rquote s systems for planning, follow-ups and reporting.
-\par 
-\par The management group is responsible for following up on results and resource consumption in order to continually prioriti
-se activities in accordance with the goals that apply to the institution. Of particular importance to this task is access to information concerning planned and actual resource consumption and associated activities.
-\par 
-\par As a part of this contract, it has been agreed that during the period the Centre is to develop a coherent system for planning, registering and reporting on activities and financial status on the basis of the Centre\rquote 
-s annual plan. From 1998, the Centre will begin to use the State\rquote s Central Accounting System (NYT SCR) for registration via its own equipment.
-\par }\pard \fi-283\li283\widctlpar\adjustright {\lang2057 
-\par }{\i\lang2057 Result objectives:
-\par }{\lang2057 
-\par {\listtext\pard\plain\f3\lang2057 \loch\af3\dbch\af0\hich\f3 \'b7\tab}}\pard \fi-360\li360\widctlpar\ls3\adjustright {\lang2057 
-In 1998, the Centre is to draw up a purpose-oriented code of accounts that is to come into force no later than 1999. As far as possible, the Centre is to achieve a uniform distribution into objectives within the fields of technical 
-and financial planning, registration and reporting.
-\par {\listtext\pard\plain\f3\lang2057 \loch\af3\dbch\af0\hich\f3 \'b7\tab}During the period of the contract, the Centre is to describe the work processes used for the management and follow-up of the Centre\rquote 
-s business. This description is to include tasks and functions concerning internal and external budgets, planning and prioritisation of activities and financial matters in single and multiple-year perspectives, as well as t
-he follow-up of budgets and action plans. The description is also to state the division of responsibility for the individual tasks and functions.
-\par {\listtext\pard\plain\f3\lang2057 \loch\af3\dbch\af0\hich\f3 \'b7\tab}In 1998, the Centre is to draw up an overview of the need for training and skill development for administrative staff due to the change in the use of the State\rquote 
-s financial systems as well as other alterations to the general and financial management of the Centre. In 1998, education and training activities related to the change in use of the State\rquote s financial systems will be carried out. 
-\par }\pard \widctlpar\adjustright {\b\i\lang2057 
-\par }{\lang2057 It has been agreed that a contact committee is to b
-e set up involving members from both the Centre and the Ministry. The committee is to discuss initiatives concerning the result objectives in the area of administration. On the basis of presentations from the Centre, the committee is to discuss and specif
-y the financial requirements linked to result objectives in the area of administration. 
-\par 
-\par 
-\par }\pard\plain \s1\fi-432\li432\sl-280\slmult0\keepn\widctlpar\outlinelevel0\adjustright \b\f62\fs32\lang1030\kerning28 {\lang2057 6. Strategy and result objectives for the use of IT
-\par }\pard\plain \widctlpar\adjustright \f63\lang1030 {\cf1\lang2057 
-\par The research and development activities of the Centre are particularly dependent on IT. It is crucial to the comm
-ercial business of the Centre that services be based on the technology that has the broadest and longest lasting penetration impact on the market.}{\lang2057 
-\par }{\cf1\lang2057 
-\par }{\i\cf1\lang2057 Result objectives:
-\par }{\cf1\lang2057 
-\par The Centre is to map out the existing use of computer equipment and software, as well as
- the purchase of external IT services. On this basis, in 1999 the Centre is to draw up an IT action plan aimed at identifying and presenting suggestions for how best to overcome any IT-related barriers blocking the realisation of the goals and strategy of
- the Centre.}{\lang2057 
-\par 
-\par }{\b\i\lang2057 
-\par }\pard\plain \s1\fi-432\li432\sl-280\slmult0\keepn\widctlpar\outlinelevel0\adjustright \b\f62\fs32\lang1030\kerning28 {\lang2057 7. Budget and grant conditions
-\par }\pard\plain \widctlpar\adjustright \f63\lang1030 {\lang2057 
-\par The Centre\rquote s basic grant is presented in the table below, cf. the National Budget for 1998, Section 19.35.09.10.
-\par 
-\par }\trowd \trgaph70\trleft-70 \clvertalt\clbrdrt\brdrs\brdrw30\brdrcf15 \clbrdrb\brdrs\brdrw15\brdrcf15 \cltxlrtb \cellx2835\clvertalt\clbrdrt\brdrs\brdrw30\brdrcf15 \clbrdrb\brdrs\brdrw15\brdrcf15 \cltxlrtb \cellx4253\clvertalt\clbrdrt
-\brdrs\brdrw30\brdrcf15 \clbrdrb\brdrs\brdrw15\brdrcf15 \cltxlrtb \cellx5723\clvertalt\clbrdrt\brdrs\brdrw30\brdrcf15 \clbrdrb\brdrs\brdrw15\brdrcf15 \cltxlrtb \cellx7230\pard \widctlpar\intbl\adjustright {\lang2057 DKK million\cell 1998\cell 1999\cell 
-2000\cell }\pard \widctlpar\intbl\adjustright {\lang2057 \row }\trowd \trgaph70\trleft-70 \clvertalt\clbrdrb\brdrs\brdrw30\brdrcf15 \cltxlrtb \cellx2835\clvertalt\clbrdrb\brdrs\brdrw30\brdrcf15 \cltxlrtb \cellx4253\clvertalt\clbrdrb
-\brdrs\brdrw30\brdrcf15 \cltxlrtb \cellx5723\clvertalt\clbrdrb\brdrs\brdrw30\brdrcf15 \cltxlrtb \cellx7230\pard \widctlpar\intbl\adjustright {\lang2057 
-\par Net grant
-\par \cell 
-\par 3.7\cell 
-\par 3.7\cell 
-\par 3.6\cell }\pard \widctlpar\intbl\adjustright {\lang2057 \row }\pard \widctlpar\adjustright {\lang2057 
-\par In addition t
-o these funds, the sum of DKK 0.2 million is set aside in the Ministry to cover extraordinary operational expenses for the Centre in connection with the completion of result objectives in the area of administration. Payment of funds from the pool for spec
-ific activities will be made on the basis of proposals from the Centre and discussions in the contact committee.
-\par Costs for the fulfilment of the Centre\rquote s professional goals in excess of the basic grant are to be covered by the Centre\rquote s external activities and through savings.
-\par 
-\par Over and above this, the following general rules apply for the Centre\rquote s grants during the contract period:
-\par 
-\par CST is subject to the State\rquote s ordinary regulations for budgets and grants, and the Centre\rquote s grants can only be set for one year at a time by the Danish Parliament.
-\par 
-\par The net grant laid down in the contract is an expression of the grant-related conditions for the contract and of the intentions of the Ministry of Research and Information Technology under the present and expected expenditure for the ministerial area at 
-the time of  the commencement of the contract. 
-\par 
-\par The expenditure of the Ministry of Research and Information Technology is adjusted continuously as a part of the State\rquote 
-s total budget in connection with the adoption of the annual National Budgets. These adjustments may have an effect on the allocation of grants in the annual National Budgets.
-\par 
-\par If considerable changes should be made to the grant-related conditions for t
-he contract, these alterations may give grounds for corresponding alterations to the result requirements insofar as there may be no possibility for re-allocation within the net grant.}{\i\lang2057 
-\par }\pard \widctlpar\tx851\adjustright {\cf1\lang2057 
-\par }\pard \fi-567\li567\widctlpar\tx851\adjustright {\i\cf1\lang2057 
-\par }\pard\plain \s1\fi-432\li432\sl-280\slmult0\keepn\widctlpar\outlinelevel0\adjustright \b\f62\fs32\lang1030\kerning28 {\lang2057 8. Division of competencies and responsibility
-\par }\pard\plain \widctlpar\adjustright \f63\lang1030 {\cf1\lang2057 
-\par The development contract is
- agreed between the Ministry of Research and Information Technology and CST. It is to be stressed that the agreement and contract-like concepts used in this development contract do not constitute an agreement in the usual legal sense. The Minist
-ry of Research and Information technology still retains its usual parliamentary responsibility taking into consideration the fact that the Centre is an independent institution. Applicable legislation and legal requirements, budget and grant regulations, a
-greements, etc. are to be followed unless legal basis for departure from them has been obtained according to usual practice.}{\lang2057 
-\par }{\cf1\lang2057 
-\par With the drawing up of the contract, no change has been made or intended in the competencies and responsibility, which, according to legislation and the Centre\rquote 
-s articles of association, have been allocated to the Minister for Research and Information Technology, the Ministry of Research and Information Technology and the Board and Director of the Centre. The contract is solely a poli
-tical statement of the desired future development of CST\rquote 
-s activities and the conditions granted politically for same. This means that the Minister can still recall or change the contract or any part thereof on the basis of usual conditions of superiority 
-and inferiority. At the same time, this means that usual political or legal responsibility can at any time be claimed against the Minister\rquote s and/or the civil servants\rquote 
- handling of the matter, including the progress of the contract management itself. Failure to fulfil contractual obligations is thus subject to normal sanction provisions.}{\lang2057 
-\par }{\cf1\lang2057 If reporting of the results achieved reveals a clearly unsatisfactory level of contractual fulfilment, the Ministry\rquote s future management of the institution will be re-evaluated.
-\par 
-\par 
-\par 
-\par }\pard\plain \s1\fi-432\li432\sl-280\slmult0\keepn\widctlpar\outlinelevel0\adjustright \b\f62\fs32\lang1030\kerning28 {\lang2057 9. Result evaluation and auditing
-\par }\pard\plain \widctlpar\adjustright \f63\lang1030 {\cf1\lang2057 
-\par The contract is to come into effect on 1 January 1998 and is to run until 31. December 2000, when the contractual relationship is to expire in the absence o
-f any agreement to the contrary. The basis for the contract is the actual situation at the commencement of the contract at 1 January 1998, cf. the National Budget for 1998.}{\lang2057 
-\par }{\cf1\lang2057 
-\par The centre is to report the degree of fulfilment of the requirements and initiativ
-es laid down by the contract annually to the Ministry of Research and Information Technology. During the last year of the contract, this report is, on an experimental basis, to be drawn up in the form of the institution's published financial statement acc
-ording to the regulations laid down in Act 82 of 4 Dece

windows-setup.txt

@@ -1,23 +0,0 @@
-
-To set up to run medley on Windows:
-
-Get the app called 'Ubuntu' from the Microsoft Store.
-Get a windows X server called Xming, the default options will do:
-
-     https://sourceforge.net/projects/xming/
-
-copy lde ldex from linux.x86_64
-into your path (/usr/local/bin)
-
-
-Stash these somewhere
-
-export MEDLEYDIR=/mnt/c/path-to-medley-directory
-export HOME=/mnt/c/path-to-windows-home
-export DISPLAY=:0
-export LDEINIT="$MEDLEYDIR"/initfiles/local-init
-
-lde -g 900x700 $MEDLEYDIR/loadups/xfull35.sysout
-
-
-(distilled from https://www.howtogeek.com/261575/)