(FILECREATED " 4-May-84 18:46:07" {PHYLUM}<LISPUSERS>DATEFNS.;1 20688  

      changes to:  (FNS CALRBUTTONFN DATEMENU CALENDARW)
		   (VARS DATEFNSCOMS)

      previous date: " 3-May-84 12:42:22" {PHYLUM}<PAPERWORKS>DATEFNS.;2)


(* Copyright (c) 1984 by Xerox Corporation)

(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)                                   (* rrb " 2-May-84 19:41")
                                                             (* 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
	      ((IGREATERP 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))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (905 20049 (BUILDCALENDAR 915 . 4819) (CALRBUTTONFN 4821 . 9427) (CENTERBLTINREGION 9429
 . 10096) (DATEMENU 10098 . 10568) (DAY 10570 . 10873) (DAYOFWEEK 10875 . 11990) (DAYSIN 11992 . 12242
) (DRAWCALENDAR 12244 . 15557) (FOLLOWING.MONTH 15559 . 15915) (LEAPYEARP 15917 . 16484) (MAKE.DATE 
16486 . 17318) (PREVIOUS.MONTH 17320 . 17698) (XYTODATE 17700 . 18224) (\CALBOXITEM 18226 . 19469) (
\CALINVERTITEM 19471 . 20047)))))
STOP