(FILECREATED "10-Oct-86 13:07:26" {DSK}<LISPFILES>DATEFNS.;1
 20771  

      changes to:  (FNS MAKE.DATE)

      previous date: " 4-May-84 18:46:07" {DANTE}<LISPNEW>LISPUSERS>DATEFNS.;1)


(* Copyright (c) 1984, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT DATEFNSCOMS)

(RPAQQ DATEFNSCOMS
 ((FNS BUILDCALENDAR CALRBUTTONFN CENTERBLTINREGION DATEMENU DAY DAYOFWEEK DAYSIN 
			   DRAWCALENDAR FOLLOWING.MONTH LEAPYEARP MAKE.DATE PREVIOUS.MONTH XYTODATE 
			   \CALBOXITEM \CALINVERTITEM)
	(VARS LISTOFDAYS MONTH.LIST)
	(VARS (CALBORDER 3)
	      (CALGRIDBORDER 1))
	[VARS (MONTHNAMEFONT (FONTCREATE (QUOTE GACHA)
					 12))
	      (OTHERMONTHFONT (FONTCREATE (QUOTE GACHA)
					  8))
	      (DAYNAMEFONT (FONTCREATE (QUOTE GACHA)
				       10))
	      (DAYNUMBERFONT (FONTCREATE (QUOTE GACHA)
					 12
					 (QUOTE BOLD]
	(DECLARE: DONTCOPY (RECORDS CALENDARINFO))))
(DEFINEQ

(BUILDCALENDAR

  [LAMBDA (MON YEAR CALENDARW)                               (* rrb " 3-May-84 12:41")

    (PROG ([YEAR (OR YEAR (MKATOM (SUBSTRING (DATE)
					     8 9]
	   (MON (OR MON (SUBSTRING (DATE)
				   4 6)))
	   DAYSIN FIRSTDAY WEEKROWS CALWIDTH CALHEIGHT CALWWIDTH CALWHEIGHT DAYWIDTH DAYHEIGHT 
	   OTHERMONWIDTH OTHERMONHEIGHT)
          (SETQ MON (MKATOM (U-CASE MON)))
      MONLP
          (COND
	    ((MEMB MON MONTH.LIST))
	    ((IGREATERP (NCHARS MON)
			3)
	      (SETQ MON (MKATOM (SUBSTRING MON 1 3)))
	      (GO MONLP))
	    (T (ERROR MON "not recognized as a month.  Should be 3 letter abbrev.")))
          (SETQ DAYSIN (DAYSIN
 MON YEAR))
          [SETQ FIRSTDAY (DAYOFWEEK
 (IDATE (CONCAT "01-" MON "-" YEAR " 12:00:00"]
          (SETQ WEEKROWS (COND
	      ((IGREATERP (IPLUS DAYSIN FIRSTDAY)
			  35)
		6)
	      ((IGREATERP (IPLUS DAYSIN FIRSTDAY)
			  28)
		5)
	      (T 4)))
          [SETQ CALWIDTH (IPLUS (IMAX (ITIMES (IPLUS (ITIMES 2 (IPLUS CALGRIDBORDER 1))
						     (IMAX (STRINGWIDTH "Su" DAYNAMEFONT)
							   (STRINGWIDTH "28" DAYNUMBERFONT)))
					      7)
				      (IPLUS [ITIMES 2 (SETQ OTHERMONWIDTH (IPLUS 4 (STRINGWIDTH
										    "MAY" 
										   OTHERMONTHFONT]
					     (STRINGWIDTH " MAR 84 " MONTHNAMEFONT]
          (SETQ CALWWIDTH (WIDTHIFWINDOW CALWIDTH CALBORDER))
          (SETQ CALHEIGHT (IPLUS (IPLUS 2 (IMAX (SETQ OTHERMONHEIGHT (IPLUS 2 (FONTHEIGHT 
										   OTHERMONTHFONT)))
						(FONTHEIGHT MONTHNAMEFONT)))
				 (IPLUS 2 (FONTHEIGHT DAYNAMEFONT))
				 (ITIMES (SETQ DAYHEIGHT (IPLUS CALGRIDBORDER 2 (FONTHEIGHT 
										    DAYNUMBERFONT)))
					 WEEKROWS)))
          (SETQ CALWHEIGHT (HEIGHTIFWINDOW CALHEIGHT NIL CALBORDER))
          [COND
	    [(WINDOWP CALENDARW)
	      (PROG [(CURRENTREG (WINDOWPROP CALENDARW (QUOTE REGION]
		    (CLEARW CALENDARW)
		    (WINDOWPROP CALENDARW (QUOTE RESHAPEFN)
				NIL)
		    (COND
		      ((NEQ (fetch
 (REGION HEIGHT) of
 CURRENTREG)
			    CALWHEIGHT)                      (* do reshape so that upper part of window remains 

							     fixed.)

			(WINDOWPROP CALENDARW (QUOTE REGION)
				    (CREATEREGION (fetch
 (REGION LEFT) of
 CURRENTREG)
						  (IDIFFERENCE (fetch
 (REGION BOTTOM) of
 CURRENTREG)
							       (IDIFFERENCE CALWHEIGHT
									    (fetch
 (REGION HEIGHT)
									       of
 CURRENTREG)))
						  CALWWIDTH CALWHEIGHT]
	    (T (SETQ CALENDARW (CREATEW (MAKEWITHINREGION (CREATEREGION LASTMOUSEX LASTMOUSEY 
									CALWWIDTH CALWHEIGHT))
					NIL CALBORDER NIL]
          (WINDOWPROP CALENDARW (QUOTE BUTTONEVENTFN)
		      (FUNCTION CALRBUTTONFN))
          (WINDOWPROP CALENDARW (QUOTE CURSORINFN)
		      (FUNCTION CALRBUTTONFN))
          (WINDOWPROP CALENDARW (QUOTE CURSORMOVEDFN)
		      (FUNCTION CALRBUTTONFN))
          (WINDOWPROP CALENDARW (QUOTE RESHAPEFN)
		      (QUOTE DON'T
))
          (WINDOWPROP CALENDARW (QUOTE CALENDARINFO)
		      (create
 CALENDARINFO
			      MONTH _ MON
			      YEAR _ YEAR
			      #DAYS _ DAYSIN
			      DAYOFFIRST _ FIRSTDAY
			      WEEKROWS _ WEEKROWS)
		      DAYSIN)
          (WINDOWPROP CALENDARW (QUOTE CALGRIDSPEC)
		      (create
 REGION
			      LEFT _(IQUOTIENT [IDIFFERENCE CALWIDTH (ITIMES 7 (SETQ DAYWIDTH
									       (IQUOTIENT CALWIDTH 7]
					       2)
			      BOTTOM _ 0
			      WIDTH _ DAYWIDTH
			      HEIGHT _ DAYHEIGHT))
          (WINDOWPROP CALENDARW (QUOTE OTHERMONTHREGIONS)
		      (LIST (create
 REGION
				    LEFT _ 0
				    BOTTOM _(IDIFFERENCE CALHEIGHT OTHERMONHEIGHT)
				    WIDTH _ OTHERMONWIDTH
				    HEIGHT _ OTHERMONHEIGHT)
			    (create
 REGION
				    LEFT _(IDIFFERENCE CALWIDTH OTHERMONWIDTH)
				    BOTTOM _(IDIFFERENCE CALHEIGHT OTHERMONHEIGHT)
				    WIDTH _ OTHERMONWIDTH
				    HEIGHT _ OTHERMONHEIGHT)))
          (DRAWCALENDAR
 CALENDARW)
          (RETURN CALENDARW])

(CALRBUTTONFN

  [LAMBDA (CALENDARW)                                        (* rrb " 2-May-84 19:51")

                                                             (* buttoneventfn for calendar menus)

    (PROG ((CALINFO (WINDOWPROP CALENDARW (QUOTE CALENDARINFO)))
	   (OTHERMONTHREGIONS (WINDOWPROP CALENDARW (QUOTE OTHERMONTHREGIONS)))
	   (MGRIDSPEC (WINDOWPROP CALENDARW (QUOTE CALGRIDSPEC)))
	   (LASTBUTTONSTATE LASTMOUSEBUTTONS)
	   (MAXXBOX 7)
	   OLDBOXX OLDBOXY BOXX BOXY DSPX DSPY MAXYBOX MOUSEDOWN ITEM YEAR MONTH)
          (SETQ MONTH (fetch
 (CALENDARINFO MONTH) of
 CALINFO))
          (SETQ YEAR (fetch
 (CALENDARINFO YEAR) of
 CALINFO))
          (SETQ MAXYBOX (fetch
 (CALENDARINFO WEEKROWS) of
 CALINFO))
          [RETURN (until
 (COND
			   (MOUSEDOWN                        (* if mouse has been down, process it)

				      (MOUSESTATE UP))
			   ((MOUSESTATE (NOT UP))            (* mouse hasn't been down but just went down.)

			     [COND
			       ((LASTMOUSESTATE RIGHT)
				 (DOWINDOWCOM CALENDARW)
				 (SETQ MOUSEDOWN NIL))
			       (T (SETQ MOUSEDOWN T)
				  (COND
				    (OLDBOXX                 (* switch between boxing to flipping items.)

					     (\CALBOXITEM
 OLDBOXX OLDBOXY MGRIDSPEC CALENDARW)
					     (\CALINVERTITEM
 OLDBOXX OLDBOXY MGRIDSPEC CALENDARW]
			     NIL))
		     do
 [COND
			  [[OR (AND (STRICTLY/BETWEEN (SETQ BOXY (GRIDYCOORD (LASTMOUSEY CALENDARW)
									     MGRIDSPEC))
						      -1 MAXYBOX)
				    (STRICTLY/BETWEEN (SETQ BOXX (GRIDXCOORD (LASTMOUSEX CALENDARW)
									     MGRIDSPEC))
						      -1 MAXXBOX))
			       (SETQ BOXX (for
 REG in
 OTHERMONTHREGIONS when
 (INSIDE? REG
										      (LASTMOUSEX
											CALENDARW)
										      (LASTMOUSEY
											CALENDARW))
					     do
 (RETURN REG]
                                                             (* BOXX and BOXY hold the number of the box pointed at.)

			    (COND
			      ((OR (NEQ BOXX OLDBOXX)
				   (NEQ BOXY OLDBOXY))       (* selected item has changed.)

                                                             (* uninvert old item if there was one.)

				[COND
				  (OLDBOXX (COND
					     (MOUSEDOWN (\CALINVERTITEM
 OLDBOXX OLDBOXY MGRIDSPEC 
									CALENDARW))
					     (T (\CALBOXITEM
 OLDBOXX OLDBOXY MGRIDSPEC CALENDARW]
                                                             (* invert new item)

				(COND
				  (MOUSEDOWN (\CALINVERTITEM
 BOXX BOXY MGRIDSPEC CALENDARW))
				  (T (\CALBOXITEM
 BOXX BOXY MGRIDSPEC CALENDARW)))
				(SETQ OLDBOXX BOXX)
				(SETQ OLDBOXY BOXY]
			  (T                                 (* cursor moved outside of the menu.)

			     (COND
			       (OLDBOXX (COND
					  (MOUSEDOWN (\CALINVERTITEM
 OLDBOXX OLDBOXY MGRIDSPEC 
								     CALENDARW))
					  (T (\CALBOXITEM
 OLDBOXX OLDBOXY MGRIDSPEC CALENDARW)))
                                                             (* OLDBOXX denotes item inverted.)

					(SETQ OLDBOXX)))
			     (COND
			       ((INSIDEP (WINDOWPROP CALENDARW (QUOTE REGION))
					 LASTMOUSEX LASTMOUSEY)
                                                             (* cursor is still inside the window, keep control.)

				 NIL)
			       (T (RETURN]
		     finally
                                 (* turn off inverse image. and call whenunheldfn is 

							     necessary.)

			     (COND
			       (OLDBOXX (COND
					  (MOUSEDOWN (\CALINVERTITEM
 OLDBOXX OLDBOXY MGRIDSPEC 
								     CALENDARW))
					  (T (\CALBOXITEM
 OLDBOXX OLDBOXY MGRIDSPEC CALENDARW)))
                                                             (* something was selected, take down the window.)

					(CLOSEW CALENDARW)))
                                                             (* return selected date or bring up new calendar)

			     (RETURN (COND
				       ((REGIONP OLDBOXX)    (* selected a month)

					 [COND
					   [(EQ OLDBOXX (CAR OTHERMONTHREGIONS))
					     (COND
					       ((EQ (SETQ MONTH (PREVIOUS.MONTH
 MONTH))
						    (QUOTE DEC))
						 (SETQ YEAR (SUB1 YEAR]
					   (T (COND
						((EQ (SETQ MONTH (FOLLOWING.MONTH
 MONTH))
						     (QUOTE JAN))
						  (SETQ YEAR (ADD1 YEAR]
					 (BUILDCALENDAR
 MONTH YEAR CALENDARW))
				       (OLDBOXX (WINDOWPROP CALENDARW (QUOTE VALUE)
							    (MAKE.DATE
 (XYTODATE
 CALENDARW OLDBOXX 
										 OLDBOXY)
								       MONTH YEAR]
                                                             (* return selected date or bring up new calendar)

      ])

(CENTERBLTINREGION

  [LAMBDA (BITMAP REGION STRM)                               (* rrb " 1-May-84 14:18")

                                                             (* puts a bitmap centered in a region of a stream)

    (BITBLT BITMAP 0 0 STRM (IPLUS (fetch
 (REGION LEFT) of
 REGION)
				   (IQUOTIENT (IDIFFERENCE (fetch
 (REGION WIDTH) of
 REGION)
							   (BITMAPWIDTH BITMAP))
					      2))
	    (IPLUS (fetch
 (REGION BOTTOM) of
 REGION)
		   (IQUOTIENT (IDIFFERENCE (fetch
 (REGION HEIGHT) of
 REGION)
					   (fetch
 (BITMAP BITMAPHEIGHT) of
 BITMAP))
			      2))
	    NIL NIL (QUOTE INPUT)
	    NIL NIL REGION])

(DATEMENU

  [LAMBDA (MON YEAR)                                         (* rrb " 2-May-84 19:53")

                                                             (* puts up a calendar menu and reads a date from the 

							     user)

    (PROG ((CALMENUW (BUILDCALENDAR
 MON YEAR)))
          (until
 (WINDOWPROP CALMENUW (QUOTE VALUE))
	     do
 (TOTOPW CALMENUW)
		(DISMISS 500))
          (RETURN (WINDOWPROP CALMENUW (QUOTE VALUE)
			      NIL])

(DAY

  [LAMBDA (STRDATE)                                          (* rrb " 1-May-84 14:30")

    (SELECTQ (DAYOFWEEK
 (IDATE STRDATE))
	     (1 "MONDAY")
	     (2 "TUESDAY")
	     (3 "WEDNESDAY")
	     (4 "THURSDAY")
	     (5 "FRIDAY")
	     (6 "SATURDAY")
	     (0 "SUNDAY")
	     (SHOULDNT])

(DAYOFWEEK

  [LAMBDA (INTERNALDATE)                                     (* gbn "11-MAY-83 10:47")

                                                             (* Returns a number between 0 

							     (Sunday) and 6 (Saturday) representing the day of the 

							     week which the given IDATE was/is/willbe)

    (PROG ((UNITSSINCEBASE (IQUOTIENT (LRSH (LISP.TO.ALTO.DATE INTERNALDATE)
					    1)
				      30)))                  (* UNITSSINCEBASE represents the number of minutes since

							     Jan 1,1901 GMT)

                                                             (* now, adjust for the time zone.

							     Since this may make UNITSSINCEBASE go negative , add in 

							     one week of hours)

          (SETQ UNITSSINCEBASE (IDIFFERENCE (IPLUS (IQUOTIENT UNITSSINCEBASE 60)
						   (ITIMES 24 7))
					    \TimeZoneComp))
                                                             (* UNITSSINCEBASE now represents the number of hours 

							     since Genesis)

          (RETURN (IREMAINDER (IPLUS 2 (IQUOTIENT UNITSSINCEBASE 24))
			      7])

(DAYSIN

  [LAMBDA (MONTH YEAR)                                       (* rrb " 2-May-84 19:38")

    (SELECTQ (MKATOM MONTH)
	     (FEB (COND
		    ((LEAPYEARP
 YEAR)
		      29)
		    (T 28)))
	     ((APR JUN SEP NOV)
	       30)
	     31])

(DRAWCALENDAR

  [LAMBDA (CALENDARW)                                        (* rrb " 2-May-84 18:47")

                                                             (* Adds the grid numbering and messages to calendar)

    (PROG ((CALENDARINFO (WINDOWPROP CALENDARW (QUOTE CALENDARINFO)))
	   (CALGRIDSPEC (WINDOWPROP CALENDARW (QUOTE CALGRIDSPEC)))
	   ROWS GRIDWIDTH GRIDHEIGHT BOTTOM MONTH)
          (CLEARW CALENDARW)                                 (* prepares the grid for the calendar)

          (GRID CALGRIDSPEC 7 (SETQ ROWS (fetch
 (CALENDARINFO WEEKROWS) of
 CALENDARINFO))
		CALGRIDBORDER CALENDARW)
          (SETQ GRIDWIDTH (fetch
 WIDTH of
 CALGRIDSPEC))
          (SETQ GRIDHEIGHT (fetch
 HEIGHT of
 CALGRIDSPEC))
          (DSPFONT DAYNUMBERFONT CALENDARW)                  (* print in the numbers for the days.)

          (for
 #DAYOFWEEK from
 (fetch
 (CALENDARINFO DAYOFFIRST) of
 CALENDARINFO) as
 DATE
	     from
 1 to
 (fetch
 (CALENDARINFO #DAYS) of
 CALENDARINFO)
	     do
 (CENTERPRINTINREGION DATE (create
 REGION
						  BOTTOM _(BOTTOMOFGRIDCOORD
						    (SUB1 (IDIFFERENCE ROWS (IQUOTIENT #DAYOFWEEK 7)))
						    CALGRIDSPEC)
						  LEFT _(LEFTOFGRIDCOORD (IREMAINDER #DAYOFWEEK 7)
									 CALGRIDSPEC)
						  WIDTH _ GRIDWIDTH
						  HEIGHT _ GRIDHEIGHT)
				     CALENDARW))             (* Now print the day headings in the top row of the 

							     calendar)

          (DSPFONT DAYNAMEFONT CALENDARW)
          (for
 CHAR in
 LISTOFDAYS as
 #DAYOFWEEK from
 0 do
 (CENTERPRINTINREGION CHAR
									       (create
 REGION
										       BOTTOM _(
										BOTTOMOFGRIDCOORD
											 ROWS 
										      CALGRIDSPEC)
										       LEFT _(
										  LEFTOFGRIDCOORD
											 #DAYOFWEEK 
										      CALGRIDSPEC)
										       WIDTH _ 
										       GRIDWIDTH
										       HEIGHT _ 
										       GRIDHEIGHT)
									       CALENDARW))
                                                             (* put up the scroll bars for moving to previous and 

							     following months.)

          (DSPFONT OTHERMONTHFONT CALENDARW)
          (SETQ MONTH (fetch
 (CALENDARINFO MONTH) of
 CALENDARINFO))
          (for
 REGION in
 (WINDOWPROP CALENDARW (QUOTE OTHERMONTHREGIONS)) as
 NEARMONTH
	     in
 (LIST (PREVIOUS.MONTH
 MONTH)
		      (FOLLOWING.MONTH
 MONTH))
	     do
 (DRAWAREABOX (fetch
 (REGION LEFT) of
 REGION)
			     (fetch
 (REGION BOTTOM) of
 REGION)
			     (fetch
 (REGION WIDTH) of
 REGION)
			     (fetch
 (REGION HEIGHT) of
 REGION)
			     1 NIL CALENDARW)
		(CENTERPRINTINREGION NEARMONTH REGION CALENDARW))
                                                             (* put up month and year.)

          (DSPFONT MONTHNAMEFONT CALENDARW)
          (CENTERPRINTINREGION (CONCAT MONTH " " (fetch
 (CALENDARINFO YEAR) of
 CALENDARINFO))
			       (create
 REGION
				       LEFT _(LEFTOFGRIDCOORD 0 CALGRIDSPEC)
				       BOTTOM _(SETQ BOTTOM (BOTTOMOFGRIDCOORD (ADD1 ROWS)
									       CALGRIDSPEC))
				       WIDTH _(ITIMES 7 GRIDWIDTH)
				       HEIGHT _(IDIFFERENCE (WINDOWPROP CALENDARW (QUOTE HEIGHT))
							    BOTTOM))
			       CALENDARW])

(FOLLOWING.MONTH

  [LAMBDA (MONTH)                                            (* rrb " 2-May-84 17:55")

                                                             (* returns the following months)

    (for
 TAIL on
 MONTH.LIST when
 (EQ MONTH (CAR TAIL)) do
 (RETURN (COND
								    ((CADR TAIL))
								    (T (CAR MONTH.LIST])

(LEAPYEARP

  [LAMBDA (YEAR)                                             (* rrb " 2-May-84 19:38")

                                                             (* determines if YEAR is a leap year.

							     Uses current year if YEAR is NIL)

                                                             (* assumes year is two digit number.)

    (AND (ZEROP (REMAINDER [SETQ YEAR (COND
			       ((NUMBERP YEAR))
			       ((NULL YEAR)
				 (MKATOM (SUBSTRING (DATE)
						    8 9)))
			       (T (\ILLEGAL.ARG YEAR]
			   4))
	 (NOT (ZEROP YEAR])

(MAKE.DATE

  [LAMBDA (DAY
 MONTH YEAR)                                 (* Newman "10-Oct-86 12:58")

                                                             (* returns a date string.)

    [
COND

      [(
ILESSP
 DAY 1)                                      (* day from previous month)

	(
SETQ
 MONTH (PREVIOUS.MONTH
 MONTH))
	[
COND

	  ((
EQ
 MONTH (
QUOTE
 DEC))
	    (
SETQ
 YEAR (
SUB1
 YEAR]
	(
SETQ
 DAY (
IPLUS
 (
ADD1
 DAY)
			     (DAYSIN
 MONTH YEAR]
      ((
IGREATERP
 DAY (DAYSIN
 MONTH YEAR))               (* day in next month)

	(
SETQ
 DAY (
IDIFFERENCE
 DAY (DAYSIN
 MONTH YEAR)))
	(
SETQ
 MONTH (FOLLOWING.MONTH
 MONTH))
	(
COND

	  ((
EQ
 MONTH (
QUOTE
 JAN))
	    (
SETQ
 YEAR (
ADD1
 YEAR]
    (
CONCAT
 (
COND

		((
IGEQ
 DAY 10)
		  DAY)
		(T (
CONCAT
 "0" DAY)))
	      "-" MONTH "-" YEAR " 00:00:00"])

(PREVIOUS.MONTH

  [LAMBDA (MONTH)                                            (* rrb " 2-May-84 17:53")

                                                             (* returns the previous months)

    (COND
      ((EQ MONTH (CAR MONTH.LIST))
	(CAR (LAST MONTH.LIST)))
      (T (for
 TAIL on
 MONTH.LIST when
 (EQ MONTH (CADR TAIL)) do
 (RETURN (CAR TAIL])

(XYTODATE

  [LAMBDA (WINDOW X Y)                                       (* rrb " 2-May-84 15:33")

                                                             (* Takes an x y position in grid coordinates and returns

							     the date which corresponds to it)

    (PROG [(CALINFO (WINDOWPROP WINDOW (QUOTE CALENDARINFO]
          (RETURN (IPLUS 1 X (MINUS (fetch
 (CALENDARINFO DAYOFFIRST) of
 CALINFO))
			 (ITIMES (IPLUS -1 (fetch
 (CALENDARINFO WEEKROWS) of
 CALINFO)
					(MINUS Y))
				 7])

(\CALBOXITEM

  [LAMBDA (COLUMN ROW GRID DSP)                              (* rrb " 2-May-84 20:00")

                                                             (* inverts an item in a calendar displayed in DSP.)

    (PROG (LFT BTM WID HGHT)
          [COND
	    ((REGIONP COLUMN)                                (* either the previous or next months.)

	      (SETQ LFT (fetch
 (REGION LEFT) of
 COLUMN))
	      (SETQ BTM (fetch
 (REGION BOTTOM) of
 COLUMN))
	      (SETQ WID (fetch
 (REGION WIDTH) of
 COLUMN))
	      (SETQ HGHT (fetch
 (REGION HEIGHT) of
 COLUMN)))
	    (T                                               (* must be part of calendar.)

	       (SETQ LFT (LEFTOFGRIDCOORD COLUMN GRID))
	       (SETQ BTM (BOTTOMOFGRIDCOORD ROW GRID))
	       (SETQ WID (fetch
 (REGION WIDTH) of
 GRID))
	       (SETQ HGHT (fetch
 (REGION HEIGHT) of
 GRID]
          (BITBLT NIL NIL NIL DSP (ADD1 LFT)
		  (ADD1 BTM)
		  (IDIFFERENCE WID 2)
		  (IDIFFERENCE HGHT 2)
		  (QUOTE TEXTURE)
		  (QUOTE INVERT)
		  BLACKSHADE)
          (BITBLT NIL NIL NIL DSP (IPLUS LFT 2)
		  (IPLUS BTM 2)
		  (IDIFFERENCE WID 4)
		  (IDIFFERENCE HGHT 4)
		  (QUOTE TEXTURE)
		  (QUOTE INVERT)
		  BLACKSHADE])

(\CALINVERTITEM

  [LAMBDA (COLUMN ROW GRID DSP)                              (* rrb " 2-May-84 18:37")

                                                             (* inverts an item in a calendar displayed in DSP.)

    (COND
      ((REGIONP COLUMN)                                      (* either the previous or next months.)

	(DSPFILL COLUMN BLACKSHADE (QUOTE INVERT)
		 DSP))
      (T                                                     (* must be part of calendar.)

	 (SHADEGRIDBOX COLUMN ROW BLACKSHADE (QUOTE INVERT)
		       GRID CALGRIDBORDER DSP])
)

(RPAQQ LISTOFDAYS
 ("Su" "M" "Tu" "W" "Th" "F" "Sa"))

(RPAQQ MONTH.LIST
 (JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC))

(RPAQQ CALBORDER
 3)

(RPAQQ CALGRIDBORDER
 1)

(RPAQ MONTHNAMEFONT
 (FONTCREATE (QUOTE GACHA)
				  12))

(RPAQ OTHERMONTHFONT
 (FONTCREATE (QUOTE GACHA)
				   8))

(RPAQ DAYNAMEFONT
 (FONTCREATE (QUOTE GACHA)
				10))

(RPAQ DAYNUMBERFONT
 (FONTCREATE (QUOTE GACHA)
				  12
				  (QUOTE BOLD)))
(DECLARE: DONTCOPY 
[DECLARE: EVAL@COMPILE 

(RECORD CALENDARINFO
 (MONTH YEAR #DAYS DAYOFFIRST WEEKROWS))
]
)
(PUTPROPS DATEFNS COPYRIGHT ("Xerox Corporation" 1984 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (896 20124 (BUILDCALENDAR 906 . 4810) (CALRBUTTONFN 4812 . 9418) (CENTERBLTINREGION 9420
 . 10087) (DATEMENU 10089 . 10559) (DAY 10561 . 10864) (DAYOFWEEK 10866 . 11981) (DAYSIN 11983 . 12233
) (DRAWCALENDAR 12235 . 15548) (FOLLOWING.MONTH 15550 . 15906) (LEAPYEARP 15908 . 16475) (MAKE.DATE 
16477 . 17393) (PREVIOUS.MONTH 17395 . 17773) (XYTODATE 17775 . 18299) (\CALBOXITEM 18301 . 19544) (
\CALINVERTITEM 19546 . 20122)))))
STOP