(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "24-Oct-88 18:28:31" {POOH/N}<POOH>LAFITE>SOURCES>LAFITEBROWSE;8 78919
changes to%: (FNS LAB.TITLE.STRING)
previous date%: "13-Sep-88 18:50:32" {POOH/N}<POOH>LAFITE>SOURCES>LAFITEBROWSE;7)
(* "
Copyright (c) 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT LAFITEBROWSECOMS)
(RPAQQ LAFITEBROWSECOMS ((COMS (* ; "BROWSE") (FNS \LAFITE.BROWSE \LAFITE.SUBBROWSE \LAFITE.BROWSE.PROC \LAFITE.BROWSE.FORGET LAFITE.BROWSE.FOLDER \LAFITE.PREPARE.BROWSER \LAFITE.MAYBE.OPEN.FOLDER LAB.LOADFOLDER LAB.DISPLAYFOLDER LAB.MAKE.INITIAL.SELECTION LAB.CREATEWINDOW LAB.TITLE.STRING LAB.COMMANDFN LAB.DO.COMMAND LAB.ASSURE.SELECTIONS) (FNS BUILD.LAFITE.LAYOUTS \LAFITE.LAYOUT.FROM.WINDOW \LAFITE.MAKE.DUMMY.WINDOWS) (VARS LAFITE.DUMMY.SHADE LAFITE.DUMMY.HALF.SHADE) (INITVARS (\LAFITE.LAST.FOLDER.NAME)) (GLOBALVARS \LAFITE.LAST.FOLDER.NAME)) (COMS (* ; "Browser operations") (FNS LAB.SETUP LAB.BUTTONEVENTFN LAB.DO.UNLESS.BUSY LOADMAILFOLDER LAFITE.OBTAIN.FOLDER \LAFITE.FIND.EXISTING.FOLDER \LAFITE.CONFLICTING.OLD.FOLDER LAB.REPAINTFN LAB.SCROLLFN LAB.RESHAPEFN LAB.CLOSEFN LAB.SHRINKFN LAB.CLOSE/SHRINK LAB.EXPANDFN LAFITEEXTRABROWSERCOMMANDFN)) (COMS (* ; "Browser selection") (FNS LAB.SELECTMESSAGE LAB.CHANGEMARK LA.READ.NEW.MARK YPOS.TO.MESSAGE# MESSAGE#.TO.YPOS) (FNS LA.CONSIDERRANGE LA.DECONSIDERRANGE LA.RECONSIDERRANGE LA.SELECTRANGE LA.DESELECTRANGE LAB.FIND.SELECTED.MSG LAB.REV.FIND.SELECTED.MSG LA.UNDOSELECTION LA.VERIFY.SELECTION) (FNS LAB.COPYBUTTONEVENTFN LAB.SHOW.COPY.SELECTION) (DECLARE%: EVAL@COMPILE DONTCOPY (P (CL:PROCLAIM (QUOTE (CL:SPECIAL *MAILFOLDER* *MESSAGES* *FIRST-VISIBLE* *LAST-VISIBLE* *TOC-STATE*))) (CL:PROCLAIM (QUOTE (GLOBAL LASTMOUSEBUTTONS)))))) (COMS (* ; "Browser display") (FNS LAB.PROMPTPRINT LAB.FORMAT LAB.MOUSECONFIRM LAB.PRINT.TO.PROMPTWINDOW LAB.PAGEFULLFN \LAFITE.MAYBE.CLEAR.PROMPT) (FNS PRINTMESSAGESUMMARY FIRSTVISIBLEMESSAGE LASTVISIBLEMESSAGE LAB.DISPLAYLINES LAB.EXPOSEMESSAGE LAB.SELECTED.MESSAGES UNSELECTALLMESSAGES SELECTMESSAGE LAB.GO.TO.MESSAGE MARKMESSAGE LA.SHOW.MARK LA.INVERT.MARK.BOX LA.BLT.MARK.BOX LA.SHOW.DELETION LA.SHOW.SELECTION SEENMESSAGE DELETEMESSAGE UNDELETEMESSAGE LAB.SET.EXPUNGEABILITY)) (COMS (* ; "ICON stuff") (FILES ICONW) (FNS LAB.ICONFN LAB.ICON.BUTTONEVENTFN) (VARS LAFITE.FOLDER.ICON)) (COMS (INITVARS (LAFITEFROMFRACTION 0.3) (LAFITEMINFROMCHARS 15) (LAFITEVERIFYFLG T) (LAFITEDELETEDLINEHEIGHT 1) (LAFITE.BROWSER.ICON.PREFERENCE)) (VARS LAFITEBROWSERMENUITEMS LAFITESUBBROWSEMENUITEMS LAFITEBROWSERICONMENUITEMS) (INITVARS (LAFITESUBBROWSEMENU) (LAFITEBROWSERICONMENU) (LAFITEEXTRAMENU)) (GLOBALVARS LAFITESUBBROWSEMENU LAFITEBROWSERICONMENU LAFITEEXTRAMENU) (ADDVARS (LAFITEMENUVARS LAFITESUBBROWSEMENU LAFITEBROWSERICONMENU LAFITEEXTRAMENU) (LAFITEEXTRAMENUITEMS ("Describe Folder" (QUOTE \LAFITE.DESCRIBE.FOLDER) "Display some relevant info about this folder"))) (VARS (BROWSERMARKXPOSITION 8)) (BITMAPS LA.SELECTION.BITMAP)) (COMS (* ; "Obsolete") (INITVARS (LAFITEBROWSERREGION (CREATEREGION 30 30 575 210)))) (DECLARE%: DOEVAL@COMPILE DONTCOPY (CONSTANTS * TOCSTATES) (P (CL:PROCLAIM (QUOTE (CL:SPECIAL \CURRENTDISPLAYLINE)))) (FILES (SOURCE) LAFITEDECLS) (LOCALVARS . T)) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA LAB.MOUSECONFIRM LAB.FORMAT LAB.PROMPTPRINT)))))
(* ; "BROWSE")
(DEFINEQ
(\LAFITE.BROWSE
(LAMBDA (ITEM MENU BUTTON) (* ; "Edited 17-Sep-87 19:13 by bvm:") (* ;;; "Function called by the Browse button on main Lafite window.") (LET ((SUBP (EQ BUTTON (QUOTE MIDDLE)))) (* ; "Pass the :confirm option to LAFITE.BROWSE.FOLDER to require confirmation on folder creation.") (\LAFITE.PROCESS (BQUOTE ((\, (COND (SUBP (FUNCTION \LAFITE.SUBBROWSE)) (T (FUNCTION \LAFITE.BROWSE.PROC)))) (QUOTE (\, ITEM)) (QUOTE (\, MENU)) (\,@ (AND (NOT SUBP) (QUOTE (NIL (QUOTE (:CONFIRM)))))))) (QUOTE LAFITEBROWSE))))
)
(\LAFITE.SUBBROWSE
(LAMBDA (ITEM MENU) (* ; "Edited 3-Sep-87 18:00 by bvm:") (PROG ((COMMAND (MENU (.LAFITEMENU. LAFITESUBBROWSEMENU LAFITESUBBROWSEMENUITEMS "Browse subcommands")))) (COND (COMMAND (CL:FUNCALL COMMAND ITEM MENU)))))
)
(\LAFITE.BROWSE.PROC
(LAMBDA (ITEM MENU FOLDERNAME OPTIONS) (* ; "Edited 10-Sep-87 15:19 by bvm:") (LET (MAILFOLDER) (COND ((NULL (OR FOLDERNAME (SETQ FOLDERNAME (\LAFITE.PROMPTFORFOLDER)))) (* ; "From BROWSE command, user aborted by not giving a file name") NIL) ((LISTP FOLDERNAME) (* ; "From LAFITE. Each element is (foldername browserregion displayregion iconposition . options)") (for ITEM in FOLDERNAME do (LAFITE.BROWSE.FOLDER (CAR FOLDERNAME) (CDR FOLDERNAME) (APPEND (CDDDDR FOLDERNAME) OPTIONS) ITEM MENU))) (T (LAFITE.BROWSE.FOLDER FOLDERNAME NIL OPTIONS ITEM MENU)))))
)
(\LAFITE.BROWSE.FORGET
(LAMBDA (ITEM MENU) (* ; "Edited 18-Jul-88 11:41 by bvm") (LET ((FOLDERNAME (PROMPTFORFILENAME NIL \LAFITE.LAST.FOLDER.NAME))) (COND (FOLDERNAME (SETQ \LAFITE.LAST.FOLDER.NAME FOLDERNAME) (* ; "Save name as typed now in case it fails. Guy who gets the actual folder will set canonical name here.") (\LAFITE.BROWSE.PROC ITEM MENU FOLDERNAME (QUOTE (:FORGET :CONFIRM)))))))
)
(LAFITE.BROWSE.FOLDER
(LAMBDA (FOLDERNAME LAYOUT OPTIONS ITEM MENU) (* ; "Edited 8-Jun-88 12:19 by bvm") (* ;; "Browse folder named FOLDERNAME. LAYOUT is a triple (browserregion iconposition displayregion). OPTIONS may include :SHRINK, meaning to shrink folder when finished, and :CONFIRM, meaning require confirmation before creating an empty folder. ITEM, if specified, is a menu item in MENU to shade while the browser is being prepared.") (LET ((FOLDER (RESETLST (AND ITEM (LA.RESETSHADE ITEM MENU)) (\LAFITE.PREPARE.BROWSER (LA.LONGFILENAME FOLDERNAME LAFITEMAIL.EXT) OPTIONS LAYOUT)))) (COND (FOLDER (WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of FOLDER) (if (NULL (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER)) then (* ; "Got a browser, but haven't loaded anything into it yet") (COND ((EQMEMB :LAUREL OPTIONS) (\LAFITE.FIX.LAUREL.FOLDER FOLDER))) (COND ((EQMEMB :ACTIVE OPTIONS) (replace (MAILFOLDER FOLDERGETSMAIL) of FOLDER with T))) (LAB.LOADFOLDER FOLDER) (COND ((EQMEMB :GETMAIL OPTIONS) (LAB.DO.COMMAND (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER) (FUNCTION \LAFITE.GETMAIL))) ((EQMEMB :SHRINK OPTIONS) (SHRINKW (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER)))))) FOLDER))))
)
(\LAFITE.PREPARE.BROWSER
(LAMBDA (FOLDERNAME OPTIONS LAYOUT) (* ; "Edited 7-Sep-88 12:18 by bvm") (* ;; "Get a browser on FOLDERNAME. If there already is one, we just top it, otherwise we create a new one. Returns the folder object or NIL on failure. OPTIONS are the options to browse. LAYOUT is where to put the browser if we have to create it.") (SETQ OPTIONS (CONS :BROWSE (MKLIST OPTIONS))) (WITH.MONITOR \LAFITE.BROWSELOCK (LET ((MAILFOLDER (LAFITE.OBTAIN.FOLDER FOLDERNAME (QUOTE INPUT) NIL OPTIONS)) BROWSERWINDOW STREAM) (AND MAILFOLDER (COND ((SETQ BROWSERWINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER)) (* ; "Already have browser") (COND ((OPENWP BROWSERWINDOW) (TOTOPW BROWSERWINDOW)) ((NOT (FMEMB :SHRINK OPTIONS)) (* ; "Make sure the EXPANDFN runs") (EXPANDW BROWSERWINDOW))) T) ((COND ((SETQ STREAM (fetch (MAILFOLDER FOLDERSTREAM) of MAILFOLDER)) (* ; "Already have folder open, e.g., from MOVETO, but no browser yet") (SETFILEINFO STREAM (QUOTE BUFFERS) LAFITEBUFFERSIZE) T) (T (\LAFITE.MAYBE.OPEN.FOLDER MAILFOLDER (QUOTE INPUT) NIL OPTIONS))) (* ; "Success in opening") (LAB.CREATEWINDOW MAILFOLDER LAYOUT))) MAILFOLDER))))
)
(\LAFITE.MAYBE.OPEN.FOLDER
(LAMBDA (FOLDER ACCESS PROMPTFOLDER OPTIONS RETURNERRORS) (* ; "Edited 8-Sep-88 17:41 by bvm") (* ;; "Open FOLDER for indicated access, with the possibility that the file does not yet exist. If it doesn't, then create it, asking for confirmation if PROMPTFOLDER is supplied (a folder in whose browser to prompt for confirmation, or T for global prompt). Returns the stream on success. On failure, returns the condition if RETURNERRORS true, else NIL.") (PROG* ((FOLDERNAME (OR (fetch (MAILFOLDER FULLFOLDERNAME) of FOLDER) (fetch (MAILFOLDER VERSIONLESSFOLDERNAME) of FOLDER))) (OLDP (EQMEMB :OLD OPTIONS)) (RECOG (AND (OR OLDP PROMPTFOLDER) (QUOTE OLD))) STREAM CONDITION) RETRY (* ;; "Just try opening. If confirmation desired, open only OLD file on first try.") (CL:MULTIPLE-VALUE-SETQ (STREAM CONDITION) (IGNORE-ERRORS (\LAFITE.OPENSTREAM FOLDERNAME ACCESS RECOG (FUNCTION \LAFITE.EOF) (EQMEMB :BROWSE OPTIONS) (QUOTE LAFITE)))) (RETURN (if CONDITION then (* ; "Failed to open") (if (AND (NEQ RECOG (QUOTE NEW)) (NOT OLDP) (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 (OR (NOT (EQMEMB :CONFIRM OPTIONS)) (LAB.MOUSECONFIRM PROMPTFOLDER "Click LEFT to confirm creating ~A" FOLDERNAME)) then (SETQ RECOG (QUOTE NEW)) (SETQ ACCESS (QUOTE BOTH)) (GO RETRY) else (* ; "Disconfirmed the create request.") NIL) elseif RETURNERRORS then (* ; "Caller wants to know why") CONDITION else (* ; "File wouldn't open for some other reason than just not existing, so report it. Should probably be a little more discriminating here.") (\LAFITE.REPORT.FILE.WONT.OPEN (AND (NEQ PROMPTFOLDER T) PROMPTFOLDER) CONDITION FOLDERNAME) NIL) else (\LAFITE.SET.FOLDER.STREAM FOLDER STREAM) (* ; "Notice name fields and such") STREAM))))
)
(LAB.LOADFOLDER
(LAMBDA (MAILFOLDER) (* ; "Edited 13-Sep-88 17:42 by bvm") (COND ((LOADMAILFOLDER MAILFOLDER) (replace (MAILFOLDER FIRSTSELECTEDMESSAGE) of MAILFOLDER with 1) (* ; "Nothing selected") (replace (MAILFOLDER LASTSELECTEDMESSAGE) of MAILFOLDER with 0) (LAB.DISPLAYFOLDER MAILFOLDER) MAILFOLDER)))
)
(LAB.DISPLAYFOLDER
(LAMBDA (MAILFOLDER) (* ; "Edited 9-Sep-87 19:33 by bvm:") (PROG ((WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER)) CLIPREGION MSGDESCRIPTOR) (CLEARW WINDOW) (LAB.SETUP MAILFOLDER) (replace (MAILFOLDER CURRENTDISPLAYEDMESSAGE) of MAILFOLDER with NIL) (replace (MAILFOLDER CURRENTDISPLAYEDSTREAM) of MAILFOLDER with NIL) (COND ((AND (SETQ MSGDESCRIPTOR (LAB.MAKE.INITIAL.SELECTION MAILFOLDER)) (< (MESSAGE#.TO.YPOS MSGDESCRIPTOR MAILFOLDER) (fetch (REGION BOTTOM) of (SETQ CLIPREGION (DSPCLIPPINGREGION NIL WINDOW))))) (* ; "Quietly scroll so that selected message is in window") (WYOFFSET (TIMES (- (fetch (LAFITEMSG %#) of MSGDESCRIPTOR) (QUOTIENT (fetch (REGION HEIGHT) of CLIPREGION) (TIMES 2 (fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER)))) (fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER)) WINDOW))) (COND ((EQ (fetch (MAILFOLDER %#OFMESSAGES) of MAILFOLDER) 0) (LAB.PROMPTPRINT MAILFOLDER T "Folder is empty.")) (T (LAB.DISPLAYLINES MAILFOLDER (FIRSTVISIBLEMESSAGE MAILFOLDER CLIPREGION) (LASTVISIBLEMESSAGE MAILFOLDER CLIPREGION))))))
)
(LAB.MAKE.INITIAL.SELECTION
(LAMBDA (MAILFOLDER) (* bvm%: "24-Feb-86 16:31") (LET ((LASTMSG# (fetch (MAILFOLDER %#OFMESSAGES) of MAILFOLDER)) (MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER)) MSGDESCRIPTOR I) (COND ((EQ LASTMSG# 0) NIL) ((SETQ I (LAB.FIND.SELECTED.MSG MAILFOLDER 1 LASTMSG#)) (* ; "There are already selected messages") (NTHMESSAGE MESSAGES I)) (T (find old I from 1 to LASTMSG# suchthat (AND (NOT (fetch (LAFITEMSG SEEN?) of (SETQ MSGDESCRIPTOR (NTHMESSAGE MESSAGES I)))) (NOT (fetch (LAFITEMSG DELETED?) of MSGDESCRIPTOR)))) (* ;; "Found an unseen, undeleted message. If we don't find one, the last MSGDESCRIPTOR is the one to select") (SELECTMESSAGE MSGDESCRIPTOR MAILFOLDER) MSGDESCRIPTOR))))
)
(LAB.CREATEWINDOW
(LAMBDA (FOLDER LAYOUT TITLE) (* ; "Edited 7-Jun-88 11:15 by bvm") (* ;;; "Build a browser window, which consists of three attached windows: the main BROWSERWINDOW, the BROWSERMENUWINDOW containing the menu, and a BROWSERPROMPTWINDOW for displaying random info") (if (NULL TITLE) then (SETQ TITLE (if FOLDER then (LAB.TITLE.STRING FOLDER) else "Dummy Browser"))) (PROG (BROWSERPROMPTWINDOW BROWSERMENUWINDOW BROWSERMENU BROWSERWINDOW WIDTH HEIGHT MENUREGION WHOLEREGION) (SETQ BROWSERMENU (create MENU ITEMS ← LAFITEBROWSERMENUITEMS CENTERFLG ← T WHENSELECTEDFN ← (if FOLDER then (FUNCTION LAB.COMMANDFN) else (FUNCTION NILL)) MENUFONT ← LAFITEMENUFONT)) (SETQ MENUREGION (WINDOWPROP (SETQ BROWSERMENUWINDOW (MENUWINDOW BROWSERMENU)) (QUOTE REGION))) (SETQ WIDTH (fetch (REGION WIDTH) of MENUREGION)) (SETQ HEIGHT (HEIGHTIFWINDOW (FONTPROP LAFITEBROWSERFONT (QUOTE HEIGHT)))) (* ;; "Now figure out where to put it all") (if LAYOUT then (* ; "user tells us all. If this happens to match one of the default regions, make sure to use it instead (future test is with EQ).") (if (EQ LAYOUT T) then (* ; "Requires prompting") (SETQ LAYOUT NIL) else (for SPEC in LAFITE.BROWSER.LAYOUTS when (EQUAL SPEC LAYOUT) do (RETURN (SETQ LAYOUT SPEC)))) elseif LAFITE.BROWSER.LAYOUTS then (* ; "Take the first layout not currently in use") (for SPEC in LAFITE.BROWSER.LAYOUTS unless (for OPEN in \ACTIVELAFITEFOLDERS thereis (EQ (fetch (MAILFOLDER BROWSERLAYOUT) of OPEN) SPEC)) do (RETURN (SETQ LAYOUT SPEC))) elseif (AND LAFITEBROWSERREGION (for OPEN in \ACTIVELAFITEFOLDERS never (fetch (MAILFOLDER BROWSERWINDOW) of OPEN))) then (* ; "For backward compatibility: if there are no open browsers, use LAFITEBROWSERREGION") (SETQ LAYOUT (LIST LAFITEBROWSERREGION NIL LAFITEDISPLAYREGION))) (COND ((SETQ WHOLEREGION (LISTP (CAR LAYOUT))) (COND ((> (fetch (REGION WIDTH) of WHOLEREGION) WIDTH) (* ; "Only use specified region width if it is wide enough") (SETQ WIDTH (fetch (REGION WIDTH) of WHOLEREGION)))) (SETQ WHOLEREGION (create REGION using WHOLEREGION WIDTH ← WIDTH)) (* ; "Copy the region so we don't smash user variable")) (T (* ; "Prompt for region") (SETQ WHOLEREGION (GETBOXREGION WIDTH (TIMES HEIGHT 9) NIL NIL NIL (CONCAT "Specify region for " TITLE))))) (replace (REGION HEIGHT) of WHOLEREGION with (- (fetch (REGION HEIGHT) of WHOLEREGION) (+ HEIGHT (fetch (REGION HEIGHT) of MENUREGION)))) (* ; "Shrink user-supplied region by the combined heights of the menu and prompt window") (SETQ BROWSERWINDOW (CREATEW WHOLEREGION TITLE)) (ATTACHWINDOW BROWSERMENUWINDOW BROWSERWINDOW (QUOTE TOP) (QUOTE JUSTIFY)) (SETQ BROWSERPROMPTWINDOW (GETPROMPTWINDOW BROWSERWINDOW 1 LAFITEBROWSERFONT)) (CLEARW BROWSERPROMPTWINDOW) (* ; "Get the xy set correctly for the actual font being used") (LINELENGTH MAX.SMALLP BROWSERPROMPTWINDOW) (* ; "Make LINELENGTH ignored -- we try not to overflow window anyway, and the LINELENGTH is no good for variable width font") (if FOLDER then (* ; "MAILFOLDER = NIL is used by dummy routine to set up regions") (WINDOWADDPROP BROWSERPROMPTWINDOW (QUOTE RESHAPEFN) (FUNCTION (LAMBDA (W) (LINELENGTH MAX.SMALLP W)))) (WINDOWADDPROP BROWSERPROMPTWINDOW (QUOTE RESHAPEFN) (FUNCTION RESHAPEBYREPAINTFN)) (* ; "Adding our own reshapefn overrode the default, so add the default back in.") (WINDOWPROP BROWSERPROMPTWINDOW (QUOTE PAGEFULLFN) (FUNCTION LAB.PAGEFULLFN)) (replace (MAILFOLDER ORIGINALBROWSERTITLE) of FOLDER with TITLE) (WINDOWPROP BROWSERWINDOW (QUOTE MAILFOLDER) FOLDER) (WINDOWPROP BROWSERWINDOW (QUOTE SCROLLFN) (FUNCTION LAB.SCROLLFN)) (replace (MAILFOLDER BROWSERWINDOW) of FOLDER with BROWSERWINDOW) (replace (MAILFOLDER BROWSERMENUWINDOW) of FOLDER with BROWSERMENUWINDOW) (replace (MAILFOLDER BROWSERMENU) of FOLDER with BROWSERMENU) (replace (MAILFOLDER BROWSERPROMPTWINDOW) of FOLDER with BROWSERPROMPTWINDOW) (replace (MAILFOLDER FOLDERDISPLAYREGION) of FOLDER with (CADDR LAYOUT)) (replace (MAILFOLDER BROWSERLAYOUT) of FOLDER with LAYOUT) (WINDOWPROP BROWSERWINDOW (QUOTE REPAINTFN) (FUNCTION LAB.REPAINTFN)) (WINDOWPROP BROWSERWINDOW (QUOTE ICONFN) (FUNCTION LAB.ICONFN)) (WINDOWPROP BROWSERWINDOW (QUOTE ICONPOSITION) (CADR LAYOUT)) (WINDOWPROP BROWSERWINDOW (QUOTE BUTTONEVENTFN) (FUNCTION LAB.BUTTONEVENTFN)) (WINDOWPROP BROWSERWINDOW (QUOTE RIGHTBUTTONFN) (FUNCTION LAB.BUTTONEVENTFN)) (WINDOWPROP BROWSERWINDOW (QUOTE COPYBUTTONEVENTFN) (FUNCTION LAB.COPYBUTTONEVENTFN)) (* ; "make sure Lafite has the first CLOSEFN and SHRINKFN") (WINDOWADDPROP BROWSERWINDOW (QUOTE CLOSEFN) (FUNCTION LAB.CLOSEFN) T) (WINDOWADDPROP BROWSERWINDOW (QUOTE SHRINKFN) (FUNCTION LAB.SHRINKFN) T) (WINDOWADDPROP BROWSERWINDOW (QUOTE RESHAPEFN) (FUNCTION LAB.RESHAPEFN))) (RETURN BROWSERWINDOW)))
)
(LAB.TITLE.STRING
(LAMBDA (FOLDER) (* ; "Edited 24-Oct-88 18:07 by bvm") (* ;; "Returns string to be used for FOLDER's browser's title. It is arranged to convey as much info as possible before it falls off the right edge of the window.") (LET* ((DEST (fetch (MAILFOLDER DEFAULTMOVETOFILE) of FOLDER)) (FIELDS (UNPACKFILENAME.STRING (fetch (MAILFOLDER FULLFOLDERNAME) of FOLDER))) (BODY (FMEMB (QUOTE NAME) FIELDS))) (RPLACD (NLEFT FIELDS 1 BODY)) (* ; "detach name.ext;version from host/directory") (CONCAT "Browsing " (if (STRING-EQUAL (LISTGET BODY (QUOTE EXTENSION)) LAFITEMAIL.EXT) then (* ; "Just the name field will do") (LISTGET BODY (QUOTE NAME)) else (CL:APPLY (FUNCTION PACKFILENAME.STRING) BODY)) (if DEST then (CONCAT " (Move To: " (fetch (MAILFOLDER SHORTFOLDERNAME) of DEST) ")") else "") " on " (if (U-CASEP (SETQ FIELDS (CL:APPLY (FUNCTION PACKFILENAME.STRING) FIELDS))) then (CL:STRING-CAPITALIZE FIELDS) else (* ; "Leave the capitalization alone") FIELDS))))
)
(LAB.COMMANDFN
(LAMBDA (ITEM MENU KEY) (* ; "Edited 18-Jul-88 11:41 by bvm") (OR \LAFITE.READY (\LAFITE.MARK.FOLDERS.OBSOLETE)) (LET ((MENUW (WFROMMENU MENU)) WINDOW FOLDER) (AND MENUW (SETQ WINDOW (WINDOWPROP MENUW (QUOTE MAINWINDOW))) (SETQ FOLDER (WINDOWPROP WINDOW (QUOTE MAILFOLDER))) (fetch (MAILFOLDER BROWSERREADY) of FOLDER) (CL:FUNCALL (EXTRACTMENUCOMMAND ITEM) WINDOW FOLDER ITEM MENU KEY))))
)
(LAB.DO.COMMAND
(LAMBDA (WINDOW ITEM/FN MENU KEY) (* ; "Edited 18-Jul-88 11:41 by bvm") (* ;; "Runs some browser command--variant on LAB.COMMANDFN to be called programmatically. If ITEM/FN is a function name, we get the real item and MENU from the window.") (OR \LAFITE.READY (\LAFITE.MARK.FOLDERS.OBSOLETE)) (LET ((FOLDER (WINDOWPROP WINDOW (QUOTE MAILFOLDER)))) (AND FOLDER (fetch (MAILFOLDER BROWSERREADY) of FOLDER) (CL:FUNCALL (if (LITATOM ITEM/FN) then (PROG1 ITEM/FN (OR MENU (SETQ MENU (fetch (MAILFOLDER BROWSERMENU) of FOLDER))) (SETQ ITEM/FN (LA.MENU.ITEM ITEM/FN MENU))) else (EXTRACTMENUCOMMAND ITEM/FN)) WINDOW FOLDER ITEM/FN MENU KEY))))
)
(LAB.ASSURE.SELECTIONS
(LAMBDA (MAILFOLDER) (* bvm%: " 3-Feb-86 14:44") (COND ((IGREATERP (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of MAILFOLDER) (fetch (MAILFOLDER LASTSELECTEDMESSAGE) of MAILFOLDER)) (LAB.PROMPTPRINT MAILFOLDER T "No messages selected.") T)))
)
)
(DEFINEQ
(BUILD.LAFITE.LAYOUTS
(LAMBDA NIL (* ; "Edited 23-Nov-87 16:48 by bvm:") (LET (DUMMYWINDOWS) (CL:UNWIND-PROTECT (PROG ((ICONBM (fetch (TITLEDICON ICON) of LAFITE.FOLDER.ICON)) (N 0) W MAILFOLDER LAYOUTS LAYOUT CURRENT OLDLAYOUTS POS) (if (AND (LISTP LAFITE.BROWSER.LAYOUTS) (CL:Y-OR-N-P "Do you wish to retain the ~D browser specifications you already have? " (LENGTH LAFITE.BROWSER.LAYOUTS))) then (SETQ OLDLAYOUTS LAFITE.BROWSER.LAYOUTS) (for LAYOUT in OLDLAYOUTS do (for FOLDER in \ACTIVELAFITEFOLDERS when (EQ (fetch (MAILFOLDER BROWSERLAYOUT) of FOLDER) LAYOUT) do (add N 1) (RETURN (CL:FORMAT T "Retaining layout in use by ~A.~%%" (fetch (MAILFOLDER SHORTFOLDERNAME) of FOLDER))) finally (* ; "Display dummy browser and icon to aid in positioning.") (SETQ W (LAB.CREATEWINDOW NIL LAYOUT (CONCAT "Sample Browser " (add N 1)))) (push DUMMYWINDOWS (\LAFITE.MAKE.DUMMY.WINDOWS W LAYOUT N)))) (SETQ LAYOUTS (REVERSE OLDLAYOUTS))) (CL:FORMAT T "Click in preference order in each browser or browser icon whose current layout you wish to include; click in background to finish~%%") (while (SETQ W (WHICHW (GETPOSITION))) do (if (AND (NOT (SETQ MAILFOLDER (WINDOWPROP W (QUOTE MAILFOLDER)))) (OR (NOT (SETQ W (WINDOWPROP W (QUOTE ICONFOR)))) (NOT (SETQ MAILFOLDER (WINDOWPROP W (QUOTE MAILFOLDER)))))) then (CL:FORMAT T "That's not a Lafite browser window/icon; try again.~%%") elseif (OR (MEMB (fetch (MAILFOLDER BROWSERLAYOUT) of MAILFOLDER) OLDLAYOUTS) (MEMBER (SETQ LAYOUT (\LAFITE.LAYOUT.FROM.WINDOW W MAILFOLDER ICONBM)) LAYOUTS)) then (CL:FORMAT T "You have already included that browser's specification.~%%") else (* ; "It's a Lafite browser window or icon.") (push LAYOUTS LAYOUT) (CL:FORMAT T "Browser for ~A noted.~%%" (fetch (MAILFOLDER SHORTFOLDERNAME) of MAILFOLDER)) (add N 1))) (while (OR (NULL LAYOUTS) (MENU (create MENU ITEMS ← (QUOTE (("Specify another browser" T) ("Finish" (QUOTE NIL)))) MENUFONT ← LAFITEMENUFONT CENTERFLG ← T))) do (SETQ W (LAB.CREATEWINDOW NIL T (CONCAT "Sample Browser " (add N 1)))) (push DUMMYWINDOWS (\LAFITE.MAKE.DUMMY.WINDOWS W (SETQ LAYOUT (\LAFITE.LAYOUT.FROM.WINDOW W NIL ICONBM)) N)) (push LAYOUTS LAYOUT)) (RETURN (if (AND LAYOUTS (MOUSECONFIRM "Click LEFT to confirm setting LAFITEBROWSERLAYOUTS to these values" T T T)) then (/SETTOPVAL (QUOTE LAFITE.BROWSER.LAYOUTS) (REVERSE LAYOUTS)) (MARKASCHANGED (QUOTE LAFITE.BROWSER.LAYOUTS) (QUOTE VARS)) LAFITE.BROWSER.LAYOUTS))) (* ;; "Cleanup dummy windows put up earlier") (for X in DUMMYWINDOWS bind TMP do (CLOSEW X) (if (SETQ TMP (WINDOWPROP X (QUOTE DUMMY.ICON))) then (CLOSEW TMP)) (if (SETQ TMP (WINDOWPROP X (QUOTE DUMMY.DISPLAY))) then (CLOSEW TMP))))))
)
(\LAFITE.LAYOUT.FROM.WINDOW
(LAMBDA (W FOLDER ICONBM) (* ; "Edited 10-Dec-87 17:15 by bvm:") (* ;; "Return a browser layout spec corresponding to window W optionally containing FOLDER.") (LET ((PW (if (OPENWP W) then (GETPROMPTWINDOW W 1 LAFITEBROWSERFONT) else PROMPTWINDOW))) (LIST (WINDOWREGION W) (if (WINDOWPROP W (QUOTE ICONPOSITION)) else (CLEARW PW) (CL:FORMAT PW "Specify position for icon.") (PROG1 (GETBOXPOSITION (BITMAPWIDTH ICONBM) (BITMAPHEIGHT ICONBM)) (CLEARW PW))) (PROG (CURRENT) (if FOLDER then (* ; "Use current values, if known") (RETURN (OR (if (CAR (SETQ CURRENT (fetch (MAILFOLDER FOLDERDISPLAYWINDOWS) of FOLDER))) then (* ; "take current primary window region") (COPY (WINDOWPROP (CAR CURRENT) (QUOTE REGION))) elseif (COPY (fetch (MAILFOLDER FOLDERDISPLAYREGION) of FOLDER))) (GO PROMPT)))) PROMPT (CLEARW PW) (CL:FORMAT PW "Specify region for display window") (RETURN (PROG1 (if LAFITE.DISPLAY.SIZE then (GETBOXREGION (CAR LAFITE.DISPLAY.SIZE) (CDR LAFITE.DISPLAY.SIZE) NIL NIL) else (GETREGION)) (CLEARW PW)))))))
)
(\LAFITE.MAKE.DUMMY.WINDOWS
(LAMBDA (MAINW LAYOUT N) (* ; "Edited 23-Nov-87 16:44 by bvm:") (LET (TMP SUBW) (DSPFILL NIL LAFITE.DUMMY.SHADE (QUOTE REPLACE) MAINW) (WINDOWPROP MAINW (QUOTE SHRINKFN) (QUOTE DON'T)) (if (SETQ TMP (CADR LAYOUT)) then (* ; "An icon position is given") (SETQ SUBW (TITLEDICONW LAFITE.FOLDER.ICON (CONCAT "Icon " N) LAFITETITLEFONT TMP)) (ICONW.SHADE SUBW LAFITE.DUMMY.HALF.SHADE) (WINDOWPROP SUBW (QUOTE BUTTONEVENTFN) (FUNCTION ICONBUTTONEVENTFN)) (WINDOWPROP MAINW (QUOTE DUMMY.ICON) SUBW)) (if (SETQ TMP (CADDR LAYOUT)) then (* ; "A display region is given") (SETQ SUBW (CREATEW TMP (CONCAT "Lafite Display window " N) LAFITETITLEFONT TMP)) (DSPFILL NIL LAFITE.DUMMY.SHADE (QUOTE REPLACE) SUBW) (WINDOWPROP MAINW (QUOTE DUMMY.DISPLAY) SUBW)) MAINW))
)
)
(RPAQQ LAFITE.DUMMY.SHADE #*(16 16)@L@HA@@FALD@@DJ@AHF@@@JDH@NFD@@EDD@EDJ@EDJD@@LD@@HD@@HDD@@DJ@@DL)
(RPAQQ LAFITE.DUMMY.HALF.SHADE #*(16 16)@H@@A@@D@@D@@DB@A@D@@@HDH@DB@@@DDD@A@B@DDHD@@D@@@@D@@H@D@@DJ@@@@)
(RPAQ? \LAFITE.LAST.FOLDER.NAME)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \LAFITE.LAST.FOLDER.NAME)
)
(* ; "Browser operations")
(DEFINEQ
(LAB.SETUP
(LAMBDA (MAILFOLDER) (* bvm%: "31-Jul-84 14:39") (PROG ((WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER)) WIDTH HEIGHT TOTALHEIGHT ASCENT DIGITWIDTH SPACEWIDTH XPOS) (CLEARW WINDOW) (SETQ LAFITEBROWSERFONT (FONTCREATE LAFITEBROWSERFONT)) (DSPFONT LAFITEBROWSERFONT WINDOW) (DSPRIGHTMARGIN MAX.SMALLP WINDOW) (LINELENGTH 10000 WINDOW) (replace (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER with (SETQ HEIGHT (FONTPROP LAFITEBROWSERFONT (QUOTE HEIGHT)))) (replace (MAILFOLDER BROWSERFONTASCENT) of MAILFOLDER with (SETQ ASCENT (FONTPROP LAFITEBROWSERFONT (QUOTE ASCENT)))) (replace (MAILFOLDER BROWSERFONTDESCENT) of MAILFOLDER with (FONTPROP LAFITEBROWSERFONT (QUOTE DESCENT))) (replace (MAILFOLDER BROWSERORIGIN) of MAILFOLDER with (+ (DSPYPOSITION NIL WINDOW) ASCENT)) (replace (MAILFOLDER BROWSERMAXXPOS) of MAILFOLDER with (SETQ WIDTH (WINDOWPROP WINDOW (QUOTE WIDTH)))) (SETQ TOTALHEIGHT (TIMES (fetch (MAILFOLDER %#OFMESSAGES) of MAILFOLDER) HEIGHT)) (WINDOWPROP WINDOW (QUOTE EXTENT) (replace (MAILFOLDER BROWSEREXTENT) of MAILFOLDER with (create REGION LEFT ← 0 BOTTOM ← (- (fetch (MAILFOLDER BROWSERORIGIN) of MAILFOLDER) TOTALHEIGHT) WIDTH ← WIDTH HEIGHT ← TOTALHEIGHT))) (* ;; "Now figure out columns for printing toc entries") (SETQ DIGITWIDTH (CHARWIDTH (CHARCODE 9) LAFITEBROWSERFONT)) (SETQ SPACEWIDTH (CHARWIDTH (CHARCODE r) LAFITEBROWSERFONT)) (replace (MAILFOLDER ORDINALXPOS) of MAILFOLDER with (SETQ XPOS (+ BROWSERMARKXPOSITION (CHARWIDTH (CHARCODE m) LAFITEBROWSERFONT) (LRSH DIGITWIDTH 1)))) (* ; "Message # starts here") (replace (MAILFOLDER DATEXPOS) of MAILFOLDER with (add XPOS (+ (TIMES 2 SPACEWIDTH) (TIMES 4 DIGITWIDTH)))) (* ; "Date starts here. Allow 4 columns of digits plus some space") (replace (MAILFOLDER FROMXPOS) of MAILFOLDER with (add XPOS (+ (TIMES 2 DIGITWIDTH) (TIMES 2 SPACEWIDTH) (CHARWIDTH (CHARCODE -) LAFITEBROWSERFONT) (STRINGWIDTH (QUOTE MAY) LAFITEBROWSERFONT)))) (* ; "From field starts here. Allow 3 columns of digits, a month, and some space") (replace (MAILFOLDER SUBJECTXPOS) of MAILFOLDER with (add XPOS (IMAX (TIMES LAFITEMINFROMCHARS (CHARWIDTH (CHARCODE A) LAFITEBROWSERFONT)) (FIXR (FTIMES LAFITEFROMFRACTION (- WIDTH XPOS)))))) (* ;; "Subject field starts here. Space is divided up between From and Subject so that From field gets LAFITEFROMFRACTION of the available space, but at least LAFITEMINFROMCHARS wide") (replace (MAILFOLDER FROMMAXXPOS) of MAILFOLDER with (- XPOS (TIMES 2 SPACEWIDTH))) (* ; "From field gets truncated beyond this position") (replace (MAILFOLDER BROWSERDIGITWIDTH) of MAILFOLDER with DIGITWIDTH)))
)
(LAB.BUTTONEVENTFN
(LAMBDA (WINDOW) (* ; "Edited 28-Jul-88 17:37 by bvm") (TOTOPW WINDOW) (COND ((INSIDEP (DSPCLIPPINGREGION NIL WINDOW) (LASTMOUSEX WINDOW) (LASTMOUSEY WINDOW)) (LAB.DO.UNLESS.BUSY WINDOW (FUNCTION LAB.SELECTMESSAGE))) ((LASTMOUSESTATE (ONLY RIGHT)) (DOWINDOWCOM WINDOW)) ((LASTMOUSESTATE (ONLY MIDDLE)) (LAB.DO.UNLESS.BUSY WINDOW (FUNCTION LAFITEEXTRABROWSERCOMMANDFN)))))
)
(LAB.DO.UNLESS.BUSY
(LAMBDA (WINDOW FN ARGUMENT) (* ; "Edited 3-Sep-87 18:01 by bvm:") (RESETLST (PROG ((MAILFOLDER (WINDOWPROP WINDOW (QUOTE MAILFOLDER)))) (COND ((AND (fetch (MAILFOLDER BROWSERREADY) of MAILFOLDER) (OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER) T T)) (CL:FUNCALL FN WINDOW MAILFOLDER ARGUMENT))))))
)
(LOADMAILFOLDER
(LAMBDA (FOLDER) (* ; "Edited 13-Sep-88 18:44 by bvm") (* ;; "LAFITEVERSION# is used to keep track of changed in internal datastructures that get written out to Lafite TOC files. If the datastructures change, then just change the version number to LAFITEVERSION#+1 and the rest of Lafite should adjust appropriately.") (LET* ((*UPPER-CASE-FILE-NAMES* NIL) (CONTENTSFILE (INFILEP (TOCFILENAME (fetch (MAILFOLDER FULLFOLDERNAME) of FOLDER))))) (COND ((OR (AND CONTENTSFILE (READTOCFILE FOLDER CONTENTSFILE)) (PARSEMAILFOLDER FOLDER)) (LAB.PROMPTPRINT FOLDER " done.") (LAB.SET.EXPUNGEABILITY FOLDER) FOLDER) (T (LAB.PROMPTPRINT FOLDER " Failed.") (DELETEMENU (fetch (MAILFOLDER BROWSERMENU) of FOLDER) NIL (fetch (MAILFOLDER BROWSERMENUWINDOW) of FOLDER)) (* ; "Get rid of menu to avoid temptation") (replace (MAILFOLDER BROWSERSTATUS) of FOLDER with LAS.OUT.OF.DATE) NIL))))
)
(LAFITE.OBTAIN.FOLDER
(LAMBDA (FOLDERNAME ACCESS PROMPTFOLDER OPTIONS) (* ; "Edited 12-Sep-88 17:42 by bvm") (* ;;; "Locates a MAILFOLDER on FOLDERNAME, or creates one if there is none. If the folder is not already on the active list, we will try to open it for ACCESS, or just return NIL if ACCESS is NIL. If PROMPTFOLDER is supplied, it is a folder (or T for PROMPTWINDOW) indicating focus of attention for prompting for confirmation to create new folder. OPTIONS may include :FORGET, in which case we don't add this folder name to the set of known folders, or :BROWSE, meaning we plan to browse the folder.") (WITH.MONITOR \LAFITE.BROWSELOCK (OR (for FOLDER in \ACTIVELAFITEFOLDERS when (OR (STRING-EQUAL (fetch (MAILFOLDER VERSIONLESSFOLDERNAME) of FOLDER) FOLDERNAME) (STRING-EQUAL (fetch (MAILFOLDER FULLFOLDERNAME) of FOLDER) FOLDERNAME)) do (* ; "Found existing folder without sweating too hard") (RETURN FOLDER)) (AND ACCESS (LET* ((UNPACKEDNAME (UNPACKFILENAME.STRING FOLDERNAME)) (OLDVERSION (LISTGET UNPACKEDNAME (QUOTE VERSION))) (VERSIONLESSNAME (PROGN (LISTPUT UNPACKEDNAME (QUOTE VERSION) NIL) (PACKFILENAME.STRING UNPACKEDNAME))) SHORTNAME NEWNAME NEWFOLDER OLDFOLDER STREAM) (COND ((AND (NOT (STRING-EQUAL VERSIONLESSNAME FOLDERNAME)) (SETQ NEWFOLDER (\LAFITE.FIND.EXISTING.FOLDER VERSIONLESSNAME)) (\LAFITE.CONFLICTING.OLD.FOLDER NEWFOLDER FOLDERNAME OLDVERSION)) (* ; "Found a folder describing a different version--can't have more than one version up at once") NIL) ((NULL (SETQ STREAM (\LAFITE.MAYBE.OPEN.FOLDER (SETQ NEWFOLDER (create MAILFOLDER FULLFOLDERNAME ← FOLDERNAME VERSIONLESSFOLDERNAME ← VERSIONLESSNAME FOLDERLOCK ← (CREATE.MONITORLOCK VERSIONLESSNAME))) ACCESS PROMPTFOLDER OPTIONS T))) (* ; "File not found and user didn't confirm creating it") NIL) ((type? STREAM STREAM) (* ; "succeeded in opening the new folder.") (PROG ((VERSIONLESSNEW (PACKFILENAME.STRING (QUOTE VERSION) NIL (QUOTE BODY) (fetch (MAILFOLDER FULLFOLDERNAME) of NEWFOLDER))) (SHORTNAME (fetch SHORTFOLDERNAME of NEWFOLDER))) (if (NOT (STRING-EQUAL VERSIONLESSNEW VERSIONLESSNAME)) then (* ; "We guessed wrong about the versionless name--having actually opened the file, here's the canonical name") (if (SETQ OLDFOLDER (\LAFITE.FIND.EXISTING.FOLDER VERSIONLESSNEW)) then (* ; "it turns out we already had this file open under a different full name. Close the new one and return the old") (\LAFITE.CLOSE.FOLDER NEWFOLDER T) (RETURN (AND (NOT (\LAFITE.CONFLICTING.OLD.FOLDER OLDFOLDER FOLDERNAME OLDVERSION)) OLDFOLDER)) else (replace (MAILFOLDER VERSIONLESSFOLDERNAME) of NEWFOLDER with VERSIONLESSNEW))) (push \ACTIVELAFITEFOLDERS NEWFOLDER) (if (NOT (CL:MEMBER SHORTNAME (CDR LAFITEMAILFOLDERS) :TEST (QUOTE STRING-EQUAL))) then (* ; "This is a new folder") (COND ((EQMEMB :FORGET OPTIONS) (* ; "Don't remember it, but do set default for next Browse&Forget") (SETQ \LAFITE.LAST.FOLDER.NAME SHORTNAME)) (T (* ; "Add to list for menu") (\LAFITE.NOTICE.FILE SHORTNAME)))) (RETURN NEWFOLDER))) (T (* ; "STREAM is a condition signaled by the attempt to open the file") (if (AND (TYPEP STREAM (QUOTE XCL:FILE-WONT-OPEN)) (SETQ OLDFOLDER (OR (AND (SETQ NEWNAME (XCL:FILE-WONT-OPEN-PATHNAME STREAM)) (NOT (STRING-EQUAL VERSIONLESSNAME (SETQ VERSIONLESSNAME (PACKFILENAME.STRING (QUOTE VERSION) NIL (QUOTE BODY) NEWNAME)))) (\LAFITE.FIND.EXISTING.FOLDER VERSIONLESSNAME)) (AND (SETQ NEWNAME (INFILEP VERSIONLESSNAME)) (NOT (STRING-EQUAL VERSIONLESSNAME (SETQ VERSIONLESSNAME (PACKFILENAME.STRING (QUOTE VERSION) NIL (QUOTE BODY) NEWNAME)))) (\LAFITE.FIND.EXISTING.FOLDER VERSIONLESSNAME)))) (NOT (\LAFITE.CONFLICTING.OLD.FOLDER NEWFOLDER FOLDERNAME OLDVERSION))) then (* ; "Looks like file wouldn't open because we already have it open by a different name. Return that folder") OLDFOLDER else (* ; "Report the problem") (\LAFITE.REPORT.FILE.WONT.OPEN PROMPTFOLDER STREAM (OR NEWNAME FOLDERNAME)) NIL))))))))
)
(\LAFITE.FIND.EXISTING.FOLDER
(LAMBDA (VERSIONLESSNAME) (* ; "Edited 22-Aug-88 17:32 by bvm") (* ;; "Returns an existing mail folder object whose versionless name is (case-insensitively) equal to VERSIONLESSNAME, or NIL on failure.") (find FOLDER in \ACTIVELAFITEFOLDERS suchthat (STRING-EQUAL (fetch (MAILFOLDER VERSIONLESSFOLDERNAME) of FOLDER) VERSIONLESSNAME)))
)
(\LAFITE.CONFLICTING.OLD.FOLDER
(LAMBDA (NEWFOLDER FOLDERNAME OLDVERSION) (* ; "Edited 22-Aug-88 18:30 by bvm") (* ;; "NEWFOLDER is a folder we found somewhere during the search for FOLDERNAME. Check that it works, i.e., that it doesn't have a version number that differs from that of FOLDERNAME") (COND ((NULL OLDVERSION) (* ; "User didn't ask for a specific version, so this folder is fine") NIL) ((OR (fetch (MAILFOLDER BROWSERWINDOW) of NEWFOLDER) (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of NEWFOLDER)) (printout PROMPTWINDOW T "A different version of " FOLDERNAME " is already being browsed." "Multiple versions may not be manipulated at once.") T) (T (* ; "Not being browsed, so kill it and pretend it never existed") (\LAFITE.CLOSE.FOLDER NEWFOLDER T) (SETQ \ACTIVELAFITEFOLDERS (DREMOVE NEWFOLDER \ACTIVELAFITEFOLDERS)) NIL)))
)
(LAB.REPAINTFN
(LAMBDA (WINDOW REGION) (* bvm%: " 9-Dec-85 17:16") (PROG ((MAILFOLDER (WINDOWPROP WINDOW (QUOTE MAILFOLDER)))) (AND (NEQ (fetch (MAILFOLDER %#OFMESSAGES) of MAILFOLDER) 0) (fetch (MAILFOLDER BROWSERREADY) of MAILFOLDER) (RESETLST (COND ((OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER) T T) (LAB.DISPLAYLINES MAILFOLDER (FIRSTVISIBLEMESSAGE MAILFOLDER REGION) (LASTVISIBLEMESSAGE MAILFOLDER REGION))) (T (MAILFOLDERBUSY MAILFOLDER)))))))
)
(LAB.SCROLLFN
(LAMBDA (WINDOW DX DY CONTINUOUSFLG) (* bvm%: " 3-Jan-84 14:53") (* ;;; "only scroll if can get the monitor lock") (RESETLST (PROG ((MAILFOLDER (WINDOWPROP WINDOW (QUOTE MAILFOLDER)))) (COND ((AND (fetch (MAILFOLDER BROWSERREADY) of MAILFOLDER) (OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER) T T)) (SCROLLBYREPAINTFN WINDOW DX DY CONTINUOUSFLG)) (T (MAILFOLDERBUSY MAILFOLDER))))))
)
(LAB.RESHAPEFN
(LAMBDA (WINDOW OLDIMAGEBM OLDREGION) (* bvm%: "28-Mar-84 14:22") (RESETLST (PROG ((MAILFOLDER (WINDOWPROP WINDOW (QUOTE MAILFOLDER))) (REGION (DSPCLIPPINGREGION NIL WINDOW)) MSG#) (COND ((NOT (OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER) T T)) (* ; "Folder is busy, have to wait until it is ready. But don't tie up mouse!") (ALLOW.BUTTON.EVENTS) (OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER) NIL T)) ((NOT (fetch (MAILFOLDER BROWSERREADY) of MAILFOLDER)) (* ; "Browser not functional") (RETURN (RESHAPEBYREPAINTFN WINDOW OLDIMAGEBM OLDREGION)))) (SETQ MSG# (FIRSTVISIBLEMESSAGE MAILFOLDER REGION)) (LAB.SETUP MAILFOLDER) (WYOFFSET (ITIMES (SUB1 MSG#) (fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER)) WINDOW) (LAB.DISPLAYLINES MAILFOLDER MSG# (LASTVISIBLEMESSAGE MAILFOLDER REGION)))))
)
(LAB.CLOSEFN
(LAMBDA (BROWSERWINDOW) (* ; "Edited 15-Sep-87 17:56 by bvm:") (LAB.CLOSE/SHRINK BROWSERWINDOW :CLOSE))
)
(LAB.SHRINKFN
(LAMBDA (WINDOW) (* ; "Edited 15-Sep-87 17:56 by bvm:") (LAB.CLOSE/SHRINK WINDOW :SHRINK)))
(LAB.CLOSE/SHRINK
(LAMBDA (BROWSERWINDOW FLG) (* ; "Edited 7-Jun-88 14:42 by bvm") (* ;; "Called from CLOSEFN or SHRINKFN of BROWSERWINDOW with FLG = :CLOSE or :SHRINK. Before doing anything, let user update file.") (RESETLST (LET ((MAILFOLDER (WINDOWPROP BROWSERWINDOW (QUOTE MAILFOLDER))) HOW?) (COND ((OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER) T T) (AND (OPENWP BROWSERWINDOW) (CLEARW (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER))) (SELECTQ (SETQ HOW? (COND ((AND (fetch (MAILFOLDER BROWSERREADY) of MAILFOLDER) (SETQ HOW? (LAB.CHOOSE.UPDATE.MENU MAILFOLDER FLG))) (MENU HOW?)) (T (FUNCTION \LAFITE.FINISH.UPDATE)))) (NIL (QUOTE DON'T)) (PROGN (\LAFITE.PROCESS (LIST HOW? (KWOTE BROWSERWINDOW) (KWOTE MAILFOLDER) (KWOTE FLG)) (QUOTE LAFITEUPDATE)) (* ; "Return DON'T now, for UPDATE.PROC will do it later") (QUOTE DON'T)))) (T (printout PROMPTWINDOW T "Browser is busy, can't close") (QUOTE DON'T))))))
)
(LAB.EXPANDFN
(LAMBDA (BROWSERWINDOW) (* bvm%: " 9-Dec-85 17:16") (PROG ((MAILFOLDER (WINDOWPROP BROWSERWINDOW (QUOTE MAILFOLDER)))) (WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER) (PROG ((FIRSTCHANGEDMSG# (fetch (MAILFOLDER BROWSERUPDATEFROMHERE) of MAILFOLDER)) REGION) (* ; "Restore SHRINKFN prop if necessary") (WINDOWADDPROP BROWSERWINDOW (QUOTE SHRINKFN) (FUNCTION LAB.SHRINKFN) T) (COND (FIRSTCHANGEDMSG# (* ; "Browser has changed since shrinking") (COND ((EQ FIRSTCHANGEDMSG# 0) (* ; "After expunge") (LAB.DISPLAYFOLDER MAILFOLDER)) (T (LAB.DISPLAYLINES MAILFOLDER (IMAX FIRSTCHANGEDMSG# (FIRSTVISIBLEMESSAGE MAILFOLDER (SETQ REGION (DSPCLIPPINGREGION NIL BROWSERWINDOW)))) (LASTVISIBLEMESSAGE MAILFOLDER REGION)))) (replace (MAILFOLDER BROWSERUPDATEFROMHERE) of MAILFOLDER with NIL)))))))
)
(LAFITEEXTRABROWSERCOMMANDFN
(LAMBDA (WINDOW MAILFOLDER) (* ; "Edited 28-Jul-88 17:37 by bvm") (PROG ((FN (MENU (.LAFITEMENU. LAFITEEXTRAMENU LAFITEEXTRAMENUITEMS)))) (COND (FN (\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER) (CL:FUNCALL FN MAILFOLDER)))))
)
)
(* ; "Browser selection")
(DEFINEQ
(LAB.SELECTMESSAGE
(LAMBDA (WINDOW) (* ; "Edited 7-Jun-88 17:37 by bvm") (PROG ((*MAILFOLDER* (WINDOWPROP WINDOW (QUOTE MAILFOLDER))) *MESSAGES* *FIRST-VISIBLE* *LAST-VISIBLE* *TOC-STATE* SELECTIONREGION FIRST# LAST# SEL# OLDSEL# CTRLDOWN OLDLASTMOUSEBUTTONS MSG LASTX LASTY MARKRIGHT) (COND ((EQ (fetch (MAILFOLDER %#OFMESSAGES) of *MAILFOLDER*) 0) (* ; "Nothing to select") (RETURN))) (SETQ SELECTIONREGION (DSPCLIPPINGREGION NIL WINDOW)) (SETQ LAST# (fetch (MAILFOLDER LASTSELECTEDMESSAGE) of *MAILFOLDER*)) (SETQ FIRST# (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of *MAILFOLDER*)) (SETQ *FIRST-VISIBLE* (FIRSTVISIBLEMESSAGE *MAILFOLDER* SELECTIONREGION)) (SETQ *LAST-VISIBLE* (LASTVISIBLEMESSAGE *MAILFOLDER* SELECTIONREGION)) (SETQ *MESSAGES* (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of *MAILFOLDER*)) (SETQ MARKRIGHT (fetch (MAILFOLDER ORDINALXPOS) of *MAILFOLDER*)) (* ;; "keep looping until all mouse buttons are up") (do (GETMOUSESTATE) (COND ((NOT (INSIDEP SELECTIONREGION (SETQ LASTX (LASTMOUSEX WINDOW)) (SETQ LASTY (LASTMOUSEY WINDOW)))) (* ;; "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 ((NEQ *TOC-STATE* TS.IDLE) (LA.UNDOSELECTION) (SETQ OLDSEL#))) (COND ((LASTMOUSESTATE UP) (RETURN)) (T (BLOCK)))) ((LASTMOUSESTATE UP) (* ; "Make selection permanent") (SELECTC *TOC-STATE* (TS.REPLACING (for MSG selectedin *MAILFOLDER* do (replace SELECTED? of MSG with NIL)) (replace SELECTED? of (NTHMESSAGE *MESSAGES* OLDSEL#) with T) (replace FIRSTSELECTEDMESSAGE of *MAILFOLDER* with (replace LASTSELECTEDMESSAGE of *MAILFOLDER* with OLDSEL#))) (TS.ADDING (LA.SELECTRANGE *MAILFOLDER* OLDSEL# OLDSEL# T)) (TS.REMOVING (LA.DESELECTRANGE *MAILFOLDER* OLDSEL# OLDSEL#)) (TS.EXTENDING.HI (LA.SELECTRANGE *MAILFOLDER* (ADD1 LAST#) OLDSEL# CTRLDOWN)) (TS.EXTENDING.LO (LA.SELECTRANGE *MAILFOLDER* OLDSEL# (SUB1 FIRST#) CTRLDOWN)) (TS.SHRINKING.HI (LA.DESELECTRANGE *MAILFOLDER* (ADD1 OLDSEL#) LAST#)) (TS.SHRINKING.LO (LA.DESELECTRANGE *MAILFOLDER* FIRST# (SUB1 OLDSEL#))) NIL) (RETURN)) ((AND (>= LASTX BROWSERMARKXPOSITION) (< LASTX MARKRIGHT)) (* ; "Inside mark region") (COND ((NEQ *TOC-STATE* TS.IDLE) (LA.UNDOSELECTION) (SETQ OLDSEL#))) (LAB.CHANGEMARK *MAILFOLDER*)) ((OR (NEQ (SETQ SEL# (YPOS.TO.MESSAGE# (LASTMOUSEY WINDOW) *MAILFOLDER*)) OLDSEL#) (NEQ LASTMOUSEBUTTONS OLDLASTMOUSEBUTTONS)) (COND ((AND (SHIFTDOWNP (QUOTE CTRL)) (NOT (LASTMOUSESTATE RIGHT))) (* ; "Deselect this message") (SELECTC *TOC-STATE* (TS.REMOVING (LA.SHOW.SELECTION *MAILFOLDER* (NTHMESSAGE *MESSAGES* OLDSEL#) (QUOTE REPLACE))) (TS.IDLE) (LA.UNDOSELECTION)) (SETQ *TOC-STATE* (COND ((fetch SELECTED? of (SETQ MSG (NTHMESSAGE *MESSAGES* SEL#))) (LA.SHOW.SELECTION *MAILFOLDER* MSG (QUOTE ERASE)) TS.REMOVING) (T TS.IDLE)))) ((LASTMOUSESTATE LEFT) (* ; "Set (change) the selection to this single message") (COND ((EQ *TOC-STATE* TS.REPLACING) (LA.SHOW.SELECTION *MAILFOLDER* (NTHMESSAGE *MESSAGES* OLDSEL#) (QUOTE ERASE))) (T (LA.DECONSIDERRANGE *FIRST-VISIBLE* *LAST-VISIBLE*) (SETQ *TOC-STATE* TS.REPLACING))) (LA.SHOW.SELECTION *MAILFOLDER* (NTHMESSAGE *MESSAGES* SEL#) (QUOTE REPLACE))) ((LASTMOUSESTATE MIDDLE) (* ; "Add this message to the selection") (SELECTC *TOC-STATE* (TS.ADDING (LA.SHOW.SELECTION *MAILFOLDER* (NTHMESSAGE *MESSAGES* OLDSEL#) (QUOTE ERASE))) (TS.IDLE) (LA.UNDOSELECTION)) (SETQ *TOC-STATE* (COND ((NOT (fetch SELECTED? of (SETQ MSG (NTHMESSAGE *MESSAGES* SEL#)))) (LA.SHOW.SELECTION *MAILFOLDER* MSG (QUOTE REPLACE)) TS.ADDING) (T TS.IDLE)))) ((LASTMOUSESTATE RIGHT) (* ; "Extend: either up or down, or shrink a selection. This is messy") (SELECTC *TOC-STATE* (TS.EXTENDING.HI (COND ((> SEL# OLDSEL#) (* ; "Extend further") (LA.CONSIDERRANGE (ADD1 OLDSEL#) SEL# CTRLDOWN)) (T (* ; "Shrinking back") (LA.RECONSIDERRANGE (ADD1 (COND ((> SEL# LAST#) SEL#) (T (SETQ *TOC-STATE* TS.IDLE) LAST#))) OLDSEL#)))) (TS.EXTENDING.LO (COND ((< SEL# OLDSEL#) (* ; "Extend further") (LA.CONSIDERRANGE SEL# (SUB1 OLDSEL#) CTRLDOWN)) (T (* ; "Shrinking back") (LA.RECONSIDERRANGE OLDSEL# (SUB1 (COND ((< SEL# FIRST#) SEL#) (T (SETQ *TOC-STATE* TS.IDLE) FIRST#))))))) (TS.SHRINKING.HI (COND ((>= SEL# OLDSEL#) (* ; "Shrinking less") (LA.RECONSIDERRANGE (ADD1 OLDSEL#) (COND ((< SEL# LAST#) SEL#) (T (SETQ *TOC-STATE* TS.IDLE) LAST#)))) ((>= SEL# FIRST#) (* ; "Shrinking further") (LA.DECONSIDERRANGE (ADD1 SEL#) OLDSEL#)) (T (* ; "Too far to shrink") (LA.RECONSIDERRANGE FIRST# LAST#) (SETQ *TOC-STATE* TS.IDLE)))) (TS.SHRINKING.LO (COND ((<= SEL# OLDSEL#) (* ; "Shrinking less") (LA.RECONSIDERRANGE (COND ((> SEL# FIRST#) SEL#) (T (SETQ *TOC-STATE* TS.IDLE) FIRST#)) (SUB1 OLDSEL#))) ((<= SEL# LAST#) (* ; "Shrinking further") (LA.DECONSIDERRANGE OLDSEL# (SUB1 SEL#))) (T (* ; "Too far to shrink") (LA.RECONSIDERRANGE FIRST# LAST#) (SETQ *TOC-STATE* TS.IDLE)))) (COND ((NOT (> FIRST# LAST#)) (COND ((NEQ *TOC-STATE* TS.IDLE) (LA.UNDOSELECTION))) (SETQ CTRLDOWN (SHIFTDOWNP (QUOTE CTRL))) (SETQ *TOC-STATE* (COND ((> SEL# LAST#) (LA.CONSIDERRANGE (ADD1 LAST#) SEL# CTRLDOWN) TS.EXTENDING.HI) ((< SEL# FIRST#) (LA.CONSIDERRANGE SEL# (SUB1 FIRST#) CTRLDOWN) TS.EXTENDING.LO) ((> SEL# (LRSH (+ LAST# FIRST#) 1)) (LA.DECONSIDERRANGE (ADD1 SEL#) LAST#) TS.SHRINKING.HI) (T (LA.DECONSIDERRANGE FIRST# (SUB1 SEL#)) TS.SHRINKING.LO)))))))) (SETQ OLDLASTMOUSEBUTTONS LASTMOUSEBUTTONS) (SETQ OLDSEL# (AND (NEQ *TOC-STATE* TS.IDLE) SEL#))))) (COND ((EQ LAFITEVERIFYFLG (QUOTE TOC)) (LA.VERIFY.SELECTION *MAILFOLDER*)))))
)
(LAB.CHANGEMARK
(LAMBDA (MAILFOLDER) (* bvm%: "17-Feb-84 15:46") (* ;; "Called when mouse is inside the 'mark' region of a browser. Tracks mouse while in that region and does whatever is appropriate") (PROG ((WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER)) (RIGHT (fetch (MAILFOLDER ORDINALXPOS) of MAILFOLDER)) SEL# OLDSEL# COCKED REGION X Y TOP BOTTOM) (SETQ BOTTOM (fetch (REGION BOTTOM) of (SETQ REGION (DSPCLIPPINGREGION NIL WINDOW)))) (SETQ TOP (fetch (REGION TOP) of REGION)) (do (GETMOUSESTATE) (COND ((OR (< (SETQ X (LASTMOUSEX WINDOW)) BROWSERMARKXPOSITION) (> X RIGHT) (< (SETQ Y (LASTMOUSEY WINDOW)) BOTTOM) (> Y TOP)) (COND (COCKED (LA.INVERT.MARK.BOX MAILFOLDER OLDSEL#))) (RETURN)) ((LASTMOUSESTATE UP) (COND (COCKED (LA.READ.NEW.MARK MAILFOLDER OLDSEL#))) (RETURN)) ((NEQ (SETQ SEL# (YPOS.TO.MESSAGE# Y MAILFOLDER)) OLDSEL#) (COND (COCKED (LA.INVERT.MARK.BOX MAILFOLDER OLDSEL#)) (T (SETQ COCKED T))) (LA.INVERT.MARK.BOX MAILFOLDER (SETQ OLDSEL# SEL#)))))))
)
(LA.READ.NEW.MARK
(LAMBDA (MAILFOLDER MSG#) (* bvm%: " 6-May-86 17:06") (PROG ((MSG (NTHMESSAGE (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER) MSG#)) (WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER)) YPOS MARK) (RESETSAVE NIL (LIST (FUNCTION CLEARW) (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER))) (RESETSAVE NIL (LIST (FUNCTION LA.SHOW.MARK) MSG MAILFOLDER)) (* ; "Display correct mark on exit no matter what happens") (RESETSAVE (TTYDISPLAYSTREAM WINDOW)) (* ; "So caret flashes in the right place") (RESETSAVE NIL (LIST (QUOTE WINDOWPROP) WINDOW (QUOTE PROCESS) NIL)) (* ;; "PROCESS prop put there by TTYDISPLAYSTREAM -- don't want it to linger, else MOUSE proc will get tty in future when we bug browser") (LA.BLT.MARK.BOX MAILFOLDER WINDOW (SETQ YPOS (MESSAGE#.TO.YPOS MSG MAILFOLDER)) (QUOTE REPLACE) WHITESHADE) (* ; "Erase whatever's there") (LAB.PROMPTPRINT MAILFOLDER T "Type single character mark, or ESC to abort") (MOVETO BROWSERMARKXPOSITION YPOS WINDOW) (COND ((AND (>= (SETQ MARK (\GETKEY)) (CHARCODE SPACE)) (<= MARK (CHARCODE DEL))) (replace (LAFITEMSG MARKSCHANGED?) of MSG with T) (replace (LAFITEMSG SEEN?) of MSG with (NOT (UNSEENMARKP MARK))) (replace (LAFITEMSG MARKCHAR) of MSG with MARK) (replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER with T)))))
)
(YPOS.TO.MESSAGE#
(LAMBDA (YPOS MAILFOLDER) (* bvm%: "24-Dec-83 17:45") (PROG ((N (IQUOTIENT (IPLUS (IDIFFERENCE (fetch (MAILFOLDER BROWSERORIGIN) of MAILFOLDER) YPOS) (fetch (MAILFOLDER BROWSERFONTASCENT) of MAILFOLDER)) (fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER)))) (RETURN (COND ((ILEQ N 0) 1) (T (IMIN N (fetch (MAILFOLDER %#OFMESSAGES) of MAILFOLDER)))))))
)
(MESSAGE#.TO.YPOS
(LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* bvm%: "24-Dec-83 16:37") (IDIFFERENCE (fetch (MAILFOLDER BROWSERORIGIN) of MAILFOLDER) (ITIMES (fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER) (fetch (LAFITEMSG %#) of MSGDESCRIPTOR))))
)
)
(DEFINEQ
(LA.CONSIDERRANGE
(LAMBDA (FIRST# LAST# EVENIFDELETED) (* ; "Edited 7-Jun-88 17:34 by bvm") (* ;;; "Change display so that messages from FIRST# to LAST# are marked as selected. Deleted messages are not selected unless EVENIFDELETED is true") (for I from (IMAX FIRST# *FIRST-VISIBLE*) to (IMIN LAST# *LAST-VISIBLE*) bind MSG do (SETQ MSG (NTHMESSAGE *MESSAGES* I)) (COND ((OR EVENIFDELETED (NOT (fetch DELETED? of MSG))) (LA.SHOW.SELECTION *MAILFOLDER* MSG (QUOTE REPLACE))))))
)
(LA.DECONSIDERRANGE
(LAMBDA (FIRST# LAST#) (* ; "Edited 7-Jun-88 17:35 by bvm") (* ;;; "Change display so that messages from FIRST# to LAST# are marked as unselected.") (for I from (IMAX FIRST# *FIRST-VISIBLE*) to (IMIN LAST# *LAST-VISIBLE*) do (LA.SHOW.SELECTION *MAILFOLDER* (NTHMESSAGE *MESSAGES* I) (QUOTE ERASE))))
)
(LA.RECONSIDERRANGE
(LAMBDA (FIRST# LAST#) (* ; "Edited 7-Jun-88 17:35 by bvm") (* ;;; "Change display so that messages from FIRST# to LAST# are marked as selected or unselected according to the truth of the matter.") (for I from (IMAX FIRST# *FIRST-VISIBLE*) to (IMIN LAST# *LAST-VISIBLE*) bind MSG do (LA.SHOW.SELECTION *MAILFOLDER* (SETQ MSG (NTHMESSAGE *MESSAGES* I)) (COND ((fetch SELECTED? of MSG) (QUOTE REPLACE)) (T (QUOTE ERASE))))))
)
(LA.SELECTRANGE
(LAMBDA (MAILFOLDER FIRST# LAST# EVENIFDELETED) (* bvm%: "15-Feb-84 15:39") (* ;;; "Mark internally messages FIRST# thru LAST# as selected. Do not select deleted messages unless EVENIFDELETED is true. Keeps MAILFOLDER:LASTSELECTEDMESSAGE and MAILFOLDER:FIRSTSELECTEDMESSAGE up to date. Assumes display has already been appropriately modified") (PROG ((MESSAGES (fetch MESSAGEDESCRIPTORS of MAILFOLDER)) (FIRSTSEL (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER)) (LASTSEL (fetch LASTSELECTEDMESSAGE of MAILFOLDER)) MSG) (for I from FIRST# to LAST# do (SETQ MSG (NTHMESSAGE MESSAGES I)) (COND ((OR EVENIFDELETED (NOT (fetch DELETED? of MSG))) (replace SELECTED? of MSG with T)))) (COND ((OR (> FIRSTSEL LASTSEL) (< FIRST# (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER))) (replace FIRSTSELECTEDMESSAGE of MAILFOLDER with FIRST#))) (COND ((OR (> FIRSTSEL LASTSEL) (> LAST# (fetch LASTSELECTEDMESSAGE of MAILFOLDER))) (replace LASTSELECTEDMESSAGE of MAILFOLDER with LAST#)))))
)
(LA.DESELECTRANGE
(LAMBDA (MAILFOLDER FIRST# LAST#) (* bvm%: "28-Mar-84 14:52") (* ;;; "Mark internally messages FIRST# thru LAST# as unselected. Keeps MAILFOLDER:LASTSELECTEDMESSAGE and MAILFOLDER:FIRSTSELECTEDMESSAGE up to date. Assumes display has already been appropriately modified") (COND ((ILEQ FIRST# LAST#) (PROG ((MESSAGES (fetch MESSAGEDESCRIPTORS of MAILFOLDER))) (for I from FIRST# to LAST# do (replace SELECTED? of (NTHMESSAGE MESSAGES I) with NIL)) (COND ((EQ FIRST# (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER)) (replace FIRSTSELECTEDMESSAGE of MAILFOLDER with (COND ((LAB.FIND.SELECTED.MSG MAILFOLDER (ADD1 LAST#) (fetch LASTSELECTEDMESSAGE of MAILFOLDER))) (T (replace LASTSELECTEDMESSAGE of MAILFOLDER with 0) (* ; "Null selection indicated by first GT last.") (ADD1 (fetch (MAILFOLDER %#OFMESSAGES) of MAILFOLDER)))))) ((EQ LAST# (fetch LASTSELECTEDMESSAGE of MAILFOLDER)) (replace LASTSELECTEDMESSAGE of MAILFOLDER with (OR (LAB.REV.FIND.SELECTED.MSG MAILFOLDER (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER) (SUB1 FIRST#)) 1))))))))
)
(LAB.FIND.SELECTED.MSG
(LAMBDA (MAILFOLDER FIRST# LAST#) (* bvm%: "15-Feb-84 12:22") (find I from FIRST# to LAST# bind (MESSAGES ← (fetch MESSAGEDESCRIPTORS of MAILFOLDER)) suchthat (fetch SELECTED? of (NTHMESSAGE MESSAGES I))))
)
(LAB.REV.FIND.SELECTED.MSG
(LAMBDA (MAILFOLDER FIRST# LAST#) (* bvm%: " 2-Mar-84 18:02") (find I from LAST# to FIRST# by -1 bind (MESSAGES ← (fetch MESSAGEDESCRIPTORS of MAILFOLDER)) suchthat (fetch SELECTED? of (NTHMESSAGE MESSAGES I))))
)
(LA.UNDOSELECTION
(LAMBDA NIL (* ; "Edited 7-Jun-88 17:37 by bvm") (* ;;; "Restore browser to state before any selections were attempted") (LA.RECONSIDERRANGE *FIRST-VISIBLE* *LAST-VISIBLE*) (SETQ *TOC-STATE* TS.IDLE))
)
(LA.VERIFY.SELECTION
(LAMBDA (MAILFOLDER) (* bvm%: "15-Feb-84 11:53") (PROG ((FIRST# (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER)) (LAST# (fetch LASTSELECTEDMESSAGE of MAILFOLDER)) (MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER)) (%#OFMESSAGES (fetch (MAILFOLDER %#OFMESSAGES) of MAILFOLDER)) SEL) (COND ((IGREATERP FIRST# LAST#) (COND ((SETQ SEL (for I from 1 to %#OFMESSAGES collect I when (fetch SELECTED? of (NTHMESSAGE MESSAGES I)))) (HELP "First > Last, but these msgs selected" SEL)))) (T (for I from 1 to %#OFMESSAGES do (COND ((fetch SELECTED? of (NTHMESSAGE MESSAGES I)) (COND ((< I FIRST#) (HELP "First is too high" FIRST#)) ((> I LAST#) (HELP "Last is too low" LAST#)))))) (COND ((AND (EQ FIRST# 1) (EQ LAST# 1)) (* ; "The only time it is okay for them not to be selected")) ((NOT (fetch SELECTED? of (NTHMESSAGE MESSAGES FIRST#))) (HELP "First not selected" FIRST#)) ((NOT (fetch SELECTED? of (NTHMESSAGE MESSAGES LAST#))) (HELP "Last not selected" LAST#)))))))
)
)
(DEFINEQ
(LAB.COPYBUTTONEVENTFN
(LAMBDA (WINDOW) (* ; "Edited 11-Dec-87 17:17 by bvm:") (* ;;; "copy select an item from the window.") (PROG ((FOLDER (WINDOWPROP WINDOW (QUOTE MAILFOLDER))) SELECTIONREGION CURRENTITEM CURRENTMSG CURRENTFIELD NEWITEM NEWFIELD LASTX LASTY DATEX FROMX SUBJECTX MSGS) (COND ((EQ (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER) 0) (* ; "Nothing to select") (RETURN (TOTOPW WINDOW)))) (SETQ SELECTIONREGION (DSPCLIPPINGREGION NIL WINDOW)) (SETQ DATEX (fetch (MAILFOLDER DATEXPOS) of FOLDER)) (SETQ FROMX (fetch (MAILFOLDER FROMXPOS) of FOLDER)) (SETQ SUBJECTX (fetch (MAILFOLDER SUBJECTXPOS) of FOLDER)) (SETQ MSGS (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER)) LP (TOTOPW WINDOW) (SETQ NEWITEM (AND (INSIDEP SELECTIONREGION (SETQ LASTX (LASTMOUSEX WINDOW)) (SETQ LASTY (LASTMOUSEY WINDOW))) (YPOS.TO.MESSAGE# LASTY FOLDER))) (SETQ NEWFIELD (if (< LASTX DATEX) then T elseif (< LASTX FROMX) then (QUOTE DATE) elseif (< LASTX SUBJECTX) then (QUOTE FROM) else (QUOTE SUBJECT))) (* ; "Figure out which field of the message is being pointed at by the xpos.") (COND ((OR (NEQ CURRENTITEM NEWITEM) (NEQ CURRENTFIELD NEWFIELD)) (* ; "Something changed") (COND (CURRENTITEM (* ; "turn off old selection.") (LAB.SHOW.COPY.SELECTION WINDOW FOLDER CURRENTMSG CURRENTFIELD))) (COND ((SETQ CURRENTITEM NEWITEM) (* ; "turn on new selection") (LAB.SHOW.COPY.SELECTION WINDOW FOLDER (SETQ CURRENTMSG (NTHMESSAGE MSGS CURRENTITEM)) (SETQ CURRENTFIELD NEWFIELD)))))) LP2 (* ;; "wait for a button up or move out of region") (BLOCK) (COND ((NOT (.COPYKEYDOWNP.)) (* ; "Finished, copy selected item") (COND (CURRENTITEM (* ; "If something is selected, bksysbuf the selected field") (LAB.SHOW.COPY.SELECTION WINDOW FOLDER CURRENTMSG CURRENTFIELD) (BKSYSBUF (OR (SELECTQ CURRENTFIELD (T (* ; "Do whole line") (CONCAT "#" (fetch (LAFITEMSG %#) of CURRENTMSG) " " (fetch (LAFITEMSG DATE) of CURRENTMSG) " " (COND ((fetch (LAFITEMSG MSGFROMMEP) of CURRENTMSG) (CONCAT "To: " (fetch (LAFITEMSG TO) of CURRENTMSG))) (T (CONCAT "From: " (OR (fetch (LAFITEMSG FROM) of CURRENTMSG) UNSUPPLIEDFIELDSTR)))) " -- " (OR (fetch (LAFITEMSG SUBJECT) of CURRENTMSG) UNSUPPLIEDFIELDSTR))) (DATE (fetch (LAFITEMSG DATE) of CURRENTMSG)) (FROM (COND ((fetch (LAFITEMSG MSGFROMMEP) of CURRENTMSG) (CONCAT "To: " (fetch (LAFITEMSG TO) of CURRENTMSG))) (T (fetch (LAFITEMSG FROM) of CURRENTMSG)))) (fetch (LAFITEMSG SUBJECT) of CURRENTMSG)) UNSUPPLIEDFIELDSTR)))) (RETURN)) ((MOUSESTATE UP) (* ; "button up, but shift still down, no action") (GO LP2)) (T (GO LP)))))
)
(LAB.SHOW.COPY.SELECTION
(LAMBDA (WINDOW FOLDER MSG FIELD) (* ; "Edited 11-Dec-87 17:16 by bvm:") (* ;;; "underline FIELD of MSG in FOLDER's window") (LET ((BOTTOM (- (MESSAGE#.TO.YPOS MSG FOLDER) (fetch (MAILFOLDER BROWSERFONTDESCENT) of FOLDER))) LEFT STR) (SELECTQ FIELD (T (* ; "Whole line")) (DATE (SETQ LEFT (fetch (MAILFOLDER DATEXPOS) of FOLDER)) (SETQ STR (fetch (LAFITEMSG DATE) of MSG))) (FROM (SETQ LEFT (fetch (MAILFOLDER FROMXPOS) of FOLDER)) (SETQ STR (COND ((fetch (LAFITEMSG MSGFROMMEP) of MSG) (CONCAT "To: " (fetch (LAFITEMSG TO) of MSG))) (T (fetch (LAFITEMSG FROM) of MSG))))) (PROGN (SETQ LEFT (fetch (MAILFOLDER SUBJECTXPOS) of FOLDER)) (SETQ STR (fetch (LAFITEMSG SUBJECT) of MSG)))) (BLTSHADE GRAYSHADE WINDOW LEFT BOTTOM (if (EQ FIELD T) then (* ; "whole line") NIL else (* ; "width of just this field") (STRINGWIDTH (OR STR UNSUPPLIEDFIELDSTR) WINDOW)) 2 (QUOTE INVERT))))
)
)
(DECLARE%: EVAL@COMPILE DONTCOPY
(CL:PROCLAIM (QUOTE (CL:SPECIAL *MAILFOLDER* *MESSAGES* *FIRST-VISIBLE* *LAST-VISIBLE* *TOC-STATE*)))
(CL:PROCLAIM (QUOTE (GLOBAL LASTMOUSEBUTTONS)))
)
(* ; "Browser display")
(DEFINEQ
(LAB.PROMPTPRINT
(CL:LAMBDA (FOLDER &REST ARGS) (* ; "Edited 14-Oct-87 15:36 by bvm:") (LAB.PRINT.TO.PROMPTWINDOW FOLDER ARGS))
)
(LAB.FORMAT
(CL:LAMBDA (FOLDER &REST ARGS) (* ; "Edited 14-Oct-87 15:53 by bvm:") (* ;; "Outputs to FOLDER's prompt window using FORMAT. If first format arg is T, then we clear the window first, and consider then next format arg to be the format string. All this is done in a way that lets the window expand if it needs to.") (LAB.PRINT.TO.PROMPTWINDOW FOLDER ARGS T))
)
(LAB.MOUSECONFIRM
(CL:LAMBDA (FOLDER &REST ARGS) (* ; "Edited 11-Dec-87 17:33 by bvm:") (* ;; "Version of MOUSECONFIRM using FOLDER's prompt window. ARGS are args to FORMAT.") (LAB.PRINT.TO.PROMPTWINDOW FOLDER ARGS T) (PROG1 (MOUSECONFIRM T T) (if FOLDER then (\LAFITE.MAYBE.CLEAR.PROMPT FOLDER) else (CLEARW PROMPTWINDOW))))
)
(LAB.PRINT.TO.PROMPTWINDOW
(LAMBDA (FOLDER ARGS FORMAT-P) (* ; "Edited 14-Oct-87 19:01 by bvm:") (* ;; "Outputs to FOLDER's prompt window the text in ARGS. If FORMAT-P is NIL, ARGS is a list of items to print, with T meaning clear the window. If FORMAT-P is true, ARGS is considered a format string and format args, except that ARGS may be prefixed with T to indicate clearing the window. All this is done in a way that lets the window expand if it needs to. If FOLDER is NIL, or its browser is not open, prints to global PROMPTWINDOW. Returns NIL.") (LET ((*PRINT-CASE* :UPCASE) (*PRINT-BASE* 10) (WINDOW (AND FOLDER (OPENWP (ffetch (MAILFOLDER BROWSERPROMPTWINDOW) of (\DTEST FOLDER (QUOTE MAILFOLDER)))))) \CURRENTDISPLAYLINE OLDTTY) (* ;; "*PRINT-CASE* is bound so symbols get printed in %"expected%" case. *PRINT-BASE* is 10 for benefit of printing numbers in the non-format case. \currentdisplayline changes with TTYDISPLAYSTREAM") (CL:UNWIND-PROTECT (LET ((ACTUALWINDOW (OR WINDOW PROMPTWINDOW))) (if WINDOW then (SETQ OLDTTY (TTYDISPLAYSTREAM WINDOW)) (SETQ \CURRENTDISPLAYLINE (fetch (MAILFOLDER CURRENTPROMPTLINE) of FOLDER)) (* ; "Do this second because TTYDISPLAYSTREAM smashes it.")) (if FORMAT-P then (if (EQ (CAR ARGS) T) then (* ; "First arg of T means clear window first.") (CLEARW ACTUALWINDOW) (SETQ ARGS (CDR ARGS))) (CL:APPLY (FUNCTION CL:FORMAT) ACTUALWINDOW ARGS) else (for ARG in ARGS do (COND ((EQ ARG T) (CLEARW ACTUALWINDOW)) (T (PRIN3 ARG ACTUALWINDOW)))))) (if WINDOW then (* ;; "Now clean up the mess. Note position for next time.") (replace (MAILFOLDER CURRENTPROMPTLINE) of FOLDER with \CURRENTDISPLAYLINE) (TTYDISPLAYSTREAM OLDTTY) (WINDOWPROP WINDOW (QUOTE PROCESS) NIL) (* ; "Get rid of process handle") (replace (MAILFOLDER BROWSERPROMPTDIRTY) of FOLDER with T))) NIL))
)
(LAB.PAGEFULLFN
(LAMBDA (PW) (* ; "Edited 14-Oct-87 16:54 by bvm:") (* ;; "PAGEFULLFN for prompt window--makes the window a line bigger and allows output to proceed") (SETQ \CURRENTDISPLAYLINE (PROG1 \#DISPLAYLINES (* ; "\Currentdisplayline is the line we're on when window fills, origin zero") (LET ((MAIN (MAINWINDOW PW)) FOLDER) (GETPROMPTWINDOW MAIN (+ 1 \#DISPLAYLINES)) (if (SETQ FOLDER (WINDOWPROP MAIN (QUOTE MAILFOLDER))) then (* ; "Note that we expanded window so that we can shrink it back later") (replace (MAILFOLDER BROWSERPROMPTGREW) of FOLDER with T))))))
)
(\LAFITE.MAYBE.CLEAR.PROMPT
(LAMBDA (FOLDER) (* ; "Edited 14-Oct-87 15:35 by bvm:") (* ;; "Clear's FOLDER's prompt window, and shrinks it back to a single line if it has grown") (LET (PW) (COND ((AND (fetch (MAILFOLDER BROWSERPROMPTDIRTY) of FOLDER) (OPENWP (SETQ PW (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of FOLDER)))) (CLEARW PW) (if (fetch (MAILFOLDER BROWSERPROMPTGREW) of FOLDER) then (* ; "Window grew") (LET (PROP HEIGHT) (SETQ HEIGHT (HEIGHTIFWINDOW (FONTPROP LAFITEBROWSERFONT (QUOTE HEIGHT)))) (WINDOWPROP PW (QUOTE MINSIZE) (CONS 0 HEIGHT)) (* ; "have to adjust the fixed size of the window before shaping, since SHAPEW obeys the minimum.") (WINDOWPROP PW (QUOTE MAXSIZE) (CONS 64000 HEIGHT)) (SHAPEW PW (create REGION using (WINDOWPROP PW (QUOTE REGION)) HEIGHT ← HEIGHT)) (CLEARW PW) (* ; "Clear it again to get coordinates right.") (if (SETQ PROP (WINDOWPROP (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER) (QUOTE PROMPTWINDOW))) then (* ; "Main window thinks it knows how tall the prompt window is.") (RPLACD PROP 1)) (replace (MAILFOLDER BROWSERPROMPTGREW) of FOLDER with NIL) (replace (MAILFOLDER CURRENTPROMPTLINE) of FOLDER with 0))) (replace (MAILFOLDER BROWSERPROMPTDIRTY) of FOLDER with NIL)))))
)
)
(DEFINEQ
(PRINTMESSAGESUMMARY
(LAMBDA (MSGDESCRIPTOR MAILFOLDER WINDOW) (* bvm%: " 2-Feb-84 12:08") (PROG (FROMSTR HERE THERE EXTENT MSG#) (OR (fetch (LAFITEMSG PARSED?) of MSGDESCRIPTOR) (LAFITE.PARSE.MSG.FOR.TOC MSGDESCRIPTOR MAILFOLDER)) (MOVETO 0 (MESSAGE#.TO.YPOS MSGDESCRIPTOR MAILFOLDER) WINDOW) (POSITION WINDOW 0) (LA.SHOW.MARK MSGDESCRIPTOR MAILFOLDER) (DSPXPOSITION (+ (fetch (MAILFOLDER ORDINALXPOS) of MAILFOLDER) (TIMES (fetch (MAILFOLDER BROWSERDIGITWIDTH) of MAILFOLDER) (COND ((< (SETQ MSG# (fetch (LAFITEMSG %#) of MSGDESCRIPTOR)) 10) 3) ((< MSG# 100) 2) ((< MSG# 1000) 1) (T 0)))) WINDOW) (* ; "Ugh. Manually right-justify message # given that font may be variable width") (PRINTNUM (QUOTE (FIX 1)) MSG# WINDOW) (DSPXPOSITION (fetch (MAILFOLDER DATEXPOS) of MAILFOLDER) WINDOW) (PRIN1 (OR (fetch (LAFITEMSG DATE) of MSGDESCRIPTOR) UNSUPPLIEDFIELDSTR) WINDOW) (DSPXPOSITION (fetch (MAILFOLDER FROMXPOS) of MAILFOLDER) WINDOW) (COND ((fetch (LAFITEMSG MSGFROMMEP) of MSGDESCRIPTOR) (PRIN1 "To: " WINDOW) (SETQ FROMSTR (OR (fetch (LAFITEMSG TO) of MSGDESCRIPTOR) (LAFITE.FETCH.TO.FIELD MSGDESCRIPTOR MAILFOLDER)))) (T (SETQ FROMSTR (OR (fetch (LAFITEMSG FROM) of MSGDESCRIPTOR) UNSUPPLIEDFIELDSTR)))) (PRIN1 FROMSTR WINDOW) (COND ((> (SETQ HERE (DSPXPOSITION NIL WINDOW)) (SETQ THERE (fetch (MAILFOLDER FROMMAXXPOS) of MAILFOLDER))) (* ; "Erase the overflow") (DSPBACKUP (- HERE THERE) WINDOW))) (DSPXPOSITION (fetch (MAILFOLDER SUBJECTXPOS) of MAILFOLDER) WINDOW) (PRIN1 (OR (fetch (LAFITEMSG SUBJECT) of MSGDESCRIPTOR) UNSUPPLIEDFIELDSTR) WINDOW) (printout WINDOW " [" |.I1| (fetch (LAFITEMSG MESSAGELENGTH) of MSGDESCRIPTOR) " chars]") (* ;; "keep track of maximum width printed to. If header is allowed to print on two lines, $$MAXWIDTH$$ was set to right margin by BUILDBROWSERMAP so this should not reset it.") (COND ((< (fetch (MAILFOLDER BROWSERMAXXPOS) of MAILFOLDER) (SETQ HERE (DSPXPOSITION NIL WINDOW))) (replace (MAILFOLDER BROWSERMAXXPOS) of MAILFOLDER with HERE) (replace (REGION WIDTH) of (SETQ EXTENT (fetch (MAILFOLDER BROWSEREXTENT) of MAILFOLDER)) with HERE) (WINDOWPROP WINDOW (QUOTE EXTENT) EXTENT))) (COND ((fetch (LAFITEMSG SELECTED?) of MSGDESCRIPTOR) (LA.SHOW.SELECTION MAILFOLDER MSGDESCRIPTOR (QUOTE REPLACE)))) (COND ((fetch (LAFITEMSG DELETED?) of MSGDESCRIPTOR) (LA.SHOW.DELETION MAILFOLDER MSGDESCRIPTOR WINDOW (QUOTE REPLACE))))))
)
(FIRSTVISIBLEMESSAGE
(LAMBDA (MAILFOLDER REGION) (* bvm%: "25-Feb-86 12:22") (* ;; "Computes number of the first message in MAILFOLDER that is visible in REGION") (IMAX 1 (IQUOTIENT (- (fetch (MAILFOLDER BROWSERORIGIN) of MAILFOLDER) (+ (fetch (REGION TOP) of (OR REGION (DSPCLIPPINGREGION NIL (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER)))) (fetch (MAILFOLDER BROWSERFONTDESCENT) of MAILFOLDER))) (fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER))))
)
(LASTVISIBLEMESSAGE
(LAMBDA (MAILFOLDER REGION) (* bvm%: "25-Feb-86 11:33") (* ;; "Computes number of the last message in MAILFOLDER that is visible in REGION") (IMIN (fetch (MAILFOLDER %#OFMESSAGES) of MAILFOLDER) (IQUOTIENT (+ (- (fetch (MAILFOLDER BROWSERORIGIN) of MAILFOLDER) (- (fetch (REGION BOTTOM) of (OR REGION (DSPCLIPPINGREGION NIL (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER)))) (fetch (MAILFOLDER BROWSERFONTASCENT) of MAILFOLDER))) (SUB1 (fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER))) (fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER))))
)
(LAB.DISPLAYLINES
(LAMBDA (MAILFOLDER FIRST# LAST#) (* bvm%: "22-Dec-83 12:23") (for MSG# from FIRST# to LAST# bind (WINDOW ← (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER)) (MESSAGES ← (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER)) do (PRINTMESSAGESUMMARY (NTHMESSAGE MESSAGES MSG#) MAILFOLDER WINDOW)))
)
(LAB.EXPOSEMESSAGE
(LAMBDA (MAILFOLDER MSGDESCRIPTOR) (* bvm%: "24-Dec-83 19:00") (PROG ((WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER)) (YPOS (MESSAGE#.TO.YPOS MSGDESCRIPTOR MAILFOLDER)) CLIPREGION) (COND ((OR (IGREATERP (fetch (REGION BOTTOM) of (SETQ CLIPREGION (DSPCLIPPINGREGION NIL WINDOW))) YPOS) (ILESSP (fetch (REGION TOP) of CLIPREGION) YPOS)) (SCROLLBYREPAINTFN WINDOW 0 (IPLUS (fetch (REGION BOTTOM) of CLIPREGION) (IQUOTIENT (fetch (REGION HEIGHT) of CLIPREGION) 2) (IMINUS YPOS)))))))
)
(LAB.SELECTED.MESSAGES
(LAMBDA (FOLDER) (* ; "Edited 14-Oct-87 16:15 by bvm:") (* ;; "Return a list of message descriptors currently selected") (for MSG selectedin FOLDER collect MSG))
)
(UNSELECTALLMESSAGES
(LAMBDA (MAILFOLDER) (* bvm%: "15-Feb-84 16:21") (for N from (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER) to (fetch LASTSELECTEDMESSAGE of MAILFOLDER) bind (MESSAGES ← (fetch MESSAGEDESCRIPTORS of MAILFOLDER)) do (LA.DESELECTRANGE MAILFOLDER N N) (LA.SHOW.SELECTION MAILFOLDER (NTHMESSAGE MESSAGES N) (QUOTE ERASE))))
)
(SELECTMESSAGE
(LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* bvm%: "15-Feb-84 12:34") (PROG ((N (fetch (LAFITEMSG %#) of MSGDESCRIPTOR))) (LA.SELECTRANGE MAILFOLDER N N T) (LA.SHOW.SELECTION MAILFOLDER MSGDESCRIPTOR (QUOTE REPLACE))))
)
(LAB.GO.TO.MESSAGE
(LAMBDA (FOLDER N) (* ; "Edited 23-Aug-88 18:14 by bvm") (* ;; "Jump to nth message in folder. N must be in range, or be a msg object in the folder. Returns the message object") (LET ((MSG (if (type? LAFITEMSG N) then N else (\DTEST (NTHMESSAGE (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER) N) (QUOTE LAFITEMSG))))) (UNSELECTALLMESSAGES FOLDER) (LAB.EXPOSEMESSAGE FOLDER MSG) (LA.SHOW.SELECTION FOLDER MSG (QUOTE REPLACE)) (replace (LAFITEMSG SELECTED?) of MSG with T) (replace FIRSTSELECTEDMESSAGE of FOLDER with (replace LASTSELECTEDMESSAGE of FOLDER with (fetch (LAFITEMSG %#) of MSG))) MSG))
)
(MARKMESSAGE
(LAMBDA (MSGDESCRIPTOR MAILFOLDER MARK) (* ; "Edited 15-Sep-87 15:21 by bvm:") (* ;;; "Changes the mark byte of MSGDESCRIPTOR to be MARK. This may also imply something about SEEN?") (replace (LAFITEMSG MARKCHAR) of MSGDESCRIPTOR with MARK) (replace (LAFITEMSG SEEN?) of MSGDESCRIPTOR with (NOT (UNSEENMARKP MARK))) (replace (LAFITEMSG MARKSCHANGED?) of MSGDESCRIPTOR with T) (replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER with T) (COND ((OPENWP (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER)) (LA.SHOW.MARK MSGDESCRIPTOR MAILFOLDER)) (T (* ; "Wait until browser expanded before showing mark update") (PROG ((N (fetch (LAFITEMSG %#) of MSGDESCRIPTOR)) (OLDU (fetch (MAILFOLDER BROWSERUPDATEFROMHERE) of MAILFOLDER))) (COND ((OR (NULL OLDU) (> OLDU N)) (replace (MAILFOLDER BROWSERUPDATEFROMHERE) of MAILFOLDER with N)))))))
)
(LA.SHOW.MARK
(LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* bvm%: "17-Feb-84 15:34") (PROG ((WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER)) (YPOS (MESSAGE#.TO.YPOS MSGDESCRIPTOR MAILFOLDER)) (MARK (fetch (LAFITEMSG MARKCHAR) of MSGDESCRIPTOR))) (LA.BLT.MARK.BOX MAILFOLDER WINDOW YPOS (QUOTE REPLACE) WHITESHADE) (* ; "Erase whatever's there") (COND ((NEQ MARK (CHARCODE SPACE)) (MOVETO BROWSERMARKXPOSITION YPOS WINDOW) (BOUT WINDOW MARK)))))
)
(LA.INVERT.MARK.BOX
(LAMBDA (MAILFOLDER MSG#) (* bvm%: "17-Feb-84 14:44") (LA.BLT.MARK.BOX MAILFOLDER (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER) (MESSAGE#.TO.YPOS (NTHMESSAGE (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER) MSG#) MAILFOLDER) (QUOTE INVERT) BLACKSHADE))
)
(LA.BLT.MARK.BOX
(LAMBDA (MAILFOLDER WINDOW YPOS OPERATION TEXTURE) (* ; "Edited 3-Sep-87 18:02 by bvm:") (BLTSHADE TEXTURE WINDOW BROWSERMARKXPOSITION (- YPOS (fetch (MAILFOLDER BROWSERFONTDESCENT) of MAILFOLDER)) (- (fetch (MAILFOLDER ORDINALXPOS) of MAILFOLDER) BROWSERMARKXPOSITION) (fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER) OPERATION))
)
(LA.SHOW.DELETION
(LAMBDA (MAILFOLDER MSGDESCRIPTOR WINDOW OPERATION) (* ; "Edited 3-Sep-87 16:23 by bvm:") (* ;;; "Draws or erases, for OPERATION = REPLACE or ERASE, the line indicating that MSGDESCRIPTOR is deleted") (BLTSHADE BLACKSHADE WINDOW BROWSERMARKXPOSITION (- (+ (MESSAGE#.TO.YPOS MSGDESCRIPTOR MAILFOLDER) (LRSH (fetch (MAILFOLDER BROWSERFONTASCENT) of MAILFOLDER) 1)) (LRSH LAFITEDELETEDLINEHEIGHT 1)) NIL LAFITEDELETEDLINEHEIGHT OPERATION))
)
(LA.SHOW.SELECTION
(LAMBDA (MAILFOLDER MSGDESCRIPTOR OPERATION) (* bvm%: " 2-Feb-84 12:37") (* ;;; "Displays or erases, per OPERATION = REPLACE or ERASE, the mark indicating that MSGDESCRIPTOR is selected") (BITBLT LA.SELECTION.BITMAP 0 0 (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER) 0 (+ (MESSAGE#.TO.YPOS MSGDESCRIPTOR MAILFOLDER) (LRSH (fetch (MAILFOLDER BROWSERFONTASCENT) of MAILFOLDER) 1) -5) NIL NIL (QUOTE INPUT) OPERATION))
)
(SEENMESSAGE
(LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* ; "Edited 15-Sep-87 15:21 by bvm:") (* ;;; "causes the 'seen character' -- as opposed to the 'seen mark' -- to be changed to 'S' on the file") (LET ((OLDMARK (fetch (LAFITEMSG MARKCHAR) of MSGDESCRIPTOR))) (COND ((OR (NULL (fetch (LAFITEMSG SEEN?) of MSGDESCRIPTOR)) (UNSEENMARKP OLDMARK)) (replace (LAFITEMSG SEEN?) of MSGDESCRIPTOR with T) (replace (LAFITEMSG MARKSCHANGED?) of MSGDESCRIPTOR with T) (replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER with T) (* ;; "only change the mark if it was ? -- it might already be something more meaningful like an answer mark") (COND ((UNSEENMARKP OLDMARK) (MARKMESSAGE MSGDESCRIPTOR MAILFOLDER SEENMARK)))))))
)
(DELETEMESSAGE
(LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* ; "Edited 15-Sep-87 15:21 by bvm:") (replace (LAFITEMSG DELETED?) of MSGDESCRIPTOR with T) (replace (LAFITEMSG MARKSCHANGED?) of MSGDESCRIPTOR with T) (replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER with T) (replace (MAILFOLDER FOLDERNEEDSEXPUNGE) of MAILFOLDER with T) (LA.SHOW.DELETION MAILFOLDER MSGDESCRIPTOR (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER) (QUOTE REPLACE)))
)
(UNDELETEMESSAGE
(LAMBDA (MSGDESCRIPTOR FOLDER) (* ; "Edited 7-Jun-88 18:40 by bvm") (if (fetch (LAFITEMSG DELETED?) of MSGDESCRIPTOR) then (LET ((WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER))) (replace (LAFITEMSG DELETED?) of MSGDESCRIPTOR with NIL) (replace (LAFITEMSG MARKSCHANGED?) of MSGDESCRIPTOR with T) (replace (MAILFOLDER FOLDERNEEDSUPDATE) of FOLDER with T) (LA.SHOW.DELETION FOLDER MSGDESCRIPTOR WINDOW (QUOTE ERASE)) (* ; "undeleted; reprint the header.") (PRINTMESSAGESUMMARY MSGDESCRIPTOR FOLDER WINDOW) (* ; "Finally, maybe clear the expungeable flag if this was the last deleted message") (LAB.SET.EXPUNGEABILITY FOLDER))))
)
(LAB.SET.EXPUNGEABILITY
(LAMBDA (FOLDER) (* ; "Edited 7-Jun-88 15:42 by bvm") (* ;; "Sets the FOLDERNEEDSEXPUNGE flag according to whether any messages are marked deleted") (* ; "Edited 7-Jun-88 15:41 by bvm") (replace (MAILFOLDER FOLDERNEEDSEXPUNGE) of FOLDER with (for I from 1 to (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER) bind (MESSAGES ← (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER)) thereis (fetch (LAFITEMSG DELETED?) of (NTHMESSAGE MESSAGES I)))))
)
)
(* ; "ICON stuff")
(FILESLOAD ICONW)
(DEFINEQ
(LAB.ICONFN
(LAMBDA (WINDOW OLDICON) (* ; "Edited 3-Jun-88 12:15 by bvm") (* ;;; "the holding place for all the fancy stuff for making an icon for a mail broswer window") (OR (WINDOWP (WINDOWPROP WINDOW (QUOTE ICONWINDOW))) (LET ((BROWSERREGION (WINDOWPROP WINDOW (QUOTE REGION))) (MAILFOLDER (WINDOWPROP WINDOW (QUOTE MAILFOLDER))) ICON) (SETQ ICON (TITLEDICONW LAFITE.FOLDER.ICON (COND (MAILFOLDER (LA.SHORTFILENAME (fetch (MAILFOLDER FULLFOLDERNAME) of MAILFOLDER) LAFITEMAIL.EXT)) (T "??")) NIL (OR (WINDOWPROP WINDOW (QUOTE ICONPOSITION)) (SELECTQ LAFITE.BROWSER.ICON.PREFERENCE ((:ASK ASK) (* ; "force prompt") NIL) (NIL (create POSITION XCOORD ← (fetch (REGION LEFT) of BROWSERREGION) YCOORD ← (fetch (REGION BOTTOM) of BROWSERREGION))) (CL:FUNCALL LAFITE.BROWSER.ICON.PREFERENCE WINDOW))) T NIL (QUOTE FILE))) (WINDOWPROP ICON (QUOTE BUTTONEVENTFN) (FUNCTION LAB.ICON.BUTTONEVENTFN)) ICON)))
)
(LAB.ICON.BUTTONEVENTFN
(LAMBDA (ICONW) (* ; "Edited 23-Aug-88 18:30 by bvm") (* ;; "BUTTONEVENTFN for browser windows. This one is like the default, except that middle button offers choices") (COND ((LASTMOUSESTATE MIDDLE) (LET (HOW) (if (AND (fetch (MAILFOLDER FOLDERGETSMAIL) of (WINDOWPROP (WINDOWPROP ICONW (QUOTE ICONFOR)) (QUOTE MAILFOLDER))) (SETQ HOW (MENU (OR LAFITEBROWSERICONMENU (SETQ LAFITEBROWSERICONMENU (\LAFITE.CREATE.MENU LAFITEBROWSERICONMENUITEMS NIL T)))))) then (* ; "Folder accepts new mail, and offer was accepted") (CL:FUNCALL HOW ICONW) else (* ; "No menu selection, just expand as you otherwise would") (EXPANDW ICONW)))) (T (MOVEW ICONW))))
)
)
(RPAQQ LAFITE.FOLDER.ICON (#*(100 72)@OOOOOOOO@@@@@@@@@@@@@@@@@@@AOOOOOOOOH@@@@@@@@@@@@@@@@@@C@@@@@@@@L@@@@@@@@@@@@@@@@@@F@@@@@@@@F@@@@@@@@@@@@@@@@@@L@DA@@@@@C@@@@@@@@@@@@@@@@@@L@FC@@@@@C@@@@@@@@@@@@@@@@@@L@EE@HGB@C@@@@@@@@@@@@@@@@@@L@EEADBB@C@@@@@@@@@@@@@@@@@@L@DIBBBB@COOOOOOOOOOOOOOL@@@L@DACNBB@COOOOOOOOOOOOOOL@@@L@DABBGCL@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@@@@@L@@@LOOOOOOOOOOOOOOOOOOOOOOOO@@@LOOOOOOOOOOOOOOOOOOOOOOOO@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@FL@@@@@@@@@@@@@@@@@@@@@@C@@@CL@@@@@@@@@@@@@@@@@@@@@@C@@@AOOOOOOOOOOOOOOOOOOOOOOOO@@@@OOOOOOOOOOOOOOOOOOOOOOOO@@@
#*(100 72)@OOOOOOOO@@@@@@@@@@@@@@@@@@@AOOOOOOOOH@@@@@@@@@@@@@@@@@@COOOOOOOOL@@@@@@@@@@@@@@@@@@GOOOOOOOON@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@GOOOOOOOOOOOOOOOOOOOOOOOO@@@COOOOOOOOOOOOOOOOOOOOOOOO@@@AOOOOOOOOOOOOOOOOOOOOOOOO@@@@OOOOOOOOOOOOOOOOOOOOOOOO@@@ (8 4 88 51)))
(RPAQ? LAFITEFROMFRACTION 0.3)
(RPAQ? LAFITEMINFROMCHARS 15)
(RPAQ? LAFITEVERIFYFLG T)
(RPAQ? LAFITEDELETEDLINEHEIGHT 1)
(RPAQ? LAFITE.BROWSER.ICON.PREFERENCE)
(RPAQQ LAFITEBROWSERMENUITEMS (("Display" (QUOTE \LAFITE.DISPLAY) "Displays the selected message in the display window.") ("Delete" (QUOTE \LAFITE.DELETE) "Deletes the selected messages.") ("Undel" (QUOTE \LAFITE.UNDELETE) "Undeletes the selected messages.") ("Answer" (QUOTE \LAFITE.ANSWER) "Prepares a delivery form to reply to the selected message.") ("Forward" (QUOTE \LAFITE.FORWARD) "Prepares a delivery form to forward the selected message(s).") (HCopy (QUOTE \LAFITE.HARDCOPY) "Sends hardcopy of the selected message(s) to the default printer") ("Move To" (QUOTE \LAFITE.MOVETO) "Moves the selected message(s) to another mail folder.") ("Update" (QUOTE \LAFITE.UPDATE) "Write out browser changes to the physical mail file.
Option to expunge all deleted messages.") ("Get Mail" (QUOTE \LAFITE.GETMAIL) "Retrieves new messages and puts them into this mail folder.")))
(RPAQQ LAFITESUBBROWSEMENUITEMS (("Browse" (QUOTE \LAFITE.BROWSE.PROC) "Browse a mail file") ("Browse & Forget" (QUOTE \LAFITE.BROWSE.FORGET) "Browse a mail file, but don't add it to the menu of known folders") ("Browse Laurel File" (QUOTE \LAFITE.BROWSE.LAURELFILE) "Massages Laurel File before browsing with Lafite") ("Forget Folders" (QUOTE \LAFITE.UNCACHE.FOLDER) "Remove one or more folders from list of known folders") ("Forget Message Form" (QUOTE \LAFITE.UNCACHE.MESSAGEFORM) "Remove a form from list of known message forms") ("Notice Folders" (QUOTE \LAFITE.NOTICE.FOLDERS) "Scan specified directory and add any folders found to the list of known folders") ("Clean up Folders" (QUOTE \LAFITE.GC.FOLDERS) "Check that all known folders correspond to actual files; remove those that no longer exist") ("Rename Folder" (QUOTE \LAFITE.RENAME.FOLDER) "Allows you to change the name of a folder")))
(RPAQQ LAFITEBROWSERICONMENUITEMS (("Get Mail" (QUOTE \LAFITE.GETMAIL.FROM.ICON) "Open this window and retrieve new mail into it")))
(RPAQ? LAFITESUBBROWSEMENU)
(RPAQ? LAFITEBROWSERICONMENU)
(RPAQ? LAFITEEXTRAMENU)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS LAFITESUBBROWSEMENU LAFITEBROWSERICONMENU LAFITEEXTRAMENU)
)
(ADDTOVAR LAFITEMENUVARS LAFITESUBBROWSEMENU LAFITEBROWSERICONMENU LAFITEEXTRAMENU)
(ADDTOVAR LAFITEEXTRAMENUITEMS ("Describe Folder" (QUOTE \LAFITE.DESCRIBE.FOLDER) "Display some relevant info about this folder"))
(RPAQQ BROWSERMARKXPOSITION 8)
(RPAQQ LA.SELECTION.BITMAP #*(8 10)L@@@N@@@O@@@OH@@OL@@OH@@O@@@N@@@L@@@@@@@)
(* ; "Obsolete")
(RPAQ? LAFITEBROWSERREGION (CREATEREGION 30 30 575 210))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(RPAQQ TOCSTATES ((TS.IDLE 0) (TS.REPLACING 1) (TS.ADDING 2) (TS.REMOVING 3) (TS.EXTENDING.HI 4) (TS.EXTENDING.LO 5) (TS.SHRINKING.HI 6) (TS.SHRINKING.LO 7)))
(DECLARE%: EVAL@COMPILE
(RPAQQ TS.IDLE 0)
(RPAQQ TS.REPLACING 1)
(RPAQQ TS.ADDING 2)
(RPAQQ TS.REMOVING 3)
(RPAQQ TS.EXTENDING.HI 4)
(RPAQQ TS.EXTENDING.LO 5)
(RPAQQ TS.SHRINKING.HI 6)
(RPAQQ TS.SHRINKING.LO 7)
(CONSTANTS (TS.IDLE 0) (TS.REPLACING 1) (TS.ADDING 2) (TS.REMOVING 3) (TS.EXTENDING.HI 4) (TS.EXTENDING.LO 5) (TS.SHRINKING.HI 6) (TS.SHRINKING.LO 7))
)
(CL:PROCLAIM (QUOTE (CL:SPECIAL \CURRENTDISPLAYLINE)))
(FILESLOAD (SOURCE) LAFITEDECLS)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA)
(ADDTOVAR NLAML)
(ADDTOVAR LAMA LAB.MOUSECONFIRM LAB.FORMAT LAB.PROMPTPRINT)
)
(PUTPROPS LAFITEBROWSE COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3478 18703 (\LAFITE.BROWSE 3488 . 4014) (\LAFITE.SUBBROWSE 4016 . 4255) (
\LAFITE.BROWSE.PROC 4257 . 4844) (\LAFITE.BROWSE.FORGET 4846 . 5247) (LAFITE.BROWSE.FOLDER 5249 . 6450
) (\LAFITE.PREPARE.BROWSER 6452 . 7613) (\LAFITE.MAYBE.OPEN.FOLDER 7615 . 9490) (LAB.LOADFOLDER 9492
. 9806) (LAB.DISPLAYFOLDER 9808 . 10894) (LAB.MAKE.INITIAL.SELECTION 10896 . 11631) (LAB.CREATEWINDOW
11633 . 16375) (LAB.TITLE.STRING 16377 . 17360) (LAB.COMMANDFN 17362 . 17771) (LAB.DO.COMMAND 17773
. 18432) (LAB.ASSURE.SELECTIONS 18434 . 18701)) (18704 23220 (BUILD.LAFITE.LAYOUTS 18714 . 21379) (
\LAFITE.LAYOUT.FROM.WINDOW 21381 . 22430) (\LAFITE.MAKE.DUMMY.WINDOWS 22432 . 23218)) (23575 36983 (
LAB.SETUP 23585 . 26198) (LAB.BUTTONEVENTFN 26200 . 26596) (LAB.DO.UNLESS.BUSY 26598 . 26941) (
LOADMAILFOLDER 26943 . 27839) (LAFITE.OBTAIN.FOLDER 27841 . 31757) (\LAFITE.FIND.EXISTING.FOLDER 31759
. 32130) (\LAFITE.CONFLICTING.OLD.FOLDER 32132 . 32972) (LAB.REPAINTFN 32974 . 33450) (LAB.SCROLLFN
33452 . 33872) (LAB.RESHAPEFN 33874 . 34726) (LAB.CLOSEFN 34728 . 34850) (LAB.SHRINKFN 34852 . 34961)
(LAB.CLOSE/SHRINK 34963 . 35909) (LAB.EXPANDFN 35911 . 36726) (LAFITEEXTRABROWSERCOMMANDFN 36728 .
36981)) (37018 45499 (LAB.SELECTMESSAGE 37028 . 42562) (LAB.CHANGEMARK 42564 . 43553) (
LA.READ.NEW.MARK 43555 . 44864) (YPOS.TO.MESSAGE# 44866 . 45243) (MESSAGE#.TO.YPOS 45245 . 45497)) (
45500 50527 (LA.CONSIDERRANGE 45510 . 45994) (LA.DECONSIDERRANGE 45996 . 46322) (LA.RECONSIDERRANGE
46324 . 46773) (LA.SELECTRANGE 46775 . 47762) (LA.DESELECTRANGE 47764 . 48820) (LAB.FIND.SELECTED.MSG
48822 . 49056) (LAB.REV.FIND.SELECTED.MSG 49058 . 49302) (LA.UNDOSELECTION 49304 . 49529) (
LA.VERIFY.SELECTION 49531 . 50525)) (50528 53992 (LAB.COPYBUTTONEVENTFN 50538 . 53083) (
LAB.SHOW.COPY.SELECTION 53085 . 53990)) (54213 58693 (LAB.PROMPTPRINT 54223 . 54356) (LAB.FORMAT 54358
. 54734) (LAB.MOUSECONFIRM 54736 . 55068) (LAB.PRINT.TO.PROMPTWINDOW 55070 . 56889) (LAB.PAGEFULLFN
56891 . 57468) (\LAFITE.MAYBE.CLEAR.PROMPT 57470 . 58691)) (58694 69512 (PRINTMESSAGESUMMARY 58704 .
61082) (FIRSTVISIBLEMESSAGE 61084 . 61547) (LASTVISIBLEMESSAGE 61549 . 62122) (LAB.DISPLAYLINES 62124
. 62444) (LAB.EXPOSEMESSAGE 62446 . 62960) (LAB.SELECTED.MESSAGES 62962 . 63152) (UNSELECTALLMESSAGES
63154 . 63496) (SELECTMESSAGE 63498 . 63730) (LAB.GO.TO.MESSAGE 63732 . 64358) (MARKMESSAGE 64360 .
65211) (LA.SHOW.MARK 65213 . 65664) (LA.INVERT.MARK.BOX 65666 . 65952) (LA.BLT.MARK.BOX 65954 . 66312)
(LA.SHOW.DELETION 66314 . 66775) (LA.SHOW.SELECTION 66777 . 67219) (SEENMESSAGE 67221 . 67936) (
DELETEMESSAGE 67938 . 68382) (UNDELETEMESSAGE 68384 . 69039) (LAB.SET.EXPUNGEABILITY 69041 . 69510)) (
69559 71155 (LAB.ICONFN 69569 . 70475) (LAB.ICON.BUTTONEVENTFN 70477 . 71153)))))
STOP