(FILECREATED "21-Sep-85 08:03:04" {ERIS}<LISPCORE>LIBRARY>KEYBOARDEDITOR.;3 43333  

      changes to:  (VARS KEYBOARDEDITORCOMS)
		   (FNS EDITCONFIGURATION)

      previous date: "20-Sep-85 11:33:40" {ERIS}<LISPCORE>LIBRARY>KEYBOARDEDITOR.;2)


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

(PRETTYCOMPRINT KEYBOARDEDITORCOMS)

(RPAQQ KEYBOARDEDITORCOMS ((FILES VIRTUALKEYBOARDS)
	(COMS (* Editor for Configurations -- the description of the physical key layout, which keys 
		 are assignable, etc.)
	      (FNS EDITCONFIGURATION VKBD.CONF.CHANGE-KEY-VALUE VKBD.CONF.DISPLAY-FIELD-VALUE 
		   VKBD.CONF.DISPLAY-INFO-KEYBOARD VKBD.CONF.DISPLAY-KEY-INFO 
		   VKBD.CONF.EDIT-DEFAULT-ASSIGNMENTS VKBD.CONF.ICONFN VKBD.CONF.PARSE-CONFIGURATION)
	      (BITMAPS VKBD.CONF.ICON))
	(FNS EDITKEYBOARD VKBD.EDIT.ADD-SUBITEM-TO-BACKGROUND-MENU VKBD.EDIT.CREATE-COMMAND-MENU 
	     VKBD.EDIT.CREATE-NON-CHAR-ASSIGMENTS-MENU VKBD.EDIT-KEYBOARD-COMMAND 
	     VKBD.EDIT.ASSIGN-CHARACTER VKBD.EDIT.ASSIGN-NON-CHARACTER 
	     VKBD.EDIT.CREATE-CHARACTER-SETS-MENU VKBD.EDIT.CREATE-CHARACTERS-MENU 
	     VKBD.EDIT.CREATE-DISPLAY VKBD.EDIT.DEFINE-COMMAND VKBD.EDIT.DO-MENU-COMMAND 
	     VKBD.EDIT.ICONFN VKBD.EDIT.INVERT-IF-LOCKED VKBD.EDIT.KEYBOARD-REPAINTFN 
	     VKBD.EDIT.LARGE-WINDOW-REPAINTFN VKBD.EDIT.MAKE-CURRENT-KEY VKBD.EDIT.QUIT-COMMAND 
	     VKBD.EDIT.STOP-COMMAND VKBD.EDIT.SWITCH-CHAR-SET-COMMAND VKBD.EDIT.SWITCH-CHARACTER-SET 
	     VKBD.EDIT.ROTATED-NUMBER)
	(INITVARS (VKBD.EDIT.ALLOW-NON-CHAR-ASSIGNMENTS T)
		  (VKBD.EDIT.MAX-NUMBER-OF-CASHED-MENUS 15)
		  (VKBD.EDITOR-WINDOW-HEIGHT 450)
		  (VKBD.EDITOR-WINDOW-WIDTH 512)
		  (VKBD.EDIT.DISPLAY-CHAR-SETS-NAMES T))
	(VARS VKBD.EDIT.BACKGROUND-MENU-SUBITEMS (VKBD.EDIT.CASH-MENUES NIL)
	      VKBD.EDIT.CHAR-SET-NAMES VKBD.EDIT.MENU-ITEMS VKBD.EDIT.NON-CHAR-ASSIGNMENTS)
	(BITMAPS VKBD.EDIT.ICON VKBD.EDIT.MASK)
	(GLOBALVARS VKBD.EDIT.ALLOW-NON-CHAR-ASSIGNMENTS VKBD.EDIT.BACKGROUND-MENU-SUBITEMS 
		    VKBD.EDIT.MAX-NUMBER-OF-CASHED-MENUS VKBD.EDITOR-WINDOW-HEIGHT 
		    VKBD.EDITOR-WINDOW-WIDTH VKBD.EDIT.DISPLAY-CHAR-SETS-NAMES VKBD.EDIT.CASH-MENUES 
		    VKBD.EDIT.CHAR-SET-NAMES VKBD.EDIT.MENU-ITEMS VKBD.EDIT.NON-CHAR-ASSIGNMENTS 
		    VKBD.CONF.ICON VKBD.EDIT.ICON VKBD.EDIT.MASK)
	(P (VKBD.EDIT.ADD-SUBITEM-TO-BACKGROUND-MENU (LIST "Edit" [QUOTE (ADD.PROCESS
									   (QUOTE (
VKBD.EDIT-KEYBOARD-COMMAND T]
							   
"Calls the keyboard editor. Will prompt for name for the new keyboard, and will use the default keyboard as the initial keyboard"
							   VKBD.EDIT.BACKGROUND-MENU-SUBITEMS)
						     "Keyboard"))))
(FILESLOAD VIRTUALKEYBOARDS)



(* Editor for Configurations -- the description of the physical key layout, which keys are 
assignable, etc.)

(DEFINEQ

(EDITCONFIGURATION
  [LAMBDA (CONFIGNAME)                                       (* jds "21-Sep-85 08:00")
    (VKBD.CONF.DISPLAY-INFO-KEYBOARD CONFIGNAME])

(VKBD.CONF.CHANGE-KEY-VALUE
  [LAMBDA (ITEM MENU MOUSEKEY)                               (* sm "14-Aug-85 18:05")
    (PROG (MAINW CONF WINDOW PROMPTW KEY)
          (SETQ WINDOW (WFROMMENU MENU))
          [SETQ PROMPTW (CAR (WINDOWPROP WINDOW (QUOTE PROMPTWINDOW]
          (SETQ MAINW (MAINWINDOW WINDOW T))
          (SETQ CONF (VKBD.GET-CONFIGURATION MAINW))
          (SETQ KEY (WINDOWPROP MAINW (QUOTE VKBD.CONF.CURRENT-KEY)))
          (SELECTQ (CADR ITEM)
		   (KEYID (PROG (NEW)
			        (SETQ NEW (CAR (TTYINEDIT (LIST KEY)
							  PROMPTW NIL "Enter new ID :")))
			        (DSUBST NEW KEY CONF)
			        (WINDOWPROP MAINW (QUOTE VKBD.CONF.CURRENT-KEY)
					    NEW)
			        (SETQ KEY NEW)))
		   (REGIONS (PROG (CURRENT-REGIONS NEW-REGIONS)
			          (SETQ CURRENT-REGIONS (FASSOC KEY (fetch (KEYBOARDCONFIGURATION
									     KEYREGIONS)
								       of CONF)))
			          (SETQ NEW-REGIONS (CAR (TTYINEDIT (LIST (CDR CURRENT-REGIONS))
								    PROMPTW NIL 
								    "Enter new region(s) :")))
			          (RPLACD CURRENT-REGIONS NEW-REGIONS)))
		   [DEFAULT (PROG (CURRENT-DEFAULT ASSIGNMENTS NEW)
			          (SETQ ASSIGNMENTS (fetch (KEYBOARDCONFIGURATION DEFAULTASSIGNMENT)
						       of CONF))
			          (SETQ CURRENT-DEFAULT (FASSOC KEY ASSIGNMENTS))
			          (SETQ ASSIGNMENTS (REMOVE CURRENT-DEFAULT ASSIGNMENTS))
			          (SETQ NEW (CAR (TTYINEDIT (LIST (CDR CURRENT-DEFAULT))
							    PROMPTW NIL "Enter new default(s):")))
			          (replace (KEYBOARDCONFIGURATION DEFAULTASSIGNMENT) of CONF
				     with (CONS (CONS KEY NEW)
						ASSIGNMENTS))
			          (WINDOWPROP MAINW (QUOTE VKBD.KEYBOARD)
					      (VKBD.CREATE-DEFAULT-KEYBOARD CONF]
		   (NAMES (PROG (CURRENT NEW MAPPING)
			        (SETQ CURRENT (VKBD.KEY-ID-TO-KEY-NAMES KEY CONF))
			        (SETQ MAPPING (fetch (KEYBOARDCONFIGURATION KEYNAMESMAPPING)
						 of CONF))
			        (for N in CURRENT do (SETQ MAPPING (REMOVE (LIST N KEY)
									   MAPPING)))
			        (SETQ NEW (CAR (TTYINEDIT (LIST CURRENT)
							  PROMPTW NIL "Enter new NAME(s) :")))
			        (for N in (MKLIST NEW) do (pushnew MAPPING (LIST N KEY)))
			        (replace (KEYBOARDCONFIGURATION KEYNAMESMAPPING) of CONF
				   with MAPPING)))
		   [LABEL (PROG (OLD-LABEL LABELS NEW)
			        (SETQ LABELS (fetch (KEYBOARDCONFIGURATION KEYLABELS) of CONF))
			        (SETQ OLD-LABEL (FASSOC KEY LABELS))
			        (if OLD-LABEL
				    then (SETQ LABELS (REMOVE OLD-LABEL LABELS))
					 (SETQ OLD-LABEL (CADR OLD-LABEL)))
			        (SETQ NEW (CAR (TTYINEDIT (LIST OLD-LABEL)
							  PROMPTW NIL "Enter new LABEL :")))
			        (replace (KEYBOARDCONFIGURATION KEYLABELS) of CONF
				   with (if NEW
					    then (CONS (LIST KEY NEW)
						       LABELS)
					  else LABELS]
		   [ASSIGNABLE (PROG (ASS-KEYS)
				     (SETQ ASS-KEYS (fetch (KEYBOARDCONFIGURATION ASSIGNABLEKEYS)
						       of CONF))
				     (if (FMEMB KEY ASS-KEYS)
					 then (DREMOVE KEY ASS-KEYS)
				       else (replace (KEYBOARDCONFIGURATION ASSIGNABLEKEYS)
					       of CONF with (CONS KEY ASS-KEYS]
		   (PROGN (PROMPTPRINT "ILLEGAL FIELD VALUE IN <VKBD.CONF.CHANGE-KEY-VALUE>")
			  (RETURN NIL)))
          (CLEARW PROMPTW)
          (VKBD.CONF.DISPLAY-FIELD-VALUE KEY (CADR ITEM)
					 CONF WINDOW MENU])

(VKBD.CONF.DISPLAY-FIELD-VALUE
  [LAMBDA (KEY FIELD CONF WINDOW MENU)                       (* sm "14-Aug-85 17:30")
    (PROG (X Y)
          [for ITEM in (fetch ITEMS of MENU) when (EQ (CADR ITEM)
						      FIELD)
	     do (SETQ Y (fetch BOTTOM of (MENUITEMREGION ITEM MENU]
          (SETQ X (IPLUS (fetch MENUREGIONLEFT of MENU)
			 (fetch IMAGEWIDTH of MENU)
			 5))
          (DSPFILL (CREATEREGION X Y (IDIFFERENCE (fetch WIDTH of (WINDOWPROP WINDOW (QUOTE REGION)))
						  Y)
				 (fetch ITEMHEIGHT of MENU))
		   (DSPTEXTURE NIL WINDOW)
		   (QUOTE REPLACE)
		   WINDOW)
          (MOVETO X Y WINDOW)
          (PRIN1 (SELECTQ FIELD
			  (KEYID KEY)
			  (REGIONS (VKBD.GET-KEY-REGIONS KEY CONF))
			  [DEFAULT (CDR (VKBD.FETCH-KEY-ASSIGNMENT KEY (MAINWINDOW WINDOW]
			  (NAMES (VKBD.KEY-ID-TO-KEY-NAMES KEY CONF))
			  [LABEL (CADR (FASSOC KEY (fetch (KEYBOARDCONFIGURATION KEYLABELS)
						      of CONF]
			  (ASSIGNABLE (if (FMEMB KEY (fetch (KEYBOARDCONFIGURATION ASSIGNABLEKEYS)
							of CONF))
					  then T
					else NIL))
			  (PROMPTPRINT "ILLEGAL FIELD VALUE FOR DISPLAY CONFIGURATION FIELD VALUE!"))
		 WINDOW])

(VKBD.CONF.DISPLAY-INFO-KEYBOARD
  [LAMBDA (CONFIGURATION)                                    (* sm "16-Aug-85 10:59")
    (PROG (WINDOW ATT-WINDOW MENU)
          (SETQ CONFIGURATION (VKBD.GET-CONFIGURATION CONFIGURATION))
          (SETQ WINDOW (VKBD.CREATE-KEYBOARD-DISPLAY (VKBD.CREATE-DEFAULT-KEYBOARD CONFIGURATION)
						     NIL
						     (QUOTE VKBD.CONF.DISPLAY-KEY-INFO)))
          (SETQ MENU (create MENU
			     ITEMS ←(QUOTE (("Key ID" KEYID)
					     ("Key regions" REGIONS)
					     ("Default assignment" DEFAULT)
					     ("Key names" NAMES)
					     ("Key Label" LABEL)
					     ("Assignable? " ASSIGNABLE)))
			     MENUBORDERSIZE ← 0
			     MENUOUTLINESIZE ← 0
			     MENUFONT ← BOLDFONT
			     WHENSELECTEDFN ←(QUOTE VKBD.CONF.CHANGE-KEY-VALUE)))
          (SETQ ATT-WINDOW (CREATEW (CREATEREGION 0 0 (fetch WIDTH of (WINDOWPROP WINDOW
										  (QUOTE REGION)))
						  (IPLUS 10 (fetch IMAGEHEIGHT of MENU)))
				    NIL NIL T))
          (ATTACHWINDOW ATT-WINDOW WINDOW (QUOTE TOP)
			(QUOTE JUSTIFY))
          (OPENW ATT-WINDOW)
          (ADDMENU MENU ATT-WINDOW (create POSITION
					   XCOORD ← 0
					   YCOORD ← 0))
          (GETPROMPTWINDOW ATT-WINDOW 2 BOLDFONT)
          (WINDOWPROP WINDOW (QUOTE ICONFN)
		      (QUOTE VKBD.CONF.ICONFN])

(VKBD.CONF.DISPLAY-KEY-INFO
  [LAMBDA (KEY WINDOW MOUSEKEY)                              (* sm "14-Aug-85 15:38")
    (PROG (CONFIGURATION OLD-KEY ATT-WINDOW)
          (if (SETQ OLD-KEY (WINDOWPROP WINDOW (QUOTE VKBD.CONF.CURRENT-KEY)))
	      then (VKBD.ERASE-FRAME OLD-KEY WINDOW 2))
          (WINDOWPROP WINDOW (QUOTE VKBD.CONF.CURRENT-KEY)
		      KEY)
          (VKBD.FRAME-KEY KEY WINDOW BLACKSHADE 2)
          (SETQ CONFIGURATION (VKBD.GET-CONFIGURATION WINDOW))
          (SETQ ATT-WINDOW (CAR (ATTACHEDWINDOWS WINDOW)))
          (for F in (QUOTE (KEYID REGIONS DEFAULT NAMES LABEL ASSIGNABLE))
	     do (VKBD.CONF.DISPLAY-FIELD-VALUE KEY F CONFIGURATION ATT-WINDOW
					       (CAR (WINDOWPROP ATT-WINDOW (QUOTE MENU])

(VKBD.CONF.EDIT-DEFAULT-ASSIGNMENTS
  [LAMBDA (CONFIGURATION)                                    (* sm "15-Aug-85 10:25")
    (PROG (DUMMY-CONFIGURATION DUMMY-KEYBOARD)
          (SETQ CONFIGURATION (VKBD.GET-CONFIGURATION CONFIGURATION))
          (SETQ DUMMY-CONFIGURATION (COPY CONFIGURATION))
          (replace (KEYBOARDCONFIGURATION ASSIGNABLEKEYS) of DUMMY-CONFIGURATION
	     with (fetch (KEYBOARDCONFIGURATION KEYSIDLIST) of DUMMY-CONFIGURATION))
          (replace (KEYBOARDCONFIGURATION KEYLABELS) of DUMMY-CONFIGURATION with NIL)
          (SETQ DUMMY-KEYBOARD (create VIRTUALKEYBOARD
				       KEYBOARDNAME ← "DEFAULT ASIGNMENTS"
				       KEYASSIGNMENTS ←(fetch (KEYBOARDCONFIGURATION 
										DEFAULTASSIGNMENT)
							  of CONFIGURATION)
				       KEYBOARDCONFIGURATION ← DUMMY-CONFIGURATION))
          (EDITKEYBOARD DUMMY-KEYBOARD)
          (replace (KEYBOARDCONFIGURATION DEFAULTASSIGNMENT) of CONFIGURATION
	     with (fetch (VIRTUALKEYBOARD KEYASSIGNMENTS) of DUMMY-KEYBOARD])

(VKBD.CONF.ICONFN
  [LAMBDA (WINDOW ICON)                                      (* sm "15-Aug-85 11:02")
    [COND
      ((NULL ICON)
	(SETQ ICON (TITLEDICONW (create TITLEDICON
					ICON ← VKBD.CONF.ICON
					MASK ← VKBD.EDIT.MASK
					TITLEREG ←(CREATEREGION 5 15 80 75))
				(CONCAT "EDIT CONFIGURATION: " (fetch (KEYBOARDCONFIGURATION 
										CONFIGURATIONNAME)
								  of (VKBD.GET-CONFIGURATION WINDOW)))
				(FONTCREATE (QUOTE GACHA)
					    8]
    ICON])

(VKBD.CONF.PARSE-CONFIGURATION
  [LAMBDA (CONFIGURATION)                                    (* sm " 5-Aug-85 17:05")
    (PROG (ERROR-FLAG REGS IDS)
          (SETQ CONFIGURATION (VKBD.GET-CONFIGURATION CONFIGURATION))
          (if (NULL CONFIGURATION)
	      then (PRINTOUT T T CONFIGURATION " NOT A CONFIGURATION. ")
		   (RETURN NIL))
          (SETQ IDS (fetch (KEYBOARDCONFIGURATION KEYSIDLIST) of CONFIGURATION))
          (SETQ REGS (fetch (KEYBOARDCONFIGURATION KEYREGIONS) of CONFIGURATION))
          (if (NULL IDS)
	      then (PRINTOUT T T "Null Id list. ")
		   (RETURN NIL))
          (if (LESSP (LENGTH REGS)
		     (LENGTH IDS))
	      then (PRINTOUT T T "KEYS WITHOUT REGIONS : ")
		   (for K in IDS when (NOT (FASSOC K REGS)) do (PRINTOUT T " " K))
		   (SETQ ERROR-FLAG T))
          (for R in REGS do (for R1 in (CDR R) when (NOT (REGIONP R1))
			       DO (SETQ ERROR-FLAG T)
				  (PRINTOUT T T "KEY : " (CAR R)
					    " -- " R1 " NOT A REGION")))
          (for KEY in (fetch (KEYBOARDCONFIGURATION ASSIGNABLEKEYS) of CONFIGURATION)
	     when (NOT (FMEMB KEY IDS))
	     do (SETQ ERROR-FLAG T)
		(PRINTOUT T T "KEY :" KEY " IS IN THE ASSIGNABLE KEYS BUT NOT IN KEY IDS"))
          (for ASS in (fetch (KEYBOARDCONFIGURATION DEFAULTASSIGNMENT) of CONFIGURATION)
	     when (NOT (FMEMB (CAR ASS)
			      IDS))
	     do (SETQ ERROR-FLAG T)
		(PRINTOUT T T "KEY : " (CAR ASS)
			  " HAS ASSIGNMENT BUT IS NOT IN ID LIST"))
          (for ID in IDS when (NOT (FASSOC ID (fetch (KEYBOARDCONFIGURATION DEFAULTASSIGNMENT)
						 of CONFIGURATION)))
	     do (SETQ ERROR-FLAG T)
		(PRINTOUT T T "KEY :" ID " DOES NOT HAVE ASSIGNMENT."))
          (RETURN (NOT ERROR-FLAG])
)

(RPAQ VKBD.CONF.ICON (READBITMAP))
(93 93
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"NGOOOOOOOOOOOOOOOOOOOOCH"
"NGOOOOOOOOOOOOOOOOOOOOCH"
"NGOOOOOOOOOOOOOOOOOOOOCH"
"NG@HECI@HDCI@HDNALHD@GCH"
"NG@HECI@HDCI@HDNALHD@GCH"
"NG@HECO@HDCM@OONALHDNGCH"
"NG@HDCO@HDCM@OONAOHGOOCH"
"NGOOOOOOOOOOOOOOOOOOOOCH"
"NG@BA@NDBAALDNA@IOBGOOCH"
"NGGBA@NDBAALDNA@HGBG@GCH"
"NGGCOOOLBAOOONAOOOOOFGCH"
"NG@COOOLBAOOONAOOOOO@GCH"
"NGOOOOOOOOOOOOOOOOOOHGCH"
"NG@CHDCI@ILBCHHNBALHIGCH"
"NG@CHDCI@ILBCHHNBALHIGCH"
"NGOOHDCOOOLBCHINBALHIGCH"
"NGOOHDCOOOLBGHINBALHHGCH"
"NGOOOOOOOOOOOOOOOOOOOOCH"
"NG@@@HDGA@HDGAALDCM@@GCH"
"NG@@@HDGA@HDGAALDCI@@GCH"
"NG@@@HDGA@HDGAALDCI@@GCH"
"NG@@@HDGA@HDGAALDCI@@GCH"
"NGOOOOOOOOOOOOOOOOOOOOCH"
"NGOOOOOOOOOOOOOOOOOOOOCH"
"NGOOOOOOOOOOOOOOOOOOOOCH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH")
(DEFINEQ

(EDITKEYBOARD
  [LAMBDA (KEYBOARD SOURCE-KEYBOARD CONFIGURATION-NAME)      (* sm " 1-Aug-85 17:55")
    (PROG (VKBD.EDIT-WINDOW CURRENT-EVENT KEYBOARD-TO-EDIT COMPLETE-KEYBOARD)
          (COND
	    ((NULL KEYBOARD)
	      (RETURN NIL)))
          (if (ATOM KEYBOARD)
	      then (SETQ KEYBOARD-TO-EDIT (FASSOC KEYBOARD VKBD.KNOWN-KEYBOARDS))
		   (if (NULL KEYBOARD-TO-EDIT)
		       then [if (AND (NULL SOURCE-KEYBOARD)
				     CONFIGURATION-NAME)
				then (SETQ KEYBOARD-TO-EDIT (VKBD.CREATE-DEFAULT-KEYBOARD 
									       CONFIGURATION-NAME))
			      else [SETQ KEYBOARD-TO-EDIT (COPY (if (AND SOURCE-KEYBOARD
									 (ATOM SOURCE-KEYBOARD))
								    then (FASSOC SOURCE-KEYBOARD 
									     VKBD.KNOWN-KEYBOARDS]
				   (if (NULL KEYBOARD-TO-EDIT)
				       then (SETQ KEYBOARD-TO-EDIT (COPY (FASSOC (QUOTE DEFAULT)
										 VKBD.KNOWN-KEYBOARDS]
			    (replace KEYBOARDNAME of KEYBOARD-TO-EDIT with KEYBOARD))
	    else (SETQ KEYBOARD-TO-EDIT KEYBOARD))
          (SETQ VKBD.EDIT-WINDOW (VKBD.EDIT.CREATE-DISPLAY KEYBOARD-TO-EDIT))
          (WINDOWPROP VKBD.EDIT-WINDOW (QUOTE VKBD.KEYBOARD)
		      (COPY KEYBOARD-TO-EDIT))
          (WINDOWPROP VKBD.EDIT-WINDOW (QUOTE VKBD.ORIGINAL-KEYBOARD)
		      KEYBOARD-TO-EDIT)
          (WINDOWPROP VKBD.EDIT-WINDOW (QUOTE VKBD.EDITOR-RETURN-EVENT)
		      (SETQ CURRENT-EVENT (CREATE.EVENT "VKBD.EDIT")))
          (AWAIT.EVENT CURRENT-EVENT)
          (CLOSEW VKBD.EDIT-WINDOW)
          (RETURN (WINDOWPROP VKBD.EDIT-WINDOW (QUOTE VKBD.KEYBOARD])

(VKBD.EDIT.ADD-SUBITEM-TO-BACKGROUND-MENU
  [LAMBDA (SUBITEM MAINITEMLABEL)                            (* sm "15-Aug-85 14:14")
    (PROG (MAINITEM OLD)
          (SETQ MAINITEM (SASSOC MAINITEMLABEL BackgroundMenuCommands))
          [if MAINITEM
	      then (if (AND (CDDDR MAINITEM)
			    (EQ (CAR (CADDDR MAINITEM))
				(QUOTE SUBITEMS)))
		       then (if (SETQ OLD (SASSOC (CAR SUBITEM)
						  (CADDDR MAINITEM)))
				then (RPLACD OLD (CDR SUBITEM))
			      else (NCONC1 (CADDDR MAINITEM)
					   SUBITEM))
		     else (RPLACD (CDDR MAINITEM)
				  (LIST (LIST (QUOTE SUBITEMS)
					      SUBITEM]
          (SETQ BackgroundMenu NIL])

(VKBD.EDIT.CREATE-COMMAND-MENU
  [LAMBDA NIL                                                (* sm " 1-Aug-85 17:22")
    (create MENU
	    ITEMS ← VKBD.EDIT.MENU-ITEMS
	    MENUFONT ←(FONTCREATE (QUOTE HELVETICA)
				  12
				  (QUOTE BOLD))
	    CENTERFLG ← T
	    MENUROWS ← 1
	    WHENSELECTEDFN ←(QUOTE VKBD.EDIT.DO-MENU-COMMAND])

(VKBD.EDIT.CREATE-NON-CHAR-ASSIGMENTS-MENU
  [LAMBDA NIL                                                (* sm "13-Aug-85 11:09")
    (create MENU
	    ITEMS ← VKBD.EDIT.NON-CHAR-ASSIGNMENTS
	    MENUFONT ←(FONTCREATE (QUOTE GACHA)
				  8)
	    MENUROWS ←(ADD1 (IQUOTIENT (SUB1 (LENGTH VKBD.EDIT.NON-CHAR-ASSIGNMENTS))
				       4))
	    CENTERFLG ← T
	    WHENSELECTEDFN ←(QUOTE VKBD.EDIT.ASSIGN-CHARACTER])

(VKBD.EDIT-KEYBOARD-COMMAND
  [LAMBDA (NEW-KEYBOARD? ASK-FOR-INITIAL?)                   (* sm "14-Aug-85 15:11")
    (PROG (NEW-NAME KEYBOARD INITIAL-KEYBOARD)
          (if (NOT NEW-KEYBOARD?)
	      then (SETQ KEYBOARD (VKBD.POP-UP-KEYBOARDS-MENU 
						      "Select the keyboard that you want to edit"))
		   (if KEYBOARD
		       then (if (EQ KEYBOARD (QUOTE DEFAULT))
				then (PROMPTPRINT "Can not edit the default keyboard.")
			      else (EDITKEYBOARD KEYBOARD)))
	    else [SETQ NEW-NAME (MKATOM (PROMPTFORWORD "Enter name for new keyboard :" NIL NIL 
						       PROMPTWINDOW NIL (QUOTE TTY]
		 (if NEW-NAME
		     then (if ASK-FOR-INITIAL?
			      then (SETQ INITIAL-KEYBOARD (VKBD.POP-UP-KEYBOARDS-MENU 
			     "Select the keyboard to be used as initial keyboard for the editing"))
				   (if INITIAL-KEYBOARD
				       then (EDITKEYBOARD NEW-NAME INITIAL-KEYBOARD))
			    else (EDITKEYBOARD NEW-NAME (QUOTE DEFAULT])

(VKBD.EDIT.ASSIGN-CHARACTER
  [LAMBDA (ITEM MENU MOUSE-KEY)                              (* sm "15-Aug-85 10:02")
    (PROG (WINDOW KEY SHIFTED CURRENT-KEY-INFO KEY-ASSIGNMENT KEYBOARD)
          (SETQ WINDOW (MAINWINDOW (WFROMMENU MENU)
				   T))
          (SETQ KEYBOARD (WINDOWPROP WINDOW (QUOTE VKBD.KEYBOARD)))
          (SETQ CURRENT-KEY-INFO (WINDOWPROP WINDOW (QUOTE VKBD.CURRENT-KEY)))
          (if CURRENT-KEY-INFO
	      then (SETQ KEY (CAR CURRENT-KEY-INFO))
		   (SETQ SHIFTED (CADR CURRENT-KEY-INFO))
		   (SETQ KEY-ASSIGNMENT (VKBD.FETCH-KEY-ASSIGNMENT KEY WINDOW))
		   [if (AND VKBD.EDIT.ALLOW-NON-CHAR-ASSIGNMENTS (MEMBER ITEM 
								   VKBD.EDIT.NON-CHAR-ASSIGNMENTS))
		       then (VKBD.EDIT.ASSIGN-NON-CHARACTER KEY-ASSIGNMENT ITEM)
		     else (if (NULL KEY-ASSIGNMENT)
			      then (replace (VIRTUALKEYBOARD KEYASSIGNMENTS) of KEYBOARD
				      with (CONS (LIST KEY (LIST (CADR ITEM)
								 (CADR ITEM)
								 (QUOTE NOLOCKSHIFT)))
						 (fetch (VIRTUALKEYBOARD KEYASSIGNMENTS)
						    of KEYBOARD)))
			    else (RPLACD (CDR KEY-ASSIGNMENT)
					 NIL)
				 (if (OR (NULL (CDR KEY-ASSIGNMENT))
					 (ATOM (CADR KEY-ASSIGNMENT)))
				     then [RPLACD KEY-ASSIGNMENT (LIST (LIST (CADR ITEM)
									     (CADR ITEM)
									     (QUOTE NOLOCKSHIFT]
				   else (if SHIFTED
					    then (RPLACA (CDADR KEY-ASSIGNMENT)
							 (CADR ITEM))
					  else (RPLACA (CADR KEY-ASSIGNMENT)
						       (CADR ITEM]
		   (VKBD.DISPLAY-KEY KEY WINDOW)
	    else (FLASHWINDOW PROMPTWINDOW)
		 (PRINTOUT PROMPTWINDOW T 
			   "There is no current selected key. Character was not assigned."])

(VKBD.EDIT.ASSIGN-NON-CHARACTER
  [LAMBDA (KEY-ASSIGNMENT NEW-ASSIGNMENT)                    (* sm "13-Aug-85 10:16")
    (RPLACD KEY-ASSIGNMENT (SELECTQ NEW-ASSIGNMENT
				    (SHIFT (QUOTE (1SHIFTDOWN . 1SHIFTUP)))
				    (CTRL (QUOTE (CTRLDOWN . CTRLUP)))
				    (META (QUOTE (METADOWN . METAUP)))
				    (LOCK (QUOTE (LOCKDOWN . LOCKUP)))
				    (LOCKDOWN (QUOTE (LOCKDOWN)))
				    (LOCKUP (QUOTE (LOCKUP)))
				    (EVENT (QUOTE (EVENT . EVENT)))
				    NIL])

(VKBD.EDIT.CREATE-CHARACTER-SETS-MENU
  [LAMBDA NIL                                                (* sm "15-Aug-85 12:13")
    (if VKBD.EDIT.DISPLAY-CHAR-SETS-NAMES
	then [create MENU
		     ITEMS ← VKBD.EDIT.CHAR-SET-NAMES
		     MENUFONT ← BIGFONT
		     ITEMWIDTH ←(ITIMES 29 16)
		     ITEMHEIGHT ←(ADD1 (IQUOTIENT (ITIMES 25 16)
						  (LENGTH VKBD.EDIT.CHAR-SET-NAMES]
      else (create MENU
		   ITEMS ←(for I from 1 to 256 bind ROTATED-I
			     collect (PROGN (SETQ ROTATED-I (SUB1 (VKBD.EDIT.ROTATED-NUMBER I 16 16)))
					    (LIST (OCTALSTRING ROTATED-I)
						  ROTATED-I)))
		   MENUCOLUMNS ← 16
		   CENTERFLG ← T
		   ITEMHEIGHT ← 25
		   ITEMWIDTH ← 29])

(VKBD.EDIT.CREATE-CHARACTERS-MENU
  [LAMBDA (CHAR-SET-NUMBER FONT)                             (* sm "15-Aug-85 12:15")
    (PROG (EXISTING-MENU-INFO NEW-MENU)
          [SETQ EXISTING-MENU-INFO (for CHARSET-FONT-MENU in VKBD.EDIT.CASH-MENUES
				      thereis (AND (EQP (CAR CHARSET-FONT-MENU)
							CHAR-SET-NUMBER)
						   (EQ (CADR CHARSET-FONT-MENU)
						       FONT]
          (if EXISTING-MENU-INFO
	      then (RETURN (CADDR EXISTING-MENU-INFO)))
          (PRINTOUT PROMPTWINDOW T "Wait. Bitmaps for character set " (OCTALSTRING CHAR-SET-NUMBER)
		    " are being retrieved. ")
          (SETQ NEW-MENU (create MENU
				 ITEMS ←(for I from 0 to 255 bind CODE bind ROTATED-I
					   collect (PROGN (SETQ ROTATED-I (SUB1 (
VKBD.EDIT.ROTATED-NUMBER (ADD1 I)
			 16 16)))
							  (LIST (GETCHARBITMAP (SETQ CODE
										 (VKBD.PARSE-CHAR-CODE
										   (LIST 
										  CHAR-SET-NUMBER 
											ROTATED-I)))
									       FONT)
								CODE)))
				 MENUCOLUMNS ← 16
				 CENTERFLG ← T
				 ITEMHEIGHT ← 25
				 ITEMWIDTH ← 29
				 WHENSELECTEDFN ←(QUOTE VKBD.EDIT.ASSIGN-CHARACTER)))
          (PROMPTPRINT "... Done. ")
          (push VKBD.EDIT.CASH-MENUES (LIST CHAR-SET-NUMBER FONT NEW-MENU))
          (if (GREATERP (LENGTH VKBD.EDIT.CASH-MENUES)
			VKBD.EDIT.MAX-NUMBER-OF-CASHED-MENUS)
	      then (RPLACD (LAST VKBD.EDIT.CASH-MENUES)
			   NIL))
          (RETURN NEW-MENU])

(VKBD.EDIT.CREATE-DISPLAY
  [LAMBDA (KEYBOARD)                                         (* sm "13-Aug-85 12:37")
    (PROG (WINDOW LARGE-WINDOW BM WPOS REGION-WIDTH REGION-HEIGHT NON-CHAR-WINDOW COMMAND-MENU 
		  NON-CHAR-MENU)
          (SETQ BM (VKBD.CREATE-KEYBOARD-BITMAP (fetch (VIRTUALKEYBOARD KEYBOARDCONFIGURATION)
						   of KEYBOARD)))
          (if VKBD.EDIT.ALLOW-NON-CHAR-ASSIGNMENTS
	      then (SETQ NON-CHAR-MENU (VKBD.EDIT.CREATE-NON-CHAR-ASSIGMENTS-MENU)))
          (SETQ COMMAND-MENU (VKBD.EDIT.CREATE-COMMAND-MENU))
          [SETQ REGION-WIDTH (MAX VKBD.EDITOR-WINDOW-WIDTH (IPLUS 8 (BITMAPWIDTH BM]
          (SETQ REGION-HEIGHT (MIN SCREENHEIGHT (IPLUS (fetch IMAGEHEIGHT of COMMAND-MENU)
						       (if VKBD.EDIT.ALLOW-NON-CHAR-ASSIGNMENTS
							   then (fetch IMAGEHEIGHT of NON-CHAR-MENU)
							 else 0)
						       (BITMAPHEIGHT BM)
						       VKBD.EDITOR-WINDOW-HEIGHT 20)))
          (SETQ WPOS (GETBOXPOSITION REGION-WIDTH REGION-HEIGHT NIL NIL NIL 
				     "Specify region for Keyboard Editor window"))
          (SETQ WINDOW (VKBD.CREATE-KEYBOARD-DISPLAY KEYBOARD WPOS (QUOTE VKBD.EDIT.MAKE-CURRENT-KEY)
						     BM))
          (WINDOWPROP WINDOW (QUOTE REPAINTFN)
		      (QUOTE VKBD.EDIT.KEYBOARD-REPAINTFN))
          (WINDOWPROP WINDOW (QUOTE ICONFN)
		      (QUOTE VKBD.EDIT.ICONFN))
          (SETQ LARGE-WINDOW (CREATEW (CREATEREGION 0 0 VKBD.EDITOR-WINDOW-WIDTH 
						    VKBD.EDITOR-WINDOW-HEIGHT)
				      (CONCAT "Edit of Keyboard : " (fetch (VIRTUALKEYBOARD 
										     KEYBOARDNAME)
								       of KEYBOARD))
				      NIL T))
          (WINDOWPROP LARGE-WINDOW (QUOTE CLOSEFN)
		      (QUOTE VKBD.EDIT.STOP-COMMAND))
          (ATTACHWINDOW LARGE-WINDOW WINDOW (QUOTE TOP)
			(QUOTE CENTER))
          (if VKBD.EDIT.ALLOW-NON-CHAR-ASSIGNMENTS
	      then (ATTACHMENU NON-CHAR-MENU LARGE-WINDOW (QUOTE TOP)
			       (QUOTE JUSTIFY)))
          (OPENW LARGE-WINDOW)
          (WINDOWPROP LARGE-WINDOW (QUOTE RESHAPEFN)
		      (QUOTE DON'T))
          (ATTACHMENU COMMAND-MENU LARGE-WINDOW (QUOTE TOP)
		      (QUOTE JUSTIFY))
          (WINDOWPROP WINDOW (QUOTE VKBD.CHAR-SET-MENU)
		      (VKBD.EDIT.CREATE-CHARACTER-SETS-MENU))
          (VKBD.EDIT.LARGE-WINDOW-REPAINTFN LARGE-WINDOW)
          (VKBD.EDIT.SWITCH-CHARACTER-SET 0 LARGE-WINDOW)
          (WINDOWADDPROP LARGE-WINDOW (QUOTE REPAINTFN)
			 (QUOTE VKBD.EDIT.LARGE-WINDOW-REPAINTFN))
          (RETURN WINDOW])

(VKBD.EDIT.DEFINE-COMMAND
  [LAMBDA (WINDOW)                                           (* sm " 5-Aug-85 09:26")
    (DEFINEKEYBOARD (WINDOWPROP WINDOW (QUOTE VKBD.KEYBOARD)))
    (PRINTOUT PROMPTWINDOW "Keyboard " (fetch (VIRTUALKEYBOARD KEYBOARDNAME)
					  of (WINDOWPROP WINDOW (QUOTE VKBD.KEYBOARD)))
	      " was added to the set of known keyboards."])

(VKBD.EDIT.DO-MENU-COMMAND
  [LAMBDA (ITEM MENU KEY)                                    (* sm " 1-Aug-85 17:34")
    (APPLY* (CADR ITEM)
	    (MAINWINDOW (WFROMMENU MENU)
			T])

(VKBD.EDIT.ICONFN
  [LAMBDA (WINDOW ICON)                                      (* sm "15-Aug-85 11:10")
    [COND
      ((NULL ICON)
	(SETQ ICON (TITLEDICONW (create TITLEDICON
					ICON ← VKBD.EDIT.ICON
					MASK ← VKBD.EDIT.MASK
					TITLEREG ←(CREATEREGION 5 25 80 65))
				[CONCAT "EDIT KEYBOARD: " (fetch (VIRTUALKEYBOARD KEYBOARDNAME)
							     of (WINDOWPROP WINDOW (QUOTE 
										    VKBD.KEYBOARD]
				(FONTCREATE (QUOTE GACHA)
					    8]
    ICON])

(VKBD.EDIT.INVERT-IF-LOCKED
  [LAMBDA (KEY WINDOW)                                       (* sm "13-Aug-85 10:01")
    (PROG (KEY-ASSIGNMENT)
          (SETQ KEY-ASSIGNMENT (VKBD.FETCH-KEY-ASSIGNMENT KEY WINDOW))
          (if (AND (VKBD.CHAR-ASSIGNMENTP KEY-ASSIGNMENT)
		   (EQ (VKBD.LOCK/NOLOCK KEY-ASSIGNMENT)
		       (QUOTE LOCKSHIFT)))
	      then (VKBD.INVERT-LOCK-KEYS WINDOW])

(VKBD.EDIT.KEYBOARD-REPAINTFN
  [LAMBDA (W)                                                (* sm " 5-Aug-85 16:12")
    (PROG (CURRENT-KEY)
          (VKBD.KEYBOARD-WINDOW-REPAINTFN W)
          (if (SETQ CURRENT-KEY (WINDOWPROP W (QUOTE VKBD.CURRENT-KEY)))
	      then (VKBD.FRAME-KEY (CAR CURRENT-KEY)
				   W BLACKSHADE 2)
		   (if (CADR CURRENT-KEY)
		       then (VKBD.INVERT-SHIFT-KEYS W))
		   (VKBD.EDIT.INVERT-IF-LOCKED (CAR CURRENT-KEY)
					       W])

(VKBD.EDIT.LARGE-WINDOW-REPAINTFN
  [LAMBDA (W)                                                (* sm "13-Aug-85 12:43")
    (for I from 0 to 20 as Y from 390 by -25
       do (MOVETO 10 Y W)
	  (PRIN1 (OCTALSTRING I)
		 W))
    (for I from 0 by 16 to 255 as X from 40 by 29
       do (MOVETO X 420 W)
	  (PRIN1 (OCTALSTRING I)
		 W])

(VKBD.EDIT.MAKE-CURRENT-KEY
  [LAMBDA (KEY WINDOW MOUSEKEY)                              (* sm " 7-Aug-85 17:51")
    (PROG (CURRENT-KEY SHIFTED CURRENT-KEY-ASSIGNMENT CURRENT-KEY-INFO LOCKED)
          (SETQ SHIFTED (WINDOWPROP WINDOW (QUOTE VKBD.SHIFT-DOWN)))
          (SETQ CURRENT-KEY-INFO (WINDOWPROP WINDOW (QUOTE VKBD.CURRENT-KEY)))
          (if (VKBD.LOCK-KEYP KEY WINDOW)
	      then (if (CADR CURRENT-KEY-INFO)
		       then (SETQ CURRENT-KEY-ASSIGNMENT (VKBD.FETCH-KEY-ASSIGNMENT (CAR 
										 CURRENT-KEY-INFO)
										    WINDOW))
			    (SETQ LOCKED (EQ (VKBD.LOCK/NOLOCK CURRENT-KEY-ASSIGNMENT)
					     (QUOTE LOCKSHIFT)))
			    (RPLACA (CDDADR CURRENT-KEY-ASSIGNMENT)
				    (if LOCKED
					then (QUOTE NOLOCKSHIFT)
				      else (QUOTE LOCKSHIFT)))
			    (VKBD.INVERT-LOCK-KEYS WINDOW))
	    elseif (VKBD.ASSIGNABLE-KEYP KEY WINDOW)
	      then (if CURRENT-KEY-INFO
		       then (VKBD.ERASE-FRAME (CAR CURRENT-KEY-INFO)
					      WINDOW 2)
			    (if (CADR CURRENT-KEY-INFO)
				then (VKBD.INVERT-SHIFT-KEYS WINDOW)
				     (VKBD.EDIT.INVERT-IF-LOCKED (CAR CURRENT-KEY-INFO)
								 WINDOW)))
		   (VKBD.FRAME-KEY KEY WINDOW BLACKSHADE 2)
		   (if SHIFTED
		       then (VKBD.INVERT-SHIFT-KEYS WINDOW)
			    (VKBD.EDIT.INVERT-IF-LOCKED KEY WINDOW))
		   (WINDOWPROP WINDOW (QUOTE VKBD.CURRENT-KEY)
			       (LIST KEY SHIFTED])

(VKBD.EDIT.QUIT-COMMAND
  [LAMBDA (WINDOW)                                           (* sm " 2-Aug-85 15:12")
    [REPLACE KEYASSIGNMENTS OF (WINDOWPROP WINDOW (QUOTE VKBD.ORIGINAL-KEYBOARD))
       WITH (FETCH KEYASSIGNMENTS OF (WINDOWPROP WINDOW (QUOTE VKBD.KEYBOARD]
    (NOTIFY.EVENT (WINDOWPROP WINDOW (QUOTE VKBD.EDITOR-RETURN-EVENT])

(VKBD.EDIT.STOP-COMMAND
  [LAMBDA (WINDOW)                                           (* sm " 2-Aug-85 13:04")
    (NOTIFY.EVENT (WINDOWPROP (MAINWINDOW WINDOW T)
			      (QUOTE VKBD.EDITOR-RETURN-EVENT])

(VKBD.EDIT.SWITCH-CHAR-SET-COMMAND
  [LAMBDA (MAIN-WINDOW)                                      (* sm " 5-Aug-85 09:28")
    (PROG (LARGE-WINDOW NEW-NUMBER)
          (SETQ LARGE-WINDOW (CAR (ATTACHEDWINDOWS MAIN-WINDOW)))
          [SETQ NEW-NUMBER (MENU (WINDOWPROP MAIN-WINDOW (QUOTE VKBD.CHAR-SET-MENU))
				 (create POSITION
					 XCOORD ←[IPLUS 34 (fetch (REGION LEFT)
							      of (WINDOWPROP LARGE-WINDOW
									     (QUOTE REGION]
					 YCOORD ←(IPLUS 9 (fetch (REGION BOTTOM)
							     of (WINDOWPROP LARGE-WINDOW
									    (QUOTE REGION]
          (if NEW-NUMBER
	      then (VKBD.EDIT.SWITCH-CHARACTER-SET NEW-NUMBER LARGE-WINDOW])

(VKBD.EDIT.SWITCH-CHARACTER-SET
  [LAMBDA (SET-NUMBER WINDOW)                                (* sm " 6-Aug-85 14:08")
    (PROG (MENU OLDCURSOR FONT)
          (if (WINDOWPROP WINDOW (QUOTE MENU))
	      then (DELETEMENU (CAR (WINDOWPROP WINDOW (QUOTE MENU)))
			       NIL WINDOW))
          (WINDOWPROP WINDOW (QUOTE TITLE)
		      (CONCAT "Character set " (OCTALSTRING SET-NUMBER)))
          [SETQ FONT (FONTCREATE (fetch (KEYBOARDCONFIGURATION KEYBOARDDISPLAYFONT)
				    of (VKBD.GET-CONFIGURATION (MAINWINDOW WINDOW]
          (ADDMENU (VKBD.EDIT.CREATE-CHARACTERS-MENU SET-NUMBER FONT)
		   WINDOW
		   (create POSITION
			   XCOORD ← 30
			   YCOORD ← 5])

(VKBD.EDIT.ROTATED-NUMBER
  [LAMBDA (NUM ROW-NUM COL-NUM)                              (* edited: " 3-Jun-85 12:47")
    (IPLUS (ITIMES (IMOD (SUB1 NUM)
			 COL-NUM)
		   ROW-NUM)
	   (ADD1 (IQUOTIENT (SUB1 NUM)
			    COL-NUM])
)

(RPAQ? VKBD.EDIT.ALLOW-NON-CHAR-ASSIGNMENTS T)

(RPAQ? VKBD.EDIT.MAX-NUMBER-OF-CASHED-MENUS 15)

(RPAQ? VKBD.EDITOR-WINDOW-HEIGHT 450)

(RPAQ? VKBD.EDITOR-WINDOW-WIDTH 512)

(RPAQ? VKBD.EDIT.DISPLAY-CHAR-SETS-NAMES T)

(RPAQQ VKBD.EDIT.BACKGROUND-MENU-SUBITEMS (SUBITEMS ("New Keyboard, default initial"
						      [QUOTE (ADD.PROCESS (QUOTE (
VKBD.EDIT-KEYBOARD-COMMAND T]
						      
"Calls the keyboard editor. Will prompt for name for the new keyboard, and will use the default keyboard as the initial keyboard"
						      )
						    ("New keyboard, other initial"
						      [QUOTE (ADD.PROCESS (QUOTE (
VKBD.EDIT-KEYBOARD-COMMAND T T]
						      
"Calls the keyboard editor. Will prompt for name for the new keyboard, and will pop up a menu of the current known keyboards. The selected one will be used as the initial keyboard"
						      )
						    ("Existing keyboard"
						      [QUOTE (ADD.PROCESS (QUOTE (
VKBD.EDIT-KEYBOARD-COMMAND]
						      
"Will let you select a keyboard from list of the known keyboards, and will calls the keyboard editor on the selected keyboard."
						      )))

(RPAQQ VKBD.EDIT.CASH-MENUES NIL)

(RPAQQ VKBD.EDIT.CHAR-SET-NAMES (("ASCII/ISO/CCITT Roman Alphabet and Punctuation" 0)
				 ("JIS Symbols 1 - Punctuation and Symbols not in Char set 0" 33)
				 ("JIS Symbols 2 - Punctuation and Symbols not in Char set 0" 34)
				 ("Extended Latin" 35)
				 ("JIS Hiragana" 36)
				 ("JIS Katakana" 37)
				 ("Greek" 38)
				 ("Cyrillic" 39)
				 ("Symbols 3 - Miscellaneous Japanese Symbols" 116)
				 ("General and Technical Symbols 2" 238)
				 ("General and Technical Symbols 1" 239)
				 ("Ligatures, Graphical Entities, and Field Format Symbols" 240)
				 ("Accented Characters" 241)))

(RPAQQ VKBD.EDIT.MENU-ITEMS (("CharSet" VKBD.EDIT.SWITCH-CHAR-SET-COMMAND 
"Pops up a menu of all possible character set number. Selecting one will switch the displayed character set."
					)
			     ("Stop" VKBD.EDIT.STOP-COMMAND 
 "Exit from the keyboard editor. Returns the new keyboard, but does not modify the original one.")
			     ("Quit" VKBD.EDIT.QUIT-COMMAND 
		"Exit from the keyboard editor. Modifies the roriginal keyboard and returns it .")
			     ("Define" VKBD.EDIT.DEFINE-COMMAND 
		   "Adds the edited keyboard in its current state to the set of known keyboards.")))

(RPAQQ VKBD.EDIT.NON-CHAR-ASSIGNMENTS (SHIFT CTRL META LOCK LOCKDOWN LOCKUP EVENT))

(RPAQ VKBD.EDIT.ICON (READBITMAP))
(93 93
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@F@@@@@@@@@@@@@@@@@@CH"
"N@@A@@@@@@@@@@@@@@@@@@CH"
"N@@F@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@AOOOOOOOO@@@@CH"
"N@@@@@@@@A@@@@@@@A@@@@CH"
"N@@B@@@@@A@@@@@@@A@@@@CH"
"N@@BAOOOOOOOON@@@A@@@@CH"
"N@@BA@@@@A@@@B@@OOO@@@CH"
"N@@BA@@@@A@@@B@@HAA@@@CH"
"N@@OI@@@@GL@@OHALAA@@@CH"
"N@@GA@@@@CH@@G@ALAA@@@CH"
"N@@BA@@@@A@@@B@@HAA@@@CH"
"NGOOOOOOOOOOOOOOOOOOOOCH"
"NGOOOOOOOOOOOOOOOOOOOOCH"
"NG@HEBA@HDBA@HDBAAHD@GCH"
"NG@HEBA@HDBA@HDBAAHD@GCH"
"NG@HEBA@HDBA@HDBAAHDNGCH"
"NG@HDBA@HDBA@HDBAAHD@GCH"
"NGOOOOOOOOOOOOOOOOOOOOCH"
"NG@BA@HDBA@HDBA@HEBA@GCH"
"NGGBA@HDBA@HDBA@HEBA@GCH"
"NGGBA@HDBA@HDBA@HDBAFGCH"
"NG@BA@HDBA@HDBA@HDBA@GCH"
"NGOOOOOOOOOOOOOOOOOOHGCH"
"NG@AHDBA@HDBA@HDBA@HIGCH"
"NG@AHDBA@HDBA@HDBA@HIGCH"
"NG@AHDBA@HDBA@HDBA@HIGCH"
"NG@AHDBA@HDBA@HDBA@HHGCH"
"NGOOOOOOOOOOOOOOOOOOOOCH"
"NG@@@HDBA@HDBA@HDBA@@GCH"
"NG@@@HDBA@HDBA@HDBA@@GCH"
"NG@@@HDBA@HDBA@HDBA@@GCH"
"NG@@@HDBA@HDBA@HDBA@@GCH"
"NGOOOOOOOOOOOOOOOOOOOOCH"
"NGOOOOOOOOOOOOOOOOOOOOCH"
"NGOOOOOOOOOOOOOOOOOOOOCH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"N@@@@@@@@@@@@@@@@@@@@@CH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH")

(RPAQ VKBD.EDIT.MASK (READBITMAP))
(93 93
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH"
"OOOOOOOOOOOOOOOOOOOOOOOH")
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS VKBD.EDIT.ALLOW-NON-CHAR-ASSIGNMENTS VKBD.EDIT.BACKGROUND-MENU-SUBITEMS 
	    VKBD.EDIT.MAX-NUMBER-OF-CASHED-MENUS VKBD.EDITOR-WINDOW-HEIGHT VKBD.EDITOR-WINDOW-WIDTH 
	    VKBD.EDIT.DISPLAY-CHAR-SETS-NAMES VKBD.EDIT.CASH-MENUES VKBD.EDIT.CHAR-SET-NAMES 
	    VKBD.EDIT.MENU-ITEMS VKBD.EDIT.NON-CHAR-ASSIGNMENTS VKBD.CONF.ICON VKBD.EDIT.ICON 
	    VKBD.EDIT.MASK)
)
(VKBD.EDIT.ADD-SUBITEM-TO-BACKGROUND-MENU (LIST "Edit" [QUOTE (ADD.PROCESS (QUOTE (
VKBD.EDIT-KEYBOARD-COMMAND T]
						
"Calls the keyboard editor. Will prompt for name for the new keyboard, and will use the default keyboard as the initial keyboard"
						VKBD.EDIT.BACKGROUND-MENU-SUBITEMS)
					  "Keyboard")
(PUTPROPS KEYBOARDEDITOR COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2774 13983 (EDITCONFIGURATION 2784 . 2951) (VKBD.CONF.CHANGE-KEY-VALUE 2953 . 6766) (
VKBD.CONF.DISPLAY-FIELD-VALUE 6768 . 8109) (VKBD.CONF.DISPLAY-INFO-KEYBOARD 8111 . 9529) (
VKBD.CONF.DISPLAY-KEY-INFO 9531 . 10362) (VKBD.CONF.EDIT-DEFAULT-ASSIGNMENTS 10364 . 11467) (
VKBD.CONF.ICONFN 11469 . 11992) (VKBD.CONF.PARSE-CONFIGURATION 11994 . 13981)) (16539 34961 (
EDITKEYBOARD 16549 . 18290) (VKBD.EDIT.ADD-SUBITEM-TO-BACKGROUND-MENU 18292 . 19067) (
VKBD.EDIT.CREATE-COMMAND-MENU 19069 . 19431) (VKBD.EDIT.CREATE-NON-CHAR-ASSIGMENTS-MENU 19433 . 19882)
 (VKBD.EDIT-KEYBOARD-COMMAND 19884 . 20957) (VKBD.EDIT.ASSIGN-CHARACTER 20959 . 22852) (
VKBD.EDIT.ASSIGN-NON-CHARACTER 22854 . 23369) (VKBD.EDIT.CREATE-CHARACTER-SETS-MENU 23371 . 24137) (
VKBD.EDIT.CREATE-CHARACTERS-MENU 24139 . 25726) (VKBD.EDIT.CREATE-DISPLAY 25728 . 28456) (
VKBD.EDIT.DEFINE-COMMAND 28458 . 28851) (VKBD.EDIT.DO-MENU-COMMAND 28853 . 29054) (VKBD.EDIT.ICONFN 
29056 . 29580) (VKBD.EDIT.INVERT-IF-LOCKED 29582 . 30019) (VKBD.EDIT.KEYBOARD-REPAINTFN 30021 . 30552)
 (VKBD.EDIT.LARGE-WINDOW-REPAINTFN 30554 . 30979) (VKBD.EDIT.MAKE-CURRENT-KEY 30981 . 32547) (
VKBD.EDIT.QUIT-COMMAND 32549 . 32945) (VKBD.EDIT.STOP-COMMAND 32947 . 33175) (
VKBD.EDIT.SWITCH-CHAR-SET-COMMAND 33177 . 33926) (VKBD.EDIT.SWITCH-CHARACTER-SET 33928 . 34693) (
VKBD.EDIT.ROTATED-NUMBER 34695 . 34959)))))
STOP