(FILECREATED " 5-Nov-85 15:37:40" {ERIS}<LISPUSERS>EDITKEYS.;2 5044   

      changes to:  (FNS BUILDFNKEYS KEY.BITMAP)
		   (VARS EDITKEYSCOMS KEY.TEMPLATE)

      previous date: " 4-Nov-85 20:34:33" {ERIS}<LISPUSERS>EDITKEYS.;1)


(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT EDITKEYSCOMS)

(RPAQQ EDITKEYSCOMS ((VARS KEY.TEMPLATE)
		       (FNS BUILDFNKEYS KEY.BITMAP)
		       (P (* could have (STRIKEOUT))
			  (BUILDFNKEYS (QUOTE ((BOLD BOLD)
					       (ITALICS ITALICS)
					       (UNDERLINE (UNDER- LINE))
					       (SUPERSCRIPT (SUPER/ SUB))
					       (LARGER (LARGER SMALLER))
					       (DEFAULTS DEFAULTS)
					       (CASE CASE)
					       (CENTER JUSTIFY)
					       (AGAIN REDO)
					       (HELP HELP)))
				       (QUOTE (Function Keys))
				       1))))

(RPAQ KEY.TEMPLATE (READBITMAP))
(78 48
"OOOOOOOOOOOOOOOOOOOL"
"ON@@@@@@@@@@@@@@@AOL"
"O@@@@@@@@@@@@@@@@@CL"
"O@@@@@@@@@@@@@@@@@CL"
"MH@@@@@@@@@@@@@@@@DL"
"NLGOOOOOOOOOOOOOOHHL"
"MFL@@@@@@@@@@@@@@M@L"
"JK@@@@@@@@@@@@@@@B@D"
"MF@@@@@@@@@@@@@@@A@D"
"JN@@@@@@@@@@@@@@@AHD"
"MD@@@@@@@@@@@@@@@@HD"
"JL@@@@@@@@@@@@@@@@HD"
"MD@@@@@@@@@@@@@@@@HD"
"JL@@@@@@@@@@@@@@@@HD"
"MD@@@@@@@@@@@@@@@@HD"
"JL@@@@@@@@@@@@@@@@HD"
"MD@@@@@@@@@@@@@@@@HD"
"JL@@@@@@@@@@@@@@@@HD"
"MD@@@@@@@@@@@@@@@@HD"
"JL@@@@@@@@@@@@@@@@HD"
"MD@@@@@@@@@@@@@@@@HD"
"JL@@@@@@@@@@@@@@@@HD"
"MD@@@@@@@@@@@@@@@@HD"
"JL@@@@@@@@@@@@@@@@HD"
"MD@@@@@@@@@@@@@@@@HD"
"JL@@@@@@@@@@@@@@@@HD"
"MD@@@@@@@@@@@@@@@@HD"
"JL@@@@@@@@@@@@@@@@HD"
"MD@@@@@@@@@@@@@@@@HD"
"JL@@@@@@@@@@@@@@@@HD"
"MD@@@@@@@@@@@@@@@@HD"
"JL@@@@@@@@@@@@@@@@HD"
"MD@@@@@@@@@@@@@@@@HD"
"JL@@@@@@@@@@@@@@@@HD"
"MD@@@@@@@@@@@@@@@@HD"
"JL@@@@@@@@@@@@@@@@HD"
"MD@@@@@@@@@@@@@@@@HD"
"JL@@@@@@@@@@@@@@@@HD"
"MF@@@@@@@@@@@@@@@AHD"
"JJ@@@@@@@@@@@@@@@A@D"
"MG@@@@@@@@@@@@@@@B@D"
"NEL@@@@@@@@@@@@@@O@L"
"LIGOOOOOOOOOOOOOOMHL"
"OBBJJJJJJJJJJJJJJJLL"
"NDEEEEEEEEEEEEEEEEGL"
"OHJJJJJJJJJJJJJJJJKL"
"OLEEEEEEEEEEEEEEEEOL"
"OOOOOOOOOOOOOOOOOOOL")
(DEFINEQ

(BUILDFNKEYS
  [LAMBDA (KEYS TITLE NROWS)                                 (* lmm " 5-Nov-85 15:35")
    (SHRINKW
      (ADDMENU
	[create MENU
		  ITEMS ←[for KEY in KEYS
			    collect
			     (LIST (KEY.BITMAP (CADR KEY))
				     (LET [(KEYN (OR (SMALLP (CAR KEY))
						       (\KEYNAMETONUMBER (CAR KEY]
				          (for LST in (LIST \DOVEKEYACTIONS \DLIONKEYACTIONS 
								  \ORIGKEYACTIONS)
					     do (AND [SETQ $$VAL
							   (for KEY in LST
							      when
							       (EQ (OR (SMALLP (CAR KEY))
									   (\KEYNAMETONUMBER
									     (CAR KEY)))
								     KEYN)
							      do (RETURN (CADR KEY]
							 (RETURN (LIST
								     (OR (SMALLP (CAR $$VAL))
									   (CHARCODE.DECODE
									     (CAR $$VAL)))
								     (OR (SMALLP (CADR $$VAL))
									   (CHARCODE.DECODE
									     (CADR $$VAL]
		  TITLE ←(SUBSTRING TITLE 2 -2)
		  MENUROWS ← NROWS
		  WHENSELECTEDFN ←(FUNCTION (LAMBDA (X)
		      (BKSYSCHARCODE (if (SHIFTDOWNP (QUOTE SHIFT))
					   then (CADR (CADR X))
					 else (CAR (CADR X]
	NIL
	(create POSITION
		  XCOORD ←(PLUS (DIFFERENCE (QUOTIENT SCREENWIDTH 2)
						(QUOTIENT (TIMES (BITMAPWIDTH KEY.TEMPLATE)
								     (LENGTH KEYS))
							    2))
				  (TIMES 2 WBorder))
		  YCOORD ← 0))
      (KEY.BITMAP TITLE)
      (QUOTE (0 . 0])

(KEY.BITMAP
  [LAMBDA (X)                                                (* lmm " 5-Nov-85 14:04")
    (PROG ((BITMAP (BITMAPCOPY KEY.TEMPLATE))
	     DS QUARTER REGION)
	    (SETQ DS (DSPCREATE BITMAP))
	    (DSPFONT MENUFONT DS)
	    (COND
	      ((LISTP X)                                   (* this is supposed to have two labels, one on top of 
							     the other)
		(SETQ QUARTER (IQUOTIENT (BITMAPHEIGHT BITMAP)
					     4))
		(CENTERPRINTINREGION (CADR X)
				       (SETQ REGION
					 (create REGION
						   LEFT ← 0
						   BOTTOM ← QUARTER
						   WIDTH ←(BITMAPWIDTH BITMAP)
						   HEIGHT ← QUARTER))
				       DS)
		(replace BOTTOM of REGION with (ITIMES 2 QUARTER))
		(CENTERPRINTINREGION (CAR X)
				       REGION DS))
	      (T (CENTERPRINTINREGION X (create REGION
						    LEFT ← 0
						    BOTTOM ← 0
						    WIDTH ←(BITMAPWIDTH BITMAP)
						    HEIGHT ←(BITMAPHEIGHT BITMAP))
					DS)))
	    (RETURN BITMAP])
)
(* could have (STRIKEOUT))
(BUILDFNKEYS (QUOTE ((BOLD BOLD)
		     (ITALICS ITALICS)
		     (UNDERLINE (UNDER- LINE))
		     (SUPERSCRIPT (SUPER/ SUB))
		     (LARGER (LARGER SMALLER))
		     (DEFAULTS DEFAULTS)
		     (CASE CASE)
		     (CENTER JUSTIFY)
		     (AGAIN REDO)
		     (HELP HELP)))
	     (QUOTE (Function Keys))
	     1)
(PUTPROPS EDITKEYS COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1976 4630 (BUILDFNKEYS 1986 . 3564) (KEY.BITMAP 3566 . 4628)))))
STOP