(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