(FILECREATED "14-Oct-85 15:41:05" {ERIS}<LISPCORE>NEWWINDOWS>WINDOW.;2 210176 

      changes to:  (FNS \CLOSEW1 \OPENW1 WWRITEMODE \MAKE.CLOSED.WINDOW.WRITABLE 
			\RESTORE.CLOSED.WINDOW)
		   (VARS WINDOWCOMS)

      previous date: " 7-Oct-85 14:32:02" {ERIS}<LISPCORE>SOURCES>WINDOW.;67)


(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT WINDOWCOMS)

(RPAQQ WINDOWCOMS [(COMS (FNS WWRITEMODE \MAKE.CLOSED.WINDOW.WRITABLE \RESTORE.CLOSED.WINDOW))
	(COMS (FNS WINDOWWORLD WINDOWWORLDP CHANGEBACKGROUND CHANGEBACKGROUNDBORDER TILE LOGOW 
		   \DRAWLOGOWINDOWIMAGE \TTY.CREATING.DISPLAYSTREAM \CREATE.TTY.OUTCHARFN 
		   \CREATE.TTYDISPLAYSTREAM HASTTYWINDOWP TTYINFOSTREAM)
	      (VARS (\TTYREGIONOFFSETSPTR))
	      [INITVARS [TTYREGIONOFFSETS (QUOTE ((0 . 0)
						  (20 . -20)
						  (40 . 0)
						  (20 . 20]
			(DEFAULTTTYREGION (QUOTE (153 100 384 208]
	      (GLOBALVARS \TTYREGIONOFFSETSPTR TTYREGIONOFFSETS))
	(COMS (* Window menu operations)
	      (FNS WINDOW.MOUSE.HANDLER \PROTECTED.APPLY DOWINDOWCOM DOBACKGROUNDCOM 
		   DEFAULT.BACKGROUND.COPYFN)
	      (VARS (BACKGROUNDCOPYRIGHTBUTTONEVENTFN (FUNCTION DEFAULT.BACKGROUND.COPYFN))
		    (BackgroundCopyMenu))
	      (INITVARS BackgroundCopyMenuCommands)
	      (FNS BURYW CLEARW CLOSEW \CLOSEW1 \OKTOCLOSEW OPENW DOUSERFNS DOUSERFNS2 \USERFNISDON'T 
		   \OPENW1 CREATEW MOVEW \ONSCREENCLIPPINGREGION RELMOVEW PAINTW PAINTW.READMODE 
		   PAINTW.READBRUSHSHAPE PAINTW.READBRUSHSIZE SHAPEW SHAPEW1 RESHOWBORDER 
		   \RESHOWBORDER1 TRACKW SNAPW WINDOWREGION)
	      (COMS (FNS PAINTW.READBRUSHSHADE PAINTW.READ.AND.SAVE.SHADE PAINTW.CACHE.SHADE 
			 PAINTW.SHADE.LABEL)
		    (INITVARS (PAINTW.SHADES))
		    (GLOBALVARS PAINTW.SHADES))
	      (FNS MINIMUMWINDOWSIZE)
	      (INITVARS (BACKGROUNDCURSORINFN)
			(BACKGROUNDBUTTONEVENTFN)
			(BACKGROUNDCURSOROUTFN)
			(BACKGROUNDCURSORMOVEDFN))
	      (GLOBALVARS BACKGROUNDCURSORINFN BACKGROUNDBUTTONEVENTFN BACKGROUNDCURSOROUTFN 
			  BACKGROUNDCURSORMOVEDFN \LASTKEYSTATE BACKGROUNDCOPYBUTTONEVENTFN 
			  BACKGROUNDCOPYRIGHTBUTTONEVENTFN \CARET.UP)
	      (EXPORT (MACROS .COPYKEYDOWNP. WSOP))
	      (PROP ARGNAMES WSOP)
	      (RECORDS WSOPS WSDATA))
	(COMS (* image object support - here so that DEDIT can use it without needing TEDIT to be 
		 loaded.)
	      (RECORDS IMAGEOBJ IMAGEFNS IMAGEBOX)
	      (FNS COPYINSERT IMAGEBOX IMAGEFNSCREATE IMAGEFNSP IMAGEOBJCREATE IMAGEOBJP IMAGEOBJPROP 
		   \IMAGEUSERPROP HPRINT.IMAGEOBJ COPYIMAGEOBJ READIMAGEOBJ WRITEIMAGEOBJ)
	      (ADDVARS (HPRINTMACROS (IMAGEOBJ . WRITEIMAGEOBJ)))
	      (GLOBALVARS (IMAGEOBJTYPES NIL)
			  (IMAGEOBJGETFNS NIL)))
	(COMS (* For encapsulating unknown-type IMAGEOBJs.)
	      (FNS ENCAPSULATEDOBJ.BUTTONEVENTINFN ENCAPSULATEDOBJ.DISPLAYFN 
		   ENCAPSULATEDOBJ.IMAGEBOXFN ENCAPSULATEDOBJ.INIT)
	      (P (ENCAPSULATEDOBJ.INIT))
	      (GLOBALVARS ENCAPSULATEDIMAGEFNS))
	(COMS (* Window utilities)
	      (FNS ADVISEWDS SHOWWFRAME SHOWWTITLE \STRINGWIDTHGUESS RESHOWTITLE TOTOPW 
		   \INTERNALTOTOPW \TTW1 WHICHW)
	      (VARS (WINDOWTITLEPRINTLEVEL (QUOTE (2 . 5)))
		    (WINDOWTITLESHADE BLACKSHADE)))
	[COMS (* Window vs non-window world)
	      (FNS SWITCHDEF WFROMDS NU\TOTOPWDS \COERCETODS)
	      (DECLARE: DONTCOPY (EXPORT (MACROS \COERCETODS .WHILE.ON.TOP.]
	(COMS (* User interface functions)
	      (FNS WINDOWP WINDOWPROP WINDOWADDPROP WINDOWDELPROP GETWINDOWPROP GETWINDOWUSERPROP 
		   PUTWINDOWPROP REMWINDOWPROP WINDOWADDFNPROP)
	      (* for compiling windowprops.)
	      (PROP ARGNAMES WINDOWPROP)
	      (MACROS WINDOWPROP)
	      (FNS CWINDOWPROP CGETWINDOWPROP \GETWINDOWHEIGHT \GETWINDOWWIDTH))
	[COMS (FNS OPENWP RESHAPEBYREPAINTFN \INBETWEENP DECODE/WINDOW/OR/DISPLAYSTREAM GROW/REGION 
		   PPROMPT3 CLRPROMPT PROMPTPRINT OPENWINDOWS \INSUREWINDOW)
	      (* these entries are left in for backward compatibility. They were dedocumented 6/83. 
		 rrb)
	      (P (MOVD (QUOTE OPENWP)
		       (QUOTE ACTIVEWP))
		 (MOVD (QUOTE OPENWINDOWS)
		       (QUOTE ACTIVEWINDOWS)))
	      (FNS OVERLAPPINGWINDOWS WOVERLAPP ORDERFROMBOTTOMTOTOP)
	      (* screen size changing functions.)
	      (FNS \ONSCREENW \PUTONSCREENW \UPDATECACHEDFIELDS \WWCHANGESCREENSIZE CREATEWFROMIMAGE 
		   UPDATEWFROMIMAGE)
	      (EXPORT (DECLARE: DOEVAL@COMPILE DONTCOPY (MACROS WINDOWWORLD]
	(COMS (* Scrolling stuff)
	      (FNS SCROLLW SCROLLBYREPAINTFN ADJUSTOFFSETS CREATESCROLLINGW IN/SCROLL/BAR? 
		   RELDSPXOFFSET RELDSPYOFFSET SCROLL.HANDLER \SCROLL.HANDLER.DOIT \DECODE.EXTENT.USE 
		   \UPDATE.EXTENT.IMAGE EXTENDPASTHORIZBOUNDARIES EXTENDPASTVERTBOUNDARIES REDISPLAYW 
		   FILLWITHBACKGROUND UPDATE/SCROLL/REG WTODSX WTODSY WXOFFSET WYOFFSET 
		   BITMAPSCROLLFN SCROLLBITMAP REDISPLAYBITMAP ULREDISPLAYBITMAP EXTENDEXTENT 
		   WIDTHIFWINDOW HEIGHTIFWINDOW)
	      (* this function should be on LLDISPLAY but Ron has it checked out. Move it later - 
		 rrb.)
	      (FNS \DSPUNTRANSFORMREGION))
	(COMS (* icon functions)
	      (FNS SHRINKW \MAKEICONWINDOW \TITLEICONMINSIZE \NOTENEWICONPOSITION EXPANDW 
		   DOICONWINDOWCOM CLOSEMAINWINDOW CLOSEICONWINDOW)
	      (VARS IconMenuItems))
	(CURSORS VertScrollCursor ScrollUpCursor ScrollDownCursor HorizScrollCursor ScrollLeftCursor 
		 ScrollRightCursor VertThumbCursor HorizThumbCursor WAITINGCURSOR)
	(DECLARE: EVAL@COMPILE DONTCOPY
		  (GLOBALVARS \LastCursorPosition \LastInWindow WindowMenu BackgroundMenu 
			      BackgroundMenuCommands \LastWindowButtons WWFNS WindowMenuCommands 
			      IconWindowMenu IconWindowMenuCommands VertScrollCursor ScrollUpCursor 
			      ScrollDownCursor ScrollLeftCursor ScrollRightCursor HorizScrollCursor 
			      WindowTitleDisplayStream WINDOWTITLEPRINTLEVEL WBorder \TOPWDS 
			      WINDOWBACKGROUNDSHADE CURRENTBACKGROUNDSHADE BACKGROUNDFNS)
		  (CONSTANTS (MinWindowWidth 26)
			     (MinWindowHeight 16))
		  (EXPORT (RECORDS WINDOW)))
	(DECLARE: EVAL@COMPILE (EXPORT (GLOBALVARS TOPW WINDOWUSERFORMS ENDOFWINDOWUSERFORMS 
						   PROMPTWINDOW KNOWNWINDOWS)))
	(SYSRECORDS WINDOW)
	(INITRECORDS WINDOW)
	(INITVARS (WWFNS (QUOTE (\TOTOPWDS)))
		  (WindowTitleDisplayStream)
		  (WindowMenu)
		  (BackgroundMenu)
		  (TOPW)
		  (\LastCursorPosition (CREATEPOSITION))
		  (\LastInWindow)
		  (\LastWindowButtons 0)
		  (IconWindowMenu)
		  (KNOWNWINDOWS)
		  (WINDOWBACKGROUNDSHADE 34850)
		  (WBorder 4)
		  (SCROLLBARWIDTH 24)
		  (SCROLLWAITTIME 100)
		  (SCROLLBARSHADE 32800)
		  (WAITBEFORESCROLLTIME 750)
		  (WAITBETWEENSCROLLTIME 100)
		  (PAINTCOMMANDBRUSH (QUOTE (ROUND 2)))
		  (PAINTCOMMANDMODE (QUOTE PAINT))
		  (PAINTCOMMANDMENU)
		  (PAINTCOMMANDSHADE BLACKSHADE)
		  (PAINTSIZEMENU)
		  (PAINTSHAPEMENU)
		  (PAINTSHADEMENU)
		  (PAINTMODEMENU)
		  (HIGHLIGHTSHADE 32800))
	[ADDVARS (WindowMenuCommands (Close (QUOTE CLOSEW)
					    "Closes a window")
				     (Snap (QUOTE SNAPW)
					   "Saves a snapshot of a region of the screen.")
				     (Paint (QUOTE PAINTW)
					    
"Starts a painting mode in which the mouse can be
used to draw pictures or make notes on windows.")
				     (Clear (QUOTE CLEARW)
					    "Clears a window to its gray.")
				     (Bury (QUOTE BURYW)
					   "Puts a window on the bottom.")
				     (Redisplay (QUOTE REDISPLAYW)
						"Redisplays a window using its REPAINTFN.")
				     (Hardcopy (QUOTE HARDCOPYIMAGEW)
					       "Prints a window using its HARDCOPYFN."
					       (SUBITEMS ("To a file" (QUOTE HARDCOPYIMAGEW.TOFILE)
								      
					  "Puts image on a file; prompts for filename and format")
							 ("To a printer" (QUOTE 
									 HARDCOPYIMAGEW.TOPRINTER)
									 
						      "Sends image to a printer of your choosing")))
				     (Move (QUOTE MOVEW)
					   "Moves a window by a corner.")
				     (Shape (QUOTE SHAPEW)
					    
"Gets a new region for a window.
Left button down marks fixed corner; sweep to other corner.
Middle button down moves closest corner.")
				     (Shrink (QUOTE SHRINKW)
					     
		       "Replaces this window with its icon (or title if it doesn't have an icon."))
		 (IconWindowMenuCommands (Close (QUOTE CLOSEW)
						"Closes the icon and its assciated window")
					 (Snap (QUOTE SNAPW)
					       "Saves a snapshot of a region of the screen.")
					 (Paint (QUOTE PAINTW)
						
"Starts a painting mode in which the mouse can
be used to draw pictures or make notes on windows.
Includes a HARDCOPY command.")
					 (Bury (QUOTE BURYW)
					       "Puts a window on the bottom.")
					 (Move (QUOTE MOVEW)
					       "Moves a window by a corner.")
					 (Shape (QUOTE SHAPEW)
						
"Gets a new region for a window.
Left button down marks fixed corner; sweep to other corner.
Middle button down moves closest corner.")
					 (Expand (QUOTE EXPANDW)
						 "Expands the window for which this is the ICON."))
		 (BackgroundMenuCommands (SaveVM (QUOTE (SAVEVM))
						 "Updates the virtual memory.")
					 (Snap (QUOTE (SNAPW))
					       "Saves a snapshot of a region of the screen.")
					 (Hardcopy (QUOTE (HARDCOPYW))
						   "Send hardcopy of screen region to printer."
						   (SUBITEMS ("To a file" (QUOTE (
HARDCOPYREGION.TOFILE))
									  
			   "Writes a region of screen to a file; prompts for filename and format")
							     ("To a printer" (QUOTE (
HARDCOPYREGION.TOPRINTER))
									     
					 "Sends a region of screen to a printer of your choosing"]
	(ADDVARS (WINDOWUSERFORMS)
		 (ENDOFWINDOWUSERFORMS))
	(P (PAINTW.CACHE.SHADE BLACKSHADE)
	   (PAINTW.CACHE.SHADE GRAYSHADE)
	   (PAINTW.CACHE.SHADE HIGHLIGHTSHADE))
	(DECLARE: DOCOPY DONTEVAL@LOAD (P (WINDOWWORLD T))
		  (ADDVARS (GLOBALVARS SCROLLBARWIDTH SCROLLWAITTIME SCROLLBARSHADE 
				       WAITBEFORESCROLLTIME WAITBETWEENSCROLLTIME WAITINGCURSOR)))
	(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
		  (ADDVARS (NLAMA)
			   (NLAML)
			   (LAMA PROMPTPRINT WINDOWPROP IMAGEOBJPROP WINDOWWORLD])
(DEFINEQ

(WWRITEMODE
  [LAMBDA (WINDOW MODE)                                      (* hdj "14-Oct-85 14:35")
    (PROG1 (SELECTQ (WINDOWPROP WINDOW (QUOTE OPEN-ON-WRITE-MODE))
			(T (QUOTE OPEN))
			(NIL (QUOTE CLOSED))
			(SHOULDNT))
	     (SELECTQ MODE
			[OPEN (\UNINTERRUPTABLY              (*)
						(WINDOWPROP WINDOW (QUOTE OPEN-ON-WRITE-MODE)
							      T)
						(if (NOT (OPENWP WINDOW))
						    then (replace (WINDOW NEXTW) of WINDOW
							      with (QUOTE CANOPEN]
			[CLOSED (\UNINTERRUPTABLY (WINDOWPROP WINDOW (QUOTE OPEN-ON-WRITE-MODE)
								NIL)
						  (if (NOT (OPENWP WINDOW))
						      then (replace (WINDOW NEXTW) of WINDOW
								with (QUOTE CLOSED]
			(NIL NIL)
			(\ILLEGAL.ARG MODE])

(\MAKE.CLOSED.WINDOW.WRITABLE
  [LAMBDA (WINDOW)                                           (* hdj "14-Oct-85 14:58")
    (UNINTERRUPTABLY                                         (*)
	(LET [(OLDXOFFSET (DSPXOFFSET NIL WINDOW))
	      (OLDYOFFSET (DSPYOFFSET NIL WINDOW))
	      (OLDDESTINATION (fetch (\DISPLAYDATA DDDestination) of (\GETDISPLAYDATA WINDOW)))
	      (SAVED-BITMAP (fetch (WINDOW SAVE) of WINDOW))
	      (OLDREGION (WINDOWPROP WINDOW (QUOTE REGION]

          (* * get old values)


	     (WINDOWPROP WINDOW (QUOTE OLDXOFFSET)
			   OLDXOFFSET)
	     (WINDOWPROP WINDOW (QUOTE OLDYOFFSET)
			   OLDYOFFSET)
	     (WINDOWPROP WINDOW (QUOTE OLDDESTINATION)
			   OLDDESTINATION)

          (* * set new ones)

                                                             (* mark it as writable while remaining closed)
	     (replace (WINDOW NEXTW) of WINDOW with (QUOTE CLOSED))
	     (replace (\DISPLAYDATA DDDestination) of (\GETDISPLAYDATA WINDOW) with 
										     SAVED-BITMAP)
	     (replace (PILOTBBT PBTDESTBPL) of (fetch (\DISPLAYDATA DDPILOTBBT)
						      of (\GETDISPLAYDATA WINDOW))
		with (fetch (BITMAP BITMAPWIDTH) of SAVED-BITMAP))
	     (DSPXOFFSET (IDIFFERENCE (fetch (REGION LEFT) of OLDREGION)
					  OLDXOFFSET)
			   WINDOW)
	     (DSPYOFFSET (IDIFFERENCE (fetch (REGION BOTTOM) of OLDREGION)
					  OLDYOFFSET)
			   WINDOW)
	 WINDOW))])

(\RESTORE.CLOSED.WINDOW
  [LAMBDA (WINDOW)                                           (* hdj "14-Oct-85 14:58")
    (LET [(OLDXOFFSET (WINDOWPROP WINDOW (QUOTE OLDXOFFSET)))
	  (OLDYOFFSET (WINDOWPROP WINDOW (QUOTE OLDYOFFSET)))
	  (OLDDESTINATION (WINDOWPROP WINDOW (QUOTE OLDDESTINATION]

          (* * clean up -- if window was modified to begin with)


         (UNINTERRUPTABLY                                    (*)
	     (if OLDXOFFSET
		 then (WINDOWPROP WINDOW (QUOTE OLDXOFFSET)
				      NIL)
			(WINDOWPROP WINDOW (QUOTE OLDYOFFSET)
				      NIL)
			(WINDOWPROP WINDOW (QUOTE OLDDESTINATION)
				      NIL)

          (* * restore)


			(replace (\DISPLAYDATA DDDestination) of (\GETDISPLAYDATA WINDOW)
			   with OLDDESTINATION)
			(replace (PILOTBBT PBTDESTBPL) of (fetch (\DISPLAYDATA DDPILOTBBT)
								 of (\GETDISPLAYDATA WINDOW))
			   with (fetch (BITMAP BITMAPWIDTH) of OLDDESTINATION))
			(DSPXOFFSET OLDXOFFSET WINDOW)
			(DSPYOFFSET OLDYOFFSET WINDOW)))
     WINDOW])
)
(DEFINEQ

(WINDOWWORLD
  (LAMBDA CHANGEIT                                           (* jwo: "23-Jul-85 02:44")
                                                             (* returns T if the window system is active.
							     If CHANGEIT is given, the window system will be turned 
							     off or on.)
    (DECLARE (GLOBALVARS \TopLevelTtyWindow))
    (PROG1 (type? WINDOW TOPW)
	   (COND
	     ((ZEROP CHANGEIT))
	     ((ARG CHANGEIT 1)
	       (UNINTERRUPTABLY
                   (SETQ CURRENTBACKGROUNDSHADE (\CLEARBM (SCREENBITMAP)
							  WINDOWBACKGROUNDSHADE))
		   (COND
		     ((WINDOWWORLD)                          (* Windows already on; close then all This keeps them 
							     from being confused about where their image is NIL)
		       (for WINDOW in (OPENWINDOWS) do (CLOSEW WINDOW)))
		     (T                                      (* Initially no windows)
			(for FN in WWFNS do (SWITCHDEF FN (QUOTE \OLD)
						       (QUOTE NU)))
			(COND
			  ((NOT (DISPLAYSTREAMP WindowTitleDisplayStream))
			    (SETQ WindowTitleDisplayStream (DSPCREATE))
			    (DSPOPERATION (QUOTE INVERT)
					  WindowTitleDisplayStream)
			    (DSPFONT (FONTCREATE (QUOTE HELVETICA)
						 8)
				     WindowTitleDisplayStream)
                                                             (* set right margin so title doesn't autoCR.)
			    (DSPRIGHTMARGIN 60000 WindowTitleDisplayStream)))
			(DSPXOFFSET 0 (TTYDISPLAYSTREAM))    (* Get TTY in shape. Region is only approx as user can 
							     change it.)
			(DSPYOFFSET 0 (TTYDISPLAYSTREAM))
			(DSPCLIPPINGREGION (create REGION
						   LEFT ← 8
						   BOTTOM ← 378
						   WIDTH ← 550
						   HEIGHT ← 333)
					   (TTYDISPLAYSTREAM))
                                                             (* First attempt to print creates TTY window)
			(\STARTDISPLAY)                      (* Not DISPLAYSTREAMINIT. No point in leaving a TTY 
							     area)
			(DSPDESTINATION (SCREENBITMAP)
					(TTYDISPLAYSTREAM))
                                                             (* SCREENBITMAP changes in STARTDISPLAY)
			(SETLINELENGTH)                      (* Resets line length for TTY)
			))
		   (SETQ \DEFAULTTTYDISPLAYSTREAM (\TTY.CREATING.DISPLAYSTREAM))
		   (SETQ TOPW NIL)
		   (SETQ \TOPWDS NIL)                        (* set up PROMPTWINDOW and TTY window and LOGO windows)
		   (PROG NIL
		         (SETQ PROMPTWINDOW (CREATEW (create REGION
							     LEFT ←(IDIFFERENCE (FOLDLO SCREENWIDTH 2)
										275)
							     BOTTOM ←(IDIFFERENCE SCREENHEIGHT 76)
							     WIDTH ← 550
							     HEIGHT ←(HEIGHTIFWINDOW 60 T 2))
						     "Prompt Window" 2))
		         (DSPTEXTURE BLACKSHADE PROMPTWINDOW)
		         (DSPOPERATION (QUOTE ERASE)
				       PROMPTWINDOW)
		         (DSPSCROLL (QUOTE ON)
				    PROMPTWINDOW)
		         (WINDOWPROP PROMPTWINDOW (QUOTE SHRINKFN)
				     (QUOTE DON'T))
		         (CLEARW PROMPTWINDOW)               (* set it so that PROMPTWINDOW doesn't hold.)
		         (WINDOWPROP PROMPTWINDOW (QUOTE PAGEFULLFN)
				     (FUNCTION NILL)))
		   (SETQ LOGOW (LOGOW "Interlisp-D" (create POSITION
							    XCOORD ← 594
							    YCOORD ← 544)))
		   (WINDOWPROP LOGOW (QUOTE CLOSEFN)
			       (FUNCTION (LAMBDA (W)         (* clear the variable so that it will be collected.)
				   (SETQ LOGOW NIL))))       (* attach the current line buffer to the top level 
							     window.)
		   (WINDOWPROP (SETQ \TopLevelTtyWindow (CREATEW (TTYDISPLAYSTREAM)
								 "Interlisp-D Executive"))
			       (QUOTE \LINEBUF.OFD)
			       (OR \LINEBUF.OFD (\CREATELINEBUFFER))))
                                                             (* initialize the window mouse handler variables.)
	       (SETQ \LastInWindow)
	       (SETQ \LastWindowButtons 0)
	       (SETQ \LastCursorPosition (create POSITION))
	       (MAPC WINDOWUSERFORMS (FUNCTION EVAL)))
	     ((WINDOWWORLD)                                  (* if its on turn it off)
	       (MAPC ENDOFWINDOWUSERFORMS (FUNCTION EVAL))
	       (UNINTERRUPTABLY
                   (for F in WWFNS do (SWITCHDEF F (QUOTE NU)
						 (QUOTE \OLD)))
		   (AND (LISTP BACKGROUNDFNS)
			(SETQ BACKGROUNDFNS (DREMOVE (QUOTE WINDOW.MOUSE.HANDLER)
						     BACKGROUNDFNS)))
		   (BITBLT NIL 0 0 (SCREENBITMAP)
			   0 0 NIL NIL (QUOTE TEXTURE)
			   (QUOTE REPLACE)
			   WHITESHADE)
		   (DISPLAYSTREAMINIT 65)
		   (SETLINELENGTH)
		   (SETQ TOPW NIL)
		   (SETQ \TOPWDS (SETQ \TopLevelTtyWindow NIL))
		   (SETQ PROMPTWINDOW T)))))))

(WINDOWWORLDP
  [LAMBDA NIL                                                (* rrb " 7-MAY-82 18:39")
                                                             (* is the window system operating?)
    (type? WINDOW TOPW])

(CHANGEBACKGROUND
  [LAMBDA (SHADE DISPLAY)                                    (* hdj " 3-Feb-85 13:55")
                                                             (* changes the window world background to SHADE)
    (WSOP (QUOTE WSCHANGEBACKGROUND)
	  (OR DISPLAY DisplayFDEV)
	  SHADE])

(CHANGEBACKGROUNDBORDER
  [LAMBDA (SHADE DISPLAY)                                    (* hdj "31-Jan-85 23:03")
                                                             (* Changes the screen border on a Dandelion.
							     SHADE is a 8x2 pattern)
    (WSOP (QUOTE WSCHANGEBACKGROUNDBORDER)
	  (OR DISPLAY DisplayFDEV)
	  SHADE])

(TILE
  [LAMBDA (SRC DST)                                          (* lmm "25-APR-82 21:55")
    (PROG ((X 0)
	   (Y 0)
	   (W (fetch BITMAPWIDTH of SRC))
	   (H (fetch BITMAPHEIGHT of SRC))
	   (DSTW (fetch BITMAPWIDTH of DST))
	   (DSTH (fetch BITMAPHEIGHT of DST)))
          (while (ILESSP X DSTW) do (SETQ Y 0)
				    (while (ILESSP Y DSTH)
				       do (BITBLT SRC 0 0 DST X Y W H NIL (QUOTE REPLACE))
					  (add Y H))
				    (add X W])

(LOGOW
  [LAMBDA (STRING WHERE TITLE ANGLEDELTA)                    (* edited: " 1-AUG-83 22:55")
                                                             (* creates a logo window.)
    (PROG ((CIRCLESIZE 60)
	   (LOGOXCENTER 70)
	   (LOGOYCENTER 65)
	   (LOGOWINDOWHEIGHT 180)
	   W LOGOWINDOWWIDTH WIMAGEWIDTH WIMAGEHEIGHT (STRING (OR STRING "Interlisp-D")))
          (OR ANGLEDELTA (SETQ ANGLEDELTA 23))
          (SETQ WIMAGEWIDTH (FIX (FTIMES CIRCLESIZE .62)))
          (SETQ WIMAGEHEIGHT (FIX (FTIMES CIRCLESIZE .5)))
          [SETQ LOGOWINDOWWIDTH (IPLUS LOGOXCENTER 30 WIMAGEWIDTH (STRINGWIDTH STRING
									       (QUOTE (TIMESROMAND
											36]
          [SETQ W (COND
	      ((TYPENAMEP WHERE (QUOTE WINDOW))
		WHERE)
	      (T (CREATEW (COND
			    ((POSITIONP WHERE)
			      (create REGION
				      LEFT ←(fetch (POSITION XCOORD) of WHERE)
				      BOTTOM ←(fetch (POSITION YCOORD) of WHERE)
				      WIDTH ← LOGOWINDOWWIDTH
				      HEIGHT ← LOGOWINDOWHEIGHT))
			    (T (GETBOXREGION LOGOWINDOWWIDTH LOGOWINDOWHEIGHT NIL NIL NIL 
					     "Specify location for logo window.")))
			  (OR TITLE (CONCAT "Copyright (c) by Xerox Corporation" "             "
					    (OR MAKESYSDATE (DATE]
          (for ANGLE from 0 to 270 by ANGLEDELTA do (\DRAWLOGOWINDOWIMAGE (IPLUS LOGOXCENTER
										 (FTIMES
										   CIRCLESIZE
										   (COS ANGLE)))
									  (IPLUS LOGOYCENTER
										 (FTIMES
										   CIRCLESIZE
										   (SIN ANGLE)))
									  WIMAGEWIDTH WIMAGEHEIGHT 2 
									  W))
          (MOVETO (IPLUS LOGOXCENTER 10 WIMAGEWIDTH)
		  (IPLUS 2 (IDIFFERENCE LOGOYCENTER CIRCLESIZE))
		  W)
          (DSPFONT (QUOTE (TIMESROMAND 36))
		   W)
          (PRIN3 STRING W)
          (RETURN W])

(\DRAWLOGOWINDOWIMAGE
  [LAMBDA (XPOS YPOS WIDTH HEIGHT BORDER W)                  (* rrb "22-FEB-82 18:04")
                                                             (* makes a window image. This is part of the logo 
							     drawing.)
    (BITBLT NIL NIL NIL W XPOS YPOS WIDTH HEIGHT (QUOTE TEXTURE)
	    (QUOTE REPLACE)
	    BLACKSHADE)
    (BITBLT NIL NIL NIL W (IPLUS BORDER XPOS)
	    (IPLUS BORDER YPOS)
	    (IDIFFERENCE WIDTH (ITIMES BORDER 2))
	    (IDIFFERENCE HEIGHT (ITIMES BORDER 3))
	    (QUOTE TEXTURE)
	    (QUOTE REPLACE)
	    WHITESHADE])

(\TTY.CREATING.DISPLAYSTREAM
  [LAMBDA NIL                                                (* rmk: "27-AUG-83 13:41")

          (* creates a displaystream that points to a stream that has a OUTCHARFN that creates a new displaystream.
	  It is used as the default TtyDisplayStream in a process.)


    (PROG [(DS (DSPCREATE (BITMAPCREATE 1 1]
          (replace OUTCHARFN of DS with (FUNCTION \CREATE.TTY.OUTCHARFN))
          (replace FULLFILENAME of DS with T)
          (RETURN DS])

(\CREATE.TTY.OUTCHARFN
  [LAMBDA (STREAM CHAR)                                      (* rmk: "26-AUG-83 12:25")
                                                             (* outcharfn for \DEFAULTTTYDISPLAYSTREAM which creates 
							     a new window and then bouts to it.)
                                                             (* make the new window the ttydisplaystream)
    (COND
      ((HASTTYWINDOWP NIL)

          (* the only case where the ttydisplaystream isn't the default is when the users has called 
	  (PRINT foo (TTYDISPLAYSTREAM)) and this is other than the first character of foo.)


	(\CREATE.TTYDISPLAYSTREAM)))
    (\OUTCHAR (TTYDISPLAYSTREAM)
	      CHAR])

(\CREATE.TTYDISPLAYSTREAM
  [LAMBDA NIL                                                (* rrb "16-AUG-83 12:20")
                                                             (* makes a new window and makes it the ttydisplaystream)
    (COND
      ((WINDOWWORLDP)

          (* \TTYWINDOW saves the window so it wouldn't get collected. This allows WFROMDS to find it even if it is closed.
	  In future, windows will be streams and this can go away.)


	(COND
	  ((NULL (SETQ \TTYREGIONOFFSETSPTR (CDR \TTYREGIONOFFSETSPTR)))
                                                             (* the offsets distribute the break windows a little so 
							     many can be seen.)
	    (SETQ \TTYREGIONOFFSETSPTR TTYREGIONOFFSETS)))
	(TTYDISPLAYSTREAM (SETQ \TTYWINDOW (CREATEW (CREATEREGION (IPLUS (fetch (REGION LEFT)
									    of DEFAULTTTYREGION)
									 (CAR (CAR 
									     \TTYREGIONOFFSETSPTR)))
								  (IPLUS (fetch (REGION BOTTOM)
									    of DEFAULTTTYREGION)
									 (CDR (CAR 
									     \TTYREGIONOFFSETSPTR)))
								  (fetch (REGION WIDTH) of 
										 DEFAULTTTYREGION)
								  (fetch (REGION HEIGHT)
								     of DEFAULTTTYREGION))
						    (CONCAT "TTY window for " (PROCESSPROP
							      (THIS.PROCESS)
							      (QUOTE NAME)))
						    NIL T])

(HASTTYWINDOWP
  [LAMBDA (PROCESS)                                          (* bvm: "17-AUG-83 13:21")
                                                             (* determines if PROCESS has a tty window yet.)
    (DECLARE (GLOBALVARS \DEFAULTTTYDISPLAYSTREAM))
    (PROG NIL
          (RETURN (NEQ (COND
			 ((NULL PROCESS)
			   TtyDisplayStream)
			 ((PROCESS.TTY PROCESS))
			 (T (RETURN)))
		       \DEFAULTTTYDISPLAYSTREAM])

(TTYINFOSTREAM
  [LAMBDA (PROCESS)                                          (* bvm: "12-NOV-83 22:55")

          (* * Returns a stream to which to print informative messages = TtyDisplayStream if PROCESS has one, else 
	  PROMPTWINDOW)


    (DECLARE (GLOBALVARS \DEFAULTTTYDISPLAYSTREAM))
    (PROG [(STREAM (COND
		     ((NULL PROCESS)
		       TtyDisplayStream)
		     (T (PROCESS.TTY PROCESS]
          (RETURN (COND
		    ((AND STREAM (NEQ STREAM \DEFAULTTTYDISPLAYSTREAM))
		      STREAM)
		    (T (\GETSTREAM PROMPTWINDOW])
)

(RPAQQ \TTYREGIONOFFSETSPTR NIL)

(RPAQ? TTYREGIONOFFSETS (QUOTE ((0 . 0)
				  (20 . -20)
				  (40 . 0)
				  (20 . 20))))

(RPAQ? DEFAULTTTYREGION (QUOTE (153 100 384 208)))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \TTYREGIONOFFSETSPTR TTYREGIONOFFSETS)
)



(* Window menu operations)

(DEFINEQ

(WINDOW.MOUSE.HANDLER
  [LAMBDA NIL                                                (* lmm "11-Jun-85 14:27")

          (* * Does user window operations if state of buttons has changed or mouse has changed windows)


    (COND
      (\INTERRUPTABLE                                        (* don't do anything if uninterruptable)
		      (PROG [\MHWINDOW \MHCOM \MHPROCESS (NBREAKS (COND
								    ((IGREATERP 0 NBREAKS)
                                                             (* bind NBREAKS to a positive values so that breaks 
							     will occur in background functions.)
								      (IMINUS NBREAKS))
								    (T NBREAKS]
			    (GETMOUSESTATE)
			    [COND
			      ((OR (NEQ LASTMOUSEX (fetch XCOORD of \LastCursorPosition))
				   (NEQ LASTMOUSEY (fetch YCOORD of \LastCursorPosition))
				   (NEQ LASTMOUSEBUTTONS \LastWindowButtons))
                                                             (* Cursor has changed position or a button is down, see
							     if it is in a window or scroll area.)
				(PROG ((\MOUSEBUSY T))
				      (DECLARE (SPECVARS \MOUSEBUSY))
                                                             (* Indicates to others that the mouse process is doing 
							     something "interesting")
				      (replace XCOORD of \LastCursorPosition with LASTMOUSEX)
				      (replace YCOORD of \LastCursorPosition with LASTMOUSEY)
				      (SETQ \MHWINDOW (WHICHW LASTMOUSEX LASTMOUSEY))
				      (COND
					[(NEQ \MHWINDOW \LastInWindow)

          (* Cursor has moved outside the current window, check to see if it moved into the scroll area and that the scroll 
	  handler wants it.)


					  (COND
					    ((AND \LastInWindow (IN/SCROLL/BAR? \LastInWindow 
										LASTMOUSEX LASTMOUSEY)
						  (PROGN     (* SCROLL.HANDLER returns NIL if this window doesn't 
							     want to scroll.)
							 (SCROLL.HANDLER \LastInWindow)))
					      (replace XCOORD of \LastCursorPosition with -1)
					      (GETMOUSESTATE)
					      (SETQ \LastWindowButtons LASTMOUSEBUTTONS)
					      (RETURN))
					    ((OR (ZEROP LASTMOUSEBUTTONS)
						 (NEQ LASTMOUSEBUTTONS \LastWindowButtons))

          (* Cursor has changed windows, so call CURSOROUTFN of old window, CURSORINFN of new. The user enters another window 
	  by moving the cursor into it with no buttons pressed or by pressing a button in the window. This allows the user to 
	  go into a window with a button down, release it and still be "in" the window he came from.)


					      [COND
						((NULL \LastInWindow)
						  (AND BACKGROUNDCURSOROUTFN (GETD 
									    BACKGROUNDCURSOROUTFN)
						       (\PROTECTED.APPLY BACKGROUNDCURSOROUTFN)))
						((SETQ \MHCOM (fetch CURSOROUTFN of \LastInWindow))
						  (ERSETQ (DOUSERFNS \MHCOM \LastInWindow]
					      [COND
						((NULL \MHWINDOW)
						  (AND BACKGROUNDCURSORINFN (GETD 
									     BACKGROUNDCURSORINFN)
						       (\PROTECTED.APPLY BACKGROUNDCURSORINFN)))
						((SETQ \MHCOM (fetch CURSORINFN of \MHWINDOW))
						  (ERSETQ (DOUSERFNS \MHCOM \MHWINDOW]
					      (SETQ \LastInWindow \MHWINDOW)
					      (SETQ \LastWindowButtons LASTMOUSEBUTTONS]
					([AND (LASTMOUSESTATE (ONLY RIGHT))
					      (NOT (AND \MHWINDOW (fetch RIGHTBUTTONFN of \MHWINDOW]
                                                             (* right button when down, normally this is window 
							     system commands but can be overridden.)
                                                             (* this is separated out so that window commands don't 
							     grab the tty.)
					  (COND
					    ((AND (NULL \MHWINDOW)
						  (.COPYKEYDOWNP.)
						  BACKGROUNDCOPYRIGHTBUTTONEVENTFN
						  (GETD BACKGROUNDCOPYRIGHTBUTTONEVENTFN))
                                                             (* check for copy key.)
					      (\PROTECTED.APPLY BACKGROUNDCOPYRIGHTBUTTONEVENTFN))
					    (T               (* if \MHWINDOW is NIL, this does background menu 
							     stuff.)
					       (DOWINDOWCOM \MHWINDOW)))
                                                             (* this attempts to prevent the cursorout fn and 
							     scrolling fns from being called if the \LastInWindow 
							     was closed.)
					  (OR (OPENWP \LastInWindow)
					      (SETQ \LastInWindow NIL)))
					[\MHWINDOW           (* look for button change or cursor moving fn.)
						   (COND
						     [(NEQ LASTMOUSEBUTTONS \LastWindowButtons)
                                                             (* Button change within same window)
						       (COND
							 ((AND (LASTMOUSESTATE (NOT UP))
							       (SETQ \MHPROCESS (WINDOWPROP
								   \MHWINDOW
								   (QUOTE PROCESS)))
							       (NOT (TTY.PROCESSP \MHPROCESS))
							       (NOT (.COPYKEYDOWNP.))
							       (SETQ \MHCOM (fetch WINDOWENTRYFN
									       of \MHWINDOW)))
                                                             (* make sure that if this window has a process that 
							     that process has the tty.)
							   (ERSETQ (DOUSERFNS \MHCOM \MHWINDOW))
							   (GO RESETBUTTONS))
							 ([SETQ \MHCOM
							     (COND
							       [(AND (.COPYKEYDOWNP.)
								     (WINDOWPROP \MHWINDOW
										 (QUOTE 
										COPYBUTTONEVENTFN]
							       ((LASTMOUSESTATE (ONLY RIGHT))
								 (fetch RIGHTBUTTONFN of \MHWINDOW))
							       (T (fetch BUTTONEVENTFN of \MHWINDOW]
							   (\PROTECTED.APPLY \MHCOM \MHWINDOW)
							   (GO RESETBUTTONS]
						     ((SETQ \MHCOM (fetch (WINDOW CURSORMOVEDFN)
								      of \MHWINDOW))
                                                             (* cursor must have moved.)
						       (ERSETQ (DOUSERFNS \MHCOM \MHWINDOW]
					(T                   (* look for button change or cursor moving in 
							     background)
					   (COND
					     [(NEQ LASTMOUSEBUTTONS \LastWindowButtons)
                                                             (* Button change within background)
					       (COND
						 ((AND (NULL \MHWINDOW)
						       (.COPYKEYDOWNP.)
						       BACKGROUNDCOPYBUTTONEVENTFN
						       (GETD BACKGROUNDCOPYBUTTONEVENTFN))
						   (\PROTECTED.APPLY BACKGROUNDCOPYBUTTONEVENTFN))
						 ((AND BACKGROUNDBUTTONEVENTFN (GETD 
									  BACKGROUNDBUTTONEVENTFN))
						   (\PROTECTED.APPLY BACKGROUNDBUTTONEVENTFN]
					     ((AND BACKGROUNDCURSORMOVEDFN (GETD 
									  BACKGROUNDCURSORMOVEDFN))
                                                             (* cursor must have moved.)
					       (\PROTECTED.APPLY BACKGROUNDCURSORMOVEDFN]
			    (RETURN)
			RESETBUTTONS                         (* Look at mouse again, since user fn may have waited 
							     for mouse to come up)
			    (GETMOUSESTATE)
			    (SETQ \LastWindowButtons LASTMOUSEBUTTONS)
			    (RETURN])

(\PROTECTED.APPLY
  [LAMBDA (FN WINDOW)                                        (* bvm: "20-Apr-84 16:20")
    (DECLARE (LOCALVARS . T))

          (* * Apply FN to WINDOW under an errorset to trap errors)


    (ERSETQ (APPLY* FN WINDOW])

(DOWINDOWCOM
  [LAMBDA (WINDOW)                                           (* lmm " 8-May-84 17:51")
                                                             (* the button handler for the window system.)
    (COND
      [(type? WINDOW WINDOW)
	(PROG ($$VAR)
	      (COND
		((SETQ $$VAR (WINDOWPROP WINDOW (QUOTE DOWINDOWCOMFN)))
		  (RETURN (APPLY* $$VAR WINDOW)))
		(T (\CHECKCARET WINDOW)
		   (TOTOPW WINDOW)
		   (RETURN (COND
			     ([SETQ $$VAR
				 (MENU (COND
					 ((type? MENU WindowMenu)
					   WindowMenu)
					 (T (SETQ WindowMenu
					      (create MENU
						      ITEMS ← WindowMenuCommands
						      CHANGEOFFSETFLG ←(QUOTE Y)
						      MENUOFFSET ←(create POSITION
									  XCOORD ← -1
									  YCOORD ← 0)
						      WHENHELDFN ←(FUNCTION PPROMPT3)
						      WHENUNHELDFN ←(FUNCTION CLRPROMPT)
						      CENTERFLG ← T]
			       (APPLY* $$VAR WINDOW)
			       T]
      ((NULL WINDOW)
	(DOBACKGROUNDCOM])

(DOBACKGROUNDCOM
  [LAMBDA NIL                                                (* rrb " 7-AUG-83 18:50")
                                                             (* something has happened and the cursor is not in a 
							     window. Default is bring up background menu if button is
							     down.)
    (COND
      ((MOUSESTATE RIGHT)
	(PROG (FORM)
	      (AND [SETQ FORM (MENU (COND
				      ((type? MENU BackgroundMenu)
					BackgroundMenu)
				      (T (SETQ BackgroundMenu
					   (create MENU
						   ITEMS ← BackgroundMenuCommands
						   CHANGEOFFSETFLG ←(QUOTE Y)
						   MENUOFFSET ←(create POSITION
								       XCOORD ← -1
								       YCOORD ← 0)
						   WHENHELDFN ←(FUNCTION PPROMPT3)
						   WHENUNHELDFN ←(FUNCTION CLRPROMPT)
						   CENTERFLG ← T]
		   (ERSETQ (EVAL FORM])

(DEFAULT.BACKGROUND.COPYFN
  [LAMBDA NIL                                                (* rrb "16-Jul-84 19:27")
                                                             (* the default function called when the right button 
							     goes down in the background and the copy key is held 
							     down.)
    (COND
      ((MOUSESTATE (NOT UP))
	(PROG (FORM)
	      (AND [SETQ FORM (MENU (COND
				      ((type? MENU BackgroundCopyMenu)
					BackgroundCopyMenu)
				      (T (SETQ BackgroundCopyMenu
					   (create MENU
						   ITEMS ← BackgroundCopyMenuCommands
						   CHANGEOFFSETFLG ←(QUOTE Y)
						   MENUOFFSET ←(create POSITION
								       XCOORD ← -1
								       YCOORD ← 0)
						   CENTERFLG ← T]
		   (ERSETQ (EVAL FORM])
)

(RPAQ BACKGROUNDCOPYRIGHTBUTTONEVENTFN (FUNCTION DEFAULT.BACKGROUND.COPYFN))

(RPAQQ BackgroundCopyMenu NIL)

(RPAQ? BackgroundCopyMenuCommands NIL)
(DEFINEQ

(BURYW
  [LAMBDA (WINDOW)                                           (* rrb " 2-May-84 16:14")
                                                             (* HACK: Puts WINDOW at the bottom by putting everything
							     that touches it to the top!)
    (SETQ WINDOW (\INSUREWINDOW WINDOW))
    (PROG ((OVERLAPPINGWINDOWS (ORDERFROMBOTTOMTOTOP (OVERLAPPINGWINDOWS WINDOW)))
	   ABOVEWINDOWS ATWINS)
          [SETQ ABOVEWINDOWS (REMOVE WINDOW (LDIFFERENCE OVERLAPPINGWINDOWS (SETQ ATWINS
							   (ALLATTACHEDWINDOWS WINDOW]

          (* close them in order from the top. This should be the fastest since they would have to come to the top to be 
	  closed anyway.)


          (for W in (REVERSE OVERLAPPINGWINDOWS) do (\CLOSEW1 W))
          (\OPENW1 WINDOW)                                   (* put attached windows below the other windows.)
          (for W in ATWINS do (\OPENW1 W))                   (* finally open the other windows.)
          (for W in ABOVEWINDOWS do (\OPENW1 W))
          (RETURN WINDOW])

(CLEARW
  [LAMBDA (WINDOW)                                           (* rrb "27-AUG-82 11:28")

          (* clears a window to its background shade, resets its offsets to 0,0 in the lower left corner and resets the 
	  position to the upper left {first line of text}.)


    (WXOFFSET (WXOFFSET NIL (SETQ WINDOW (\INSUREWINDOW WINDOW)))
	      WINDOW)
    (WYOFFSET (WYOFFSET NIL WINDOW)
	      WINDOW)
    (DSPRESET (fetch DSP of WINDOW])

(CLOSEW
  [LAMBDA (WINDOW)                                           (* rrb " 1-May-85 14:11")
                                                             (* closes a window. saves the current state in the 
							     WINDOW and allow it to be reOPENWed.)
    (SETQ WINDOW (\INSUREWINDOW WINDOW))
    (COND
      ((OPENWP WINDOW)
	(COND
	  ((\OKTOCLOSEW WINDOW)                              (* one of the CLOSEFNs may have closed the window.
							     If so, don't reopen it.)
	    (AND (OPENWP WINDOW)
		 (\CLOSEW1 WINDOW])

(\CLOSEW1
  [LAMBDA (WINDOW)                                           (* hdj "14-Oct-85 14:44")
                                                             (* actually does the closing operation.
							     Is used by SHRINKW to avoid the CLOSEFN mechanism.)
    (.WHILE.ON.TOP. WINDOW (\SW2BM (SCREENBITMAP)
				     (fetch (WINDOW REG) of WINDOW)
				     (fetch (WINDOW SAVE) of WINDOW)
				     NIL)
		    (COND
		      ((SETQ TOPW (fetch (WINDOW NEXTW) of WINDOW))
			(SETQ \TOPWDS (fetch (WINDOW DSP) of TOPW)))
		      (T                                     (* users is closing the last window.
							     make sure \TOPWDS is NIL also.)
			 (SETQ \TOPWDS NIL)))              (* smash the window's link to other's in the chain.)
		    (if (WINDOWPROP WINDOW (QUOTE OPEN-ON-WRITE-MODE))
			then (replace (WINDOW NEXTW) of WINDOW with (QUOTE CANOPEN))
		      else (\MAKE.CLOSED.WINDOW.WRITABLE WINDOW])

(\OKTOCLOSEW
  [LAMBDA (WINDOW)                                           (* rrb "14-JUN-82 12:40")
                                                             (* calls the windows closefns.
							     Returns T if it is ok to close the window.)
    (COND
      ((EQ (DOUSERFNS (fetch (WINDOW CLOSEFN) of WINDOW)
		      WINDOW T)
	   (QUOTE DON'T))
	NIL)
      (T WINDOW])

(OPENW
  [LAMBDA (WINDOW)                                           (* rrb "28-JUN-83 11:52")

          (* opens a window by putting on the window stack and putting its bits on the screen. Returns the window if it was 
	  actually opened.)


    (SETQ WINDOW (\INSUREWINDOW WINDOW))
    (COND
      ((OPENWP WINDOW)                                       (* used to bring the window to top but doesn't since 
							     TOTOPW has been documented.)
	NIL)
      (T (PROG [(USEROPENFN (WINDOWPROP WINDOW (QUOTE OPENFN]
	       (COND
		 ((\USERFNISDON'T USEROPENFN)                (* one of the OPENFNs is DON'T)
		   NIL)
		 (T                                          (* open it by putting it on top and swapping its bits 
							     in)
		    (\OPENW1 WINDOW)                         (* call the openfns after the window has been opened.)
		    (DOUSERFNS USEROPENFN WINDOW)
		    (RETURN WINDOW])

(DOUSERFNS
  [LAMBDA (FNLST WINDOW CHECKFORDON'TFLG)                    (* rrb "20-Mar-84 16:18")

          (* applys a list of user functins and If CHECKFORDON'TFLG is non-NIL, it stops if don't is returned as one of the 
	  values and returns DON'T)


    (DECLARE (GLOBALVARS LAMBDASPLST))
    (COND
      [(OR (NLISTP FNLST)
	   (FMEMB (CAR FNLST)
		  LAMBDASPLST))
	(COND
	  ((AND CHECKFORDON'TFLG (EQ FNLST (QUOTE DON'T)))
	    (QUOTE DON'T))
	  (FNLST (AND (EQ (APPLY* FNLST WINDOW)
			  (QUOTE DON'T))
		      (QUOTE DON'T]
      ((AND CHECKFORDON'TFLG (FMEMB (QUOTE DON'T)
				    FNLST))
	(QUOTE DON'T))
      ((for USERFN in FNLST when (EQ (APPLY* USERFN WINDOW)
				     (QUOTE DON'T))
	  do                                                 (* return if any of the openfns says don't)
	     (AND CHECKFORDON'TFLG (RETURN (QUOTE DON'T])

(DOUSERFNS2
  [LAMBDA (FNLST WINDOW ARG1 ARG2 ARG3)                      (* rrb " 3-Jul-84 15:59")
                                                             (* applys a list of user functions to two arguments.
							     This is used by SHAPEW.)
    (DECLARE (GLOBALVARS LAMBDASPLST))
    (COND
      [(OR (NLISTP FNLST)
	   (FMEMB (CAR FNLST)
		  LAMBDASPLST))
	(COND
	  (FNLST (APPLY* FNLST WINDOW ARG1 ARG2 ARG3]
      ((for USERFN in FNLST do (APPLY* USERFN WINDOW ARG1 ARG2 ARG3])

(\USERFNISDON'T
  [LAMBDA (USERFN)                                           (* rrb "18-JUN-82 12:16")
                                                             (* determines if one of the userfunction is DON'T)
    (COND
      ((NLISTP USERFN)
	(EQ USERFN (QUOTE DON'T)))
      (T (FMEMB (QUOTE DON'T)
		USERFN])

(\OPENW1
  [LAMBDA (WINDOW)                                           (* hdj "14-Oct-85 11:04")
    (DECLARE (GLOBALVARS SCREENWIDTH))
    (UNINTERRUPTABLY                                         (*)
	(\RESTORE.CLOSED.WINDOW WINDOW)
	(replace (WINDOW NEXTW) of WINDOW with TOPW)
	(SETQ TOPW WINDOW)
	(SETQ \TOPWDS (fetch (WINDOW DSP) of TOPW))
	(replace (PILOTBBT PBTDESTBPL) of (fetch (\DISPLAYDATA DDPILOTBBT) of (\GETDISPLAYDATA
											WINDOW))
	   with SCREENWIDTH)                               (* changed from (SCREENBITMAP) to destination in 
							     preparation for multiple screens.)
                                                             (* Assume that the DSP of a window is guaranteed to be
							     a display-stream)
	(\SW2BM (fetch DDDestination of (fetch IMAGEDATA of \TOPWDS))
		  (fetch (WINDOW REG) of WINDOW)
		  (fetch (WINDOW SAVE) of WINDOW)
		  NIL))])

(CREATEW
  [LAMBDA (REGION TITLE BORDERSIZE NOOPENFLG)                (* rrb "27-OCT-83 11:15")
    (PROG (REG DSP DISPLAYDATA (TITLEHEIGHT (COND
					      (TITLE (IMINUS (DSPLINEFEED NIL 
									 WindowTitleDisplayStream)))
					      (T 0)))
	       WINDOW
	       (WBORDER (OR (NUMBERP BORDERSIZE)
			    WBorder)))
          [COND
	    [(AND (DISPLAYSTREAMP REGION)
		  (EQ (SCREENBITMAP)
		      (DSPDESTINATION NIL DSP)))
	      (SETQ DSP REGION)
	      (SETQ DISPLAYDATA (fetch IMAGEDATA of DSP))
	      (SETQ REG (ffetch DDClippingRegion of DISPLAYDATA))
                                                             (* adjust region by offsets and reduce to size screen.
							     (destination bitmap.))
	      (SETQ REG (create REGION
				LEFT ←(IDIFFERENCE (IMAX (IPLUS (fetch DDXOFFSET of DISPLAYDATA)
								(fetch (REGION LEFT) of REG))
							 0)
						   WBORDER)
				BOTTOM ←(IDIFFERENCE (IMAX (IPLUS (ffetch DDYOFFSET of DISPLAYDATA)
								  (fetch (REGION BOTTOM)
								     of REG))
							   0)
						     WBORDER)
				WIDTH ←(IPLUS (IMIN SCREENWIDTH (fetch (REGION WIDTH) of REG))
					      (UNFOLD WBORDER 2))
				HEIGHT ←(IPLUS (IMIN (IDIFFERENCE SCREENHEIGHT TITLEHEIGHT)
						     (fetch (REGION HEIGHT) of REG))
					       (UNFOLD WBORDER 2)
					       TITLEHEIGHT]
	    (T [SETQ REG (COND
		   ((type? REGION REGION)                    (* Copy so that smash-happy user won't clobber the 
							     window system smashing the region he gives us.)
		     (create REGION using REGION))
		   (T (AND TITLE (printout PROMPTWINDOW T "Specify region for window %"" TITLE "%""))
		      (PROG1 (GETREGION MinWindowWidth MinWindowHeight)
			     (AND TITLE (CLRPROMPT]
	       (SETQ DSP (DSPCREATE))
	       (SETQ DISPLAYDATA (fetch IMAGEDATA of DSP]
          (OR (type? REGION REG)
	      (HELP "Not a region" REG))
          (OR (IGREATERP (IMIN (fetch (REGION WIDTH) of REG)
			       (fetch (REGION HEIGHT) of REG))
			 (UNFOLD WBORDER 2))
	      (ERROR "Region too small to use as a window" REG))
          (DSPDESTINATION (SCREENBITMAP)
			  DSP)
          (SETQ WINDOW (create WINDOW
			       DSP ← DSP
			       REG ← REG
			       SAVE ←(BITMAPCREATE (fetch (REGION WIDTH) of REG)
						   (fetch (REGION HEIGHT) of REG))
			       WTITLE ← TITLE
			       WBORDER ← WBORDER
			       NEXTW ←(QUOTE CLOSED)))
          (replace XWINDOWHINT of DISPLAYDATA with WINDOW)
          (ADVISEWDS WINDOW)
          (MOVETOUPPERLEFT WINDOW)
          (SHOWWFRAME WINDOW)
          (COND
	    ((NOT NOOPENFLG)
	      (OPENW WINDOW)))
          (RETURN WINDOW])

(MOVEW
  [LAMBDA (WINDOW POSorX Y)                                  (* jow "16-Aug-85 11:53")
                                                             (* moves a window. If window is closed and position is 
							     given, it won't open the window.
							     It also calls the window's MOVEFN property.)
    (SETQ WINDOW (\INSUREWINDOW WINDOW))
    (PROG ((OLDREGION (fetch REG of WINDOW))
	   (USERMOVEFN (fetch (WINDOW MOVEFN) of WINDOW))
	   (OPEN? (OPENWP WINDOW))
	   POS NEWREGION OLDLEFT OLDBOTTOM OLDWIDTH OLDHEIGHT OLDCLIPREGION LFT BTM REG FN)
          (COND
	    ([COND
		((LISTP USERMOVEFN)
		  (FMEMB (QUOTE DON'T)
			 USERMOVEFN))
		(T (EQ USERMOVEFN (QUOTE DON'T]
	      (PROMPTPRINT "Can't move this window.")
	      (RETURN)))
          [COND
	    ((NOT (SUBREGIONP OLDREGION WHOLEDISPLAY))       (* use T as an indication that the window was 
							     completely off screen.)
	      (SETQ OLDCLIPREGION (OR (\ONSCREENCLIPPINGREGION WINDOW)
				      T]
          (SETQ OLDLEFT (fetch (REGION LEFT) of OLDREGION))
          (SETQ OLDBOTTOM (fetch (REGION BOTTOM) of OLDREGION))
          (SETQ OLDWIDTH (fetch (REGION WIDTH) of OLDREGION))
          (SETQ OLDHEIGHT (fetch (REGION HEIGHT) of OLDREGION))
          (COND
	    ([AND POSorX (SETQ POS (COND
		      ((POSITIONP POSorX)
			POSorX)
		      [(NUMBERP POSorX)
			(COND
			  ((NUMBERP Y)
			    (create POSITION
				    XCOORD ← POSorX
				    YCOORD ← Y))
			  (T (\ILLEGAL.ARG Y]
		      ((REGIONP POSorX)
			(create POSITION
				XCOORD ←(fetch (REGION LEFT) of POSorX)
				YCOORD ←(fetch (REGION BOTTOM) of POSorX)))
		      (T (\ILLEGAL.ARG POSorX]               (* if not aready open, don't)
	      (AND OPEN? (TOTOPW WINDOW)))
	    (T                                               (* no position to move to has been given, ask user for 
							     one.)
	       (TOTOPW WINDOW)                               (* TOTOPW opens the window if it is not already.)
	       [COND
		 [[AND (SETQ FN (WINDOWPROP WINDOW (QUOTE CALCULATEREGIONFN)))
		       (SETQ REG (APPLY* FN WINDOW (QUOTE MOVEW]
                                                             (* prompt with a region that is calculated by the 
							     window)
		   [SETQ POS (GETBOXPOSITION (fetch (REGION WIDTH) of REG)
					     (fetch (REGION HEIGHT) of REG)
					     (SETQ LFT (fetch (REGION LEFT) of REG))
					     (SETQ BTM (fetch (REGION BOTTOM) of REG]
                                                             (* use a position that is offset by the same amount as 
							     the calculated region was from the window's region.)
		   (SETQ POS (create POSITION
				     XCOORD ←(IPLUS (fetch (POSITION XCOORD) of POS)
						    (IDIFFERENCE OLDLEFT LFT))
				     YCOORD ←(IPLUS (fetch (POSITION YCOORD) of POS)
						    (IDIFFERENCE OLDBOTTOM BTM]
		 (T (SETQ POS (GETBOXPOSITION OLDWIDTH OLDHEIGHT OLDLEFT OLDBOTTOM]
	       (SETQ OPEN? T)))
          [COND
	    ((AND (LISTP USERMOVEFN)
		  (NOT (FMEMB (CAR USERMOVEFN)
			      LAMBDASPLST)))
	      (AND (EQ [for MFN in USERMOVEFN
			  do (SETQ NEWREGION (APPLY* MFN WINDOW POS))
			     (COND
			       ((EQ NEWREGION (QUOTE DON'T))
				 (RETURN (QUOTE DON'T)))
			       ((POSITIONP NEWREGION)
				 (SETQ POS NEWREGION]
		       (QUOTE DON'T))
		   (RETURN)))
	    (USERMOVEFN (SETQ NEWREGION (APPLY* USERMOVEFN WINDOW POS))
			(COND
			  ((EQ NEWREGION (QUOTE DON'T))
			    (RETURN))
			  ((POSITIONP NEWREGION)
			    (SETQ POS NEWREGION]
          (COND
	    ((OR (NEQ (fetch XCOORD of POS)
		      OLDLEFT)
		 (NEQ (fetch YCOORD of POS)
		      OLDBOTTOM))
	      (SETQ NEWREGION (create REGION
				      LEFT ←(fetch (POSITION XCOORD) of POS)
				      BOTTOM ←(fetch (POSITION YCOORD) of POS)
				      WIDTH ← OLDWIDTH
				      HEIGHT ← OLDHEIGHT))
	      (UNINTERRUPTABLY
                  [COND
		    (OPEN?                                   (* if window is open, move it to top as its MOVEFN may 
							     have changed things and swap its bits to its new 
							     location)
			   (.WHILE.ON.TOP. WINDOW (\SW2BM (SCREENBITMAP)
							  OLDREGION
							  (fetch SAVE of WINDOW)
							  NIL)
					   (\SW2BM (fetch SAVE of WINDOW)
						   NIL
						   (SCREENBITMAP)
						   NEWREGION]
		  (replace REG of WINDOW with NEWREGION)
		  (ADVISEWDS WINDOW OLDREGION T))
	      [COND
		((AND (WINDOWPROP WINDOW (QUOTE REPAINTFN))
		      OLDCLIPREGION)                         (* redisplay those parts that were off the screen.)
		  (COND
		    ((EQ OLDCLIPREGION T)                    (* whole window was off.)
		      (REDISPLAYW WINDOW NIL T))
		    (T (PROG ((NEWCLIPPINGREGION (\ONSCREENCLIPPINGREGION WINDOW))
			      NCL OCL NCB OCB OCR NCR OCW NCW OCH NCH OCT NCT)
                                                             (* the title may be the only thing now on the screen.)
			     (OR NEWCLIPPINGREGION (RETURN))
			     (SETQ NCB (fetch (REGION BOTTOM) of NEWCLIPPINGREGION))
			     (SETQ OCB (fetch (REGION BOTTOM) of OLDCLIPREGION))
			     (SETQ OCW (fetch (REGION WIDTH) of OLDCLIPREGION))
			     (SETQ NCW (fetch (REGION WIDTH) of NEWCLIPPINGREGION))
			     (SETQ OCH (fetch (REGION HEIGHT) of OLDCLIPREGION))
			     (SETQ NCH (fetch (REGION HEIGHT) of NEWCLIPPINGREGION))
			     [COND
			       ((ILESSP (SETQ NCL (fetch (REGION LEFT) of NEWCLIPPINGREGION))
					(SETQ OCL (fetch (REGION LEFT) of OLDCLIPREGION)))
				 (REDISPLAYW WINDOW (CREATEREGION NCL OCB (IDIFFERENCE OCL NCL)
								  OCH]
			     [COND
			       ((ILESSP (SETQ OCR (IPLUS OCL OCW))
					(SETQ NCR (IPLUS NCL NCW)))
                                                             (* some stuff appeared from the right.)
				 (REDISPLAYW WINDOW (CREATEREGION OCR OCB (IDIFFERENCE NCR OCR)
								  OCH]
			     [COND
			       ((ILESSP NCB OCB)
				 (REDISPLAYW WINDOW (CREATEREGION NCL NCB NCW (IDIFFERENCE OCB NCB]
			     [COND
			       ((ILESSP (SETQ OCT (IPLUS OCB OCH))
					(SETQ NCT (IPLUS NCB NCH)))
                                                             (* some stuff appeared from the top)
				 (REDISPLAYW WINDOW (CREATEREGION NCL OCT NCW (IDIFFERENCE NCT OCT]
			     (COND
			       ((IGREATERP (IPLUS OLDBOTTOM OLDHEIGHT)
					   SCREENHEIGHT)     (* should reshow the title but don't have any entry for
							     that.)
				 NIL]
	      (DOUSERFNS (WINDOWPROP WINDOW (QUOTE AFTERMOVEFN))
			 WINDOW)))
          (RETURN POS])

(\ONSCREENCLIPPINGREGION
  [LAMBDA (WIN)                                              (* rmk: "30-AUG-83 13:20")
                                                             (* returns a region which is the part of the windows 
							     clipping region that is on the screen.)
    (INTERSECTREGIONS (DSPCLIPPINGREGION NIL WIN)
		      (\DSPUNTRANSFORMREGION WHOLEDISPLAY (fetch IMAGEDATA
							     of (WINDOWPROP WIN (QUOTE DSP])

(RELMOVEW
  [LAMBDA (WINDOW POS)                                       (* rrb "13-JUN-82 15:54")
                                                             (* Move WINDOW by relative DX DY)
    (PROG [(WINREG (WINDOWPROP WINDOW (QUOTE REGION]
          (MOVEW WINDOW (create POSITION
				XCOORD ←(IPLUS (fetch LEFT of WINREG)
					       (fetch (POSITION XCOORD) of POS))
				YCOORD ←(IPLUS (fetch BOTTOM of WINREG)
					       (fetch (POSITION YCOORD) of POS])

(PAINTW
  [LAMBDA (WINDOW)                                           (* mpl "21-Jul-85 14:15")
                                                             (* allows the user to paint with the cursor)
                                                             (* should make sure cursor has moved or a button has 
							     change before proceeding with the inner loop.)
                                                             (* has some of the stuff to allow the brush to be an 
							     arbitrary bitmap but not all.)
    (SETQ WINDOW (\INSUREWINDOW WINDOW))
    (printout PROMPTWINDOW 
"Left button paints;  Middle button erases.
Right button pops up a command menu.
To stop, select the QUIT command.")
    (RESETLST (RESETSAVE NIL (LIST (QUOTE CURSOR)
				   (CURSOR)))
	      (PROG (BRUSH DS HOTX HOTY (SCRATCHCURSOR (CURSORCREATE (BITMAPCREATE CURSORWIDTH 
										   CURSORHEIGHT)
								     0 0)))
		    (TOTOPW WINDOW)                          (* look for a previously stored brush.)
		    [COND
		      ((SETQ BRUSH (WINDOWPROP WINDOW (QUOTE PAINTBRUSH)))
			(SETQ PAINTCOMMANDMODE (CAR BRUSH))
			(SETQ PAINTCOMMANDSHADE (CADR BRUSH))
			(SETQ PAINTCOMMANDBRUSH (CADDR BRUSH]
		    (SETQ DS (fetch DSP of WINDOW))
		BRUSHLP
		    [SETQ BRUSH (COND
			((BITMAPP PAINTCOMMANDBRUSH))
			(T (\GETBRUSH PAINTCOMMANDBRUSH]     (* clear cursor)
		    (BITBLT NIL NIL NIL (fetch CURSORBITMAP of SCRATCHCURSOR)
			    0 0 CURSORWIDTH CURSORHEIGHT (QUOTE TEXTURE)
			    (QUOTE REPLACE)
			    WHITESHADE)                      (* put lower left part of brush shape in cursor)
		    (BITBLT BRUSH 0 0 (fetch CURSORBITMAP of SCRATCHCURSOR)
			    0 0 CURSORWIDTH CURSORHEIGHT (QUOTE INPUT)
			    (QUOTE REPLACE))                 (* set the hot spot to the middle of the brush.)
		    [replace CURSORHOTSPOT of SCRATCHCURSOR
		       with (create POSITION
				    XCOORD ←(SETQ HOTX (HALF (IMIN (fetch BITMAPWIDTH of BRUSH)
								   CURSORWIDTH)))
				    YCOORD ←(SETQ HOTY (HALF (IMIN (fetch BITMAPHEIGHT of BRUSH)
								   CURSORHEIGHT]
		    (SETCURSOR SCRATCHCURSOR)
		PAINTLP
		    (GETMOUSESTATE)
		    [COND
		      [(LASTMOUSESTATE RIGHT)
			(COND
			  ((OR (INSIDE? (DSPCLIPPINGREGION NIL DS)
					(LASTMOUSEX DS)
					(LASTMOUSEY DS))
			       (NOT (WHICHW LASTMOUSEX LASTMOUSEY)))
                                                             (* inside the interior, give command menu)
			    (SELECTQ [MENU (COND
					     ((type? MENU PAINTCOMMANDMENU)
					       PAINTCOMMANDMENU)
					     (T (SETQ PAINTCOMMANDMENU
						  (create MENU
							  ITEMS ←(QUOTE ((SetMode (QUOTE MODE)
										  
						"Allows specification of how new bits are merged")
									  (SetShade (QUOTE SHADE)
										    
							     "Allows specification of new shade.")
									  (SetShape (QUOTE SHAPE)
										    
							    "Allows specification of brush shape")
									  (SetSize (QUOTE SIZE)
										   
							 "Allows specification of the brush size")
									  (QUIT (QUOTE QUIT)
										"Exits painting mode"]
				     (SHADE (SETQ PAINTCOMMANDSHADE (OR (PAINTW.READBRUSHSHADE)
									PAINTCOMMANDSHADE))
					    (GO BRUSHLP))
				     (MODE (SETQ PAINTCOMMANDMODE (OR (PAINTW.READMODE)
								      PAINTCOMMANDMODE))
					   (GO BRUSHLP))
				     (SHAPE (RPLACA PAINTCOMMANDBRUSH (OR (PAINTW.READBRUSHSHAPE)
									  (CAR PAINTCOMMANDBRUSH)))
					    (GO BRUSHLP))
				     (SIZE (RPLACA (CDR PAINTCOMMANDBRUSH)
						   (OR (PAINTW.READBRUSHSIZE)
						       (CADR PAINTCOMMANDBRUSH)))
					   (GO BRUSHLP))
				     (QUIT (RETURN))
				     NIL))
			  (T                                 (* do the window menu)
			     (DOWINDOWCOM (WHICHW LASTMOUSEX LASTMOUSEY]
		      [(AND (LASTMOUSESTATE LEFT)
			    (OR (EQ PAINTCOMMANDMODE (QUOTE REPLACE))
				(NEQ PAINTCOMMANDSHADE BLACKSHADE)))
                                                             (* painting in grey is slightly harder.)
			(COND
			  ((EQ PAINTCOMMANDMODE (QUOTE REPLACE))
                                                             (* erase what is there now)
			    (BITBLT BRUSH 0 0 DS (IDIFFERENCE (LASTMOUSEX DS)
							      HOTX)
				    (IDIFFERENCE (LASTMOUSEY DS)
						 HOTY)
				    NIL NIL (QUOTE INPUT)
				    (QUOTE ERASE))           (* put in grey)
			    (BITBLT BRUSH 0 0 DS (IDIFFERENCE (LASTMOUSEX DS)
							      HOTX)
				    (IDIFFERENCE (LASTMOUSEY DS)
						 HOTY)
				    NIL NIL (QUOTE MERGE)
				    (QUOTE PAINT)
				    PAINTCOMMANDSHADE))
			  (T (BITBLT BRUSH 0 0 DS (IDIFFERENCE (LASTMOUSEX DS)
							       HOTX)
				     (IDIFFERENCE (LASTMOUSEY DS)
						  HOTY)
				     NIL NIL (QUOTE MERGE)
				     PAINTCOMMANDMODE PAINTCOMMANDSHADE]
		      ((LASTMOUSESTATE (OR MIDDLE LEFT))
			(BITBLT BRUSH 0 0 DS (IDIFFERENCE (LASTMOUSEX DS)
							  HOTX)
				(IDIFFERENCE (LASTMOUSEY DS)
					     HOTY)
				NIL NIL (QUOTE INPUT)
				(COND
				  ((LASTMOUSESTATE MIDDLE)
				    (QUOTE ERASE))
				  (T PAINTCOMMANDMODE]
		    (GO PAINTLP))
	      (CLRPROMPT)
	      (WINDOWPROP WINDOW (QUOTE PAINTBRUSH)
			  (LIST PAINTCOMMANDMODE PAINTCOMMANDSHADE (COPY PAINTCOMMANDBRUSH])

(PAINTW.READMODE
  [LAMBDA NIL                                                (* rrb " 1-DEC-82 17:29")
    (MENU (COND
	    ((type? MENU PAINTMODEMENU)
	      PAINTMODEMENU)
	    (T (SETQ PAINTMODEMENU (create MENU
					   ITEMS ←(QUOTE ((REPLACE (QUOTE REPLACE)
								   
						 "the screen bits are replaced by the brush bits")
							   (INVERT (QUOTE INVERT)
								   
					      "the screen bits inverted whereever brush bits are")
							   (ADD (QUOTE PAINT)
								
					     "the brush bits are added to the bits on the screen"])

(PAINTW.READBRUSHSHAPE
  [LAMBDA NIL                                                (* rrb " 1-DEC-82 17:29")
    (MENU (COND
	    ((type? MENU PAINTSHAPEMENU)
	      PAINTSHAPEMENU)
	    (T (SETQ PAINTSHAPEMENU (create MENU
					    ITEMS ←(QUOTE (DIAGONAL VERTICAL HORIZONTAL SQUARE ROUND])

(PAINTW.READBRUSHSIZE
  [LAMBDA NIL                                                (* rrb " 1-DEC-82 17:30")
    (MENU (COND
	    ((type? MENU PAINTSIZEMENU)
	      PAINTSIZEMENU)
	    (T (SETQ PAINTSIZEMENU (create MENU
					   ITEMS ←(QUOTE (16 8 4 2 1])

(SHAPEW
  [LAMBDA (WINDOW NEWREGION)                                 (* jow "26-Aug-85 13:46")

          (* entry that shapes a window checking the userfns for DON'T and interacting to get a region if necessary.
	  This also checks for a user function to do the actual reshaping. look for a function on windowprop INITCORNERSFN, 
	  which will take the window and return the initcorners for the window, to be passed to getregion.)


    (SETQ WINDOW (\INSUREWINDOW WINDOW))
    (PROG (USERFN X)
          (COND
	    ((\USERFNISDON'T (fetch (WINDOW RESHAPEFN) of WINDOW))
                                                             (* don't allow the window to be reshaped.)
	      (PROMPTPRINT "This window cannot be reshaped.")
	      (RETURN NIL)))
          (SETQ X (MINIMUMWINDOWSIZE WINDOW))
          [SETQ X (COND
	      (NEWREGION (COND
			   ((OR (LESSP (fetch (REGION WIDTH) of NEWREGION)
				       (CAR X))
				(LESSP (fetch (REGION HEIGHT) of NEWREGION)
				       (CDR X)))             (* given a region that is too small)
			     (CREATEREGION (fetch (REGION LEFT) of NEWREGION)
					   (fetch (REGION BOTTOM) of NEWREGION)
					   (CAR X)
					   (CDR X)))
			   (T NEWREGION)))
	      ((WINDOWPROP WINDOW (QUOTE INITCORNERSFN))
		(GETREGION (CAR X)
			   (CDR X)
			   (WINDOWREGION WINDOW (QUOTE SHAPEW))
			   (fetch NEWREGIONFN of WINDOW)
			   WINDOW
			   (APPLY* (WINDOWPROP WINDOW (QUOTE INITCORNERSFN))
				   WINDOW)))
	      (T (GETREGION (CAR X)
			    (CDR X)
			    (WINDOWREGION WINDOW (QUOTE SHAPEW))
			    (fetch NEWREGIONFN of WINDOW)
			    WINDOW]
          (RETURN (COND
		    ((SETQ USERFN (WINDOWPROP WINDOW (QUOTE DOSHAPEFN)))
		      (APPLY* USERFN WINDOW X))
		    (T (SHAPEW1 WINDOW X])

(SHAPEW1
  [LAMBDA (WINDOW REGION)                                    (* rrb " 3-Jul-84 15:27")
                                                             (* entry for shaping a window that does the reshape 
							     without checking for a user function.)
    (DECLARE (LOCALVARS . T))
    (SETQ WINDOW (\INSUREWINDOW WINDOW))
    (OR (REGIONP REGION)
	(\ILLEGAL.ARG REGION))
    (PROG ((OLDREGION (fetch REG of WINDOW))
	   (OLDCLIPREG (DSPCLIPPINGREGION NIL (fetch (WINDOW DSP) of WINDOW)))
	   (WBORDER (fetch WBORDER of WINDOW))
	   NUSAV NOWOPEN?)
          (SETQ NUSAV (BITMAPCREATE (fetch (REGION WIDTH) of REGION)
				    (fetch (REGION HEIGHT) of REGION)))
          (UNINTERRUPTABLY
              (COND
		((OPENWP WINDOW)                             (* notice whether window is open or not to call OPENFNs 
							     only if not now open.)
		  (SETQ NOWOPEN? T)
		  (\CLOSEW1 WINDOW)))                        (* Save window image)
	      (replace REG of WINDOW with REGION)
	      [replace SAVE of WINDOW with (PROG1 NUSAV (SETQ NUSAV (fetch SAVE of WINDOW]
	      (ADVISEWDS WINDOW OLDREGION)
	      (SHOWWFRAME WINDOW)
	      (COND
		(NOWOPEN? (\OPENW1 WINDOW))
		(T (OPENW WINDOW))))
          (DOUSERFNS2 (OR (fetch (WINDOW RESHAPEFN) of WINDOW)
			  (FUNCTION RESHAPEBYREPAINTFN))
		      WINDOW NUSAV (create REGION
					   LEFT ← WBORDER
					   BOTTOM ← WBORDER
					   WIDTH ←(fetch (REGION WIDTH) of OLDCLIPREG)
					   HEIGHT ←(fetch (REGION HEIGHT) of OLDCLIPREG))
		      OLDREGION)
          (RETURN WINDOW])

(RESHOWBORDER
  [LAMBDA (BORDER WINDOW)                                    (* rrb "15-JUN-83 14:46")
                                                             (* updates a windows display with a new border)
                                                             (* if the border is the same, don't change anything.)
    (OR (EQ BORDER (fetch (WINDOW WBORDER) of WINDOW))
	(\RESHOWBORDER1 BORDER (fetch (WINDOW WBORDER) of WINDOW)
			WINDOW])

(\RESHOWBORDER1
  [LAMBDA (NEWBORDER OLDBORDER WINDOW)                       (* rrb "17-Aug-84 16:59")

          (* redisplays the border of a window. Is called by RESHOWBORDER and RESHOWTITLE. It doesn't check for equality 
	  between the new and old borders because it is also used when a title is added or deleted.)


    (PROG ((REGION (fetch REG of WINDOW))
	   (OLDSAVE (fetch SAVE of WINDOW))
	   NUSAV DELTA NUWIDTH NUHEIGHT)
          (SETQ DELTA (IDIFFERENCE NEWBORDER OLDBORDER))
          [SETQ NUSAV (BITMAPCREATE (SETQ NUWIDTH (IPLUS (fetch (REGION WIDTH) of REGION)
							 (ITIMES DELTA 2)))
				    (SETQ NUHEIGHT (IDIFFERENCE
					(IPLUS (fetch (REGION HEIGHT)
						  of (DSPCLIPPINGREGION NIL (fetch (WINDOW DSP)
									       of WINDOW)))
					       (ITIMES NEWBORDER 2))
					(COND
					  ((fetch (WINDOW WTITLE) of WINDOW)
					    (DSPLINEFEED NIL WindowTitleDisplayStream))
					  (T 0]
          (.WHILE.ON.TOP. WINDOW                             (* Save window image)
			  (\SW2BM (SCREENBITMAP)
				  REGION
				  (fetch SAVE of WINDOW)
				  NIL)                       (* put new save image into window)
			  (replace SAVE of WINDOW with NUSAV)
			  (replace (WINDOW WBORDER) of WINDOW with NEWBORDER)
                                                             (* create a region that coresponds to the old region 
							     with the new border.)
			  (replace (WINDOW REG) of WINDOW with (create REGION
								       LEFT ←(IDIFFERENCE
									 (fetch (REGION LEFT)
									    of REGION)
									 DELTA)
								       BOTTOM ←(IDIFFERENCE
									 (fetch (REGION BOTTOM)
									    of REGION)
									 DELTA)
								       WIDTH ← NUWIDTH
								       HEIGHT ← NUHEIGHT))
			  (UPDATE/SCROLL/REG WINDOW)         (* draw border in the new image.)
			  (SHOWWFRAME WINDOW)                (* copy the visible part from the old image into the new
							     one.)
			  (BITBLT OLDSAVE OLDBORDER OLDBORDER NUSAV NEWBORDER NEWBORDER
				  (IDIFFERENCE (fetch BITMAPWIDTH of OLDSAVE)
					       (ITIMES 2 OLDBORDER))
				  (fetch (REGION HEIGHT) of (DSPCLIPPINGREGION NIL
									       (fetch (WINDOW DSP)
										  of WINDOW)))
				  (QUOTE INPUT)
				  (QUOTE REPLACE))           (* put the new image up on the screen.)
			  (\SW2BM (SCREENBITMAP)
				  (fetch REG of WINDOW)
				  (fetch SAVE of WINDOW)
				  NIL])

(TRACKW
  [LAMBDA (WINDOW)                                           (* rrb " 9-MAR-82 14:28")
                                                             (* causes a window to follow the cursor.
							     found to be not useful but very pretty for small 
							     windows.)
    (SETQ WINDOW (\INSUREWINDOW WINDOW))
    (RESETFORM (CURSOR CROSSHAIRS)
	       (TOTOPW WINDOW)
	       (until (MOUSESTATE (NOT UP)))
	       (CURSOR LOCKEDSPOT)
	       (bind (DX ←(IDIFFERENCE (fetch (REGION LEFT) of (fetch (WINDOW REG) of WINDOW))
				       LASTMOUSEX))
		     (DY ←(IDIFFERENCE (fetch (REGION BOTTOM) of (fetch (WINDOW REG) of WINDOW))
				       LASTMOUSEY))
		  until (MOUSESTATE UP) do (MOVEW WINDOW (create POSITION
								 XCOORD ←(IPLUS LASTMOUSEX DX)
								 YCOORD ←(IPLUS LASTMOUSEY DY])

(SNAPW
  [LAMBDA NIL                                                (* rrb " 9-Dec-83 15:29")
                                                             (* makes a new window which is a copy of the bits 
							     underneath the REGION read from the user.)
    (PROG ((REG (GETREGION 30 20))
	   NEWWINDOW)
          (OR (type? REGION REG)
	      (HELP "Not a region" REG))
          (SETQ NEWWINDOW (CREATEW (GROW/REGION REG WBorder)
				   NIL NIL T))               (* keep it closed so it doesn't cover any of the bits it
							     is to copy.)
                                                             (* put existing screen bits from SAVE.)
          (BITBLT (SCREENBITMAP)
		  (fetch (REGION LEFT) of REG)
		  (fetch (REGION BOTTOM) of REG)
		  (fetch SAVE of NEWWINDOW)
		  WBorder WBorder (fetch (REGION WIDTH) of REG)
		  (fetch (REGION HEIGHT) of REG)
		  (QUOTE INPUT)
		  (QUOTE REPLACE))
          (OPENW NEWWINDOW)
          (MOVEW NEWWINDOW)
          (RETURN NEWWINDOW])

(WINDOWREGION
  [LAMBDA (WINDOW COM)                                       (* jow "26-Aug-85 13:48")

          (* gets the region that a window wants to consider to be its. COM can be a window com used to help calculate the 
	  region, ie for shaping or moving...)


    (PROG (FN)
          (RETURN (COND
		    ((SETQ FN (WINDOWPROP WINDOW (QUOTE CALCULATEREGIONFN)))
		      (APPLY* FN WINDOW COM))
		    (T (WINDOWPROP WINDOW (QUOTE REGION])
)
(DEFINEQ

(PAINTW.READBRUSHSHADE
  [LAMBDA NIL                                                (* rrb " 7-Oct-85 14:30")
                                                             (* reads a shade)
    (PROG (SHADE)

          (* I removed the 16x16 case because PAINTW uses merge mode and the alignment of 16x16 texture is off in that case.
	  When fixed at the menu item ("16x16 shade" (QUOTE 16X16) "Allows creation of a 16 bits by 16 bits shade"))


	    (SELECTQ (SETQ SHADE (MENU (create MENU
						       CENTERFLG ← T
						       TITLE ← "Choose shade"
						       ITEMS ←[APPEND
							 (for FILLPAT in PAINTW.SHADES
							    collect (LIST (CAR FILLPAT)
									      (KWOTE (CADR 
											  FILLPAT))
									      
								"changes filling to this pattern"))
							 (QUOTE (("4 x 4 shade" (QUOTE 4X4)
										  
						    "Allows creation of a 4 bits by 4 bits shade"]
						       MENUBORDERSIZE ← 1)))
		       (4X4 (RETURN (PAINTW.READ.AND.SAVE.SHADE)))
		       (16X16 (RETURN (PAINTW.READ.AND.SAVE.SHADE T)))
		       (RETURN SHADE])

(PAINTW.READ.AND.SAVE.SHADE
  [LAMBDA (16X16FLG)                                         (* rrb " 4-Oct-85 11:34")
                                                             (* reads a new filling, confirms it with the user and 
							     adds it to PAINTW.SHADES)
    (PROG (SHADE)
	    (COND
	      ([NULL (SETQ SHADE (EDITSHADE (COND
						    (16X16FLG (BITMAPCREATE 16 16]
                                                             (* user aborted)
		(RETURN NIL)))
	    (PAINTW.CACHE.SHADE SHADE)
	    (RETURN SHADE])

(PAINTW.CACHE.SHADE
  [LAMBDA (SHADE)                                            (* rrb " 4-Oct-85 11:32")
                                                             (* adds a shade to the global cache.)
    (OR (for ENTRY in PAINTW.SHADES when (EQUAL (CADR ENTRY)
							  SHADE)
	     do (RETURN T))
	  (COND
	    (PAINTW.SHADES (NCONC1 PAINTW.SHADES (LIST (PAINTW.SHADE.LABEL SHADE)
							   SHADE)))
	    (T (SETQ PAINTW.SHADES (LIST (LIST (PAINTW.SHADE.LABEL SHADE)
						     SHADE)))
	       (QUOTE ADDED])

(PAINTW.SHADE.LABEL
  [LAMBDA (FILLING)                                          (* rrb " 7-Oct-85 14:29")
                                                             (* creates a bitmap label which fills it with the 
							     texture FILLING.)
    (PROG [(BM (BITMAPCREATE (PLUS 8 (STRINGWIDTH "4 x 4 shade" MENUFONT))
				 (FONTPROP MENUFONT (QUOTE HEIGHT]
	    (BLTSHADE FILLING BM)
	    (RETURN BM])
)

(RPAQ? PAINTW.SHADES )
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS PAINTW.SHADES)
)
(DEFINEQ

(MINIMUMWINDOWSIZE
  [LAMBDA (WINDOW)                                           (* rrb "20-NOV-83 12:06")
                                                             (* returns the minimum extent of a window)
    (PROG [(EXT (WINDOWPROP WINDOW (QUOTE MINSIZE]
          [COND
	    [(NULL EXT)
	      (SETQ EXT (CONS MinWindowWidth (HEIGHTIFWINDOW (FONTPROP WINDOW (QUOTE HEIGHT))
							     (WINDOWPROP WINDOW (QUOTE TITLE]
	    ((LITATOM EXT)
	      (SETQ EXT (APPLY* EXT WINDOW]
          [COND
	    [(AND (NUMBERP (CAR EXT))
		  (NUMBERP (CDR EXT]
	    (T (SETQ EXT (ERROR "Illegal extent property" EXT]
          (RETURN EXT])
)

(RPAQ? BACKGROUNDCURSORINFN )

(RPAQ? BACKGROUNDBUTTONEVENTFN )

(RPAQ? BACKGROUNDCURSOROUTFN )

(RPAQ? BACKGROUNDCURSORMOVEDFN )
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS BACKGROUNDCURSORINFN BACKGROUNDBUTTONEVENTFN BACKGROUNDCURSOROUTFN 
	    BACKGROUNDCURSORMOVEDFN \LASTKEYSTATE BACKGROUNDCOPYBUTTONEVENTFN 
	    BACKGROUNDCOPYRIGHTBUTTONEVENTFN \CARET.UP)
)
(* FOLLOWING DEFINITIONS EXPORTED)


(DECLARE: EVAL@COMPILE 
[PUTPROPS .COPYKEYDOWNP. MACRO (NIL (OR (KEYDOWNP (QUOTE LSHIFT))
					(KEYDOWNP (QUOTE RSHIFT))
					(KEYDOWNP (QUOTE COPY]
[PUTPROPS WSOP MACRO (ARGS (LET ((METHOD (CADR (CAR ARGS)))
				 (DISPLAY (CADR ARGS))
				 (OTHERARGS (CDDR ARGS)))
				(BQUOTE (SPREADAPPLY* (fetch (WSOPS , METHOD)
							     of
							     (fetch (FDEV WINDOWOPS)
								    of , DISPLAY))
						      , DISPLAY ,@ OTHERARGS]
)


(* END EXPORTED DEFINITIONS)


(PUTPROPS WSOP ARGNAMES (METHOD DISPLAY . ARGS))
[DECLARE: EVAL@COMPILE 

(RECORD WSOPS (WSCHANGEBACKGROUND WSCHANGEBACKGROUNDBORDER WSDISPLAYHEIGHT STARTCOLOR STOPCOLOR 
				    SETSCREENCOLORMAP COLORLEVEL ROTATECOLORMAP MEDIUM))

(RECORD WSDATA (WSDESTINATION WSREGION WSBACKGROUND WSCOLORMAP))
]



(* image object support - here so that DEDIT can use it without needing TEDIT to be loaded.)

[DECLARE: EVAL@COMPILE 

(DATATYPE IMAGEOBJ (OBJECTDATUM IMAGEOBJPLIST IMAGEOBJFNS))

(DATATYPE IMAGEFNS (DISPLAYFN                              (* FN called to display the object's image)
				IMAGEBOXFN                   (* To tell how big it is)
				PUTFN                        (* To write it onto a file)
				GETFN                        (* To read it back from the file)
				COPYFN                       (* To make a copy of the object)
				BUTTONEVENTINFN              (* Called when the mouse goes down over the object)
				COPYBUTTONEVENTINFN          (* Called when the MIDDLE mouse button goes down over 
							     the object)
				WHENMOVEDFN                  (* Called when the object is moved within a document 
							     or other environment)
				WHENINSERTEDFN               (* Called when the object is inserted into a context)
				WHENDELETEDFN                (* Called when the object is removed from a context)
				WHENCOPIEDFN                 (* Called when the object is copied within a context)
				WHENOPERATEDONFN             (* Called when something interesting happens to the 
							     object)
				PREPRINTFN IMAGECLASSNAME    (* LITATOM unique name by which this kind of IMAGEOBJ 
							     is to be known to the world.)))

(RECORD IMAGEBOX (XSIZE YSIZE YDESC XKERN))
]
(/DECLAREDATATYPE (QUOTE IMAGEOBJ)
		  (QUOTE (POINTER POINTER POINTER))
		  (QUOTE ((IMAGEOBJ 0 POINTER)
			  (IMAGEOBJ 2 POINTER)
			  (IMAGEOBJ 4 POINTER)))
		  (QUOTE 6))
(/DECLAREDATATYPE (QUOTE IMAGEFNS)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER POINTER POINTER POINTER POINTER))
		  (QUOTE ((IMAGEFNS 0 POINTER)
			  (IMAGEFNS 2 POINTER)
			  (IMAGEFNS 4 POINTER)
			  (IMAGEFNS 6 POINTER)
			  (IMAGEFNS 8 POINTER)
			  (IMAGEFNS 10 POINTER)
			  (IMAGEFNS 12 POINTER)
			  (IMAGEFNS 14 POINTER)
			  (IMAGEFNS 16 POINTER)
			  (IMAGEFNS 18 POINTER)
			  (IMAGEFNS 20 POINTER)
			  (IMAGEFNS 22 POINTER)
			  (IMAGEFNS 24 POINTER)
			  (IMAGEFNS 26 POINTER)))
		  (QUOTE 28))
(DEFINEQ

(COPYINSERT
  [LAMBDA (IMAGEOBJ)                                         (* rrb "29-Jun-84 18:31")

          (* * inserts IMAGEOBJ into the window that currently has the tty. If this window has a COPYINSERTFN property, that
	  is called, otherwise BKSYSBUF is called.)


    (PROG ([TTYW (\INSUREWINDOW (WFROMDS (PROCESS.TTY (TTY.PROCESS]
	   INSERTFN)
          (COND
	    ((SETQ INSERTFN (WINDOWPROP TTYW (QUOTE COPYINSERTFN)))
	      (APPLY* INSERTFN IMAGEOBJ TTYW))
	    (T                                               (* IMAGEOBJ can be a list of things too.)
	       (for IMOBJ inside IMAGEOBJ do (BKSYSBUF (OR (COND
							     [(IMAGEOBJP IMOBJ)
							       (COND
								 ((SETQ INSERTFN (IMAGEOBJPROP
								       IMOBJ
								       (QUOTE PREPRINTFN)))
								   (APPLY* INSERTFN IMOBJ))
								 (T (IMAGEOBJPROP IMOBJ (QUOTE 
										      OBJECTDATUM]
							     (T IMOBJ))
							   "")
						       T
						       (PROCESS.EVAL (TTY.PROCESS)
								     (GETREADTABLE)
								     T])

(IMAGEBOX
  [LAMBDA (OBJ STREAM MODE)                                  (* jds " 8-Feb-84 10:48")
    (APPLY* (IMAGEOBJPROP OBJ (QUOTE IMAGEBOXFN))
	    OBJ STREAM MODE])

(IMAGEFNSCREATE
  [LAMBDA (DISPLAYFN IMAGEBOXFN PUTFN GETFN COPYFN BUTTONEVENTINFN COPYBUTTONEVENTINFN WHENMOVEDFN 
		     WHENINSERTEDFN WHENDELETEDFN WHENCOPIEDFN WHENOPERATEDONFN PREPRINTFN CLASSNAME)
                                                             (* jds "19-Feb-85 09:33")
                                                             (* returns a structure which contains the image 
							     functions for a type of image object.)
    [COND
      (GETFN                                                 (* If a GETFN was specified, add it to the list of 
							     known GETFNs, so that people who verify them will know 
							     about it.)
	     (OR (ASSOC GETFN IMAGEOBJGETFNS)
		 (push IMAGEOBJGETFNS (LIST GETFN]
    (create IMAGEFNS
	    DISPLAYFN ← DISPLAYFN
	    IMAGEBOXFN ← IMAGEBOXFN
	    PUTFN ← PUTFN
	    GETFN ← GETFN
	    COPYFN ← COPYFN
	    BUTTONEVENTINFN ← BUTTONEVENTINFN
	    COPYBUTTONEVENTINFN ← COPYBUTTONEVENTINFN
	    WHENMOVEDFN ← WHENMOVEDFN
	    WHENINSERTEDFN ← WHENINSERTEDFN
	    WHENDELETEDFN ← WHENDELETEDFN
	    WHENCOPIEDFN ← WHENCOPIEDFN
	    WHENOPERATEDONFN ← WHENOPERATEDONFN
	    PREPRINTFN ← PREPRINTFN])

(IMAGEFNSP
  [LAMBDA (X)                                                (* rrb " 1-Feb-84 11:13")
                                                             (* is X an IMAGEFNS?)
    (AND (type? IMAGEFNS X)
	 X])

(IMAGEOBJCREATE
  [LAMBDA (OBJECTDATUM IMAGEFNS)                             (* jds " 8-Feb-84 10:20")
                                                             (* returns an image object)
    (OR (IMAGEFNSP IMAGEFNS)
	(\ILLEGAL.ARG IMAGEFNS))                             (* Make sure he handed us a valid set of fn references)
    (create IMAGEOBJ
	    OBJECTDATUM ← OBJECTDATUM
	    IMAGEOBJPLIST ← NIL
	    IMAGEOBJFNS ← IMAGEFNS])

(IMAGEOBJP
  [LAMBDA (X)                                                (* rrb " 1-Feb-84 16:22")
                                                             (* is X an IMAGEOBJ?)
    (AND (type? IMAGEOBJ X)
	 X])

(IMAGEOBJPROP
  [LAMBDA NARGS                                              (* jds "18-Feb-85 18:22")
                                                             (* accesses and sets properties of an IMAGEOBJ.)
    (SELECTQ NARGS
	     ((0 1)
	       (\ILLEGAL.ARG NIL))
	     (PROG ((IMAGEOBJ (ARG NARGS 1))
		    (PROP (ARG NARGS 2))
		    (VAL (AND (IGREATERP NARGS 2)
			      (ARG NARGS 3)))
		    (SET? (NEQ NARGS 2))
		    IMAGEFNS)
	           (COND
		     ((NOT (IMAGEOBJP IMAGEOBJ))
		       (\ILLEGAL.ARG IMAGEOBJ)))
	           (SETQ IMAGEFNS (fetch (IMAGEOBJ IMAGEOBJFNS) of IMAGEOBJ))
	           (RETURN (SELECTQ PROP
				    [OBJECTDATUM (PROG1 (fetch (IMAGEOBJ OBJECTDATUM) of IMAGEOBJ)
							(COND
							  (SET? (replace (IMAGEOBJ OBJECTDATUM)
								   of IMAGEOBJ with VAL]
				    [DISPLAYFN (PROG1 (fetch (IMAGEFNS DISPLAYFN) of IMAGEFNS)
						      (COND
							(SET? (replace (IMAGEFNS DISPLAYFN)
								 of IMAGEFNS with VAL]
				    [IMAGEBOXFN (PROG1 (fetch (IMAGEFNS IMAGEBOXFN) of IMAGEFNS)
						       (COND
							 (SET? (replace (IMAGEFNS IMAGEBOXFN)
								  of IMAGEFNS with VAL]
				    [PUTFN (PROG1 (fetch (IMAGEFNS PUTFN) of IMAGEFNS)
						  (COND
						    (SET? (replace (IMAGEFNS PUTFN) of IMAGEFNS
							     with VAL]
				    [GETFN (PROG1 (fetch (IMAGEFNS GETFN) of IMAGEFNS)
						  (COND
						    (SET? (replace (IMAGEFNS GETFN) of IMAGEFNS
							     with VAL]
				    [COPYFN (PROG1 (fetch (IMAGEFNS COPYFN) of IMAGEFNS)
						   (COND
						     (SET? (replace (IMAGEFNS COPYFN) of IMAGEFNS
							      with VAL]
				    [BUTTONEVENTINFN (PROG1 (fetch (IMAGEFNS BUTTONEVENTINFN)
							       of IMAGEFNS)
							    (COND
							      (SET? (replace (IMAGEFNS 
										  BUTTONEVENTINFN)
								       of IMAGEFNS with VAL]
				    [COPYBUTTONEVENTINFN (PROG1 (fetch (IMAGEFNS COPYBUTTONEVENTINFN)
								   of IMAGEFNS)
								(COND
								  (SET? (replace (IMAGEFNS 
									      COPYBUTTONEVENTINFN)
									   of IMAGEFNS with VAL]
				    [WHENMOVEDFN (PROG1 (fetch (IMAGEFNS WHENMOVEDFN) of IMAGEFNS)
							(COND
							  (SET? (replace (IMAGEFNS WHENMOVEDFN)
								   of IMAGEFNS with VAL]
				    [WHENINSERTEDFN (PROG1 (fetch (IMAGEFNS WHENINSERTEDFN)
							      of IMAGEFNS)
							   (COND
							     (SET? (replace (IMAGEFNS WHENINSERTEDFN)
								      of IMAGEFNS with VAL]
				    [WHENDELETEDFN (PROG1 (fetch (IMAGEFNS WHENDELETEDFN)
							     of IMAGEFNS)
							  (COND
							    (SET? (replace (IMAGEFNS WHENDELETEDFN)
								     of IMAGEFNS with VAL]
				    [WHENCOPIEDFN (PROG1 (fetch (IMAGEFNS WHENCOPIEDFN) of IMAGEFNS)
							 (COND
							   (SET? (replace (IMAGEFNS WHENCOPIEDFN)
								    of IMAGEFNS with VAL]
				    [WHENOPERATEDONFN (PROG1 (fetch (IMAGEFNS WHENOPERATEDONFN)
								of IMAGEFNS)
							     (COND
							       (SET? (replace (IMAGEFNS 
										 WHENOPERATEDONFN)
									of IMAGEFNS with VAL]
				    [PREPRINTFN (PROG1 (fetch (IMAGEFNS PREPRINTFN) of IMAGEFNS)
						       (COND
							 (SET? (replace (IMAGEFNS PREPRINTFN)
								  of IMAGEFNS with VAL]
				    [IMAGECLASSNAME (PROG1 (fetch (IMAGEFNS IMAGECLASSNAME)
							      of IMAGEFNS)
							   (COND
							     (SET? (replace (IMAGEFNS IMAGECLASSNAME)
								      of IMAGEFNS with VAL]
				    (\IMAGEUSERPROP IMAGEOBJ PROP VAL SET?])

(\IMAGEUSERPROP
  [LAMBDA (IMAGEOBJ PROP VAL SET?)                           (* rrb " 1-Feb-84 11:44")
                                                             (* reads and sets the values of properties on an 
							     IMAGEOBJ)
    (PROG ((PLIST (fetch (IMAGEOBJ IMAGEOBJPLIST) of IMAGEOBJ)))
          (RETURN (PROG1 (LISTGET PLIST PROP)
			 (COND
			   (SET? (COND
				   (PLIST (LISTPUT PLIST PROP VAL))
				   (T (replace (IMAGEOBJ IMAGEOBJPLIST) of IMAGEOBJ
					 with (LIST PROP VAL])

(HPRINT.IMAGEOBJ
  [LAMBDA (IMAGEOBJ STREAM)                                  (* rrb "19-Dec-84 16:22")
                                                             (* HPRINT function for writing out IMAGE OBJECTS)
                                                             (* write out the name of the function to read things 
							     back in with.)
    (PRIN2 (LIST (fetch (IMAGEFNS GETFN) of (fetch (IMAGEOBJ IMAGEOBJFNS) of IMAGEOBJ)))
	   STREAM HPRINTRDTBL)
    (APPLY* (fetch (IMAGEFNS PUTFN) of (fetch (IMAGEOBJ IMAGEOBJFNS) of IMAGEOBJ))
	    IMAGEOBJ STREAM)
    T])

(COPYIMAGEOBJ
  [LAMBDA (FROM TO)                                          (* jds "19-Feb-85 09:59")
                                                             (* Copis the contents of one IMAGEOBJ nto another, 
							     effectively making TO be the same object as FROM.)
    (replace (IMAGEOBJ OBJECTDATUM) of TO with (fetch (IMAGEOBJ OBJECTDATUM) of FROM))
    (replace (IMAGEOBJ IMAGEOBJPLIST) of TO with (fetch (IMAGEOBJ IMAGEOBJPLIST) of FROM))
    (replace (IMAGEOBJ IMAGEOBJFNS) of TO with (fetch (IMAGEOBJ IMAGEOBJFNS) of FROM])

(READIMAGEOBJ
  [LAMBDA (STREAM GETFN NOERROR)                             (* jds "19-Feb-85 15:54")
                                                             (* Reads an IMAGEOBJ, using GETFN.
							     Verifies that the GETFN is legitimate)
    (LET* [(ENTRY (ASSOC GETFN IMAGEOBJGETFNS))
       (SUPPORTFILE (LISTGET (CDR ENTRY)
			     (QUOTE FILE]
      [COND
	((OR (NOT GETFN)
	     (NOT (GETD GETFN))
	     (NOT ENTRY))                                    (* This function wasn't specified in the IMAGEOBJTYPES 
							     list, or isn't defined. Try loading the support file.)
	  (COND
	    ((AND SUPPORTFILE (MOUSECONFIRM (CONCAT "Trying to read an IMAGEOBJ with GETFN " GETFN 
						    ". Shall I load the support file, "
						    SUPPORTFILE "?")
					    NIL NIL NIL))    (* Ask if the user wants to load the support file.)
	      (DOFILESLOAD (LIST SUPPORTFILE))               (* LOAD the file)
	      ]
      (COND
	[(OR (NOT GETFN)
	     (NOT (GETD GETFN))
	     (NOT (ASSOC GETFN IMAGEOBJGETFNS)))             (* Still no support for this kind of IMAGEOBJ.
							     Encapsulate it in something safe.)
	  (COND
	    (NOERROR                                         (* The caller doesn't want errors if there's a 
							     failure.)
		     NIL)
	    (T (LET* ((OBJ (IMAGEOBJCREATE NIL ENCAPSULATEDIMAGEFNS)))
                                                             (* Build an ENCAPSULATED imageobj.)
		 (IMAGEOBJPROP OBJ (QUOTE FILE)
			       STREAM)                       (* Remember which file it came from)
		 (IMAGEOBJPROP OBJ (QUOTE FILEPTR)
			       (GETFILEPTR STREAM))          (* And where on the file)
		 (IMAGEOBJPROP OBJ (QUOTE UNKNOWNGETFN)
			       GETFN)                        (* And the name of its GETFN)
		 OBJ]
	(T (APPLY* GETFN STREAM])

(WRITEIMAGEOBJ
  [LAMBDA (IMAGEOBJ STREAM)                                  (* jds "19-Feb-85 09:36")
                                                             (* HPRINT function for writing out IMAGE OBJECTS)
                                                             (* write out the name of the function to read things 
							     back in with.)
    (COND
      ((NOT (fetch (IMAGEFNS GETFN) of (fetch (IMAGEOBJ IMAGEOBJFNS) of IMAGEOBJ)))
                                                             (* This IMAGEOBJ has no GETFN.
							     Complain!)
	(HELP "No GETFN for IMAGEOBJ " IMAGEOBJ)))
    (PRIN2 [LIST (QUOTE READIMAGEOBJ)
		 NIL
		 (KWOTE (fetch (IMAGEFNS GETFN) of (fetch (IMAGEOBJ IMAGEOBJFNS) of IMAGEOBJ]
	   STREAM HPRINTRDTBL)                               (* Write out a call to READIMAGEOBJ, which takes the 
							     input stream and a GETFN name as arguments.)
    (APPLY* (fetch (IMAGEFNS PUTFN) of (fetch (IMAGEOBJ IMAGEOBJFNS) of IMAGEOBJ))
	    IMAGEOBJ STREAM)                                 (* Then write out the guts of the IMAGEOBJ itself.)
    T])
)

(ADDTOVAR HPRINTMACROS (IMAGEOBJ . WRITEIMAGEOBJ))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS (IMAGEOBJTYPES NIL)
	    (IMAGEOBJGETFNS NIL))
)



(* For encapsulating unknown-type IMAGEOBJs.)

(DEFINEQ

(ENCAPSULATEDOBJ.BUTTONEVENTINFN
  [LAMBDA (IMAGEOBJ WINDOW)                                  (* jds "19-Feb-85 10:40")

          (* * The user hit a button inside this object. Try loading it now.)


    (SETFILEPTR (IMAGEOBJPROP IMAGEOBJ (QUOTE FILE))
		(IMAGEOBJPROP IMAGEOBJ (QUOTE FILEPTR)))     (* Move to where the IMAGEOBJ's description started in 
							     the file we read it from)
    (PROG ((OBJ (READIMAGEOBJ (IMAGEOBJPROP IMAGEOBJ (QUOTE FILE))
			      (IMAGEOBJPROP IMAGEOBJ (QUOTE UNKNOWNGETFN))
			      T)))
          (COND
	    (OBJ                                             (* We succeeded in reading the object this time.
							     Copy its guts over the placeholder.)
		 (COPYIMAGEOBJ OBJ IMAGEOBJ)))
          (RETURN (QUOTE CHANGED])

(ENCAPSULATEDOBJ.DISPLAYFN
  [LAMBDA (OBJ STREAM)                                       (* jds "19-Feb-85 10:37")
                                                             (* Display function for an IMAGEOBJ that has been 
							     encapsulated for safety)
                                                             (* Displays as a box containing text saying 
							     "Unknown IMAGEOBJ type", and naming the unknown GETFN.)
    (LET* ((CURX (DSPXPOSITION NIL STREAM))
       (CURY (DSPYPOSITION NIL STREAM))
       (FONT (FONTCREATE (QUOTE HELVETICA)
			 8
			 (QUOTE BOLD)
			 NIL STREAM))
       (OLDFONT (DSPFONT FONT STREAM))
       (GETFN (IMAGEOBJPROP OBJ (QUOTE UNKNOWNGETFN)))
       (TYPE (IMAGEOBJPROP OBJ (QUOTE TYPE)))
       (OBJBOX (IMAGEOBJPROP OBJ (QUOTE BOUNDBOX)))
       (XSIZE (IDIFFERENCE (fetch XSIZE of OBJBOX)
			   4))
       (YSIZE (IDIFFERENCE (fetch YSIZE of OBJBOX)
			   4)))
      (RELMOVETO 3 (IPLUS (FONTPROP FONT (QUOTE HEIGHT))
			  3)
		 STREAM)
      (PRIN1 "Unknown IMAGEOBJ type" STREAM)
      (MOVETO (IPLUS CURX 3)
	      (IPLUS CURY 3)
	      STREAM)
      (printout STREAM "GETFN:  " GETFN)
      (MOVETO CURX (IDIFFERENCE CURY (fetch YDESC of OBJBOX))
	      STREAM)
      (RELDRAWTO XSIZE 0 2 (QUOTE PAINT)
		 STREAM NIL (QUOTE (16 8 8 8)))
      (RELDRAWTO 0 YSIZE 2 (QUOTE PAINT)
		 STREAM NIL (QUOTE (16 8 8 8)))
      (RELDRAWTO (IMINUS XSIZE)
		 0 2 (QUOTE PAINT)
		 STREAM NIL (QUOTE (16 8 8 8)))
      (RELDRAWTO 0 (IMINUS YSIZE)
		 2
		 (QUOTE PAINT)
		 STREAM NIL (QUOTE (16 8 8 8)))
      (DSPFONT OLDFONT STREAM])

(ENCAPSULATEDOBJ.IMAGEBOXFN
  [LAMBDA (OBJ STREAM)                                       (* jds "19-Feb-85 10:05")
                                                             (* IMAGEOBXFN for an encapsulated IMAGEOBJ)
    (PROG ((FONT (FONTCREATE (QUOTE HELVETICA)
			     8
			     (QUOTE BOLD)
			     NIL STREAM))
	   (GETFN (IMAGEOBJPROP OBJ (QUOTE UNKNOWNGETFN)))
	   WIDTH HEIGHT)
          [SETQ HEIGHT (ITIMES 2 (FONTPROP FONT (QUOTE HEIGHT]
          (SETQ WIDTH (IMAX (STRINGWIDTH "Unknown IMAGEOBJ type" FONT)
			    (STRINGWIDTH (CONCAT "GETFN:  " GETFN)
					 FONT)))
          (RETURN (create IMAGEBOX
			  XSIZE ←(IPLUS WIDTH 6)
			  YSIZE ←(IPLUS HEIGHT 6)
			  YDESC ← 0
			  XKERN ← 0])

(ENCAPSULATEDOBJ.INIT
  [LAMBDA NIL                                                (* jds "19-Feb-85 10:10")
                                                             (* Set up the IMAGEFNS for the encapsulated-IMAGEOBJ 
							     type: The way to protect TEdit and friends from 
							     unfriendly IMAGEOBJs)
    (SETQ ENCAPSULATEDIMAGEFNS (IMAGEFNSCREATE (FUNCTION ENCAPSULATEDOBJ.DISPLAYFN)
					       (FUNCTION ENCAPSULATEDOBJ.IMAGEBOXFN)
					       (FUNCTION NIL)
					       (FUNCTION NIL)
					       (FUNCTION NIL)
					       (FUNCTION ENCAPSULATEDOBJ.BUTTONEVENTINFN)
					       (FUNCTION NILL)
					       (FUNCTION NILL)
					       (FUNCTION NILL)
					       (FUNCTION NILL)
					       (FUNCTION NILL)
					       (FUNCTION NILL)
					       (FUNCTION NILL)
					       (FUNCTION NILL])
)
(ENCAPSULATEDOBJ.INIT)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS ENCAPSULATEDIMAGEFNS)
)



(* Window utilities)

(DEFINEQ

(ADVISEWDS
  [LAMBDA (WINDOW OLDREG MOVEONLYFLG)                        (* rrb "11-Oct-84 16:56")
    (DECLARE (LOCALVARS . T))

          (* called whenever the dimensions of a guaranteed WINDOW change. Updates the dependent fields in the associated 
	  DisplayStream. Also updates dependent fields in the WINDOW such as Scroll region.)



          (* OLDREG if given, is the region this window used to have and is used to maintain the relationship between the 
	  WINDOW coordinates and the displaystreams when the WINDOW moves.)

                                                             (* MOVEONLYFLG indicates that the dimensions of the 
							     region haven't changed.)
    (PROG ((R (fetch REG of WINDOW))
	   (D (fetch DSP of WINDOW))
	   (WBORDERSIZE (fetch WBORDER of WINDOW))
	   CLIPREG TWICEBORDER PROC)
          (SETQ TWICEBORDER (UNFOLD WBORDERSIZE 2))
          (COND
	    (OLDREG (RELDSPXOFFSET (IDIFFERENCE (fetch (REGION LEFT) of R)
						(fetch (REGION LEFT) of OLDREG))
				   D)
		    (RELDSPYOFFSET (IDIFFERENCE (fetch (REGION BOTTOM) of R)
						(fetch (REGION BOTTOM) of OLDREG))
				   D)

          (* if only moving, the clipping region remains the same. This is checked for because the height of the window title 
	  may have changed and this calculation results in the wrong answer. All other calls to ADVISEWDS should repaint the 
	  border.)


		    (OR MOVEONLYFLG (DSPCLIPPINGREGION [create REGION
							       LEFT ←(fetch (REGION LEFT)
									of (SETQ CLIPREG
									     (DSPCLIPPINGREGION
									       NIL D)))
							       BOTTOM ←(fetch (REGION BOTTOM)
									  of CLIPREG)
							       WIDTH ←(IDIFFERENCE
								 (fetch (REGION WIDTH) of R)
								 TWICEBORDER)
							       HEIGHT ←(IPLUS
								 (IDIFFERENCE (fetch (REGION HEIGHT)
										 of R)
									      TWICEBORDER)
								 (COND
								   ((fetch (WINDOW WTITLE)
								       of WINDOW)
								     (DSPLINEFEED NIL 
									 WindowTitleDisplayStream))
								   (T 0]
						       D)))
	    (T (DSPXOFFSET (IPLUS (fetch (REGION LEFT) of R)
				  WBORDERSIZE)
			   D)
	       (DSPYOFFSET (IPLUS (fetch (REGION BOTTOM) of R)
				  WBORDERSIZE)
			   D)
	       (DSPCLIPPINGREGION [create REGION
					  LEFT ← 0
					  BOTTOM ← 0
					  WIDTH ←(IDIFFERENCE (fetch (REGION WIDTH) of R)
							      TWICEBORDER)
					  HEIGHT ←(IPLUS (IDIFFERENCE (fetch (REGION HEIGHT)
									 of R)
								      TWICEBORDER)
							 (COND
							   ((fetch (WINDOW WTITLE) of WINDOW)
							     (DSPLINEFEED NIL 
									 WindowTitleDisplayStream))
							   (T 0]
				  D)))
          [COND
	    ((NULL MOVEONLYFLG)                              (* if the previous right margin was the default, change
							     it.)
	      (AND (OR (NOT OLDREG)
		       (EQ (DSPRIGHTMARGIN NIL D)
			   (IDIFFERENCE (fetch (REGION WIDTH) of OLDREG)
					TWICEBORDER)))
		   (DSPRIGHTMARGIN (IDIFFERENCE (fetch (REGION WIDTH) of R)
						TWICEBORDER)
				   D))
	      (COND
		((AND (SETQ PROC (WINDOWPROP WINDOW (QUOTE PROCESS)))
		      (EQ D (PROCESS.TTY PROC)))             (* if the window changing is a tty, set its 
							     linelength.)
		  [PROCESS.EVAL PROC (LIST (FUNCTION PAGEHEIGHT)
					   (IQUOTIENT (fetch (REGION HEIGHT)
							 of (SETQ CLIPREG (DSPCLIPPINGREGION NIL D)))
						      (IMINUS (DSPLINEFEED NIL D]
		  (PROCESS.EVAL PROC (QUOTE (SETLINELENGTH)))

          (* try it without this. (COND ((EQ (PROCESSPROP PROC (QUOTE NAME)) (QUOTE EXEC)) (* in the exec process, make sure 
	  the current position is inside the new shape. reuse variables R and TWICEBORDER to save binding.) 
	  (COND ((ILESSP (SETQ R (DSPYPOSITION NIL D)) (SETQ TWICEBORDER (fetch (REGION BOTTOM) of CLIPREG))) 
	  (DSPYPOSITION TWICEBORDER D)) ((IGREATERP R (SETQ TWICEBORDER (IPLUS (fetch (REGION HEIGHT) of CLIPREG) TWICEBORDER)
)) (DSPYPOSITION (IDIFFERENCE TWICEBORDER (FONTPROP D (QUOTE ASCENT))) D))))))


		  ]
          (UPDATE/SCROLL/REG WINDOW))
    WINDOW])

(SHOWWFRAME
  [LAMBDA (WIN)                                              (* rrb "23-May-84 16:12")
                                                             (* Displays the border and title in the save image of a 
							     window)
    (PROG ((TITLE (fetch WTITLE of WIN))
	   (BORDER (fetch WBORDER of WIN))
	   (DSP (fetch DSP of WIN))
	   (SAVEIMAGE (fetch SAVE of WIN))
	   WINWDTH WINHGHT BLACKPART WHITEPART)
          [SETQ WINHGHT (fetch (REGION HEIGHT) of (SETQ WINWDTH (fetch (WINDOW REG) of WIN]
          (SETQ WINWDTH (fetch (REGION WIDTH) of WINWDTH))   (* make most of the border black)
          (SETQ BLACKPART (IMAX (FOLDHI BORDER 2)
				(IDIFFERENCE BORDER 2)))
          (SETQ WHITEPART (IDIFFERENCE BORDER BLACKPART))    (* Fill in frame in save image)
          (BITBLT NIL NIL NIL SAVEIMAGE 0 0 WINWDTH WINHGHT (QUOTE TEXTURE)
		  (QUOTE REPLACE)
		  BLACKSHADE)                                (* White out the frame in the saved image)
          (BITBLT NIL NIL NIL SAVEIMAGE BLACKPART BLACKPART (IDIFFERENCE WINWDTH (ITIMES 2 BLACKPART))
		  (IPLUS (fetch (REGION HEIGHT) of (DSPCLIPPINGREGION NIL DSP))
			 (ITIMES 2 WHITEPART))
		  (QUOTE TEXTURE)
		  (QUOTE REPLACE)
		  WHITESHADE)
          (AND TITLE (SHOWWTITLE TITLE SAVEIMAGE BORDER NIL WIN)))
    WIN])

(SHOWWTITLE
  [LAMBDA (TITLE BM BORDER CENTERFLG WINDOW)                 (* rrb "24-May-84 11:52")
                                                             (* prints a title in a window.)
    (PROG ((FONT (DSPFONT NIL WindowTitleDisplayStream))
	   (BLACKPART (SELECTQ BORDER
			       (0 0)
			       ((1 2)
				 1)
			       (3 2)
			       (IDIFFERENCE BORDER 2)))
	   (TITLESHADE (OR (TEXTUREP (OR (WINDOWPROP WINDOW (QUOTE WINDOWTITLESHADE))
					 WINDOWTITLESHADE))
			   BLACKSHADE))
	   BMWIDTH HEIGHT BOTTOM X LEFTMARGIN)
          (DSPDESTINATION BM WindowTitleDisplayStream)
          (DSPCLIPPINGREGION (create REGION
				     LEFT ← 0
				     BOTTOM ←[SETQ BOTTOM (IDIFFERENCE (IPLUS (BITMAPHEIGHT BM)
									      (COND
										((ZEROP BORDER)
										  0)
										(T 
                                                             (* if room, leave a line of the border at the top of the
							     title.)
										   -1)))
								       (SETQ HEIGHT
									 (FONTPROP FONT (QUOTE HEIGHT]
				     WIDTH ←(SETQ BMWIDTH (BITMAPWIDTH BM))
				     HEIGHT ← HEIGHT)
			     WindowTitleDisplayStream)
          (MOVETO (COND
		    [CENTERFLG                               (* save left margin for later shading.)
			       (SETQ LEFTMARGIN (IMAX BORDER (IQUOTIENT (IDIFFERENCE BMWIDTH
										     (
\STRINGWIDTHGUESS TITLE FONT))
									2]
		    (T BORDER))
		  (IPLUS BOTTOM (FONTPROP FONT (QUOTE DESCENT)))
		  WindowTitleDisplayStream)
          (RESETFORM (PRINTLEVEL WINDOWTITLEPRINTLEVEL)
		     (PROG ((PLVLFILEFLG T))
		           (PRIN3 TITLE WindowTitleDisplayStream)))
          (BITBLT NIL NIL NIL WindowTitleDisplayStream (SETQ X (IPLUS (IMAX 2 BLACKPART)
								      (DSPXPOSITION NIL 
									 WindowTitleDisplayStream)))
		  (COND
		    ((EQ BLACKPART 1)
		      (ADD1 BOTTOM))
		    (T BOTTOM))
		  (IDIFFERENCE BMWIDTH (IPLUS X BLACKPART))
		  NIL
		  (QUOTE TEXTURE)
		  (QUOTE REPLACE)
		  TITLESHADE)                                (* shade stuff before title if centered.)
          (AND CENTERFLG (BITBLT NIL NIL NIL WindowTitleDisplayStream BORDER (COND
				   ((EQ BLACKPART 1)
				     (ADD1 BOTTOM))
				   (T BOTTOM))
				 (IDIFFERENCE LEFTMARGIN (IPLUS (IMAX 2 BLACKPART)
								BORDER))
				 NIL
				 (QUOTE TEXTURE)
				 (QUOTE REPLACE)
				 TITLESHADE])

(\STRINGWIDTHGUESS
  [LAMBDA (X FONT)                                           (* rrb "30-Apr-85 15:32")

          (* returns a guess as to the string width of X. It goes one level so works on circular structures.
	  It is used as a heuristic by functions who are going to print something with printlevel.)


    (COND
      ((NLISTP X)
	(STRINGWIDTH X FONT T))
      (T                                                     (* Might be circular, don't call STRINGWIDTH)
	 (PROG ((SPACEWIDTH (CHARWIDTH (CHARCODE % )
				       FONT)))
	       (RETURN (PLUS (CHARWIDTH (CHARCODE %())
			     (DIFFERENCE SPACEWIDTH (CHARWIDTH (CHARCODE %()))
			     (for ELT in X sum (IPLUS SPACEWIDTH (COND
							((NLISTP ELT)
							  (STRINGWIDTH ELT FONT T))
							(T 
                                                             (* use some number for embedded lists.)
							   (ITIMES 7 SPACEWIDTH])

(RESHOWTITLE
  [LAMBDA (TITLE WINDOW JUSTDISPLAYFLG)                      (* rrb " 5-Jun-84 15:19")
                                                             (* updates a windows display with a new title)
    (PROG ((WREG (fetch (WINDOW REG) of WINDOW))
	   (TITLEHEIGHT (IMINUS (DSPLINEFEED NIL WindowTitleDisplayStream)))
	   (OLDTITLE (fetch (WINDOW WTITLE) of WINDOW))
	   (BORDER (fetch WBORDER of WINDOW))
	   BM BMBTM HGHT)
          [COND
	    (JUSTDISPLAYFLG)
	    ((EQ TITLE (fetch (WINDOW WTITLE) of WINDOW))
	      (RETURN))
	    (T (replace (WINDOW WTITLE) of WINDOW with TITLE)
	       (COND
		 ([OR (NULL OLDTITLE)
		      (NULL TITLE)
		      (NEQ TITLEHEIGHT (IDIFFERENCE (fetch (REGION HEIGHT) of WREG)
						    (IPLUS (fetch (REGION HEIGHT)
							      of (DSPCLIPPINGREGION
								   NIL
								   (fetch (WINDOW DSP) of WINDOW)))
							   (ITIMES 2 BORDER]
                                                             (* Previously no title, so make space for one)
                                                             (* Have to remove title)
                                                             (* or title height changed.)
                                                             (* so windows region on the screen has to be made 
							     larger.)
		   (\RESHOWBORDER1 (fetch (WINDOW WBORDER) of WINDOW)
				   (fetch (WINDOW WBORDER) of WINDOW)
				   WINDOW)
		   (RETURN]                                  (* code from here is to reprint the title in place to 
							     avoid creating any large bitmaps.)
          [SETQ BM (BITMAPCREATE (fetch (REGION WIDTH) of WREG)
				 (SETQ TITLEHEIGHT (ADD1 TITLEHEIGHT]
          (BITBLT NIL NIL NIL BM 0 0 NIL NIL (QUOTE TEXTURE)
		  (QUOTE REPLACE)
		  BLACKSHADE)                                (* use SHOWWTITLE to put the image of the title into the
							     auxilliary bitmap.)
          (SHOWWTITLE TITLE BM BORDER NIL WINDOW)
          [COND
	    ((IGREATERP TITLEHEIGHT (SETQ HGHT (fetch (REGION HEIGHT) of WREG)))
	      (SETQ BMBTM (IDIFFERENCE (SUB1 TITLEHEIGHT)
				       HGHT]
          (UNINTERRUPTABLY
              (TOTOPW WINDOW)
	      (BITBLT BM 0 (COND
			(BMBTM)
			((IGREATERP BORDER 0)                (* if there is a border, the title was printed in the 
							     scratch bitmap so to leave one point of the border on 
							     top)
			  0)
			(T 1))
		      (SCREENBITMAP)
		      (fetch (REGION LEFT) of WREG)
		      [IDIFFERENCE (fetch (REGION PTOP) of WREG)
				   (COND
				     (BMBTM HGHT)
				     (T (IPLUS TITLEHEIGHT (COND
						 ((IGREATERP BORDER 0)
                                                             (* if there is a border, the title was printed in the 
							     scratch bitmap so to leave one point of the border on 
							     top)
						   0)
						 (T -1]
		      NIL
		      (COND
			(BMBTM HGHT))))])

(TOTOPW
  [LAMBDA (WINDOW NOCALLTOTOPFNFLG)                          (* rrb "28-JUN-83 11:55")
                                                             (* user entry to bring a window to the top.
							     Unless NOCALLTOTOPFNFLG is non-NIL, it will call the 
							     windows TOTOPFN)
    (SETQ WINDOW (\INSUREWINDOW WINDOW))
    (COND
      ((EQ WINDOW TOPW))
      ((OPENWP WINDOW)
	(OR NOCALLTOTOPFNFLG (DOUSERFNS (WINDOWPROP WINDOW (QUOTE TOTOPFN))
					WINDOW))
	(\INTERNALTOTOPW WINDOW))
      ((OPENW WINDOW)                                        (* if it is not open, open it and then call the TOTOPFN)
	(OR NOCALLTOTOPFNFLG (DOUSERFNS (WINDOWPROP WINDOW (QUOTE TOTOPFN))
					WINDOW)))
      (T                                                     (* window won't open probably because of DON'T OPENFN)
	 (ERROR "Window won't open; Can't be bring to top." WINDOW)))
    WINDOW])

(\INTERNALTOTOPW
  [LAMBDA (W1 RPT)                                           (* bas: "21-OCT-82 16:50")
    (SETQ W1 (\INSUREWINDOW W1))
    (OR (EQ W1 TOPW)
	(COND
	  ((NULL TOPW)                                       (* all windows are closed open this one.)
	    (OPENW W1))
	  (T (UNINTERRUPTABLY
                 (\TTW1 W1 TOPW)                             (* GC msgs or other glitches can cause W1 not to make 
							     it. Check and try ONCE more)
		 (COND
		   ((EQ W1 TOPW))
		   (RPT (SHOULDNT))
		   (T (\INTERNALTOTOPW W1 T))))])

(\TTW1
  [LAMBDA (WINDOW WS)                                        (* rrb "26-OCT-83 14:56")
    (COND
      [(fetch (WINDOW NEXTW) of WS)
	(PROG ((ISECT (INTERSECTREGIONS (fetch REG of WINDOW)
					(fetch REG of WS)
					WHOLESCREEN)))
	      (AND ISECT (\SW2BM (fetch SAVE of WS)
				 (TRANSLATEREG ISECT (fetch REG of WS))
				 (SCREENBITMAP)
				 ISECT))
	      [COND
		((EQ WINDOW (fetch (WINDOW NEXTW) of WS))    (* doesn't have to be uninterruptable here because 
							     TOTOPW is.)
		  (replace (WINDOW NEXTW) of WS with (fetch (WINDOW NEXTW) of WINDOW))
		  (replace (WINDOW NEXTW) of WINDOW with TOPW)
		  (SETQ TOPW WINDOW)
		  (SETQ \TOPWDS (fetch (WINDOW DSP) of WINDOW)))
		(T (\TTW1 WINDOW (fetch (WINDOW NEXTW) of WS]
	      (AND ISECT (\SW2BM (fetch SAVE of WINDOW)
				 (TRANSLATEREG ISECT (fetch REG of WINDOW))
				 (fetch SAVE of WS)
				 (TRANSLATEREG ISECT (fetch REG of WS]
      ((type? WINDOW WINDOW)                                 (* must be closed window; reopen it)
	(OPENW WINDOW])

(WHICHW
  [LAMBDA (X Y)                                              (* rrb "26-OCT-83 14:56")
    (COND
      ((POSITIONP X)
	(WHICHW (fetch (POSITION XCOORD) of X)
		(fetch (POSITION YCOORD) of X)))
      (T (for (WINDOW ← TOPW) by (fetch (WINDOW NEXTW) of WINDOW) while WINDOW
	    thereis (INSIDE? (fetch REG of WINDOW)
			     X Y])
)

(RPAQQ WINDOWTITLEPRINTLEVEL (2 . 5))

(RPAQ WINDOWTITLESHADE BLACKSHADE)



(* Window vs non-window world)

(DEFINEQ

(SWITCHDEF
  [LAMBDA (F FROM TO)
               (* rrb "24-JUN-81 14:52")
    (MOVD? F (PACK* FROM F))
    (AND (GETD (PACK* TO F))
	 (MOVD (PACK* TO F)
	       F))
    F])

(WFROMDS
  [LAMBDA (DS DONTCREATE)                                    (* AJB " 7-Jun-85 15:08")
                                                             (* Finds or creates a window for a display stream)
                                                             (* uses an XPointer from the displaystream as a hint.
							     This means that the window might have been garbage 
							     collected, hence all the confirmation.)
    (DECLARE (GLOBALVARS \DEFAULTTTYDISPLAYSTREAM))
    (PROG (DD HINTW)
          [COND
	    ((IMAGESTREAMTYPEP DS (QUOTE TEXT))
	      (RETURN (CAR (fetch \WINDOW of (TEXTOBJ DS]
          (SETQ DD (\GETDISPLAYDATA DS DS))
          (RETURN (COND
		    ((AND (SETQ HINTW (ffetch XWINDOWHINT of DD))
			  (EQ (ffetch (WINDOW DSP) of HINTW)
			      DS))
		      HINTW)
		    [(AND (EQ DS \DEFAULTTTYDISPLAYSTREAM)
			  (EQ (TTYDISPLAYSTREAM)
			      \DEFAULTTTYDISPLAYSTREAM))     (* assume this process is doing something with T.)
		      (COND
			((NOT DONTCREATE)
			  (\CREATE.TTYDISPLAYSTREAM)
			  (WFROMDS (TTYDISPLAYSTREAM]
		    ((NEQ (ffetch DDDestination of DD)
			  (SCREENBITMAP))                    (* for now color display streams don't have windows 
							     associated with them.)
		      NIL)
		    ([SETQ HINTW (for (WINDOW ← TOPW) by (fetch (WINDOW NEXTW) of WINDOW)
				    while WINDOW thereis (EQ DS (fetch (WINDOW DSP) of WINDOW]
		      HINTW)
		    ((NOT DONTCREATE)
		      (CREATEW DS NIL NIL T])

(NU\TOTOPWDS
  [LAMBDA (DS)                                              (* rmk: "21-OCT-81 22:31")
                                                            (* Moves the window of displaystream DS to the top)
    (AND (EQ (DSPDESTINATION NIL DS)
	     (SCREENBITMAP))
	 (TOTOPW (WFROMDS DS])

(\COERCETODS
  [LAMBDA (X)                                               (* rrb "23-OCT-81 13:29")
                                                            (* Called from \SFInsureDisplayStream macro.
							    Compiles open in system code, closed call in user code, 
							    and equivalent to \ILLEGAL.ARG if no window package.)
    (COND
      ((type? WINDOW X)
	(fetch (WINDOW DSP) of X))
      (T (\ILLEGAL.ARG X])
)
(DECLARE: DONTCOPY 
(* FOLLOWING DEFINITIONS EXPORTED)


(DECLARE: EVAL@COMPILE 
[PUTPROPS \COERCETODS MACRO (OPENLAMBDA (X)
					(COND ((type? WINDOW X)
					       (fetch (WINDOW DSP)
						      of X))
					      (T (\ILLEGAL.ARG X]
[PUTPROPS .WHILE.ON.TOP. MACRO ((FIRST . REST)
	   (UNINTERRUPTABLY
               (\INTERNALTOTOPW FIRST) . REST)]
)


(* END EXPORTED DEFINITIONS)

)



(* User interface functions)

(DEFINEQ

(WINDOWP
  [LAMBDA (X)                                               (* rrb "20-NOV-81 07:30")
    (AND (type? WINDOW X)
	 X])

(WINDOWPROP
  [LAMBDA X                                                  (* rrb "26-AUG-82 17:36")
                                                             (* general top level entry for both fetching and setting
							     window properties.)
    (COND
      ((IGREATERP X 2)
	(PUTWINDOWPROP (ARG X 1)
		       (ARG X 2)
		       (ARG X 3)))
      ((EQ X 2)
	(GETWINDOWPROP (ARG X 1)
		       (ARG X 2)))
      (T (\ILLEGAL.ARG NIL])

(WINDOWADDPROP
  [LAMBDA (WINDOW PROP ITEMTOADD FIRSTFLG)                   (* rrb "20-Mar-84 16:07")
                                                             (* adds an element to a window property.)
    (PROG ((CURRENT (WINDOWPROP WINDOW PROP)))
          (RETURN (WINDOWPROP WINDOW PROP (COND
				((NULL CURRENT)
				  (LIST ITEMTOADD))
				[(NLISTP CURRENT)
				  (COND
				    ((EQ CURRENT ITEMTOADD)
				      (LIST ITEMTOADD))
				    (FIRSTFLG (LIST ITEMTOADD CURRENT))
				    (T (LIST CURRENT ITEMTOADD]
				((FMEMB ITEMTOADD CURRENT)   (* don't put things on twice.)
				  (COND
				    ((AND FIRSTFLG (NEQ (CAR CURRENT)
							ITEMTOADD))
                                                             (* make it first)
				      (CONS ITEMTOADD (REMOVE ITEMTOADD CURRENT)))
				    (T CURRENT)))
				(FIRSTFLG (CONS ITEMTOADD CURRENT))
				(T (NCONC1 (APPEND CURRENT)
					   ITEMTOADD])

(WINDOWDELPROP
  [LAMBDA (WINDOW PROP ITEMTODELETE)                         (* rrb "13-JUN-82 17:58")
                                                             (* deletes a property from a window property.)
    (PROG ((CURRENT (WINDOWPROP WINDOW PROP)))
          (RETURN (COND
		    ((LISTP CURRENT)
		      (AND (FMEMB ITEMTODELETE CURRENT)
			   (WINDOWPROP WINDOW PROP (REMOVE ITEMTODELETE CURRENT])

(GETWINDOWPROP
  [LAMBDA (WINDOW PROP)                                      (* rrb "30-Sep-85 17:05")
                                                             (* gets values from a window.
							     Called by the macro for WINDOWPROP.)
    [OR (type? WINDOW WINDOW)
	(COND
	  ((DISPLAYSTREAMP (\OUTSTREAMARG WINDOW T))
	    (SETQ WINDOW (WFROMDS WINDOW)))
	  (T (\ILLEGAL.ARG WINDOW]
    (SELECTQ PROP
	     (HEIGHT (\GETWINDOWHEIGHT WINDOW))
	     (WIDTH                                          (* calculate the width from the REGION in case the user
							     has changed the clipping region.)
		    (\GETWINDOWWIDTH WINDOW))
	     (RIGHTBUTTONFN (fetch (WINDOW RIGHTBUTTONFN) of WINDOW))
	     (BUTTONEVENTFN (fetch (WINDOW BUTTONEVENTFN) of WINDOW))
	     (CURSORINFN (fetch (WINDOW CURSORINFN) of WINDOW))
	     (CURSOROUTFN (fetch (WINDOW CURSOROUTFN) of WINDOW))
	     (CURSORMOVEDFN (fetch (WINDOW CURSORMOVEDFN) of WINDOW))
	     (DSP (fetch (WINDOW DSP) of WINDOW))
	     (SCROLLFN (fetch (WINDOW SCROLLFN) of WINDOW))
	     (RESHAPEFN (fetch (WINDOW RESHAPEFN) of WINDOW))
	     (EXTENT (fetch (WINDOW EXTENT) of WINDOW))
	     (REPAINTFN (fetch (WINDOW REPAINTFN) of WINDOW))
	     (MOVEFN (fetch (WINDOW MOVEFN) of WINDOW))
	     (CLOSEFN (fetch (WINDOW CLOSEFN) of WINDOW))
	     (WINDOWENTRYFN (fetch (WINDOW WINDOWENTRYFN) of WINDOW))
	     (PROCESS (fetch (WINDOW PROCESS) of WINDOW))
	     (REGION                                         (* make a copy so we don't have to worry about {or 
							     document} the user clobbering it.)
		     (fetch (WINDOW REG) of WINDOW))
	     (NEWREGIONFN (fetch (WINDOW NEWREGIONFN) of WINDOW))
	     (TITLE (fetch (WINDOW WTITLE) of WINDOW))
	     (BORDER (fetch (WINDOW WBORDER) of WINDOW))
	     (IMAGECOVERED (fetch (WINDOW SAVE) of WINDOW))
	     (GETWINDOWUSERPROP WINDOW PROP])

(GETWINDOWUSERPROP
  [LAMBDA (WINDOW USERPROP)                                  (* rrb "28-OCT-83 11:00")

          (* gets a property from the USERDATA property list of a window. This is the function called by the macro for 
	  GETWINDOWPROP which result from a call to WINDOWPROP that doesn't have a third argument.)


    (LISTGET (fetch (WINDOW USERDATA) of (\INSUREWINDOW WINDOW))
	     USERPROP])

(PUTWINDOWPROP
  [LAMBDA (WINDOW PROP VALUE)                                (* rrb " 5-Jun-84 15:21")
    [OR (type? WINDOW WINDOW)
	(COND
	  ((DISPLAYSTREAMP (\OUTSTREAMARG WINDOW))
	    (SETQ WINDOW (WFROMDS WINDOW)))
	  (T (\ILLEGAL.ARG WINDOW]
    (SELECTQ PROP
	     (RIGHTBUTTONFN (PROG1 (fetch (WINDOW RIGHTBUTTONFN) of WINDOW)
				   (replace (WINDOW RIGHTBUTTONFN) of WINDOW with VALUE)))
	     (BUTTONEVENTFN (PROG1 (fetch (WINDOW BUTTONEVENTFN) of WINDOW)
				   (replace (WINDOW BUTTONEVENTFN) of WINDOW with VALUE)))
	     (CLOSEFN (PROG1 (fetch (WINDOW CLOSEFN) of WINDOW)
			     (replace (WINDOW CLOSEFN) of WINDOW with VALUE)))
	     (MOVEFN (PROG1 (fetch (WINDOW MOVEFN) of WINDOW)
			    (replace (WINDOW MOVEFN) of WINDOW with VALUE)))
	     (CURSORINFN (PROG1 (fetch (WINDOW CURSORINFN) of WINDOW)
				(replace (WINDOW CURSORINFN) of WINDOW with VALUE)))
	     (CURSOROUTFN (PROG1 (fetch (WINDOW CURSOROUTFN) of WINDOW)
				 (replace (WINDOW CURSOROUTFN) of WINDOW with VALUE)))
	     (CURSORMOVEDFN (PROG1 (fetch (WINDOW CURSORMOVEDFN) of WINDOW)
				   (replace (WINDOW CURSORMOVEDFN) of WINDOW with VALUE)))
	     (DSP (ERROR "Can't change DSP of a window" WINDOW))
	     (RESHAPEFN (PROG1 (fetch (WINDOW RESHAPEFN) of WINDOW)
			       (replace (WINDOW RESHAPEFN) of WINDOW with VALUE)))
	     (REPAINTFN (PROG1 (fetch (WINDOW REPAINTFN) of WINDOW)
			       (replace (WINDOW REPAINTFN) of WINDOW with VALUE)))
	     (EXTENT (PROG1 (fetch (WINDOW EXTENT) of WINDOW)
			    (OR (NULL VALUE)
				(REGIONP VALUE)
				(\ILLEGAL.ARG VALUE))
			    (replace (WINDOW EXTENT) of WINDOW with VALUE)))
	     (SCROLLFN (PROG1 (fetch (WINDOW SCROLLFN) of WINDOW)
			      (replace (WINDOW SCROLLFN) of WINDOW with VALUE)
			      (UPDATE/SCROLL/REG WINDOW)))
	     (IMAGECOVERED (ERROR "Not implemented to change IMAGECOVERED property." WINDOW))
	     (HEIGHT (ERROR "Not implemented to change HEIGHT as property." WINDOW))
	     (WIDTH (ERROR "Not implemented to change WIDTH as property." WINDOW))
	     [REGION (PROG [(CURREGION (WINDOWPROP WINDOW (QUOTE REGION]
		           (COND
			     ((NOT (REGIONP VALUE))
			       (\ILLEGAL.ARG VALUE)))        (* there is no check for where the new region is nor how
							     big it is; this is left to MOVEW and RESHAPEW.)
		           (COND
			     ((AND (EQ (fetch (REGION WIDTH) of CURREGION)
				       (fetch (REGION WIDTH) of VALUE))
				   (EQ (fetch (REGION HEIGHT) of CURREGION)
				       (fetch (REGION HEIGHT) of VALUE)))
                                                             (* width and height are the same, move the window)
			       (MOVEW WINDOW (fetch (REGION LEFT) of VALUE)
				      (fetch (REGION BOTTOM) of VALUE)))
			     (T                              (* dimensions changed, reshape it.)
				(SHAPEW WINDOW VALUE]
	     (NEWREGIONFN (PROG1 (fetch (WINDOW NEWREGIONFN) of WINDOW)
				 (replace (WINDOW NEWREGIONFN) of WINDOW with VALUE)))
	     (TITLE (PROG1 (fetch (WINDOW WTITLE) of WINDOW)
			   (RESHOWTITLE VALUE WINDOW)))
	     [BORDER (PROG1 (fetch (WINDOW WBORDER) of WINDOW)
			    (COND
			      ((NUMBERP VALUE)
				(RESHOWBORDER VALUE WINDOW))
			      (T (\ILLEGAL.ARG VALUE]
	     (PROCESS (PROG1 (fetch (WINDOW PROCESS) of WINDOW)
			     (replace (WINDOW PROCESS) of WINDOW with VALUE)))
	     (WINDOWENTRYFN (PROG1 (fetch (WINDOW WINDOWENTRYFN) of WINDOW)
				   (replace (WINDOW WINDOWENTRYFN) of WINDOW with VALUE)))
	     (PROG ((OLDDATA (fetch USERDATA of WINDOW))
		    OLDVALUE)
	           (RETURN (PROG1 (COND
				    (OLDDATA (SETQ OLDVALUE (LISTGET OLDDATA PROP))
					     [COND
					       (VALUE (LISTPUT OLDDATA PROP VALUE))
					       (OLDVALUE     (* Remove the property)
							 (COND
							   ((EQ (CAR OLDDATA)
								PROP)
							     (replace USERDATA of WINDOW
								with (CDDR OLDDATA)))
							   (T (for TAIL on (CDR OLDDATA)
								 by (CDDR TAIL)
								 when (EQ (CADR TAIL)
									  PROP)
								 do (FRPLACD TAIL (CDDDR TAIL))
								    (RETURN]
					     OLDVALUE)
				    (VALUE (replace USERDATA of WINDOW with (LIST PROP VALUE))
                                                             (* know old value is NIL)
					   NIL))
				  (COND
				    ((AND (fetch (WINDOW WTITLE) of WINDOW)
					  (EQ PROP (QUOTE WINDOWTITLESHADE)))
                                                             (* change windowtitleshade.)
				      (RESHOWTITLE (fetch (WINDOW WTITLE) of WINDOW)
						   WINDOW T])

(REMWINDOWPROP
  [LAMBDA (WINDOW PROP)                                      (* rmk: "31-AUG-83 16:42")
    [OR (type? WINDOW WINDOW)
	(COND
	  ((DISPLAYSTREAMP (\OUTSTREAMARG WINDOW))
	    (SETQ WINDOW (WFROMDS WINDOW)))
	  (T (LISPERROR "ILLEGAL ARG" WINDOW]
    (PROG ((DATA (fetch USERDATA of WINDOW)))
          (RETURN (for TAIL on DATA by (CDDR TAIL) bind PREV
		     do (COND
			  ((EQ (CAR TAIL)
			       PROP)
			    (COND
			      (PREV (RPLACD (CDR PREV)
					    (CDDR TAIL)))
			      ((CDDR TAIL)
				(FRPLNODE2 TAIL (CDDR TAIL)))
			      (T (replace USERDATA of WINDOW with NIL)))
			    (RETURN PROP)))
			(SETQ PREV TAIL])

(WINDOWADDFNPROP
  [LAMBDA (WINDOW PROP ITEMTOADD)                            (* rrb "18-JUN-82 16:30")
                                                             (* adds A functional element to a window property.
							     This is different from WINDOWADDTOPROP because is checks
							     for LAMBDA expressions as a single element.)
    (PROG ((CURRENT (WINDOWPROP WINDOW PROP)))
          (RETURN (WINDOWPROP WINDOW PROP (COND
				((NULL CURRENT)
				  (LIST ITEMTOADD))
				((OR (NLISTP CURRENT)
				     (FMEMB (CAR CURRENT)
					    LAMBDASPLST))
				  (LIST CURRENT ITEMTOADD))
				((FMEMB ITEMTOADD CURRENT)   (* don't put things on twice.)
				  CURRENT)
				(T (NCONC1 (APPEND CURRENT)
					   ITEMTOADD])
)



(* for compiling windowprops.)


(PUTPROPS WINDOWPROP ARGNAMES (NIL (WINDOW PROP {NEWVALUE}) . U))
(DECLARE: EVAL@COMPILE 
(PUTPROPS WINDOWPROP MACRO (ARGS (CWINDOWPROP ARGS)))
)
(DEFINEQ

(CWINDOWPROP
  [LAMBDA (FORMTAIL)                                         (* rrb "28-OCT-83 10:51")
                                                             (* compiles calls to WINDOWPROP)
    (COND
      ((NULL (CDR FORMTAIL))                                 (* less that 2 args)
	(printout T "Possible error in call to WINDOWPROP: less than 2 args" T (LIST (QUOTE 
										       WINDOWPROP)
										     FORMTAIL)
		  T)
	(CGETWINDOWPROP (CAR FORMTAIL)
			NIL))
      ((NOT (EQ (CAADR FORMTAIL)
		(QUOTE QUOTE)))                              (* property is not quoted.)
	(QUOTE IGNOREMACRO))
      [(NULL (CDDR FORMTAIL))                                (* fetching a window property.)
	(CGETWINDOWPROP (CAR FORMTAIL)
			(CADR (CADR FORMTAIL]
      (T                                                     (* storing a window property)
	 (CONS (QUOTE PUTWINDOWPROP)
	       FORMTAIL])

(CGETWINDOWPROP
  [LAMBDA (WINFORM PROP)                                     (* rrb " 5-Jun-84 11:29")
                                                             (* compiles calls on WINDOWPROP that are fetching 
							     values. This needs to be changed whenever GETWINDOWPROP 
							     is changed.)
    (PROG NIL
          (RETURN (SUBST (LIST (QUOTE \INSUREWINDOW)
			       WINFORM)
			 (QUOTE DATUM)
			 (SELECTQ PROP
				  [RIGHTBUTTONFN (CONSTANT (RECORDACCESSFORM (QUOTE RIGHTBUTTONFN)
									     (QUOTE DATUM)
									     (QUOTE ffetch]
				  [BUTTONEVENTFN (CONSTANT (RECORDACCESSFORM (QUOTE BUTTONEVENTFN)
									     (QUOTE DATUM)
									     (QUOTE ffetch]
				  [CURSORINFN (CONSTANT (RECORDACCESSFORM (QUOTE CURSORINFN)
									  (QUOTE DATUM)
									  (QUOTE ffetch]
				  [CURSOROUTFN (CONSTANT (RECORDACCESSFORM (QUOTE CURSOROUTFN)
									   (QUOTE DATUM)
									   (QUOTE ffetch]
				  [CURSORMOVEDFN (CONSTANT (RECORDACCESSFORM (QUOTE CURSORMOVEDFN)
									     (QUOTE DATUM)
									     (QUOTE ffetch]
				  [DSP (CONSTANT (RECORDACCESSFORM (QUOTE DSP)
								   (QUOTE DATUM)
								   (QUOTE ffetch]
				  [SCROLLFN (CONSTANT (RECORDACCESSFORM (QUOTE SCROLLFN)
									(QUOTE DATUM)
									(QUOTE ffetch]
				  [MOVEFN (CONSTANT (RECORDACCESSFORM (QUOTE MOVEFN)
								      (QUOTE DATUM)
								      (QUOTE ffetch]
				  [RESHAPEFN (CONSTANT (RECORDACCESSFORM (QUOTE RESHAPEFN)
									 (QUOTE DATUM)
									 (QUOTE ffetch]
				  [EXTENT (CONSTANT (RECORDACCESSFORM (QUOTE EXTENT)
								      (QUOTE DATUM)
								      (QUOTE ffetch]
				  [REPAINTFN (CONSTANT (RECORDACCESSFORM (QUOTE REPAINTFN)
									 (QUOTE DATUM)
									 (QUOTE ffetch]
				  [CLOSEFN (CONSTANT (RECORDACCESSFORM (QUOTE CLOSEFN)
								       (QUOTE DATUM)
								       (QUOTE ffetch]
				  [WINDOWENTRYFN (CONSTANT (RECORDACCESSFORM (QUOTE WINDOWENTRYFN)
									     (QUOTE DATUM)
									     (QUOTE ffetch]
				  [PROCESS (CONSTANT (RECORDACCESSFORM (QUOTE PROCESS)
								       (QUOTE DATUM)
								       (QUOTE ffetch]
				  [REGION (CONSTANT (RECORDACCESSFORM (QUOTE REG)
								      (QUOTE DATUM)
								      (QUOTE ffetch]
				  [NEWREGIONFN (CONSTANT (RECORDACCESSFORM (QUOTE NEWREGIONFN)
									   (QUOTE DATUM)
									   (QUOTE ffetch]
				  [TITLE (CONSTANT (RECORDACCESSFORM (QUOTE WTITLE)
								     (QUOTE DATUM)
								     (QUOTE ffetch]
				  [BORDER (CONSTANT (RECORDACCESSFORM (QUOTE WBORDER)
								      (QUOTE DATUM)
								      (QUOTE ffetch]
				  [IMAGECOVERED (CONSTANT (RECORDACCESSFORM (QUOTE SAVE)
									    (QUOTE DATUM)
									    (QUOTE ffetch]
				  [HEIGHT (LIST (QUOTE GETWINDOWPROP)
						WINFORM
						(QUOTE (QUOTE HEIGHT]
				  [WIDTH (LIST (QUOTE GETWINDOWPROP)
					       WINFORM
					       (QUOTE (QUOTE WIDTH]
				  (RETURN (PROGN             (* return around SUBST. GETWINDOWUSERPROP will perform 
							     the window check and this avoids compiling code for it 
							     at every call.)
						 (LIST (QUOTE GETWINDOWUSERPROP)
						       WINFORM
						       (KWOTE PROP])

(\GETWINDOWHEIGHT
  [LAMBDA (WINDOW)                                           (* rrb " 4-Jun-84 18:03")

          (* calculate the height from the REGION in case user has changed the clipping region. This won't work if the 
	  height of the title display stream has changed.)


    (SETQ WINDOW (\INSUREWINDOW WINDOW))
    (DIFFERENCE (fetch (REGION HEIGHT) of (fetch (WINDOW REG) of WINDOW))
		(DIFFERENCE (ITIMES 2 (fetch (WINDOW WBORDER) of WINDOW))
			    (COND
			      ((fetch (WINDOW WTITLE) of WINDOW)
				(DSPLINEFEED NIL WindowTitleDisplayStream))
			      (T 0])

(\GETWINDOWWIDTH
  [LAMBDA (WINDOW)                                           (* rrb " 4-Jun-84 18:03")
                                                             (* calculate the width from the REGION in case the user 
							     has changed the clipping region.)
    (SETQ WINDOW (\INSUREWINDOW WINDOW))
    (DIFFERENCE (fetch (REGION WIDTH) of (fetch (WINDOW REG) of WINDOW))
		(ITIMES 2 (fetch (WINDOW WBORDER) of WINDOW])
)
(DEFINEQ

(OPENWP
  [LAMBDA (WINDOW)                                           (* rrb "26-OCT-83 15:01")
                                                             (* is WINDOW an open window?)
    (AND (type? WINDOW WINDOW)
	 (NEQ (fetch (WINDOW NEXTW) of WINDOW)
	      (QUOTE CLOSED))
	 WINDOW])

(RESHAPEBYREPAINTFN
  [LAMBDA (WINDOW OLDIMAGE IMAGEREGION OLDSCREENREGION)      (* rrb "11-Oct-84 17:22")

          (* default reshaping function that copies the lower left portion of the old image into the new image and calls the 
	  repaint function on the newly exposed portions.)



          (* if IMAGEREGION shares a corner with the current region, the excess is added in the opposite directions.
	  Also the newly exposed region will be a subset of the EXTENT property if the window has one.)


    (PROG ((NEWSCREENREGION (WINDOWPROP WINDOW (QUOTE REGION)))
	   (EXTENT (WINDOWPROP WINDOW (QUOTE EXTENT)))
	   (DSP (WINDOWPROP WINDOW (QUOTE DSP)))
	   (OLDWIDTH (fetch (REGION WIDTH) of IMAGEREGION))
	   (OLDHEIGHT (fetch (REGION HEIGHT) of IMAGEREGION))
	   NEWWID NEWHGHT WREGION OLDCRLFT OLDCRBTM NEWCRLFT NEWCRBTM DELTAWID DELTAHGHT NEWPTOP 
	   OLDPTOP NEWPRIGHT OLDPRIGHT YPOS)
          (SETQ WREGION (DSPCLIPPINGREGION NIL DSP))
          (SETQ OLDCRLFT (fetch (REGION LEFT) of WREGION))
          (SETQ OLDCRBTM (fetch (REGION BOTTOM) of WREGION))
                                                             (* calculate the position of the new clipping region.)
          (SETQ NEWWID (fetch (REGION WIDTH) of WREGION))
          (SETQ DELTAWID (IDIFFERENCE NEWWID OLDWIDTH))
          (SETQ NEWHGHT (fetch (REGION HEIGHT) of WREGION))
          (SETQ DELTAHGHT (IDIFFERENCE NEWHGHT OLDHEIGHT))
          [COND
	    [(AND OLDSCREENREGION EXTENT (EQ (fetch (REGION PRIGHT) of NEWSCREENREGION)
					     (fetch (REGION PRIGHT) of OLDSCREENREGION)))
                                                             (* right edges match, move the left one)
	      (SETQ NEWCRLFT (IDIFFERENCE OLDCRLFT DELTAWID))
	      (COND
		((AND (IGREATERP DELTAWID 0)
		      (IGREATERP (fetch (REGION LEFT) of EXTENT)
				 NEWCRLFT))

          (* this would be extending the window onto parts of the extent that don't have anything in them, reset the left so 
	  that it gets the entire extent)


		  (SETQ NEWCRLFT (IMIN (fetch (REGION LEFT) of EXTENT)
				       (IDIFFERENCE (fetch (REGION RIGHT) of EXTENT)
						    NEWWID]
	    (T                                               (* otherwise move the right edge.)
	       (COND
		 [(AND (IGREATERP DELTAWID 0)
		       EXTENT
		       (IGREATERP (IPLUS OLDCRLFT NEWWID)
				  (fetch (REGION RIGHT) of EXTENT)))

          (* this would be extending the window onto parts of the extent that don't have anything in them, reset the left so 
	  that it gets the entire extent)


		   (SETQ NEWCRLFT (IMAX (IMIN (fetch (REGION LEFT) of EXTENT)
					      OLDCRLFT)
					(IDIFFERENCE OLDCRLFT DELTAWID]
		 (T (SETQ NEWCRLFT OLDCRLFT]
          [COND
	    [(AND OLDSCREENREGION (EQ (fetch (REGION PTOP) of NEWSCREENREGION)
				      (fetch (REGION PTOP) of OLDSCREENREGION)))
                                                             (* top edges match, move the bottom one)
	      (SETQ NEWCRBTM (IDIFFERENCE OLDCRBTM DELTAHGHT))
	      (COND
		((AND (IGREATERP DELTAHGHT 0)
		      EXTENT
		      (IGREATERP (fetch (REGION BOTTOM) of EXTENT)
				 NEWCRBTM))

          (* this would be extending the window onto parts of the extent that don't have anything in them, reset the bottom so
	  that it gets the entire extent)


		  (SETQ NEWCRBTM (IMIN (fetch (REGION BOTTOM) of EXTENT)
				       (IDIFFERENCE (fetch (REGION TOP) of EXTENT)
						    NEWHGHT]
	    (T                                               (* otherwise move the top edge.)
	       (COND
		 [(AND (IGREATERP DELTAHGHT 0)
		       EXTENT
		       (IGREATERP (IPLUS OLDCRBTM OLDHEIGHT DELTAHGHT)
				  (fetch (REGION PTOP) of EXTENT)))

          (* this would be extending the window onto parts of the extent that don't have anything in them, reset the bottom so
	  that it gets the entire extent)


		   (SETQ NEWCRBTM (IMAX (IDIFFERENCE OLDCRBTM DELTAHGHT)
					(fetch (REGION BOTTOM) of EXTENT)
					(IDIFFERENCE (fetch (REGION PTOP) of EXTENT)
						     NEWHGHT]
		 (T (SETQ NEWCRBTM OLDCRBTM]                 (* scroll the window so that the new left bottom is the
							     left bottom of the clipping region.)
          [COND
	    ((AND (NULL EXTENT)
		  (\INBETWEENP (DSPXPOSITION NIL WINDOW)
			       OLDCRLFT
			       (IPLUS OLDCRLFT OLDWIDTH))
		  (\INBETWEENP (SETQ YPOS (DSPYPOSITION NIL WINDOW))
			       OLDCRBTM
			       (IPLUS OLDCRBTM OLDHEIGHT)))

          (* if the window doesn't have any EXTENT and its position is visible, make sure its Y position is visible at the end
	  of the scroll.)


	      (COND
		[(ILESSP YPOS NEWCRBTM)                      (* make sure the entire line of text being printed is 
							     visible.)
		  (SETQ NEWCRBTM (DIFFERENCE YPOS (FONTPROP WINDOW (QUOTE DESCENT]
		([IGREATERP YPOS (DIFFERENCE (IPLUS NEWCRBTM NEWHGHT)
					     (FONTPROP WINDOW (QUOTE ASCENT]
		  (SETQ NEWCRBTM (IPLUS (IDIFFERENCE YPOS NEWHGHT)
					(FONTPROP WINDOW (QUOTE ASCENT]
          [COND
	    ((NEQ OLDCRLFT NEWCRLFT)
	      (COND
		((EQ (DSPSCROLL NIL WINDOW)
		     (QUOTE ON))                             (* if scrolling is turned on, don't change the 
							     coordinates.)
		  NIL)
		(T (WXOFFSET (DIFFERENCE OLDCRLFT NEWCRLFT)
			     WINDOW]
          [COND
	    ((NEQ OLDCRBTM NEWCRBTM)
	      (COND
		((EQ (DSPSCROLL NIL WINDOW)
		     (QUOTE ON))                             (* if scrolling is turned on, change the Y rather than 
							     the coordinates.)
		  (DSPYPOSITION (PLUS (DIFFERENCE OLDCRBTM NEWCRBTM)
				      YPOS)
				WINDOW))
		(T (WYOFFSET (DIFFERENCE OLDCRBTM NEWCRBTM)
			     WINDOW]                         (* call the redisplay function on the four possible 
							     areas and blt the middle one.)
          (COND
	    ((IGREATERP (SETQ NEWPTOP (IPLUS NEWCRBTM NEWHGHT))
			(SETQ OLDPTOP (IPLUS OLDCRBTM OLDHEIGHT)))
                                                             (* call the display function on the newly exposed top 
							     area.)
	      (REDISPLAYW WINDOW (create REGION
					 LEFT ← NEWCRLFT
					 BOTTOM ← OLDPTOP
					 WIDTH ← NEWWID
					 HEIGHT ←(IDIFFERENCE NEWPTOP OLDPTOP))
			  T)))
          (COND
	    ((IGREATERP OLDCRLFT NEWCRLFT)                   (* call the display function on the newly exposed LEFT 
							     area.)
	      (REDISPLAYW WINDOW (create REGION
					 LEFT ← NEWCRLFT
					 BOTTOM ← OLDCRBTM
					 WIDTH ←(IDIFFERENCE OLDCRLFT NEWCRLFT)
					 HEIGHT ← OLDHEIGHT)
			  T)))                               (* blt center region.)
          (BITBLT OLDIMAGE (fetch (REGION LEFT) of IMAGEREGION)
		  (fetch (REGION BOTTOM) of IMAGEREGION)
		  DSP OLDCRLFT OLDCRBTM OLDWIDTH OLDHEIGHT NIL (QUOTE REPLACE))
          (COND
	    ((IGREATERP (SETQ NEWPRIGHT (IPLUS NEWCRLFT NEWWID))
			(SETQ OLDPRIGHT (IPLUS OLDCRLFT OLDWIDTH)))
                                                             (* call the display function on the newly exposed right
							     area.)
	      (REDISPLAYW WINDOW (create REGION
					 LEFT ← OLDPRIGHT
					 BOTTOM ← OLDCRBTM
					 WIDTH ←(IDIFFERENCE NEWPRIGHT OLDPRIGHT)
					 HEIGHT ← OLDHEIGHT)
			  T)))
          (COND
	    ((IGREATERP OLDCRBTM NEWCRBTM)                   (* call the display function on the newly exposed LEFT 
							     area.)
	      (REDISPLAYW WINDOW (create REGION
					 LEFT ← NEWCRLFT
					 BOTTOM ← NEWCRBTM
					 WIDTH ← NEWWID
					 HEIGHT ←(IDIFFERENCE OLDCRBTM NEWCRBTM))
			  T)))
          (RETURN WINDOW])

(\INBETWEENP
  [LAMBDA (X LFT RGHT)                                       (* rrb "11-Oct-84 17:07")
                                                             (* returns T if X is between LEFT and RIGHT)
    (AND (GEQ X LFT)
	 (GREATERP RGHT X])

(DECODE/WINDOW/OR/DISPLAYSTREAM
  [LAMBDA (DSORW WINDOWVAR TITLE BORDER)                     (* rmk: "12-OCT-83 11:31")

          (* provides a defaulting mechanism for display-streams that uses windows too. If DSORW is NIL, it uses the value 
	  of WINDOWVAR and if DSORW is NEW, it creates a new one.)


    (COND
      ((DISPLAYSTREAMP DSORW))
      ((WINDOWP DSORW)
	(OPENW DSORW)
	(AND TITLE (NOT (EQUAL TITLE (fetch WTITLE of DSORW)))
	     (WINDOWPROP DSORW (QUOTE TITLE)
			 TITLE))
	(AND BORDER (WINDOWPROP DSORW (QUOTE BORDER)
				BORDER))
	(fetch DSP of DSORW))
      [(NULL DSORW)
	(fetch DSP of (PROG ((WINDOW (EVALV WINDOWVAR)))
			    (RETURN (COND
				      ((WINDOWP WINDOW)
					(OPENW WINDOW)
					(AND TITLE (NOT (EQUAL TITLE (fetch WTITLE of WINDOW)))
					     (WINDOWPROP WINDOW (QUOTE TITLE)
							 TITLE))
					(AND BORDER (WINDOWPROP WINDOW (QUOTE BORDER)
								BORDER))
					WINDOW)
				      (T (SET WINDOWVAR (CREATEW NIL TITLE BORDER]
      [(EQ DSORW (QUOTE NEW))
	(fetch DSP of (SET WINDOWVAR (CREATEW NIL TITLE BORDER]
      (T (ERROR "Illegal args" (LIST DSORW WINDOWVAR])

(GROW/REGION
  [LAMBDA (REGION AMOUNT)                                    (* rrb "19-OCT-83 11:18")
                                                             (* increase REGION by amount in all directions)
    (CREATEREGION (IDIFFERENCE (fetch (REGION LEFT) of REGION)
			       AMOUNT)
		  (IDIFFERENCE (fetch (REGION BOTTOM) of REGION)
			       AMOUNT)
		  (IPLUS (fetch (REGION WIDTH) of REGION)
			 (SETQ AMOUNT (ITIMES AMOUNT 2)))
		  (IPLUS (fetch (REGION HEIGHT) of REGION)
			 AMOUNT])

(PPROMPT3
  [LAMBDA (ITEM)                                             (* rrb "17-NOV-81 12:15")
                                                             (* prints the third element of ITEM in the prompt 
							     window. This is the default WHENHELDFN for MENUs.)
    (COND
      ((AND (LISTP ITEM)
	    (CADDR ITEM))
	(PROMPTPRINT (CADDR ITEM])

(CLRPROMPT
  [LAMBDA NIL                      (* lmm "28-MAY-83 12:06")
                                   (* clears the prompt window)
    (COND
      ((type? WINDOW PROMPTWINDOW)
	(CLEARW PROMPTWINDOW))
      (T (TERPRI PROMPTWINDOW)
	 (TERPRI PROMPTWINDOW])

(PROMPTPRINT
  [LAMBDA N                        (* lmm "28-MAY-83 14:45")
                                   (* prints its arguments in the prompt window.)
    (CLRPROMPT)
    (for I from 1 to N do (PRIN1 (ARG N I)
				 PROMPTWINDOW])

(OPENWINDOWS
  [LAMBDA NIL                                                (* rrb "28-JUN-83 12:00")
                                                             (* returns a list of all open windows)
    (PROG (WINDOWS WPTR)
          (SETQ WPTR TOPW)
      LP  (COND
	    ((NULL WPTR)
	      (RETURN WINDOWS))
	    (T (SETQ WINDOWS (CONS WPTR WINDOWS))
	       (SETQ WPTR (fetch (WINDOW NEXTW) of WPTR))
	       (GO LP])

(\INSUREWINDOW
  [LAMBDA (WINDOW)                                           (* rmk: " 1-SEP-83 10:25")
                                                             (* coerces to a window)
    (COND
      ((type? WINDOW WINDOW)
	WINDOW)
      ((AND (DISPLAYSTREAMP (\OUTSTREAMARG WINDOW T))
	    (WFROMDS WINDOW)))
      (T (\ILLEGAL.ARG WINDOW])
)



(* these entries are left in for backward compatibility. They were dedocumented 6/83. rrb)

(MOVD (QUOTE OPENWP)
      (QUOTE ACTIVEWP))
(MOVD (QUOTE OPENWINDOWS)
      (QUOTE ACTIVEWINDOWS))
(DEFINEQ

(OVERLAPPINGWINDOWS
  [LAMBDA (WINDOW)                                           (* rrb " 8-May-84 16:26")
                                                             (* returns all windows that overlap with WINDOW or that 
							     overlap a window that is in the OVERLAPPINGWINDOWS of 
							     WINDOW.)
    (PROG ((WPTR TOPW)
	   (OVERLAPS (CONS WINDOW (ALLATTACHEDWINDOWS WINDOW)))
	   DONTS)
      LP  [COND
	    ((NULL WPTR)
	      (RETURN OVERLAPS))
	    ((MEMB WPTR OVERLAPS)                            (* skip the window itself)
	      NIL)
	    ([SOME OVERLAPS (FUNCTION (LAMBDA (X)
		       (WOVERLAPP WPTR X]                    (* this window overlaps a member of the interesting 
							     ones.)
	      (SETQ OVERLAPS (CONS WPTR OVERLAPS))           (* find all members of donts that overlap this new 
							     window and move them {and ones that overlap them} to 
							     OVERLAPS.)
	      (PROG ((ADDS (CONS WPTR))
		     OVERLAPPED)
		NWLP(COND
		      ((for old OVERLAPPED in DONTS thereis (WOVERLAPP (CAR ADDS)
								       OVERLAPPED))
                                                             (* the window that was added overlaps one of the 
							     previously looked at windows that was untouched.)
			(SETQ ADDS (CONS OVERLAPPED ADDS))
			(SETQ OVERLAPS (CONS OVERLAPPED OVERLAPS))
			(SETQ DONTS (REMOVE OVERLAPPED DONTS))
			(GO NWLP))
		      ((SETQ ADDS (CDR ADDS))                (* there are more windows that were added.)
			(GO NWLP)))
		    (RETURN)))
	    (T (SETQ DONTS (CONS WPTR DONTS]
          (SETQ WPTR (fetch (WINDOW NEXTW) of WPTR))
          (GO LP])

(WOVERLAPP
  [LAMBDA (W1 W2)                                           (* rrb "16-AUG-81 08:30")
                                                            (* do these windows overlap?)
    (REGIONSINTERSECTP (fetch (WINDOW REG) of W1)
		       (fetch (WINDOW REG) of W2])

(ORDERFROMBOTTOMTOTOP
  [LAMBDA (WLST)                                            (* rrb "16-AUG-81 16:57")
                                                            (* returns a list of windows in order from bottom to 
							    top)
    (PROG (ANS (WPTR TOPW))
      LP  [COND
	    ((NULL WPTR)
	      (RETURN ANS))
	    ((FMEMB WPTR WLST)
	      (SETQ ANS (CONS WPTR ANS]
          (SETQ WPTR (fetch (WINDOW NEXTW) of WPTR))
          (GO LP])
)



(* screen size changing functions.)

(DEFINEQ

(\ONSCREENW
  [LAMBDA (W)                                                (* rrb "14-OCT-81 11:19")
                                                             (* does W have any part on the screen?)
                                                             (* for now only consider that it might be too far to the
							     right as this is the wide to narrow screen case.)

          (* CURSORWIDTH is to make sure the cursor can be set in the window. It can be taken out when cursor hotspot can go
	  anywhere.)


    (IGREATERP (IDIFFERENCE SCREENWIDTH CURSORWIDTH)
	       (fetch (REGION LEFT) of (WINDOWPROP W (QUOTE REGION])

(\PUTONSCREENW
  [LAMBDA (W)                                                (* rrb " 3-MAR-82 11:16")
                                                             (* moves W so that it will be on the screen.
							     For now, moves it to the left by screenwidth)
    (MOVEW W (create POSITION
		     XCOORD ←(IDIFFERENCE (fetch (REGION LEFT) of (fetch (WINDOW REG) of W))
					  SCREENWIDTH)
		     YCOORD ←(fetch (REGION BOTTOM) of (WINDOWPROP W (QUOTE REGION])

(\UPDATECACHEDFIELDS
  [LAMBDA (DS)                                               (* rrb "14-OCT-81 16:53")
                                                             (* updates the cached fields of a displaystream for the 
							     fact that the screen bitmap changed sizes)
    (\SFFixDestination DS])

(\WWCHANGESCREENSIZE
  [LAMBDA NIL                                                (* rrb "28-Aug-84 15:29")

          (* the sysout has been moved to a screen of a different size. All windows are closed, the screenbitmap is updated 
	  to correct new size and the windows are reopened so that at least part of each is visible.)


    (PROG [(WINDOWS (DREVERSE (OPENWINDOWS]                  (* OPENWINDOWS returns the windows with bottom window 
							     first.)
          (for W in WINDOWS do (CLOSEW W))
          (\STARTDISPLAY)
          (\CLEARBM (SCREENBITMAP)
		    WINDOWBACKGROUNDSHADE)                   (* update cached bitmap width information that is in the
							     display streams)
          [for W in WINDOWS do (\UPDATECACHEDFIELDS (WINDOWPROP W (QUOTE DSP]
          [for W in KNOWNWINDOWS do (\UPDATECACHEDFIELDS (WINDOWPROP W (QUOTE DSP]
                                                             (* bring back windows)
          (for W in (DREVERSE WINDOWS)
	     do (COND
		  ((NOT (\ONSCREENW W))
		    (\PUTONSCREENW W)))
		(OPENW W])

(CREATEWFROMIMAGE
  [LAMBDA (IMAGE)                                            (* rrb "17-Jan-84 13:51")
                                                             (* creates a window that has IMAGE as an image.
							     It is initially closed and can be opened.)
    (PROG ((WINDOW (CREATEW (create REGION
				    LEFT ← 0
				    BOTTOM ← 0
				    WIDTH ←(BITMAPWIDTH IMAGE)
				    HEIGHT ←(BITMAPHEIGHT IMAGE))
			    NIL 0 T)))
          [WINDOWPROP WINDOW (QUOTE MINSIZE)
		      (CONS (IMIN MinWindowWidth (BITMAPWIDTH IMAGE))
			    (IMIN MinWindowWidth (BITMAPHEIGHT IMAGE]
          (BITBLT IMAGE 0 0 (fetch (WINDOW SAVE) of WINDOW))
          (RETURN WINDOW])

(UPDATEWFROMIMAGE
  [LAMBDA (WINDOW)                                           (* rrb " 9-MAR-82 14:33")
                                                             (* makes the fields of a window consistent with its 
							     image.)
    (PROG ((REGION (fetch REG of WINDOW))
	   (IMAGE (fetch SAVE of WINDOW)))
          (replace (REGION LEFT) of REGION with 0)
          (replace (REGION BOTTOM) of REGION with 0)
          (replace (REGION WIDTH) of REGION with (fetch (BITMAP BITMAPWIDTH) of IMAGE))
          (replace (REGION HEIGHT) of REGION with (fetch (BITMAP BITMAPHEIGHT) of IMAGE))
          (replace WBORDER of WINDOW with 0])
)
(* FOLLOWING DEFINITIONS EXPORTED)


(DECLARE: DOEVAL@COMPILE DONTCOPY 
(DECLARE: EVAL@COMPILE 
[PUTPROPS WINDOWWORLD MACRO (X (COND ((NULL X)
				      (QUOTE (type? WINDOW TOPW)))
				     (T (QUOTE IGNOREMACRO]
)
)


(* END EXPORTED DEFINITIONS)




(* Scrolling stuff)

(DEFINEQ

(SCROLLW
  [LAMBDA (WINDOW DX DY CONTINUOUSFLG)                       (* lmm "11-Jun-85 14:25")

          (* scrolls a window by DX in the X direction and DY in the Y direction. If CONTINUOUSFLG is non-NIL, this is part of
	  a continuous scroll so that the window scrolling function can decide for example to scroll a constant smount.)


    (\CHECKCARET WINDOW)
    (APPLY* (OR (fetch SCROLLFN of WINDOW)
		(FUNCTION SCROLLBYREPAINTFN))
	    WINDOW DX DY CONTINUOUSFLG])

(SCROLLBYREPAINTFN
  [LAMBDA (WINDOW XDELTA YDELTA CONTINUOUSFLG)               (* rrb " 2-May-85 10:00")
                                                             (* standard scrolling function that scrolls by blting 
							     existing bits and then calling the windows repaintfn to
							     repaint the newly exposed bits.)
    (PROG ((DSP (WINDOWPROP WINDOW (QUOTE DSP)))
	   (EXTENT (WINDOWPROP WINDOW (QUOTE EXTENT)))
	   (EXTENTUSE (WINDOWPROP WINDOW (QUOTE SCROLLEXTENTUSE)))
	   X CRHEIGHT CRWIDTH CRLEFT CRBOTTOM WHOLEHEIGHT WHOLEWIDTH XEXTENTUSE YEXTENTUSE)
          (SETQ X (DSPCLIPPINGREGION NIL DSP))
          (SETQ CRLEFT (fetch (REGION LEFT) of X))
          (SETQ CRBOTTOM (fetch (REGION BOTTOM) of X))
          (SETQ CRWIDTH (fetch (REGION WIDTH) of X))
          (SETQ CRHEIGHT (fetch (REGION HEIGHT) of X))
          [AND EXTENT (SELECTQ EXTENTUSE
			       (NIL                          (* original scrolling mode.)
				    (SETQ XEXTENTUSE (QUOTE LIMIT))
				    (SETQ YEXTENTUSE (QUOTE +)))
			       ((T + - +- LIMIT)
				 (SETQ XEXTENTUSE (SETQ YEXTENTUSE EXTENTUSE)))
			       [-+ (SETQ XEXTENTUSE (SETQ YEXTENTUSE (QUOTE +-]
			       (COND
				 [(LISTP EXTENTUSE)          (* CAR is X spec, CDR is Y spec)
				   (SETQ XEXTENTUSE (\DECODE.EXTENT.USE (CAR EXTENTUSE)))
				   (SETQ YEXTENTUSE (\DECODE.EXTENT.USE (CDR EXTENTUSE]
				 (T                          (* unknown value, default to T)
				    (SETQ XEXTENTUSE (SETQ YEXTENTUSE T]

          (* * calculate the amount to be moved in X)


          [COND
	    ((FLOATP XDELTA)                                 (* thumb scroll, XDELTA gives the fraction of the way 
							     from the left margin the cursor was.)
	      (COND
		[(AND EXTENT (NEQ (fetch (REGION WIDTH) of EXTENT)
				  -1))
		  (PROG (OLDX NEWX)                          (* if there is an extent, calculate a value of XDELTA 
							     that moves to the proper place.
							     If there is not, Don't do anything.)
		        [SETQ NEWX (IPLUS (fetch (REGION LEFT) of EXTENT)
					  (FIXR (FTIMES XDELTA (IDIFFERENCE (fetch (REGION WIDTH)
									       of EXTENT)
									    CRWIDTH]
		        (SETQ OLDX (WXOFFSET NIL DSP))
		        (SETQ XDELTA (IDIFFERENCE OLDX NEWX]
		(T (SETQ XDELTA 0]
          [COND
	    (CONTINUOUSFLG                                   (* if continuous set it scroll by the linefeed height 
							     {no particularly good reason why the linefeed height 
							     but why not}.)
			   (COND
			     ((EQ XDELTA 0))
			     [(IGREATERP XDELTA 0)           (* linefeed height is normally negative.)
			       (SETQ XDELTA (IMINUS (DSPLINEFEED NIL DSP]
			     (T (SETQ XDELTA (DSPLINEFEED NIL DSP]

          (* * calculate the amount to be moved in Y)


          [COND
	    ((FLOATP YDELTA)                                 (* thumb scroll, YDELTA gives the fraction of the way 
							     from the top margin the cursor was.)
	      (COND
		[(AND EXTENT (NEQ (fetch (REGION HEIGHT) of EXTENT)
				  -1))
		  (PROG (OLDY NEWY)                          (* if there is an extent, calculate a value of YDELTA 
							     that moves to the proper place.
							     If there is not, Don't do anything.)
		        (SETQ NEWY (IPLUS (FIXR (FTIMES (FDIFFERENCE 1.0 YDELTA)
							(IDIFFERENCE (fetch (REGION HEIGHT)
									of EXTENT)
								     CRHEIGHT)))
					  (fetch (REGION BOTTOM) of EXTENT)))
		        (SETQ OLDY (WYOFFSET NIL DSP))
		        (SETQ YDELTA (IDIFFERENCE OLDY NEWY]
		(T (SETQ YDELTA 0]
          [COND
	    (CONTINUOUSFLG                                   (* if continuous set it scroll by the linefeed height)
			   (COND
			     ((EQ YDELTA 0))
			     [(IGREATERP YDELTA 0)           (* linefeed height is normally negative.)
			       (SETQ YDELTA (IMINUS (DSPLINEFEED NIL DSP]
			     (T (SETQ YDELTA (DSPLINEFEED NIL DSP]
          [COND
	    ([NOT (SUBREGIONP WHOLEDISPLAY (WINDOWPROP WINDOW (QUOTE REGION]
                                                             (* reduce clipping region to be that part of the window
							     that is on the screen.)
	      (COND
		([NULL (SETQ X (INTERSECTREGIONS X (\DSPUNTRANSFORMREGION WHOLEDISPLAY
									  (fetch IMAGEDATA
									     of DSP]
                                                             (* whole image is off the screen.
							     Just move the coordinates.)
		  (WXOFFSET XDELTA DSP)
		  (WYOFFSET YDELTA DSP)
		  (RETURN]

          (* only one of XDELTA or YDELTA should be non-zero but do both anyway. When both can be non-zero, this code should 
	  avoid calling the repaintfn on the part of the object that is scrolled on by X but then scrolled off by Y.)

                                                             (* do X first because in the common case of printing it
							     is faster to do it first.)
          (COND
	    ((AND (NEQ XDELTA 0)
		  (COND
		    ((AND EXTENT (NEQ XEXTENTUSE T)
			  (NEQ (fetch (REGION WIDTH) of EXTENT)
			       -1))                          (* use the extent to limit the scrolling.)
                                                             (* for now limit right extent to right of window ETC. 
							     ie keep it always visible.)
		      (SETQ XDELTA (IMIN (IDIFFERENCE CRLEFT (IDIFFERENCE (fetch (REGION LEFT)
									     of EXTENT)
									  (SELECTQ XEXTENTUSE
										   ((+- +)
                                                             (* if X is allowed to go off to right move effective 
							     left of extent.)
										     CRWIDTH)
										   0)))
					 (IMAX (IDIFFERENCE (IPLUS CRLEFT CRWIDTH)
							    (PLUS (fetch (REGION PRIGHT)
								     of EXTENT)
								  (SELECTQ XEXTENTUSE
									   ((- +-)
									     CRWIDTH)
									   0)))
					       XDELTA)))     (* make sure it is still not 0)
		      (NEQ XDELTA 0))
		    (T T)))
	      (BITBLT WINDOW CRLEFT CRBOTTOM WINDOW (IPLUS XDELTA CRLEFT)
		      CRBOTTOM CRWIDTH CRHEIGHT (QUOTE INPUT)
		      (QUOTE REPLACE))
	      (WXOFFSET XDELTA DSP)
	      (SETQ CRLEFT (IDIFFERENCE CRLEFT XDELTA))
	      (REDISPLAYW WINDOW (COND
			    ((IGREATERP XDELTA 0)            (* moving to right, create new region on left for 
							     repaintfn)
			      (CREATEREGION CRLEFT CRBOTTOM (IMIN XDELTA CRWIDTH)
					    CRHEIGHT))
			    (T                               (* moving to left.)
			       (CREATEREGION (IMAX (IPLUS CRLEFT CRWIDTH XDELTA)
						   CRLEFT)
					     CRBOTTOM
					     (IMIN (IMINUS XDELTA)
						   CRWIDTH)
					     CRHEIGHT)))
			  T)))
          (COND
	    ((AND (NEQ YDELTA 0)
		  (COND
		    ((AND EXTENT (NEQ YEXTENTUSE T)
			  (NEQ (fetch (REGION HEIGHT) of EXTENT)
			       -1))                          (* limit amount by the extent)
		      (SETQ YDELTA (IMIN (IDIFFERENCE CRBOTTOM (IDIFFERENCE (fetch (REGION BOTTOM)
									       of EXTENT)
									    (SELECTQ YEXTENTUSE
										     ((+- +)
                                                             (* if Y is allowed to go off to top, move effective 
							     bottom of extent.)
										       CRHEIGHT)
										     0)))
					 (IMAX (IDIFFERENCE (IPLUS CRBOTTOM CRHEIGHT)
							    (PLUS (fetch (REGION PTOP) of EXTENT)
								  (SELECTQ YEXTENTUSE
									   ((- +-)
									     CRHEIGHT)
									   0)))
					       YDELTA)))

          (* old code (SETQ YDELTA (IMAX (IDIFFERENCE (SETQ X (PLUS CRBOTTOM CRHEIGHT)) (fetch (REGION PTOP) of EXTENT)) 
	  (IMIN (IDIFFERENCE (SUB1 X) (fetch (REGION BOTTOM) of EXTENT)) YDELTA))))

                                                             (* make sure its still not 0)
		      (NEQ YDELTA 0))
		    (T T)))                                  (* move the current image if any of it is still in 
							     view.)
	      (BITBLT WINDOW CRLEFT CRBOTTOM WINDOW CRLEFT (IPLUS YDELTA CRBOTTOM)
		      CRWIDTH CRHEIGHT (QUOTE INPUT)
		      (QUOTE REPLACE))
	      (WYOFFSET YDELTA DSP)                          (* use X as pointer to bottom in scrolled clipping 
							     region.)
	      (SETQ X (IDIFFERENCE CRBOTTOM YDELTA))
	      (REDISPLAYW WINDOW [COND
			    ((IGREATERP YDELTA 0)            (* moving up.)
			      (CREATEREGION CRLEFT X CRWIDTH (IMIN YDELTA CRHEIGHT)))
			    (T                               (* moving down, fill in top)
			       (CREATEREGION CRLEFT (IMAX (IPLUS CRHEIGHT X YDELTA)
							  X)
					     CRWIDTH
					     (IMIN (IMINUS YDELTA)
						   CRHEIGHT]
			  T)))
          (RETURN])

(ADJUSTOFFSETS
  [LAMBDA (WINDOW XDELTA YDELTA)                             (* rrb "26-AUG-81 15:38")
    (PROG [(DSP (WINDOWPROP WINDOW (QUOTE DSP]               (* determine the change in offsets caused by the scroll.
							     and redisplay the graph.)
          (WYOFFSET YDELTA DSP)
          (WXOFFSET XDELTA DSP)
          (RETURN])

(CREATESCROLLINGW
  [LAMBDA (TITLE BORDER)                                    (* rrb "30-DEC-81 12:00")
    (WINDOWPROP (CREATEW NIL TITLE BORDER)
		(QUOTE SCROLLFN)
		(FUNCTION SCROLLBYREPAINTFN])

(IN/SCROLL/BAR?
  [LAMBDA (WINDOW X Y)                                       (* rrb " 2-May-85 10:11")
                                                             (* is X, Y in the scroll bar for WINDOW?)
    (AND (fetch SCROLLFN of WINDOW)
	 (NOT (WINDOWPROP WINDOW (QUOTE NOSCROLLBARS)))
	 (COND
	   ((INSIDE? (fetch REG of WINDOW)
		     X Y)

          (* if it is inside the window, it is not in its scroll bar. This handles case where window is near left or bottom 
	  edge.)


	     NIL)
	   [(INSIDE? (fetch (WINDOW VERTSCROLLREG) of WINDOW)
		     X Y)
	     (PROG [(EXTENT (WINDOWPROP WINDOW (QUOTE EXTENT)))
		    (EXTENTUSE (WINDOWPROP WINDOW (QUOTE SCROLLEXTENTUSE]
	           (RETURN (COND
			     [(OR (NOT EXTENT)
				  (EQ (fetch (REGION WIDTH) of EXTENT)
				      -1)
				  (NOT EXTENTUSE)
				  (NEQ (COND
					 ((LISTP EXTENTUSE)
					   (\DECODE.EXTENT.USE (CDR EXTENTUSE)))
					 (T (\DECODE.EXTENT.USE EXTENTUSE)))
				       (QUOTE LIMIT]
			     (T (EXTENDPASTVERTBOUNDARIES (DSPCLIPPINGREGION NIL WINDOW)
							  EXTENT]
	   ((INSIDE? (fetch (WINDOW HORIZSCROLLREG) of WINDOW)
		     X Y)

          (* if there is an extent, make sure it is past the current view boundaries. -1 is used to mark an unknown width, 
	  treat it as if EXTENT wasn't given.)


	     (PROG [(EXTENT (WINDOWPROP WINDOW (QUOTE EXTENT)))
		    (EXTENTUSE (WINDOWPROP WINDOW (QUOTE SCROLLEXTENTUSE]
	           (RETURN (COND
			     [(OR (NOT EXTENT)
				  (EQ (fetch (REGION WIDTH) of EXTENT)
				      -1)
				  (NEQ (COND
					 ((LISTP EXTENTUSE)
					   (\DECODE.EXTENT.USE (CAR EXTENTUSE)))
					 (T (\DECODE.EXTENT.USE EXTENTUSE)))
				       (QUOTE LIMIT]
			     (T (EXTENDPASTHORIZBOUNDARIES (DSPCLIPPINGREGION NIL WINDOW)
							   EXTENT])

(RELDSPXOFFSET
  [LAMBDA (DX DISPLAYSTREAM)                                 (* relative offsetting function.)
    (DSPXOFFSET (IPLUS DX (DSPXOFFSET NIL DISPLAYSTREAM))
		DISPLAYSTREAM])

(RELDSPYOFFSET
  [LAMBDA (DY DISPLAYSTREAM)                                 (* relative offsetting function.)
    (DSPYOFFSET (IPLUS DY (DSPYOFFSET NIL DISPLAYSTREAM))
		DISPLAYSTREAM])

(SCROLL.HANDLER
  [LAMBDA (WINDOW)                                           (* rrb " 2-May-85 12:13")

          (* cursor has moved into scroll region. region of a window that has a scrollfn and has been IN/SCROLL/BAR? Handle 
	  interaction to determine type of scroll, if any, desired.)

                                                             (* returns non-NIL if scrolling was applicable.)
    (PROG (SCROLLREG SCROLLW BUTTON DIRECTION SCROLLCURSOR LEFTCURSOR RIGHTCURSOR MIDDLECURSOR 
		     TIMEDOWN CONTINUOUSSCROLL? TIMEIN TIMEINTIMER)
                                                             (* create a window as the easiest thing to do.
							     Fairly inefficient.)
                                                             (* if the main window is not open, it was probably 
							     closed before we got control here.
							     Don't do anything.)
          (OR (OPENWP WINDOW)
	      (RETURN))
          (GETMOUSESTATE)
          (COND
	    ((AND (INSIDE? (SETQ SCROLLREG (fetch (WINDOW VERTSCROLLREG) of WINDOW))
			   LASTMOUSEX LASTMOUSEY)
		  (PROGN (DISMISS SCROLLWAITTIME)
			 (GETMOUSESTATE)
			 (INSIDE? SCROLLREG LASTMOUSEX LASTMOUSEY)))
	      [COND
		((SETQ SCROLLW (fetch (WINDOW VERTSCROLLWINDOW) of WINDOW))
                                                             (* if there is one already, reopen it.)
		  (OPENW SCROLLW))
		((SETQ SCROLLW (replace (WINDOW VERTSCROLLWINDOW) of WINDOW
				  with (CREATEW SCROLLREG NIL 2]
	      (SETQ DIRECTION (QUOTE VERT))
	      (SETQ SCROLLCURSOR VertScrollCursor)
	      (SETQ LEFTCURSOR ScrollUpCursor)
	      (SETQ RIGHTCURSOR ScrollDownCursor)
	      (SETQ MIDDLECURSOR VertThumbCursor))
	    ((AND (INSIDE? (SETQ SCROLLREG (fetch (WINDOW HORIZSCROLLREG) of WINDOW))
			   LASTMOUSEX LASTMOUSEY)
		  (PROGN (DISMISS SCROLLWAITTIME)
			 (GETMOUSESTATE)
			 (INSIDE? SCROLLREG LASTMOUSEX LASTMOUSEY)))
	      [COND
		((SETQ SCROLLW (fetch (WINDOW HORIZSCROLLWINDOW) of WINDOW))
                                                             (* if there is one already, reopen it.)
		  (OPENW SCROLLW))
		((SETQ SCROLLW (replace (WINDOW HORIZSCROLLWINDOW) of WINDOW
				  with (CREATEW SCROLLREG NIL 2]
	      (SETQ DIRECTION (QUOTE HORIZ))
	      (SETQ SCROLLCURSOR HorizScrollCursor)
	      (SETQ LEFTCURSOR ScrollLeftCursor)
	      (SETQ MIDDLECURSOR HorizThumbCursor)
	      (SETQ RIGHTCURSOR ScrollRightCursor))
	    (T                                               (* moved out quickly)
	       (RETURN NIL)))
          (\UPDATE.EXTENT.IMAGE SCROLLW DIRECTION WINDOW)

          (* set up the timer for when to bring the window to the top. This gives the user a chance to notice that the scroll 
	  bar has come up and get out of it if it was unintentional.)


          (SETQ TIMEIN (SETUPTIMER 1200))
          (RETURN (RESETFORM (CURSOR SCROLLCURSOR)
			     (PROG NIL
			       LP  (GETMOUSESTATE)
			           (COND
				     ((NOT (OPENWP WINDOW))
                                                             (* the user closed the window, quit.)
				       (CLOSEW SCROLLW)
				       (SETQ \LastInWindow NIL)
				       (RETURN T)))
			           (COND
				     ((AND TIMEIN (TIMEREXPIRED? TIMEIN))
                                                             (* after a little while, bring the window to the top.
							     This avoids bringing it up if nothing is happening.)
				       (SETQ TIMEIN NIL)
				       (TOTOPW WINDOW)))
			           (COND
				     ((NOT (INSIDE? SCROLLREG LASTMOUSEX LASTMOUSEY))
                                                             (* if cursor is no longer in scroll region quit.)
				       (CLOSEW SCROLLW)

          (* if the mouse is in the window, set last in window so window will get control again. If it is outside, don't set 
	  it so that the cursoroutfn for WINDOW will get called.)


				       (AND (INSIDE? (WINDOWPROP WINDOW (QUOTE REGION))
						     LASTMOUSEX LASTMOUSEY)
					    (SETQ \LastInWindow NIL))
				       (RETURN T)))          (* bring the scroll window to the top so that it will 
							     be visible.)
			           (TOTOPW SCROLLW)
			           [COND
				     [(LASTMOUSESTATE UP)    (* no buttons down; if there was one down, take action;
							     otherwise, wait for one to go down.)
				       (COND
					 (BUTTON (COND
						   (CONTINUOUSSCROLL? 
                                                             (* were continuously scrolling, stop it.)
								      (SETQ CONTINUOUSSCROLL? NIL))
						   (T (\SCROLL.HANDLER.DOIT WINDOW BUTTON DIRECTION 
									    SCROLLREG LASTMOUSEX 
									    LASTMOUSEY)
						      (\UPDATE.EXTENT.IMAGE SCROLLW DIRECTION WINDOW))
						   )
						 (CURSOR SCROLLCURSOR)
						 (SETQ BUTTON)
                                                             (* if a button went up, reset the timedown for 
							     scrolling.)
						 (SETQ TIMEDOWN)
						 (SETQ CONTINUOUSSCROLL? NIL))
					 (T (BLOCK]
				     [(LASTMOUSESTATE (OR LEFT RIGHT))
				       (COND
					 ((AND (LASTMOUSESTATE LEFT)
					       (NEQ BUTTON (QUOTE LEFT)))
                                                             (* LEFT button just when down.)
					   (SETQ BUTTON (QUOTE LEFT))
					   (SETQ TIMEDOWN (CLOCK 0))
					   (CURSOR LEFTCURSOR))
					 ((AND (LASTMOUSESTATE RIGHT)
					       (NEQ BUTTON (QUOTE RIGHT)))
                                                             (* RIGHT button just when down.)
					   (SETQ BUTTON (QUOTE RIGHT))
					   (SETQ TIMEDOWN (CLOCK 0))
					   (CURSOR RIGHTCURSOR))
					 ((AND CONTINUOUSSCROLL? (\CLOCKGREATERP TIMEDOWN 
									    WAITBETWEENSCROLLTIME))
                                                             (* button is still down, keep scrolling.)
                                                             (* note time before calling scroll fn so time to 
							     display is included in the wait time.)
					   (SETQ TIMEDOWN (\CLOCK0 TIMEDOWN))
					   (\SCROLL.HANDLER.DOIT WINDOW BUTTON DIRECTION SCROLLREG 
								 LASTMOUSEX LASTMOUSEY T)
					   (\UPDATE.EXTENT.IMAGE SCROLLW DIRECTION WINDOW))
					 ((\CLOCKGREATERP TIMEDOWN WAITBEFORESCROLLTIME)
                                                             (* has enough time past to start continuous scroll?)
					   (SETQ CONTINUOUSSCROLL? T]
				     ((LASTMOUSESTATE MIDDLE)
				       (COND
					 ((NEQ BUTTON (QUOTE MIDDLE))
                                                             (* MIDDLE button just when down.)
					   (SETQ BUTTON (QUOTE MIDDLE))
                                                             (* don't keep track of time down for middle buttons.)
					   (CURSOR MIDDLECURSOR))
					 (T NIL]
			           (GO LP])

(\SCROLL.HANDLER.DOIT
  [LAMBDA (WINDOW BUTTON DIRECTION SCROLLREGION XPOS YPOS CONTINUOUS?)
                                                             (* rrb " 2-Oct-85 16:31")
                                                             (* decodes how far to scroll given that the button was
							     let up at position XPOS YPOS in the scroll region 
							     SCROLLREGION.)
    (ERSETQ
      (PROG ((WBORDER (WINDOWPROP WINDOW (QUOTE BORDER)))
	       LFT TOP (SIZEOFORIGIN 8))                     (* correct for the border on the window so that it 
							     never moves more than the amount that is seen.)
	      (SETQ LFT (IPLUS WBORDER (fetch (REGION LEFT) of SCROLLREGION)))
	      (SETQ TOP (IDIFFERENCE (fetch (REGION TOP) of SCROLLREGION)
					 WBORDER))
	      (RETURN
		(SCROLLW
		  WINDOW
		  (COND
		    ((EQ DIRECTION (QUOTE HORIZ))
		      (SELECTQ BUTTON
				 (LEFT                       (* always scroll at least 1)
				       (IMIN (IDIFFERENCE LFT XPOS)
					       1))
				 (RIGHT                      (* correct for border in window.)
					(IMAX (IDIFFERENCE XPOS LFT)
						1))
				 [MIDDLE (COND
					   ((IGREATERP (IPLUS LFT SIZEOFORIGIN)
							 XPOS)
                                                             (* make a portion of the left of the scroll bar 
							     indicate left edge of doc since it is a common case.)
					     0.0)
					   (T (MIN 1.0 (MAX 0.0
								(FQUOTIENT
								  (IDIFFERENCE XPOS
										 (IPLUS LFT 
										     SIZEOFORIGIN))
								  (IDIFFERENCE (fetch
										   (REGION WIDTH)
										    of SCROLLREGION)
										 (IPLUS 4 
										     SIZEOFORIGIN]
				 (SHOULDNT)))
		    (T 0))
		  (COND
		    ((EQ DIRECTION (QUOTE VERT))
		      (SELECTQ BUTTON
				 (LEFT                       (* always scroll at least 1)
				       (IMAX (IDIFFERENCE TOP YPOS)
					       1))
				 (RIGHT (IMIN (IDIFFERENCE YPOS TOP)
						-1))
				 [MIDDLE (COND
					   ((IGREATERP YPOS (IDIFFERENCE TOP SIZEOFORIGIN))
                                                             (* make a portion of the top of the scroll bar 
							     indicate top edge of doc since it is a common case.)
					     0.0)
					   (T (MIN 1.0 (MAX 0.0
								(FQUOTIENT
								  (IDIFFERENCE (IDIFFERENCE
										   TOP SIZEOFORIGIN)
										 YPOS)
								  (IDIFFERENCE (fetch
										   (REGION HEIGHT)
										    of SCROLLREGION)
										 (IPLUS 4 
										     SIZEOFORIGIN]
				 (SHOULDNT)))
		    (T 0))
		  CONTINUOUS?])

(\DECODE.EXTENT.USE
  [LAMBDA (EXTENTUSE)                                        (* rrb " 2-May-85 08:59")

          (* * decodes an indicator of how the extent should be used to limit scrolling.)


    (SELECTQ EXTENTUSE
	     (NIL (QUOTE LIMIT))
	     ((LIMIT T + - +-)
	       EXTENTUSE)
	     (-+ (QUOTE +-))
	     T])

(\UPDATE.EXTENT.IMAGE
  [LAMBDA (SCROLLBARW DIRECTION SCROLLINGW)                  (* rrb " 5-Oct-85 11:37")
                                                             (* paints the appropriate grey region in the scrolling
							     bar window.)
    (CLEARW SCROLLBARW)
    (PROG [(EXTENT (WINDOWPROP SCROLLINGW (QUOTE EXTENT]
	    (OR EXTENT (RETURN NIL))
	    (COND
	      [(EQ DIRECTION (QUOTE VERT))
		(PROG (GRAYHEIGHT GRAYBOTTOM SCROLLWIDTH SCROLLHEIGHT (WINREGION (
										DSPCLIPPINGREGION
										     NIL SCROLLINGW))
				    (SCROLLREGION (DSPCLIPPINGREGION NIL SCROLLBARW))
				    WINHEIGHT
				    (EXHEIGHT (fetch (REGION HEIGHT) of EXTENT)))
                                                             (* -1 is used to mark an extent of unknown height.
							     If height is 0, return also.)
		        (OR (GREATERP EXHEIGHT 0)
			      (RETURN))
		        (SETQ SCROLLWIDTH (fetch (REGION WIDTH) of SCROLLREGION))
		        (SETQ SCROLLHEIGHT (fetch (REGION HEIGHT) of SCROLLREGION))
		        (SETQ WINHEIGHT (fetch (REGION HEIGHT) of WINREGION))
		        [SETQ GRAYHEIGHT (IMAX 2 (IMIN SCROLLHEIGHT (IQUOTIENT (ITIMES
											 WINHEIGHT 
										     SCROLLHEIGHT)
										       EXHEIGHT]
		        (SETQ GRAYBOTTOM (IDIFFERENCE
			    (IDIFFERENCE SCROLLHEIGHT (IQUOTIENT
					     (ITIMES SCROLLHEIGHT (IDIFFERENCE
							 (fetch (REGION TOP) of EXTENT)
							 (fetch (REGION TOP) of WINREGION)))
					     EXHEIGHT))
			    GRAYHEIGHT))
		        (BITBLT NIL NIL NIL SCROLLBARW 0 GRAYBOTTOM SCROLLWIDTH GRAYHEIGHT
				  (QUOTE TEXTURE)
				  (QUOTE REPLACE)
				  BLACKSHADE)
		        (BITBLT NIL NIL NIL SCROLLBARW 1 (IPLUS GRAYBOTTOM 2)
				  (IDIFFERENCE SCROLLWIDTH 2)
				  (IDIFFERENCE GRAYHEIGHT 4)
				  (QUOTE TEXTURE)
				  (QUOTE REPLACE)
				  (OR (TEXTUREP SCROLLBARSHADE)
					32800]
	      ((EQ DIRECTION (QUOTE HORIZ))
		(PROG (GRAYWIDTH GRAYLEFT SCROLLWIDTH SCROLLHEIGHT (WINREGION (DSPCLIPPINGREGION
										  NIL SCROLLINGW))
				   (SCROLLREGION (DSPCLIPPINGREGION NIL SCROLLBARW))
				   WINWIDTH
				   (EXWIDTH (fetch (REGION WIDTH) of EXTENT)))
                                                             (* -1 is used to mark an EXTENT of unknown width.
							     If width is zero, return too.)
		        (AND (GREATERP 0 EXWIDTH)
			       (RETURN))
		        (SETQ SCROLLWIDTH (fetch (REGION WIDTH) of SCROLLREGION))
		        (SETQ SCROLLHEIGHT (fetch (REGION HEIGHT) of SCROLLREGION))
		        (SETQ WINWIDTH (fetch (REGION WIDTH) of WINREGION))
		        (SETQ GRAYWIDTH (IMIN SCROLLWIDTH (IQUOTIENT (ITIMES WINWIDTH 
										     SCROLLWIDTH)
									   EXWIDTH)))
		        (SETQ GRAYLEFT (IQUOTIENT (ITIMES WINWIDTH (IDIFFERENCE
								  (fetch (REGION LEFT)
								     of WINREGION)
								  (fetch (REGION LEFT)
								     of EXTENT)))
						      EXWIDTH))
		        (BITBLT NIL NIL NIL SCROLLBARW GRAYLEFT 0 GRAYWIDTH SCROLLHEIGHT
				  (QUOTE TEXTURE)
				  (QUOTE REPLACE)
				  BLACKSHADE)
		        (BITBLT NIL NIL NIL SCROLLBARW (IPLUS GRAYLEFT 2)
				  1
				  (IDIFFERENCE GRAYWIDTH 4)
				  (IDIFFERENCE SCROLLHEIGHT 2)
				  (QUOTE TEXTURE)
				  (QUOTE REPLACE)
				  (OR (TEXTUREP SCROLLBARSHADE)
					32800])

(EXTENDPASTHORIZBOUNDARIES
  [LAMBDA (VIEW EXTENT)                                      (* rrb "24-JAN-82 11:13")
                                                             (* does VIEW entirely cover the hoizontal dimensions of 
							     EXTENT?)
    (OR (IGREATERP (fetch (REGION LEFT) of VIEW)
		   (fetch (REGION LEFT) of EXTENT))
	(IGREATERP (fetch (REGION RIGHT) of EXTENT)
		   (fetch (REGION RIGHT) of VIEW])

(EXTENDPASTVERTBOUNDARIES
  [LAMBDA (VIEW EXTENT)                                      (* rrb " 2-May-85 10:10")
                                                             (* does VIEW entirely cover the vertical dimensions of 
							     EXTENT?)
    (OR (IGREATERP (fetch (REGION BOTTOM) of VIEW)
		   (fetch (REGION BOTTOM) of EXTENT))
	(IGREATERP (fetch (REGION TOP) of EXTENT)
		   (fetch (REGION TOP) of VIEW])

(REDISPLAYW
  [LAMBDA (WINDOW REGION ALWAYSFLG)                          (* rrb " 3-Jul-84 17:11")

          (* calls a repaint function after setting the clipping region of the window to it. If ALWAYSFLG is NIL, it won't 
	  redisplay unless there is a window repaintfn.)


    (PROG ((DSP (fetch (WINDOW DSP) of WINDOW))
	   REPAINTFN CLIPREG)
          (COND
	    [(SETQ REPAINTFN (WINDOWPROP WINDOW (QUOTE REPAINTFN]
	    (ALWAYSFLG (SETQ REPAINTFN (FUNCTION NILL)))
	    (T (PROMPTPRINT "Window has no REPAINTFN.  Can't redisplay.")
	       (RETURN)))
          (SETQ CLIPREG (DSPCLIPPINGREGION NIL DSP))
          (RETURN (COND
		    (REGION [COND
			      ((NOT (SUBREGIONP CLIPREG REGION))
                                                             (* reduce REGION so that it is within the clipping 
							     region of the window)
				(OR (SETQ REGION (INTERSECTREGIONS REGION CLIPREG))
				    (RETURN]
			    (RESETLST (RESETSAVE NIL (LIST (QUOTE DSPCLIPPINGREGION)
							   (DSPCLIPPINGREGION REGION DSP)
							   DSP))
				      (RESETSAVE NIL (LIST (QUOTE DSPXOFFSET)
							   (DSPXOFFSET NIL DSP)
							   DSP))
				      (RESETSAVE NIL (LIST (QUOTE DSPYOFFSET)
							   (DSPYOFFSET NIL DSP)
							   DSP))
				      (FILLWITHBACKGROUND WINDOW REGION)
				      (DOUSERFNS2 REPAINTFN WINDOW REGION)))
		    (T (FILLWITHBACKGROUND WINDOW REGION)
		       (DOUSERFNS2 REPAINTFN WINDOW CLIPREG])

(FILLWITHBACKGROUND
  [LAMBDA (WIN REG)                                         (* rrb "31-DEC-81 12:17")
                                                            (* fills a window with its background.
							    This is the default window repainting function.)
    (DSPFILL REG (DSPTEXTURE NIL WIN)
	     (QUOTE REPLACE)
	     (WINDOWPROP WIN (QUOTE DSP])

(UPDATE/SCROLL/REG
  [LAMBDA (WINDOW)                                           (* rrb " 9-MAR-82 14:34")
                                                             (* updates the scroll region field of the WINDOW)
    (COND
      ((fetch SCROLLFN of WINDOW)
	(PROG ((IMAGEREG (fetch REG of WINDOW)))             (* kill the cache for the scroll region.)
	      (COND
		((fetch (WINDOW VERTSCROLLWINDOW) of WINDOW)
		  (CLOSEW (fetch (WINDOW VERTSCROLLWINDOW) of WINDOW))
		  (replace (WINDOW VERTSCROLLWINDOW) of WINDOW with NIL)))
	      (COND
		((fetch (WINDOW HORIZSCROLLWINDOW) of WINDOW)
		  (CLOSEW (fetch (WINDOW HORIZSCROLLWINDOW) of WINDOW))
		  (replace (WINDOW HORIZSCROLLWINDOW) of WINDOW with NIL)))
	      [replace (WINDOW VERTSCROLLREG) of WINDOW
		 with (create REGION
			      LEFT ←(IMAX 0 (IDIFFERENCE (fetch (REGION LEFT) of IMAGEREG)
							 SCROLLBARWIDTH))
			      BOTTOM ←(fetch (REGION BOTTOM) of IMAGEREG)
			      WIDTH ← SCROLLBARWIDTH
			      HEIGHT ←(IPLUS (fetch (REGION HEIGHT) of IMAGEREG)
					     (COND
					       ((fetch (WINDOW WTITLE) of WINDOW)
						 (DSPLINEFEED NIL WindowTitleDisplayStream))
					       (T 0]
	      (replace (WINDOW HORIZSCROLLREG) of WINDOW
		 with (create REGION
			      LEFT ←(fetch (REGION LEFT) of IMAGEREG)
			      BOTTOM ←(IMAX 0 (IDIFFERENCE (fetch (REGION BOTTOM) of IMAGEREG)
							   SCROLLBARWIDTH))
			      WIDTH ←(fetch (REGION WIDTH) of IMAGEREG)
			      HEIGHT ← SCROLLBARWIDTH])

(WTODSX
  [LAMBDA (WX WINDOW)                                        (* rrb " 9-MAR-82 14:32")
                                                             (* converts from the window natural coordinates which 
							     have 0,0 at lower left corner of the window and the 
							     displaystreams coordinates.)
    (IPLUS WX (fetch (REGION LEFT) of (DSPCLIPPINGREGION NIL (fetch DSP of WINDOW])

(WTODSY
  [LAMBDA (WY WINDOW)                                        (* rrb " 9-MAR-82 14:23")
                                                             (* converts from the window natural coordinates which 
							     have 0,0 at lower left corner of the window and the 
							     displaystreams coordinates.)
    (IPLUS WY (fetch (REGION BOTTOM) of (DSPCLIPPINGREGION NIL (fetch DSP of WINDOW])

(WXOFFSET
  [LAMBDA (DX WINDOW)                                        (* rmk: " 1-SEP-83 10:25")
                                                             (* offsets a displaystream by a given delta but leaves 
							     its clipping region where it was.
							     Used for offsetting display streams under window.)
    (PROG [CR (DS (OR (DISPLAYSTREAMP (\OUTSTREAMARG WINDOW))
		      (\ILLEGAL.ARG WINDOW]
          (SETQ CR (DSPCLIPPINGREGION NIL DS))
          (RETURN (PROG1 (fetch (REGION LEFT) of CR)
			 (COND
			   ((NUMBERP DX)
			     (DSPXOFFSET (IPLUS DX (DSPXOFFSET NIL DS))
					 DS)
			     (add (fetch (REGION LEFT) of CR)
				  (IMINUS DX))               (* recall DSPCLIPPINGREGION to update dependent fields 
							     in DS.)
			     (DSPCLIPPINGREGION CR DS])

(WYOFFSET
  [LAMBDA (DY WINDOW)                                        (* rmk: "31-AUG-83 16:44")
                                                             (* offsets a displaystream by a given delta but leaves 
							     its clipping region where it was.
							     Used for offsetting display streams under window.)
    (PROG [CR (DS (OR (DISPLAYSTREAMP (\OUTSTREAMARG WINDOW))
		      (\ILLEGAL.ARG WINDOW]
          (SETQ CR (DSPCLIPPINGREGION NIL DS))
          (RETURN (PROG1 (fetch (REGION BOTTOM) of CR)
			 (COND
			   ((NUMBERP DY)
			     (DSPYOFFSET (IPLUS DY (DSPYOFFSET NIL DS))
					 DS)
			     (add (fetch (REGION BOTTOM) of CR)
				  (IMINUS DY))               (* recall DSPCLIPPINGREGION to update dependent fields 
							     in DS.)
			     (DSPCLIPPINGREGION CR DS])

(BITMAPSCROLLFN
  [LAMBDA (WINDOW XDELTA YDELTA)                             (* rrb "17-AUG-81 15:16")
                                                             (* scrolls a bitmap under a window)
    (SCROLLBITMAP (WINDOWPROP WINDOW (QUOTE BITMAP))
		  WINDOW XDELTA YDELTA])

(SCROLLBITMAP
  [LAMBDA (BITMAP WINDOW XDELTA YDELTA)                      (* rrb " 9-MAR-82 14:33")
                                                             (* scrolls a bitmap under a window.)
    (PROG ((DSP (WINDOWPROP WINDOW (QUOTE DSP)))
	   REGION)
          (COND
	    ((NOT (type? BITMAP BITMAP))
	      (RETURN)))
          (SETQ REGION (DSPCLIPPINGREGION NIL DSP))          (* determine the change in offsets caused by the 
							     scroll.)
          (WYOFFSET (IMAX (IMIN (fetch (REGION BOTTOM) of REGION)
				YDELTA)
			  (IDIFFERENCE (fetch (REGION HEIGHT) of REGION)
				       (fetch (BITMAP BITMAPHEIGHT) of BITMAP)))
		    DSP)
          (WXOFFSET (IMAX (IMIN (fetch (REGION LEFT) of REGION)
				XDELTA)
			  (IDIFFERENCE (fetch (REGION WIDTH) of REGION)
				       (fetch (BITMAP BITMAPWIDTH) of BITMAP)))
		    DSP)                                     (* stuff new image over old)
          (BITBLT BITMAP 0 0 DSP])

(REDISPLAYBITMAP
  [LAMBDA (BITMAP WINDOW)                                    (* rrb " 9-MAR-82 14:32")

          (* blts a bitmap into a window so that the lower left corner of the bitmap is in the lower left corner of the 
	  window.)


    (OR (type? BITMAP BITMAP)
	(ERROR "ILLEGAL ARG" BITMAP))
    (PROG ((DSP (WINDOWPROP WINDOW (QUOTE DSP)))
	   WREGION)
          (SETQ WREGION (DSPCLIPPINGREGION NIL DSP))
          (RETURN (BITBLT BITMAP 0 0 DSP (fetch (REGION LEFT) of WREGION)
			  (fetch (REGION BOTTOM) of WREGION])

(ULREDISPLAYBITMAP
  [LAMBDA (BITMAP WNEW)                                      (* rrb " 9-MAR-82 14:33")

          (* blts a bitmap into a window so that the upper left corner of the bitmap is in the upper left corner of the 
	  window.)


    (OR (type? BITMAP BITMAP)
	(ERROR "ILLEGAL ARG" BITMAP))
    (PROG ((DSP (WINDOWPROP WNEW (QUOTE DSP)))
	   REGION)
          (SETQ REGION (DSPCLIPPINGREGION NIL DSP))
          (RETURN (BITBLT BITMAP 0 0 DSP (fetch (REGION LEFT) of REGION)
			  (IDIFFERENCE (IPLUS (fetch (REGION BOTTOM) of REGION)
					      (fetch (REGION HEIGHT) of REGION))
				       (fetch BITMAPHEIGHT of BITMAP])

(EXTENDEXTENT
  [LAMBDA (WINDOW INCLUDEREGION)                             (* rrb "20-JAN-82 10:05")
                                                             (* destructively changes the EXTENT region of a WINDOW 
							     to include INCLUDEREGION)
    (PROG [(EXTENT (WINDOWPROP WINDOW (QUOTE EXTENT]
          (RETURN (COND
		    (EXTENT (EXTENDREGION EXTENT INCLUDEREGION))
		    (T (WINDOWPROP WINDOW (QUOTE EXTENT)
				   (create REGION using INCLUDEREGION])

(WIDTHIFWINDOW
  [LAMBDA (INTERIORWIDTH BORDER)                             (* rrb "28-JUN-83 14:17")
                                                             (* returns the exterior width of a window with interior 
							     dimension INTERIORWIDTH)
    (IPLUS INTERIORWIDTH (ITIMES 2 (OR BORDER WBorder])

(HEIGHTIFWINDOW
  [LAMBDA (INTERIORHEIGHT TITLEFLG BORDER)                   (* rrb "28-JUN-83 14:18")
                                                             (* returns the exterior height of a window which has 
							     interior height dimension INTERIORHEIGHT)
    (IPLUS INTERIORHEIGHT (COND
	     (TITLEFLG (IMINUS (DSPLINEFEED NIL WindowTitleDisplayStream)))
	     (T 0))
	   (ITIMES 2 (OR BORDER WBorder])
)



(* this function should be on LLDISPLAY but Ron has it checked out. Move it later - rrb.)

(DEFINEQ

(\DSPUNTRANSFORMREGION
  [LAMBDA (REGION DISPLAYDATA)                               (* rmk: "30-AUG-83 13:19")
                                                             (* translates a region from destination coordinates into
							     display stream coordinates.)
    (CREATEREGION (\DSPUNTRANSFORMX (fetch (REGION LEFT) of REGION)
				    DISPLAYDATA)
		  (\DSPUNTRANSFORMY (fetch (REGION BOTTOM) of REGION)
				    DISPLAYDATA)
		  (fetch (REGION WIDTH) of REGION)
		  (fetch (REGION HEIGHT) of REGION])
)



(* icon functions)

(DEFINEQ

(SHRINKW
  [LAMBDA (WINDOW TOWHAT ICONPOSITION EXPANDFN)              (* rrb " 3-Oct-85 10:38")

          (* Create a small WINDOW which acts as an Icon of window. This "icon window" provides a popup menu which will open 
	  the main WINDOW again, and run the function EXPANDFN. TOWHAT can be a BITMAP which will be used to make a WINDOW 
	  image, an existing window, or a string which will be printed in TITLE only icon window, or can be an existing 
	  window. If TOWHAT is NIL, the TITLE of the main WINDOW is used as the TOWHAT for the icon.)


    (SETQ WINDOW (\INSUREWINDOW WINDOW))
    (PROG (TITLE ICONW FN)                                 (* get the icon specification from the window if none 
							     is given.)
	    (COND
	      ((NOT (OPENWP WINDOW))                     (* if it is not currently active, don't do anything.
							     Maybe something should happen here but I don't 
							     understand what -
							     rrb)
		(RETURN NIL))
	      ((WINDOWPROP WINDOW (QUOTE ICONFOR))       (* This is already an icon!)
		(RETURN))
	      ((EQ (DOUSERFNS (WINDOWPROP WINDOW (QUOTE SHRINKFN))
				  WINDOW T)
		     (QUOTE DON'T))                        (* one of the shrinkfns disallowed the shrinkage.)
		(RETURN NIL)))
	    [SETQ ICONW (COND
		((type? BITMAP TOWHAT)                     (* use bitMap to create a WINDOW)
                                                             (* save the icon on the window so that next time it 
							     will shrink to the same thing.)
		  (WINDOWPROP WINDOW (QUOTE ICON)
				TOWHAT)
		  [WINDOWPROP WINDOW (QUOTE ICON)
				(SETQ ICONW (CREATEWFROMIMAGE (BITMAPCOPY TOWHAT]
		  ICONW)
		((WINDOWP TOWHAT)                          (* use given WINDOW as icon)
		  (OR (POSITIONP ICONPOSITION)
			(SETQ ICONPOSITION (QUOTE SAME)))
                                                             (* save the icon on the window so that next time it 
							     will shrink to the same thing.)
		  (WINDOWPROP WINDOW (QUOTE ICON)
				TOWHAT)
		  TOWHAT)
		((STRINGP TOWHAT)
		  (\MAKEICONWINDOW TOWHAT))
		(T                                           (* current call doesn't specify an icon window.
							     Look for something on the window.)
		   [SETQ TOWHAT (COND
		       [(SETQ FN (WINDOWPROP WINDOW (QUOTE ICONFN)))
                                                             (* User fn to create an icon.
							     Can return cached value)
			 (APPLY* FN WINDOW (WINDOWPROP WINDOW (QUOTE ICONWINDOW]
		       (T (WINDOWPROP WINDOW (QUOTE ICON]
		   (COND
		     ((WINDOWP TOWHAT)                     (* use given WINDOW as icon)
		       (OR (POSITIONP ICONPOSITION)
			     (SETQ ICONPOSITION (QUOTE SAME)))
		       TOWHAT)
		     ((type? BITMAP TOWHAT)                (* use bitMap to create a WINDOW)
		       (CREATEWFROMIMAGE (BITMAPCOPY TOWHAT)))
		     (T (\MAKEICONWINDOW (OR TOWHAT (AND (SETQ TITLE (WINDOWPROP
								   WINDOW
								   (QUOTE TITLE)))
							       (NOT (EQUAL TITLE ""))
							       TITLE)
						 (CONCAT "Icon made " (DATE]
	    (WINDOWPROP WINDOW (QUOTE ICONWINDOW)
			  ICONW)
	    (WINDOWPROP ICONW (QUOTE ICONFOR)
			  WINDOW)                            (* set up so that if icon is closed, main window will 
							     be also.)
	    (WINDOWADDFNPROP ICONW (QUOTE CLOSEFN)
			       (FUNCTION CLOSEMAINWINDOW))
	    [COND
	      ((EQ (WINDOWPROP ICONW (QUOTE BUTTONEVENTFN))
		     (QUOTE TOTOPW))                       (* if the iconw doesn't have a buttoneventfn, give it 
							     one that the middle expands it.)
		(WINDOWPROP ICONW (QUOTE BUTTONEVENTFN)
			      (FUNCTION (LAMBDA (ICONW)
				  (COND
				    [(LASTMOUSESTATE MIDDLE)
				      (CURSOR (PROG1 (CURSOR WAITINGCURSOR)
							 (EXPANDW ICONW]
				    (T (MOVEW ICONW]       (* set up so that if main window is opened, icon is 
							     closed.)
	    (WINDOWADDFNPROP WINDOW (QUOTE OPENFN)
			       (FUNCTION CLOSEICONWINDOW))
	    (WINDOWADDFNPROP ICONW (QUOTE MOVEFN)
			       (FUNCTION \NOTENEWICONPOSITION))
	    (AND EXPANDFN (WINDOWADDFNPROP WINDOW (QUOTE EXPANDFN)
					       EXPANDFN))
	    (WINDOWPROP ICONW (QUOTE DOWINDOWCOMFN)
			  (FUNCTION DOICONWINDOWCOM))
	    [OR (EQ ICONPOSITION (QUOTE SAME))
		  (MOVEW ICONW
			   (COND
			     ((POSITIONP ICONPOSITION)
			       (WINDOWPROP ICONW (QUOTE ICONPOSITION)
					     ICONPOSITION)
			       ICONPOSITION)
			     [(POSITIONP (WINDOWPROP WINDOW (QUOTE ICONPOSITION]
			     (T                              (* leave it in its current location.)
				(PROG [(WREG (WINDOWPROP WINDOW (QUOTE REGION)))
					 (ICONREG (WINDOWPROP ICONW (QUOTE REGION]
				        (RETURN (create
						    POSITION
						    XCOORD ←[COND
						      ((ILESSP (fetch (REGION LEFT) of WREG)
								 (IDIFFERENCE SCREENWIDTH
										(fetch
										  (REGION PRIGHT)
										   of WREG)))
							(IMAX 0 (fetch (REGION LEFT)
								     of WREG)))
						      (T (IDIFFERENCE (IMIN SCREENWIDTH
										(fetch
										  (REGION PRIGHT)
										   of WREG))
									(fetch (REGION WIDTH)
									   of ICONREG]
						    YCOORD ←(COND
						      ((ILESSP (fetch (REGION BOTTOM)
								    of WREG)
								 (IDIFFERENCE SCREENHEIGHT
										(fetch
										  (REGION PTOP)
										   of WREG)))
							(IMAX 0 (fetch (REGION BOTTOM)
								     of WREG)))
						      (T (IDIFFERENCE (IMIN SCREENHEIGHT
										(fetch
										  (REGION PTOP)
										   of WREG))
									(fetch (REGION HEIGHT)
									   of ICONREG]
	    (\CLOSEW1 WINDOW)
	    (OPENW ICONW)
	    (RETURN ICONW])

(\MAKEICONWINDOW
  [LAMBDA (ICONTEXT)                                         (* rrb "30-Sep-85 15:51")
                                                             (* returns an icon window with the text ICONTEXT as its
							     label.)
    (PROG ((W (CREATEW [create REGION
			       LEFT ← LASTMOUSEX
			       BOTTOM ← LASTMOUSEY
			       HEIGHT ←(IMINUS (DSPLINEFEED NIL WindowTitleDisplayStream))
			       WIDTH ←(IMAX MinWindowWidth (IPLUS 8 (STRINGWIDTH ICONTEXT 
									 WindowTitleDisplayStream]
		       ICONTEXT NIL T)))
          (WINDOWPROP W (QUOTE MINSIZE)
		      (FUNCTION \TITLEICONMINSIZE))
          (RETURN W])

(\TITLEICONMINSIZE
  [LAMBDA (WINDOW)                                           (* rrb "17-Jan-84 13:56")
                                                             (* returns the minimum size the default icon can be.)
    (CONS MinWindowWidth (IMINUS (DSPLINEFEED NIL WindowTitleDisplayStream])

(\NOTENEWICONPOSITION
  [LAMBDA (ICONW NEWPOS)                                     (* rrb "13-Jan-84 10:39")
                                                             (* saves the new position of the icon on the property 
							     list so that the icon will come up there again.)
    (AND (SETQ ICONW (WINDOWPROP ICONW (QUOTE ICONFOR)))
	 (WINDOWPROP ICONW (QUOTE ICONPOSITION)
		     NEWPOS))
    NEWPOS])

(EXPANDW
  [LAMBDA (ICONW)                                            (* rrb " 2-Jul-84 15:41")
                                                             (* expands an icon window into its main window.)
    (PROG ((IW ICONW)
	   MAINWINDOW USEREXPANDFN)
          [COND
	    [(SETQ MAINWINDOW (WINDOWPROP IW (QUOTE ICONFOR]
	    ((SETQ IW (WINDOWPROP IW (QUOTE ICONWINDOW)))    (* user has passed in the window to expand, not its 
							     icon.)
	      (COND
		((OPENWP (SETQ MAINWINDOW ICONW))            (* make sure the window is shrunken.)
		  (RETURN ICONW]
          (COND
	    ([AND MAINWINDOW (NULL (\USERFNISDON'T (SETQ USEREXPANDFN (WINDOWPROP MAINWINDOW
										  (QUOTE EXPANDFN]
                                                             (* if the main window will open and none of the 
							     expandfns stop it, open the main window and Close icon 
							     Window)
	      (\OPENW1 MAINWINDOW)
	      (\CLOSEW1 IW)
	      (WINDOWDELPROP MAINWINDOW (QUOTE OPENFN)
			     (QUOTE CLOSEICONWINDOW))
	      (WINDOWDELPROP IW (QUOTE CLOSEFN)
			     (QUOTE CLOSEMAINWINDOW))        (* call the expand functions after the window has been 
							     opened.)
	      (DOUSERFNS USEREXPANDFN MAINWINDOW)            (* break link from icon to window.)
	      (RETURN (WINDOWPROP IW (QUOTE ICONFOR)
				  NIL])

(DOICONWINDOWCOM
  [LAMBDA (WINDOW)                                           (* rrb " 7-AUG-83 18:52")

          (* the button handler for an ICON window Test for non-NIL WINDOW means that caller needn't worry about whether the
	  mouse is pointing at a window.)


    (AND (type? WINDOW WINDOW)
	 (PROG (COM)
	       (TOTOPW WINDOW)
	       (RETURN (COND
			 ((SETQ COM (MENU [COND
					    ((TYPENAMEP IconWindowMenu (QUOTE MENU))
					      IconWindowMenu)
					    ((SETQ IconWindowMenu
						(create MENU
							ITEMS ← IconWindowMenuCommands
							CHANGEOFFSETFLG ←(QUOTE Y)
							MENUOFFSET ←(create POSITION
									    XCOORD ← -1
									    YCOORD ← 0)
							WHENHELDFN ←(FUNCTION PPROMPT3)
							WHENUNHELDFN ←(FUNCTION CLRPROMPT)
							CENTERFLG ← T]
					  IconWindowMenu))
			   (APPLY* COM WINDOW)
			   T])

(CLOSEMAINWINDOW
  [LAMBDA (ICONWIN)                                          (* rrb "28-JUN-83 11:58")
                                                             (* the closefn for an icon window that closes the main 
							     window as well.)
    (PROG [(MAINWIN (WINDOWPROP ICONWIN (QUOTE ICONFOR]
          [COND
	    (MAINWIN (COND
		       ((NULL (\OKTOCLOSEW MAINWIN))

          (* Call the main windows closefns. If main window won't close, don't close the icon. The main window has already 
	  been removed from the window stack but its closefns haven't been executed.)


			 (RETURN (QUOTE DON'T)))
		       (T                                    (* closefns for main window may have opened it for 
							     example by printing to it. Close it if it is open.)
			  (AND (OPENWP MAINWIN)
			       (\CLOSEW1 MAINWIN]

          (* break link between the icon and the main window. This may give problems if someone holds onto the icon window 
	  and explicitly reopens it and expects it to still be an icon.)


          (WINDOWPROP ICONWIN (QUOTE ICONFOR)
		      NIL)
          (RETURN NIL])

(CLOSEICONWINDOW
  [LAMBDA (MAINWIN)                                          (* rrb " 1-May-85 15:55")
                                                             (* the open function for a window which has an icon.
							     It closes the (icon and does the expandfns))
    (PROG ((ICONW (WINDOWPROP MAINWIN (QUOTE ICONWINDOW)))
	   USEREXPANDFN)

          (* this code duplicates much of EXPANDW but I couldn't quite get it to be a call because EXPANDW opens the main 
	  window which in this case is already open.)


          (COND
	    (ICONW                                           (* Don't die if user removed the ICONWINDOW prop)
		   (WINDOWDELPROP ICONW (QUOTE CLOSEFN)
				  (QUOTE CLOSEMAINWINDOW))   (* remove the mainwindowclosing function first.)
		   (CLOSEW ICONW)
		   (DOUSERFNS (WINDOWPROP MAINWIN (QUOTE EXPANDFN))
			      MAINWIN)                       (* break link from icon to main window.)
		   (WINDOWPROP ICONW (QUOTE ICONFOR)
			       NIL)))                        (* remove icon closing function.)
          (WINDOWDELPROP MAINWIN (QUOTE OPENFN)
			 (QUOTE CLOSEICONWINDOW])
)

(RPAQQ IconMenuItems (Expand))
(RPAQ VertScrollCursor (CURSORCREATE (READBITMAP) 7 15))
(16 16
"@A@@"
"@CH@"
"@CH@"
"@GL@"
"@GL@"
"@ON@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@ON@"
"@GL@"
"@GL@"
"@CH@"
"@CH@"
"@A@@")(RPAQ ScrollUpCursor (CURSORCREATE (READBITMAP) 7 15))
(16 16
"@A@@"
"@CH@"
"@CH@"
"@GL@"
"@GL@"
"@ON@"
"@ON@"
"AOO@"
"AOO@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@")(RPAQ ScrollDownCursor (CURSORCREATE (READBITMAP) 7 15))
(16 16
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"@CH@"
"AOO@"
"AOO@"
"@ON@"
"@ON@"
"@GL@"
"@GL@"
"@CH@"
"@CH@"
"@A@@")(RPAQ HorizScrollCursor (CURSORCREATE (READBITMAP) 7 5))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@HB@"
"AHC@"
"CHCH"
"GHCL"
"OOON"
"OOON"
"GHCL"
"CHCH"
"AHC@"
"@HB@")(RPAQ ScrollLeftCursor (CURSORCREATE (READBITMAP) 8 5))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@H@"
"@CH@"
"@OH@"
"COH@"
"OOOO"
"OOOO"
"COH@"
"@OH@"
"@CH@"
"@@H@")(RPAQ ScrollRightCursor (CURSORCREATE (READBITMAP) 7 5))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@A@@"
"@AL@"
"@AO@"
"@AOL"
"OOOO"
"OOOO"
"@AOL"
"@AO@"
"@AL@"
"@A@@")(RPAQ VertThumbCursor (CURSORCREATE (READBITMAP) 6 8))
(16 16
"@@@@"
"OH@@"
"@@@@"
"OO@@"
"@@@@"
"OON@"
"@@@@"
"OOOH"
"@@@@"
"OON@"
"@@@@"
"OO@@"
"@@@@"
"OH@@"
"@@@@"
"@@@@")(RPAQ HorizThumbCursor (CURSORCREATE (READBITMAP) 6 6))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@B@@"
"@B@@"
"@JH@"
"@JH@"
"@JH@"
"BJJ@"
"BJJ@"
"BJJ@"
"JJJH"
"JJJH"
"JJJH"
"JJJH"
"JJJH")(RPAQ WAITINGCURSOR (CURSORCREATE (READBITMAP) 7 8))
(16 16
"OOON"
"L@@F"
"F@AL"
"CMGH"
"AOO@"
"@ON@"
"@FL@"
"@CH@"
"@BH@"
"@FL@"
"@MF@"
"AIC@"
"CGMH"
"FGNL"
"OOON"
"OOON")(DECLARE: EVAL@COMPILE DONTCOPY 
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \LastCursorPosition \LastInWindow WindowMenu BackgroundMenu BackgroundMenuCommands 
	    \LastWindowButtons WWFNS WindowMenuCommands IconWindowMenu IconWindowMenuCommands 
	    VertScrollCursor ScrollUpCursor ScrollDownCursor ScrollLeftCursor ScrollRightCursor 
	    HorizScrollCursor WindowTitleDisplayStream WINDOWTITLEPRINTLEVEL WBorder \TOPWDS 
	    WINDOWBACKGROUNDSHADE CURRENTBACKGROUNDSHADE BACKGROUNDFNS)
)

(DECLARE: EVAL@COMPILE 

(RPAQQ MinWindowWidth 26)

(RPAQQ MinWindowHeight 16)

(CONSTANTS (MinWindowWidth 26)
	   (MinWindowHeight 16))
)

(* FOLLOWING DEFINITIONS EXPORTED)


[DECLARE: EVAL@COMPILE 

(DATATYPE WINDOW (DSP NEXTW SAVE REG BUTTONEVENTFN RIGHTBUTTONFN CURSORINFN CURSOROUTFN 
			CURSORMOVEDFN REPAINTFN RESHAPEFN EXTENT USERDATA VERTSCROLLREG 
			HORIZSCROLLREG SCROLLFN VERTSCROLLWINDOW HORIZSCROLLWINDOW CLOSEFN MOVEFN 
			WTITLE NEWREGIONFN WBORDER PROCESS WINDOWENTRYFN SCREEN)
	  BUTTONEVENTFN ←(FUNCTION TOTOPW)
	  WBORDER ← WBorder WINDOWENTRYFN ←(FUNCTION GIVE.TTY.PROCESS))
]
(/DECLAREDATATYPE (QUOTE WINDOW)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER))
		  (QUOTE ((WINDOW 0 POINTER)
			  (WINDOW 2 POINTER)
			  (WINDOW 4 POINTER)
			  (WINDOW 6 POINTER)
			  (WINDOW 8 POINTER)
			  (WINDOW 10 POINTER)
			  (WINDOW 12 POINTER)
			  (WINDOW 14 POINTER)
			  (WINDOW 16 POINTER)
			  (WINDOW 18 POINTER)
			  (WINDOW 20 POINTER)
			  (WINDOW 22 POINTER)
			  (WINDOW 24 POINTER)
			  (WINDOW 26 POINTER)
			  (WINDOW 28 POINTER)
			  (WINDOW 30 POINTER)
			  (WINDOW 32 POINTER)
			  (WINDOW 34 POINTER)
			  (WINDOW 36 POINTER)
			  (WINDOW 38 POINTER)
			  (WINDOW 40 POINTER)
			  (WINDOW 42 POINTER)
			  (WINDOW 44 POINTER)
			  (WINDOW 46 POINTER)
			  (WINDOW 48 POINTER)
			  (WINDOW 50 POINTER)))
		  (QUOTE 52))


(* END EXPORTED DEFINITIONS)

)
(DECLARE: EVAL@COMPILE 
(* FOLLOWING DEFINITIONS EXPORTED)


(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS TOPW WINDOWUSERFORMS ENDOFWINDOWUSERFORMS PROMPTWINDOW KNOWNWINDOWS)
)


(* END EXPORTED DEFINITIONS)

)
[ADDTOVAR SYSTEMRECLST

(DATATYPE WINDOW (DSP NEXTW SAVE REG BUTTONEVENTFN RIGHTBUTTONFN CURSORINFN CURSOROUTFN 
			CURSORMOVEDFN REPAINTFN RESHAPEFN EXTENT USERDATA VERTSCROLLREG 
			HORIZSCROLLREG SCROLLFN VERTSCROLLWINDOW HORIZSCROLLWINDOW CLOSEFN MOVEFN 
			WTITLE NEWREGIONFN WBORDER PROCESS WINDOWENTRYFN SCREEN))
]
(/DECLAREDATATYPE (QUOTE WINDOW)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER))
		  (QUOTE ((WINDOW 0 POINTER)
			  (WINDOW 2 POINTER)
			  (WINDOW 4 POINTER)
			  (WINDOW 6 POINTER)
			  (WINDOW 8 POINTER)
			  (WINDOW 10 POINTER)
			  (WINDOW 12 POINTER)
			  (WINDOW 14 POINTER)
			  (WINDOW 16 POINTER)
			  (WINDOW 18 POINTER)
			  (WINDOW 20 POINTER)
			  (WINDOW 22 POINTER)
			  (WINDOW 24 POINTER)
			  (WINDOW 26 POINTER)
			  (WINDOW 28 POINTER)
			  (WINDOW 30 POINTER)
			  (WINDOW 32 POINTER)
			  (WINDOW 34 POINTER)
			  (WINDOW 36 POINTER)
			  (WINDOW 38 POINTER)
			  (WINDOW 40 POINTER)
			  (WINDOW 42 POINTER)
			  (WINDOW 44 POINTER)
			  (WINDOW 46 POINTER)
			  (WINDOW 48 POINTER)
			  (WINDOW 50 POINTER)))
		  (QUOTE 52))

(RPAQ? WWFNS (QUOTE (\TOTOPWDS)))

(RPAQ? WindowTitleDisplayStream )

(RPAQ? WindowMenu )

(RPAQ? BackgroundMenu )

(RPAQ? TOPW )

(RPAQ? \LastCursorPosition (CREATEPOSITION))

(RPAQ? \LastInWindow )

(RPAQ? \LastWindowButtons 0)

(RPAQ? IconWindowMenu )

(RPAQ? KNOWNWINDOWS )

(RPAQ? WINDOWBACKGROUNDSHADE 34850)

(RPAQ? WBorder 4)

(RPAQ? SCROLLBARWIDTH 24)

(RPAQ? SCROLLWAITTIME 100)

(RPAQ? SCROLLBARSHADE 32800)

(RPAQ? WAITBEFORESCROLLTIME 750)

(RPAQ? WAITBETWEENSCROLLTIME 100)

(RPAQ? PAINTCOMMANDBRUSH (QUOTE (ROUND 2)))

(RPAQ? PAINTCOMMANDMODE (QUOTE PAINT))

(RPAQ? PAINTCOMMANDMENU )

(RPAQ? PAINTCOMMANDSHADE BLACKSHADE)

(RPAQ? PAINTSIZEMENU )

(RPAQ? PAINTSHAPEMENU )

(RPAQ? PAINTSHADEMENU )

(RPAQ? PAINTMODEMENU )

(RPAQ? HIGHLIGHTSHADE 32800)

(ADDTOVAR WindowMenuCommands (Close (QUOTE CLOSEW)
				      "Closes a window")
			       (Snap (QUOTE SNAPW)
				     "Saves a snapshot of a region of the screen.")
			       (Paint (QUOTE PAINTW)
				      
"Starts a painting mode in which the mouse can be
used to draw pictures or make notes on windows.")
			       (Clear (QUOTE CLEARW)
				      "Clears a window to its gray.")
			       (Bury (QUOTE BURYW)
				     "Puts a window on the bottom.")
			       (Redisplay (QUOTE REDISPLAYW)
					  "Redisplays a window using its REPAINTFN.")
			       (Hardcopy (QUOTE HARDCOPYIMAGEW)
					 "Prints a window using its HARDCOPYFN."
					 (SUBITEMS ("To a file" (QUOTE HARDCOPYIMAGEW.TOFILE)
								
					  "Puts image on a file; prompts for filename and format")
						   ("To a printer" (QUOTE HARDCOPYIMAGEW.TOPRINTER)
								   
						      "Sends image to a printer of your choosing")))
			       (Move (QUOTE MOVEW)
				     "Moves a window by a corner.")
			       (Shape (QUOTE SHAPEW)
				      
"Gets a new region for a window.
Left button down marks fixed corner; sweep to other corner.
Middle button down moves closest corner.")
			       (Shrink (QUOTE SHRINKW)
				       
		       "Replaces this window with its icon (or title if it doesn't have an icon."))

(ADDTOVAR IconWindowMenuCommands (Close (QUOTE CLOSEW)
					  "Closes the icon and its assciated window")
				   (Snap (QUOTE SNAPW)
					 "Saves a snapshot of a region of the screen.")
				   (Paint (QUOTE PAINTW)
					  
"Starts a painting mode in which the mouse can
be used to draw pictures or make notes on windows.
Includes a HARDCOPY command.")
				   (Bury (QUOTE BURYW)
					 "Puts a window on the bottom.")
				   (Move (QUOTE MOVEW)
					 "Moves a window by a corner.")
				   (Shape (QUOTE SHAPEW)
					  
"Gets a new region for a window.
Left button down marks fixed corner; sweep to other corner.
Middle button down moves closest corner.")
				   (Expand (QUOTE EXPANDW)
					   "Expands the window for which this is the ICON."))

(ADDTOVAR BackgroundMenuCommands (SaveVM (QUOTE (SAVEVM))
					   "Updates the virtual memory.")
				   (Snap (QUOTE (SNAPW))
					 "Saves a snapshot of a region of the screen.")
				   (Hardcopy (QUOTE (HARDCOPYW))
					     "Send hardcopy of screen region to printer."
					     (SUBITEMS ("To a file" (QUOTE (HARDCOPYREGION.TOFILE))
								    
			   "Writes a region of screen to a file; prompts for filename and format")
						       ("To a printer" (QUOTE (
HARDCOPYREGION.TOPRINTER))
								       
					 "Sends a region of screen to a printer of your choosing"))))

(ADDTOVAR WINDOWUSERFORMS )

(ADDTOVAR ENDOFWINDOWUSERFORMS )
(PAINTW.CACHE.SHADE BLACKSHADE)
(PAINTW.CACHE.SHADE GRAYSHADE)
(PAINTW.CACHE.SHADE HIGHLIGHTSHADE)
(DECLARE: DOCOPY DONTEVAL@LOAD 
(WINDOWWORLD T)


(ADDTOVAR GLOBALVARS SCROLLBARWIDTH SCROLLWAITTIME SCROLLBARSHADE WAITBEFORESCROLLTIME 
				      WAITBETWEENSCROLLTIME WAITINGCURSOR)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML )

(ADDTOVAR LAMA PROMPTPRINT WINDOWPROP IMAGEOBJPROP WINDOWWORLD)
)
(PUTPROPS WINDOW COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (9892 13409 (WWRITEMODE 9902 . 10739) (\MAKE.CLOSED.WINDOW.WRITABLE 10741 . 12288) (
\RESTORE.CLOSED.WINDOW 12290 . 13407)) (13410 25877 (WINDOWWORLD 13420 . 18444) (WINDOWWORLDP 18446 . 
18684) (CHANGEBACKGROUND 18686 . 18996) (CHANGEBACKGROUNDBORDER 18998 . 19356) (TILE 19358 . 19868) (
LOGOW 19870 . 21677) (\DRAWLOGOWINDOWIMAGE 21679 . 22258) (\TTY.CREATING.DISPLAYSTREAM 22260 . 22784) 
(\CREATE.TTY.OUTCHARFN 22786 . 23509) (\CREATE.TTYDISPLAYSTREAM 23511 . 24872) (HASTTYWINDOWP 24874 . 
25322) (TTYINFOSTREAM 25324 . 25875)) (26191 36470 (WINDOW.MOUSE.HANDLER 26201 . 33602) (
\PROTECTED.APPLY 33604 . 33858) (DOWINDOWCOM 33860 . 34841) (DOBACKGROUNDCOM 34843 . 35684) (
DEFAULT.BACKGROUND.COPYFN 35686 . 36468)) (36633 71333 (BURYW 36643 . 37765) (CLEARW 37767 . 38251) (
CLOSEW 38253 . 38841) (\CLOSEW1 38843 . 39879) (\OKTOCLOSEW 39881 . 40288) (OPENW 40290 . 41253) (
DOUSERFNS 41255 . 42174) (DOUSERFNS2 42176 . 42697) (\USERFNISDON'T 42699 . 43035) (\OPENW1 43037 . 
44053) (CREATEW 44055 . 46834) (MOVEW 46836 . 54205) (\ONSCREENCLIPPINGREGION 54207 . 54673) (RELMOVEW
 54675 . 55194) (PAINTW 55196 . 60946) (PAINTW.READMODE 60948 . 61516) (PAINTW.READBRUSHSHAPE 61518 . 
61826) (PAINTW.READBRUSHSIZE 61828 . 62100) (SHAPEW 62102 . 64086) (SHAPEW1 64088 . 65791) (
RESHOWBORDER 65793 . 66279) (\RESHOWBORDER1 66281 . 68857) (TRACKW 68859 . 69747) (SNAPW 69749 . 70832
) (WINDOWREGION 70834 . 71331)) (71334 74144 (PAINTW.READBRUSHSHADE 71344 . 72496) (
PAINTW.READ.AND.SAVE.SHADE 72498 . 73087) (PAINTW.CACHE.SHADE 73089 . 73685) (PAINTW.SHADE.LABEL 73687
 . 74142)) (74237 74905 (MINIMUMWINDOWSIZE 74247 . 74903)) (78332 90616 (COPYINSERT 78342 . 79412) (
IMAGEBOX 79414 . 79595) (IMAGEFNSCREATE 79597 . 80820) (IMAGEFNSP 80822 . 81052) (IMAGEOBJCREATE 81054
 . 81515) (IMAGEOBJP 81517 . 81747) (IMAGEOBJPROP 81749 . 85596) (\IMAGEUSERPROP 85598 . 86132) (
HPRINT.IMAGEOBJ 86134 . 86780) (COPYIMAGEOBJ 86782 . 87407) (READIMAGEOBJ 87409 . 89398) (
WRITEIMAGEOBJ 89400 . 90614)) (90823 95175 (ENCAPSULATEDOBJ.BUTTONEVENTINFN 90833 . 91686) (
ENCAPSULATEDOBJ.DISPLAYFN 91688 . 93478) (ENCAPSULATEDOBJ.IMAGEBOXFN 93480 . 94274) (
ENCAPSULATEDOBJ.INIT 94276 . 95173)) (95299 110718 (ADVISEWDS 95309 . 99766) (SHOWWFRAME 99768 . 
101156) (SHOWWTITLE 101158 . 103519) (\STRINGWIDTHGUESS 103521 . 104521) (RESHOWTITLE 104523 . 107595)
 (TOTOPW 107597 . 108554) (\INTERNALTOTOPW 108556 . 109137) (\TTW1 109139 . 110317) (WHICHW 110319 . 
110716)) (110841 113394 (SWITCHDEF 110851 . 111031) (WFROMDS 111033 . 112617) (NU\TOTOPWDS 112619 . 
112933) (\COERCETODS 112935 . 113392)) (113824 124712 (WINDOWP 113834 . 113972) (WINDOWPROP 113974 . 
114437) (WINDOWADDPROP 114439 . 115369) (WINDOWDELPROP 115371 . 115797) (GETWINDOWPROP 115799 . 117878
) (GETWINDOWUSERPROP 117880 . 118311) (PUTWINDOWPROP 118313 . 123255) (REMWINDOWPROP 123257 . 123954) 
(WINDOWADDFNPROP 123956 . 124710)) (124903 130085 (CWINDOWPROP 124913 . 125846) (CGETWINDOWPROP 125848
 . 128979) (\GETWINDOWHEIGHT 128981 . 129608) (\GETWINDOWWIDTH 129610 . 130083)) (130086 142494 (
OPENWP 130096 . 130410) (RESHAPEBYREPAINTFN 130412 . 138733) (\INBETWEENP 138735 . 139006) (
DECODE/WINDOW/OR/DISPLAYSTREAM 139008 . 140214) (GROW/REGION 140216 . 140757) (PPROMPT3 140759 . 
141132) (CLRPROMPT 141134 . 141414) (PROMPTPRINT 141416 . 141682) (OPENWINDOWS 141684 . 142125) (
\INSUREWINDOW 142127 . 142492)) (142694 145195 (OVERLAPPINGWINDOWS 142704 . 144411) (WOVERLAPP 144413
 . 144718) (ORDERFROMBOTTOMTOTOP 144720 . 145193)) (145240 149430 (\ONSCREENW 145250 . 145926) (
\PUTONSCREENW 145928 . 146445) (\UPDATECACHEDFIELDS 146447 . 146771) (\WWCHANGESCREENSIZE 146773 . 
147960) (CREATEWFROMIMAGE 147962 . 148674) (UPDATEWFROMIMAGE 148676 . 149428)) (149709 187733 (SCROLLW
 149719 . 150228) (SCROLLBYREPAINTFN 150230 . 159699) (ADJUSTOFFSETS 159701 . 160070) (
CREATESCROLLINGW 160072 . 160285) (IN/SCROLL/BAR? 160287 . 162305) (RELDSPXOFFSET 162307 . 162500) (
RELDSPYOFFSET 162502 . 162695) (SCROLL.HANDLER 162697 . 170065) (\SCROLL.HANDLER.DOIT 170067 . 172852)
 (\DECODE.EXTENT.USE 172854 . 173201) (\UPDATE.EXTENT.IMAGE 173203 . 176833) (
EXTENDPASTHORIZBOUNDARIES 176835 . 177304) (EXTENDPASTVERTBOUNDARIES 177306 . 177785) (REDISPLAYW 
177787 . 179262) (FILLWITHBACKGROUND 179264 . 179643) (UPDATE/SCROLL/REG 179645 . 181297) (WTODSX 
181299 . 181735) (WTODSY 181737 . 182175) (WXOFFSET 182177 . 183016) (WYOFFSET 183018 . 183861) (
BITMAPSCROLLFN 183863 . 184162) (SCROLLBITMAP 184164 . 185195) (REDISPLAYBITMAP 185197 . 185767) (
ULREDISPLAYBITMAP 185769 . 186459) (EXTENDEXTENT 186461 . 186963) (WIDTHIFWINDOW 186965 . 187293) (
HEIGHTIFWINDOW 187295 . 187731)) (187832 188403 (\DSPUNTRANSFORMREGION 187842 . 188401)) (188431 
200871 (SHRINKW 188441 . 194719) (\MAKEICONWINDOW 194721 . 195424) (\TITLEICONMINSIZE 195426 . 195735)
 (\NOTENEWICONPOSITION 195737 . 196173) (EXPANDW 196175 . 197601) (DOICONWINDOWCOM 197603 . 198467) (
CLOSEMAINWINDOW 198469 . 199642) (CLOSEICONWINDOW 199644 . 200869)))))
STOP