!Last Modified: 18-FEB-1987 14:54:23.80 ! Prompts for a single key; returns the keyword for that key. ! ! Parameters: ! ! prompt Text of prompt - input procedure eveplus$prompt_key (prompt) local this_key; map (eve$prompt_window, eve$prompt_buffer); erase (eve$prompt_buffer); position (end_of (eve$prompt_buffer)); copy_text (prompt); update (eve$prompt_window); this_key := read_key; unmap (eve$prompt_window); return (this_key); endprocedure !+ ! describe key !- ! This procedure will prompt for a key stroke or shift sequence and look ! up the comment that was attributed to the keystroke when it was defined. ! If there was no comment given, the message "Key Has No Function..." is ! displayed in the message area at the bottom of the screen. Otherwise, ! the key's function is displayed. This function assumes that there will ! always be some sort of comment given when keys are defined to user ! procedures. This may not be an acurate assumption in all circumstances. ! The value of this function depends on the descriptive nature of the names ! of user routines. It should be noted that this works on DEFINE KEY ! operations also. So use the whole function name to get the best ! description. ! PROCEDURE eve_describe_key LOCAL key_to_describe, key_description; MESSAGE("Press Key to Describe:"); key_to_describe := READ_KEY; key_description := LOOKUP_KEY(key_to_describe,COMMENT); IF key_description <> "" THEN MESSAGE("Function Description : " + key_description); ELSE MESSAGE("Key Has No Function..."); ENDIF; ENDPROCEDURE ; ! Allow a user to define a key. If the key is a keypad key then wipe ! out the current map binding, else wipe out all of the map bindings-- ! assume the user doesn't want to have a keyboard key bound to more than ! one map, in fact insist that it's always in the eve$user_keys map. procedure eve_user_define_key LOCAL key_to_define, key_description,prompt,answer, user_comment,user_procedure,this_map,user_keymap,keycheck; on_error if error = tpu$_notdefinable then message ("No key defined"); return; endif; endon_error; keycheck := 0; prompt := "Press the Key you want to define:"; key_to_define := eveplus$prompt_key(prompt); ! Return gets you out without redefining a key if (key_to_define = PF1) then message("Illegal to change value of PF1 key...try again!"); return; endif; if key_to_define = ret_key then message ("No key defined"); return; endif; keycheck := eve_keypad_check(key_to_define); if (eve$lookup_comment (key_to_define) = "do") and (not (keycheck)) then message ("You cannot bind another command to the DO key"); return; else if eve$alphabetic (key_to_define) <>eve$kt_null then message("Can not define a typing key"); return; endif; endif; this_map := get_info(key_map,"first","tpu$key_map_list"); prompt := "Enter keymap to place key : "; user_keymap := ""; user_keymap := read_line(prompt); edit(user_keymap,UPPER); if (user_keymap <> "") then key_description := lookup_key(key_to_define,KEY_MAP,user_keymap); else ! get the first binding key_description := lookup_key(key_to_define,KEY_MAP); endif; message(key_description); ! if we are redefining a key or if the user didn't type in a map and ! the key will are attempting to redefine to bound to the current map if ((key_description = user_keymap) and (user_keymap <> "")) or ((user_keymap = "") and (key_description = this_map)) or ((user_keymap = "") and (key_description = "eve_user_keys")) then prompt := "Preparing to delete previous key binding(s)"; prompt := prompt+ " ok to proceed ? "; answer := read_line(prompt); edit(answer,UPPER); if (answer = "Y") or (answer = "YES") then else return; endif; endif; prompt:= "Procedure to associate with key: "; user_procedure := read_line(prompt); if user_procedure = eve$kt_null then message("Illegal to define key to a null procedure"); return; endif; edit(user_procedure,TRIM); if (keycheck) then ! if redefining a keypad key if (user_keymap <> "") then ! if keymap specified undefine_key(key_to_define,user_keymap); else ! delete only this level undefine_key(key_to_define,this_map); endif; else ! else non keypad if (user_keymap <> "") then ! if keymap specified undefine_key(key_to_define,user_keymap); else ! non-keypad non specified delete all undefine_key(key_to_define); endif; endif; prompt := "Type a short description of the key: "; user_comment := read_line(prompt); if keycheck then ! if its a keypad key associate with map user_procedure := user_procedure + ";eve_toggle_white_map"; if (user_keymap = "") then ! default to current keymap define_key(user_procedure,key_to_define,user_comment,this_map); else ! put it in the keymap named by user define_key(user_procedure,key_to_define,user_comment,user_keymap); endif; else if (user_keymap = "") then ! if no keymap names define_key(user_procedure,key_to_define,user_comment,"eve$user_keys"); else ! put it in the keymap named define_key(user_procedure,key_to_define,user_comment,user_keymap); endif; endif; endprocedure ! procedure eveplus_key ! Redefine a key, saving old definition ( new_pgm, ! Valid 1st argument for define_key builtin default_key, ! Default keyname if user hasn't defined one new_doc, ! Valid 3rd argument for define_key builtin key_string ) ! String containing name for user defined keys ! 1) Determine if we have a user specified key; if not, use default. ! 2) Save the present definition & doc. of the user specified key. ! 3) Do a define key on the new key information. ! A note on methods: ! We use a string argument for the variable name of the user specified key ! so that: 1) We can successfully pass it to this procedure if its not defined. ! 2) We can generate variables to hold the old key's info, avoiding ! passing more arguments for these. ! We combine the string argument with string constants to form valid TPU ! statements which we then execute. (Ha! We TPU programmers can limp ! along without LISP very well thanks!) on_error endon_error; eveplus$x := default_key; ! default, to global variables; the variables eveplus$x_string := key_string; ! Move arguments, which are local by eveplus$x_old_pgm := 0; ! in and EXECUTE statement are all global. ! Determine if we have a user specified key; if not, use default. if expand_name ( eveplus$x_string, variables ) <> eve$x_null then execute ( 'if(get_info('+eveplus$x_string+',"type")=integer)then ' +'eveplus$x:='+eveplus$x_string+';' +'else ' +eveplus$x_string+':=eveplus$x;' +'endif;' ); else execute ( eveplus$x_string+ ':= eveplus$x;' ); endif; ! Save the present definition & doc. of the user specified key ! one exists. eveplus$x_old_pgm := lookup_key ( eveplus$x, program); if (get_info ( eveplus$x_old_pgm, "type") = program) then execute( eveplus$x_string +'_doc := lookup_key ( eveplus$x, comment);' +eveplus$x_string +'_pgm := lookup_key ( eveplus$x, program);'); else execute( eveplus$x_string +'_doc := "~none~";'); endif; ! Do a define key on the new key information define_key ( new_pgm, eveplus$x, new_doc,"eve$standard_keys" ); endprocedure ! Page 4 procedure eveplus_restore_key ( the_key ) ! Restore a saved key definition. ! This is the companion procedure to EVEplus_key, and restores the previous ! definition of a key saved during EVEplus_key. See EVEplus_key for ! more info. on_error endon_error; eveplus$x_string := the_key; if expand_name ( eveplus$x_string+'_pgm', variables ) <> eve$x_null then execute ( 'define_key('+eveplus$x_string+'_pgm,' +eveplus$x_string+',' +eveplus$x_string +'_doc,"eve$standard_keys"); '); else execute ( 'undefine_key ('+eveplus$x_string+'"eve$standard_keys"); '); endif; endprocedure ; ! VAXTPU does not save the shift key across sessions, so we have to ! be tricky to make it work. When Eve's set shift key command is used, ! it sets the shift key, but also does a define_key to this procedure. ! The define_key, unlike the shift setting, is saved across sessions. ! This procedure sets the shift key to the last (i.e. current) key, ! reads in the next key, and returns the shifted key. procedure eve$get_shift_key local key_to_shift; ! Keyword for key pressed after shift key set (shift_key, last_key); key_to_shift := key_name (read_key, shift_key); return (key_to_shift); endprocedure