(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