(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "ROOMS") (IL:FILECREATED "17-Aug-90 14:43:18"  IL:|{DSK}RELEASE>rooms>current>users-src>LAFITE-WINDOW-TYPES.;3| 8873 IL:|changes| IL:|to:| (IL:VARS IL:LAFITE-WINDOW-TYPESCOMS) IL:|previous| IL:|date:| "27-Jul-90 06:11:06" IL:|{DSK}RELEASE>rooms>current>users-src>LAFITE-WINDOW-TYPES.;2|) ; Copyright (c) 1988, 1989, 1990 by Venue & Xerox Corporation. All rights reserved. (IL:PRETTYCOMPRINT IL:LAFITE-WINDOW-TYPESCOMS) (IL:RPAQQ IL:LAFITE-WINDOW-TYPESCOMS ( (IL:* IL:|;;| "window types for Lafite") (FILE-ENVIRONMENTS IL:LAFITE-WINDOW-TYPES) (IL:P (REQUIRE "ROOMS")) (EVAL-WHEN (COMPILE EVAL) (IL:FILES (IL:LOADCOMP T) IL:LAFITEDECLS)) (IL:WINDOW-TYPES :LAFITE-STATUS-WINDOW :LAFITE-BROWSER) (IL:FUNCTIONS ABSTRACT-LAFITE-BROWSER RECONSTITUTE-LAFITE-BROWSER) (IL:* IL:|;;| "keep il:shapew from hanging") (IL:P (IL:CHANGENAME 'IL:LAB.RESHAPEFN 'IL:OBTAIN.MONITORLOCK 'TRUE) (IL:CHANGENAME 'IL:LAB.REPAINTFN 'IL:OBTAIN.MONITORLOCK 'TRUE)) (IL:GLOBALVARS IL:LAFITESTATUSWINDOW IL:DEFAULTMAILFOLDERNAME IL:\\LAFITE.ACTIVE IL:LAFITEBROWSERREGION))) (IL:* IL:|;;| "window types for Lafite") (DEFINE-FILE-ENVIRONMENT IL:LAFITE-WINDOW-TYPES :COMPILER :COMPILE-FILE :READTABLE "XCL" :PACKAGE "ROOMS") (REQUIRE "ROOMS") (EVAL-WHEN (COMPILE EVAL) (IL:FILESLOAD (IL:LOADCOMP T) IL:LAFITEDECLS) ) (DEF-WINDOW-TYPE :LAFITE-STATUS-WINDOW :RECOGNIZER (LAMBDA (WINDOW) (EQ WINDOW IL:LAFITESTATUSWINDOW)) :ABSTRACTER (LAMBDA (WINDOW) NIL) :RECONSTITUTER (LAMBDA (IGNORE) (WHEN (FBOUNDP 'IL:LAFITE) (OR IL:LAFITESTATUSWINDOW (PROGN (IL:LAFITE 'IL:ON NIL) (IL:BLOCK) IL:LAFITESTATUSWINDOW)))) :UPDATER (LAMBDA (PLACEMENT) (IF IL:\\LAFITE.OUTBOX (IL:* IL:|;;| "note the height of the outbox") (PLACEMENT-PROP PLACEMENT :OUTBOX-HEIGHT (REGION-HEIGHT (IL:WINDOWPROP (FIRST IL:\\LAFITE.OUTBOX ) 'IL:REGION))) (REMF (PLACEMENT-PROPS PLACEMENT) :OUTBOX-HEIGHT))) :PLACER (LAMBDA (PLACEMENT) (IL:* IL:|;;| "adjust placement as outbox might have appeared or been removed since we were last here & we don't want status window creeping around.") (IL:RELMOVEW (PLACEMENT-WINDOW PLACEMENT) (MAKE-POSITION 0 (- (GETF (PLACEMENT-PROPS PLACEMENT) :OUTBOX-HEIGHT 0) (IF IL:\\LAFITE.OUTBOX (REGION-HEIGHT (IL:WINDOWPROP (FIRST IL:\\LAFITE.OUTBOX ) 'IL:REGION)) 0))))) :TITLE (LAMBDA (PLACEMENT REGION DSP) (PRINT-PEP-TITLE-STRING "Lafite" REGION DSP :NO-TITLE-BAR? T)) :FILES (IL:* IL:|;;;| "we don't load Lafite on demand.") (IL:LAFITE-WINDOW-TYPES)) (DEF-WINDOW-TYPE :LAFITE-BROWSER :RECOGNIZER (LAMBDA (WINDOW) (TYPEP (IL:WINDOWPROP WINDOW 'IL:MAILFOLDER) 'IL:MAILFOLDER)) :ABSTRACTER ABSTRACT-LAFITE-BROWSER :RECONSTITUTER RECONSTITUTE-LAFITE-BROWSER :TITLE (LAMBDA (PLACEMENT REGION DSP) (LET* ((FOLDER (IL:WINDOWPROP (PLACEMENT-WINDOW PLACEMENT) 'IL:MAILFOLDER))) (PRINT-PEP-TITLE-STRING (IF FOLDER (IL:|fetch| (IL:MAILFOLDER IL:SHORTFOLDERNAME) IL:|of| FOLDER) "Lafite Browser") REGION DSP :NO-TITLE-BAR? (PLACEMENT-SHRUNKEN? PLACEMENT)))) :FILES (IL:* IL:|;;;| "we don't load Lafite on demand") (IL:LAFITE-WINDOW-TYPES)) (DEFUN ABSTRACT-LAFITE-BROWSER (WINDOW) (LET ((FOLDER (IL:WINDOWPROP WINDOW 'IL:MAILFOLDER)) (MOVE-TO-WINDOW (IL:WINDOWPROP WINDOW 'IL:LAFITE.AUTO.MOVE.MENU))) (LIST :FOLDER-NAME (IL:|fetch| (IL:MAILFOLDER IL:SHORTFOLDERNAME) IL:|of| FOLDER) :LAYOUT (LET ((FOLDER-REGION (WINDOW-REGION WINDOW)) (ICON-POSITION (ICON-POSITION WINDOW)) (DISPLAY-REGION (IL:|fetch| (IL:MAILFOLDER IL:FOLDERDISPLAYREGION) IL:|of| FOLDER))) (WHEN MOVE-TO-WINDOW (IL:* IL:|;;| "knock off portion of FOLDER-REGION which includes MoveTo menu window so tht FOLDER-REGION is right for passing to LAFITE.BROWSE.FOLDER (which won't create the MoveTo menu for us).") (DECF (REGION-WIDTH FOLDER-REGION) (REGION-WIDTH (IL:WINDOWPROP MOVE-TO-WINDOW 'IL:REGION)))) (LIST (EXTERNALIZE-REGION FOLDER-REGION) (WHEN ICON-POSITION (EXTERNALIZE-POSITION ICON-POSITION)) (WHEN DISPLAY-REGION (EXTERNALIZE-REGION DISPLAY-REGION)))) :OPTIONS (WHEN (IL:|fetch| (IL:MAILFOLDER IL:FOLDERGETSMAIL) IL:|of| FOLDER) (LIST :ACTIVE)) :MOVE-TO-FOLDERS (WHEN MOVE-TO-WINDOW (MAPCAR #'IL:LA.SHORTFILENAME (IL:WINDOWPROP WINDOW 'IL:LAFITE.AUTO.MOVE.NAMES)))))) (DEFUN RECONSTITUTE-LAFITE-BROWSER (PLIST) (IL:* IL:|;;| "pass if lafite is not loaded") (WHEN (FBOUNDP 'IL:LAFITE) (IL:* IL:|;;| "first make sure lafite is turned on") (UNLESS (EQ IL:\\LAFITE.ACTIVE T) (IL:LAFITE 'IL:ON NIL) (LOOP (IL:BLOCK) (WHEN (EQ IL:\\LAFITE.ACTIVE T) (RETURN))) (IL:* IL:|;;| "don't want to add windows to current room") (HIDE-WINDOW IL:LAFITESTATUSWINDOW)) (LET* ((EXTERNALIZED-REGION (GETF PLIST :REGION)) (EXTERNALIZED-LAYOUT (GETF PLIST :LAYOUT (LIST IL:LAFITEBROWSERREGION))) (LAYOUT (IF EXTERNALIZED-REGION (IL:* IL:|;;| "for back compatability") (LIST (INTERNALIZE-REGION EXTERNALIZED-REGION)) (LIST (INTERNALIZE-REGION (FIRST EXTERNALIZED-LAYOUT)) (WHEN (SECOND EXTERNALIZED-LAYOUT) (INTERNALIZE-POSITION (SECOND EXTERNALIZED-LAYOUT))) (WHEN (THIRD EXTERNALIZED-LAYOUT) (INTERNALIZE-REGION (THIRD EXTERNALIZED-LAYOUT)))))) (FOLDER (IL:LAFITE.BROWSE.FOLDER (GETF PLIST :FOLDER-NAME IL:DEFAULTMAILFOLDERNAME) LAYOUT (GETF PLIST :OPTIONS))) (MOVE-TO-FOLDERS (GETF PLIST :MOVE-TO-FOLDERS))) (WHEN FOLDER (WHEN MOVE-TO-FOLDERS (IL:WINDOWPROP (IL:FETCH (IL:MAILFOLDER IL:BROWSERWINDOW) IL:OF FOLDER) 'IL:LAFITE.AUTO.MOVE.NAMES MOVE-TO-FOLDERS) (IL:\\LAFITE.UPDATE.MOVE.MENU FOLDER T)) (IL:FETCH (IL:MAILFOLDER IL:BROWSERWINDOW) IL:OF FOLDER))))) (IL:* IL:|;;| "keep il:shapew from hanging") (IL:CHANGENAME 'IL:LAB.RESHAPEFN 'IL:OBTAIN.MONITORLOCK 'TRUE) (IL:CHANGENAME 'IL:LAB.REPAINTFN 'IL:OBTAIN.MONITORLOCK 'TRUE) (IL:DECLARE\: IL:DOEVAL@COMPILE IL:DONTCOPY (IL:GLOBALVARS IL:LAFITESTATUSWINDOW IL:DEFAULTMAILFOLDERNAME IL:\\LAFITE.ACTIVE IL:LAFITEBROWSERREGION) ) (IL:PUTPROPS IL:LAFITE-WINDOW-TYPES IL:COPYRIGHT ("Venue & Xerox Corporation" 1988 1989 1990)) (IL:DECLARE\: IL:DONTCOPY (IL:FILEMAP (NIL))) IL:STOP