! EVE$MENUS.TPU 31-DEC-1992 11:35 Page 1 module eve$menus ident "V03-020" ! ! COPYRIGHT © 1987,1991 BY ! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS ! ALL RIGHTS RESERVED ! ! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ! TRANSFERRED. ! ! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ! CORPORATION. ! ! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. ! !++ ! FACILITY: ! DECTPU - Text Processing Utility ! EVE - Extensible Versatile Editor ! ! ABSTRACT: ! This is the source program for the EVE interface DECwindow menu ! and widget functions. ! ! ENVIRONMENT: ! OpenVMS VAX, OpenVMS AXP, RISC/ULTRIX ! !Author: Bill Robinson (among others) ! ! CREATION DATE: 5-Jan-1988 ! ! MODIFIED BY: ! !-- ! EVE$MENUS.TPU Page 2 !++ ! Table of Contents ! ! EVE$MENUS.TPU ! 31-DEC-1992 11:35 ! ! Procedure name Page Description ! -------------- ---- ------------ ! ! eve$init_menu_arrays 3 initialize menu extension arrays ! eve$set_cs_help 4 HELP delivery mechanism ! eve$callback_dispatch 5 DECwindows event callback ! eve$help_widget 6 Help displayed in Help Widget ! eve$$help_widget_unmapped 7 Unmap the Help Widget ! eve$$set_responder 8 Supercede widget program ! eve$invalid_event 9 Invalid menu/mouse event ! eve$$widget_new_ok 10 Ok callback on New Dialog ! eve$$widget_new_apply 10 Apply callback on New Dialog ! eve$$widget_new_cancel 10 CANCEL button in NEW dialog box ! eve$$widget_open_file_selection* 11 OK/CANCEL in OPEN file_sel box ! eve$$widget_openbuffer_ok 12 Ok callback open buffer ! eve$$widget_openbuffer_apply 12 Apply callback open buf ! eve$$widget_openbuffer_cancel 12 CANCEL button in OPENBUFFER dialog ! eve$$widget_include 13 INCLUDE ! eve$$widget_include_file_select* 13 OK/CANCEL in INCLUDE file_sel box ! eve$$widget_reallyquit_dialog 14 Modified buffers exist, save changes? ! eve$$widget_replace_ok 14 Ok callback in Replace dialog ! eve$$widget_replace_cancel 14 Cancel callback Replace dialog ! eve$$widget_replace_all 14 All toggle callback in Replace dialog ! eve$$widget_replace_each_ok 15 OK callback replace each dialog ! eve$$widget_replace_each_no 15 No callback replace each dialog ! eve$$widget_replace_each_last 15 Last callback replace each dialog ! eve$$widget_replace_each_all 15 ALL callback replace each dialog ! eve$$widget_replace_each_quit 15 Quit callback replace each dialog ! eve$$widget_replace_go_each_ok 15 Ok go other direction (replace) ! eve$$widget_replace_go_each_no 15 No go other direction (replace) ! eve$$widget_writedelprompt_ok 16 get file before delete ! eve$$widget_save_file_as_ok 17 OK callback save file as dialog ! eve$$widget_save_file_as_apply 17 APPLY callback save file as db ! eve$$widget_save_file_as_cancel* 17 CANCEL callback save file as ! eve$$widget_needfilename_ok 18 OK callback - got filename ! eve$$widget_needfilename_cancel* 18 Cancel - No filename ! eve$$widget_nofilespecexit_ok 18 OK to exit - no filename ! eve$$widget_writebuf_yes 19 Write buffer (exit) ! eve$$widget_writebuf_no 19 Don't write buffer (exit) ! eve$$widget_writefileprompt_ok 20 OK callback ! eve$$widget_writefileprompt_can* 20 CANCEL callback ! eve$$widget_find_ok 21 OK callback FIND ! eve$$widget_find_each_yes 22 Find in opposite direction ! eve$$widget_global_attr 23 GLOBAL ATTR menu item ! eve$$widget_scroll_on 24 GLOBAL ATTR SCROLL ON ! eve$$widget_scroll_off 24 GLOBAL ATTR SCROLL OFF ! eve$$widget_scroll_smooth 24 GLOBAL ATTR SCROLL SMOOTH ! eve$$widget_scroll_jump 24 GLOBAL ATTR SCROLL JUMP ! eve$$widget_free_cursor 24 GLOBAL ATTR FREE CURSOR ! eve$$widget_bound_cursor 24 GLOBAL ATTR BOUND CURSOR ! eve$$widget_tab_insert 24 GLOBAL ATTR TAB INSERT ! eve$$widget_tab_spaces 24 GLOBAL ATTR TAB SPACES ! eve$$widget_tab_movement 24 GLOBAL ATTR TAB MOVEMENT ! eve$$widget_global_tabs 24 GLOBAL ATTR GLOBAL TABS (vis/invis) ! eve$$widget_global_clipboard 24 GLOBAL ATTR CLIPBOARD ! eve$$widget_global_pending_dele* 24 GLOBAL ATTR PENDING_DELETE ! eve$$widget_global_search 24 GLOBAL ATTR GLOBAL SEARCH (ex/noexact) ! eve$$widget_global_box_select 24 GLOBAL ATTR BOX_SELECT ! eve$$widget_global_box_pad 24 GLOBAL ATTR BOX_PAD ! eve$$widget_global_cancel 25 GLOBAL ATTR CANCEL ! eve$$widget_attr 26 SAVE ATTRIBUTES menu entry logic ! eve$$widget_attr_ok 27 Callback: user attr dialog ! eve$$widget_clear_attr 28 SAVE SYSTEM ATTRIBUTES menu entry logic ! eve_save_system_attributes 28 for menu entry of same name ! eve$$accum_all_attr 28 Accumulate all of the current attributes ! eve$$widget_set_margins 29 Set Margins callback routine ! eve$$widget_set_margins_ok 30 OK callback Set Margins ! eve$$widget_set_margins_apply 30 Apply callback Set Margins ! eve$$widget_set_margins_cancel 30 CANCEL callback Set Margins ! eve$$widget_buffer_attr 31 BUFFER ATTR menu item ! eve$$widget_buffer_word_wrap 32 Word Wrap callback routine ! eve$$widget_buffer_modifiable 32 Buffer Modifiable callback ! eve$$widget_buffer_readonly 32 Buffer Read-only callback ! eve$$widget_buffer_apply 33 Apply callback buffer attrs ! eve$$widget_buffer_ok 34 OK callback buffer attrs ! eve$$widget_buffer_cancel 35 CANCEL callback buffer attrs ! eve$$widget_set_width 36 Set Width callback ! eve$$widget_set_width_ok 36 OK callback Set Width ! eve$$widget_set_width_apply 36 APPLY callback Set Width ! eve$$widget_set_width_cancel 36 CANCEL callback Set Width ! eve$$widget_set_para_indent 37 Set Paragraph Indent ! eve$$widget_set_para_indent_ok 37 OK Set Paragraph Indent ! eve$$widget_set_para_indent_app* 37 Apply callback set para indent ! eve$$widget_set_para_indent_can* 37 Cancel callback set para ind. ! eve$$widget_split_window_ok 38 OK callback split window ! eve$$widget_split_window_apply 38 Apply callback split window ! eve$$widget_split_window_cancel* 38 Cancel callback split window ! eve$$widget_extend 39 Extend callback ! eve$$widget_extend_ok 39 OK callback Extend ! eve$$widget_extend_apply 39 Apply callback Extend ! eve$$widget_extend_cancel 39 Cancel callback Extend ! eve$$widget_save_extended 40 Save extended callback ! eve$$widget_save_extended_ok 40 OK callback save extended ! eve$$widget_save_extended_apply* 40 Apply callback save extended ! eve$$widget_save_extended_cance* 40 Cancel callback save extended ! eve$$widget_at_eve_file 41 @EVE file callback ! eve$$widget_at_eve_file_ok 41 @EVE file OK callback ! eve$$widget_at_eve_file_apply 41 @EVE file APPLY callback ! eve$$widget_at_eve_file_cancel 41 @EVE file CANCEL callback ! eve$$widget_mark 42 Mark callback ! eve$$widget_mark_ok 42 OK callback Mark ! eve$$widget_goto 43 GOTO callback ! eve$$widget_goto_ok 43 OK callback goto ! eve$$widget_extend_menu 44 Extend menu callback ! eve$$get_selected_item 45 get single selected item in list box ! eve$$get_menu_index 46 get the index of menu in eve$$x_popup_menus ! eve$$get_menu_array 47 get the array of menu entries of a menu ! eve$$widget_extmenu_list_popups* 48 callback for menu extension service ! eve$$find_command_index 49 get index of cmd in available commands ! eve$$get_command 50 get a command from available commands ! eve$$widget_extmenu_list_comman* 51 Select an available entry ! eve$$widget_extmenu_enter 52 callback menu extension service ! eve$$set_list_box 53 set the contents of a list box ! eve$$widget_extmenu_delete 54 callback menu extension service ! eve$$widget_extmenu_add 55 callback menu extension service ! eve$$widget_extmenu_remove 56 callback menu extension service ! eve$undefine_menu_entry 57 guts of undefine a menu entry ! eve$$edit 58 edit label - compress and strip trailing ... ! eve$$update_separator_count 59 Update separator ct ! eve$$renum_separators 60 renumber the separator widgets ! eve$$get_parent_widget 61 Get the parent widget id of a menu ! eve$$delete_menu_array_entry 62 delete menu entry from popup ! eve_define_menu_entry 63 Add a menu entry to EVE menu ! eve$define_menu_entry 64 Guts of define menu entry ! eve$define_user_menu_entry 65 Guts of define menu entry ! eve$$is_entry_defined 66 Check if entry is already in menu ! eve$$add_menu_array 67 Add menu entry to menu array ! eve_undefine_menu_entry 68 Delete a menu entry from a menu ! eve$$widget_on_context 69 Enter Motif on-context help mode !-- ! EVE$MENUS.TPU Page 3 procedure eve$init_menu_arrays ! initialize menu extension arrays ! ABSTRACT: This procedure gets the menu entries in EVE's menus and puts them ! into arrays. The way DECTPU does this is by getting a string table out of a ! UIL list box widget. Some "dummy" list boxes were created expressly for this ! purpose - they are not used for any other purpose than to load a UIL string ! table containing EVE menu entries into a DECTPU array. local dummy_list_box, ! placeholder list box used to grab menu entry arrays temp_array, ! temp array to hold list of eve commands got out of UIL scratch_array, ! a temp array used to create label and command arrays the_index, ! temp index used to create label and command arrays upper_index, ! the_index upper-cased last_index, ! temp index used to create label and command arrays menu_array, ! temp array for creating array of separator counts menu_name, ! name of a menu temp, status, screen_ht, widget_ht, too_big, subform1, subform2, subform3, sublist1, sublist2, sublist3; ! if decwindows is not active then kick out if not eve$x_decwindows_active then return (FALSE); endif; ! need to create the extend menu dialog box so can get the select popup array ! entries, the list of menus, and the list of EVE commands. These things will ! be contained in three separate DECTPU arrays. if get_info (eve$x_extend_menu_dialog, "type") <> WIDGET then eve$x_extend_menu_dialog := eve$create_widget ("EXTEND_MENU_DIALOG"); temp := get_info (eve$x_extend_menu_dialog, "widget_info", eve$x_resource_array {eve$k_nheight}, widget_ht); screen_ht := get_info (SCREEN, "pixel_length"); ! Shorten the widget height if too big to fit on screen. if widget_ht >= screen_ht then too_big := TRUE; set (WIDGET, eve$x_extend_menu_dialog, eve$x_resource_array {eve$k_nheight}, screen_ht); endif; endif; ! get list of menus - includes popup menus and pulldown menus eve$$x_popup_menus := create_array; eve$$x_popup_menus {eve$x_resource_array {eve$k_nselected_count}} := 0; eve$$x_popup_menus {eve$x_resource_array {eve$k_nitems_count}} := 0; ! Motif xmscrolledwindow is parent of xmlist (name = xmlist name + "SW") temp := "EXTEND_MENU_DIALOG.EXTEND_SUBFORM2"; subform2 := get_info (WIDGET, "widget_id", eve$x_extend_menu_dialog, temp); temp := temp + ".EXTEND_MENU_LIST_POPUPSSW.EXTEND_MENU_LIST_POPUPS"; sublist2 := get_info (WIDGET, "widget_id", eve$x_extend_menu_dialog, temp); if too_big then ! reduce the size of this listbox (+ Motif form) to shrink overall height set (WIDGET, sublist2, eve$x_resource_array {eve$k_nvisitemcount}, 2); ! Match Motif subform height to new list box size set (WIDGET, subform2, eve$x_resource_array {eve$k_nheight}, 80); endif; status := get_info (sublist2, "widget_info", eve$$x_popup_menus); ! get list of menu entry labels on the select popup eve$$x_select_popup_entries := create_array; eve$$x_select_popup_entries {eve$x_resource_array {eve$k_nselected_count}} := 0; eve$$x_select_popup_entries {eve$x_resource_array {eve$k_nitems_count}} := 0; temp := "EXTEND_MENU_DIALOG.EXTEND_SUBFORM3"; subform3 := get_info (WIDGET, "widget_id", eve$x_extend_menu_dialog, temp); temp := temp + ".EXTEND_MENU_LIST_CONTENTSSW.EXTEND_MENU_LIST_CONTENTS"; sublist3 := get_info (WIDGET, "widget_id", eve$x_extend_menu_dialog, temp); if too_big then set (WIDGET, sublist3, eve$x_resource_array {eve$k_nvisitemcount}, 2); set (WIDGET, subform3, eve$x_resource_array {eve$k_nheight}, 80); endif; status := get_info (sublist3, "widget_info", eve$$x_select_popup_entries); ! get list of menu entry labels on the noselect popup eve$$x_noselect_popup_entries := create_array; eve$$x_noselect_popup_entries {eve$x_resource_array {eve$k_nselected_count}} := 0; eve$$x_noselect_popup_entries {eve$x_resource_array {eve$k_nitems_count}} := 0; dummy_list_box := create_widget ("EXTEND_MENU_NOSEL_DUMMY", eve$x_widget_hierarchy, eve$x_extend_menu_dialog, eve$kt_callback_routine); status := get_info (dummy_list_box, "widget_info", eve$$x_noselect_popup_entries); ! Remove the ghost outline of this list box from the dialog box delete (dummy_list_box); ! Get list of all the EVE commands - these are actually a subset of EVE ! commands - they include all the commands currently on the EVE menus and the ! non-prompting commands. It has been EVE's policy that any menu item clicked ! on in a menu must prompt with a dialog box, and therefore any commands that ! prompt only from the command line have been left out. Note that the user can ! still bind menu items to commands that will prompt from the command line. temp_array := create_array; temp_array {eve$x_resource_array {eve$k_nselected_count}} := 0; temp_array {eve$x_resource_array {eve$k_nitems_count}} := 0; temp := "EXTEND_MENU_DIALOG.EXTEND_SUBFORM1"; subform1 := get_info (WIDGET, "widget_id", eve$x_extend_menu_dialog, temp); temp := temp + ".EXTEND_MENU_LIST_COMMANDSSW.EXTEND_MENU_LIST_COMMANDS"; sublist1 := get_info (WIDGET, "widget_id", eve$x_extend_menu_dialog, temp); if too_big then set (WIDGET, sublist1, eve$x_resource_array {eve$k_nvisitemcount}, 2); set (WIDGET, subform1, eve$x_resource_array {eve$k_nheight}, 80); endif; status := get_info (sublist1, "widget_info", temp_array); ! Create two parallel arrays. EVE$$X_EVE_COMMANDS is an array indexed ! by the menu label and contains the command the menu label is bound to. ! Initially the menu label and command label are equivalent. ! EVE$$X_EVE_COMMAND_LABEL is a parallel array to the command array and is ! indexed by menu label. The contents of this array is also the menu label. eve$$x_eve_commands := create_array; eve$$x_eve_command_label := create_array; scratch_array := temp_array {eve$x_resource_array {eve$k_nitems_count}}; last_index := scratch_array {get_info (scratch_array, "last")}; the_index := scratch_array {get_info (scratch_array, "first")}; loop upper_index := the_index; edit (upper_index, COMPRESS, UPPER); eve$$x_eve_command_label {upper_index} := the_index; eve$$x_eve_commands {upper_index} := the_index; exitif (the_index = last_index); the_index := scratch_array {get_info (scratch_array, "next")}; endloop; ! Need to get "Separator" label - for internationalization eve$$x_separator_array := create_array; eve$$x_separator_array {eve$x_resource_array {eve$k_nselected_count}} := 0; eve$$x_separator_array {eve$x_resource_array {eve$k_nitems_count}} := 0; dummy_list_box := create_widget ("EXTEND_MENU_SEP_DUMMY", eve$x_widget_hierarchy, eve$x_extend_menu_dialog, eve$kt_callback_routine); status := get_info (dummy_list_box, "widget_info", eve$$x_separator_array); delete (dummy_list_box); temp_array := eve$$x_separator_array {eve$x_resource_array {eve$k_nitems_count}}; eve$$x_separator_label := temp_array {get_info (temp_array, "first")}; ! get File Pulldown menu entry labels eve$$x_file_pulldown_menu := create_array; eve$$x_file_pulldown_menu {eve$x_resource_array {eve$k_nselected_count}} := 0; eve$$x_file_pulldown_menu {eve$x_resource_array {eve$k_nitems_count}} := 0; dummy_list_box := create_widget ("EXTEND_MENU_FILE_DUMMY", eve$x_widget_hierarchy, eve$x_extend_menu_dialog, eve$kt_callback_routine); status := get_info (dummy_list_box, "widget_info", eve$$x_file_pulldown_menu); delete (dummy_list_box); ! get Edit Pulldown menu entry labels eve$$x_edit_pulldown_menu := create_array; eve$$x_edit_pulldown_menu {eve$x_resource_array {eve$k_nselected_count}} := 0; eve$$x_edit_pulldown_menu {eve$x_resource_array {eve$k_nitems_count}} := 0; dummy_list_box := create_widget ("EXTEND_MENU_EDIT_DUMMY", eve$x_widget_hierarchy, eve$x_extend_menu_dialog, eve$kt_callback_routine); status := get_info (dummy_list_box, "widget_info", eve$$x_edit_pulldown_menu); delete (dummy_list_box); ! get Format Pulldown menu entry labels eve$$x_format_pulldown_menu := create_array; eve$$x_format_pulldown_menu {eve$x_resource_array {eve$k_nselected_count}} := 0; eve$$x_format_pulldown_menu {eve$x_resource_array {eve$k_nitems_count}} := 0; dummy_list_box := create_widget ("EXTEND_MENU_FORMAT_DUMMY", eve$x_widget_hierarchy, eve$x_extend_menu_dialog, eve$kt_callback_routine); status := get_info (dummy_list_box, "widget_info", eve$$x_format_pulldown_menu); delete (dummy_list_box); ! get Search Pulldown menu entry labels eve$$x_search_pulldown_menu := create_array; eve$$x_search_pulldown_menu {eve$x_resource_array {eve$k_nselected_count}} := 0; eve$$x_search_pulldown_menu {eve$x_resource_array {eve$k_nitems_count}} := 0; dummy_list_box := create_widget ("EXTEND_MENU_SEARCH_DUMMY", eve$x_widget_hierarchy, eve$x_extend_menu_dialog, eve$kt_callback_routine); status := get_info (dummy_list_box, "widget_info", eve$$x_search_pulldown_menu); delete (dummy_list_box); ! get Display Pulldown menu entry labels eve$$x_display_pulldown_menu := create_array; eve$$x_display_pulldown_menu {eve$x_resource_array {eve$k_nselected_count}} := 0; eve$$x_display_pulldown_menu {eve$x_resource_array {eve$k_nitems_count}} := 0; dummy_list_box := create_widget ("EXTEND_MENU_DISPLAY_DUMMY", eve$x_widget_hierarchy, eve$x_extend_menu_dialog, eve$kt_callback_routine); status := get_info (dummy_list_box, "widget_info", eve$$x_display_pulldown_menu); delete (dummy_list_box); ! get Customize Pulldown menu entry labels eve$$x_custom_pulldown_menu := create_array; eve$$x_custom_pulldown_menu {eve$x_resource_array {eve$k_nselected_count}} := 0; eve$$x_custom_pulldown_menu {eve$x_resource_array {eve$k_nitems_count}} := 0; dummy_list_box := create_widget ("EXTEND_MENU_CUSTOM_DUMMY", eve$x_widget_hierarchy, eve$x_extend_menu_dialog, eve$kt_callback_routine); status := get_info (dummy_list_box, "widget_info", eve$$x_custom_pulldown_menu); delete (dummy_list_box); ! Create array of separator counts for each menu. eve$$x_menu_separator_count := create_array; menu_array := eve$$x_popup_menus {eve$x_resource_array {eve$k_nitems_count}}; menu_name := menu_array {get_info (menu_array, "first")}; eve$$x_menu_separator_count {menu_name} := 4; ! Select menu_name := menu_array {get_info (menu_array, "next")}; eve$$x_menu_separator_count {menu_name} := 5; ! No Select menu_name := menu_array {get_info (menu_array, "next")}; eve$$x_menu_separator_count {menu_name} := 4; ! File menu_name := menu_array {get_info (menu_array, "next")}; eve$$x_menu_separator_count {menu_name} := 3; ! Edit menu_name := menu_array {get_info (menu_array, "next")}; eve$$x_menu_separator_count {menu_name} := 0; ! Format menu_name := menu_array {get_info (menu_array, "next")}; eve$$x_menu_separator_count {menu_name} := 4; ! Search menu_name := menu_array {get_info (menu_array, "next")}; ! View or eve$$x_menu_separator_count {menu_name} := 2; ! Display menu_name := menu_array {get_info (menu_array, "next")}; ! Option or eve$$x_menu_separator_count {menu_name} := 3; ! Customize return (TRUE); endprocedure; ! eve$init_menu_arrays ! EVE$MENUS.TPU Page 4 procedure eve$set_cs_help ! HELP delivery mechanism (the_facility, the_arg) if (((the_facility and %xffff0000) = 0) or ((the_facility and %x0000ffff) <> 0)) then return (FALSE); endif; if get_info (eve$$x_cs_help_type, "type") <> ARRAY then eve$$x_cs_help_type := create_array; endif; case get_info (the_arg, "type") [KEYWORD]: case (the_arg) [WINDOW, WIDGET]: eve$$x_cs_help_type {the_facility} := the_arg; return (TRUE); [OTHERWISE]: return (FALSE); endcase; [PROGRAM]: eve$$x_cs_help_type {the_facility} := the_arg; return (TRUE); [OTHERWISE]: return (FALSE); endcase; endprocedure; ! eve$set_cs_help ! EVE$MENUS.TPU Page 5 procedure eve$callback_dispatch ! DECwindows event callback ! Handles event callbacks from all EVE widgets. ! Get_info's an array containing: ! array {"widget"} = widget from CREATE_WIDGET ! array {"closure"} = widget integer tag (from eve$constants.sdl) ! array {"reason_code"} = reason code local an_array, an_index, the_program, status, the_topic, the_facility, the_legend, the_library, the_arg_list, the_help, temp_array; on_error [TPU$_CONTROLC]: eve$$x_state_array {eve$$k_command_line_flag} := eve$k_invoked_by_key; eve$learn_abort; abort; [OTHERWISE]: eve$$x_state_array {eve$$k_command_line_flag} := eve$k_invoked_by_key; endon_error if not eve$x_decwindows_active then return (FALSE); endif; eve$$x_state_array {eve$$k_command_line_flag} := eve$k_invoked_by_menu; status := get_info (WIDGET, "callback_parameters", temp_array); ! make the following available to all the eve$$widget_xxx procedures eve$x_widget := temp_array {eve$k_widget}; ! widget (from CREATE_WIDGET) eve$x_widget_tag := temp_array {eve$k_closure}; ! widget tag (see UIL file) eve$x_widget_reason := temp_array {eve$k_reason_code};! reason code if (eve$x_widget_reason = eve$x_callback_array {eve$k_cr_help}) and (eve$x_widget <> eve$x_reallyquit_dialog) ! Help callback = cancel quit then if get_info (eve$$x_cs_help_type, "type") <> ARRAY then eve$$x_cs_handler := WINDOW; !*** will be WIDGET else eve$$x_cs_handler := eve$$x_cs_help_type {eve$x_widget_tag and %xffff0000}; if eve$$x_cs_handler = tpu$k_unspecified then eve$$x_cs_handler := WINDOW; !*** will be WIDGET endif; endif; case get_info (eve$$x_cs_handler, "type") [PROGRAM]: execute (eve$$x_cs_handler); [KEYWORD]: an_index := get_info (eve$$x_widget_help_arrays, "first"); loop exitif an_index = tpu$k_unspecified; ! silence if no widget matches an_array := eve$$x_widget_help_arrays {an_index}; the_help := an_array {eve$x_widget_tag}; if the_help <> tpu$k_unspecified then eve$$parse_comment (the_help, "", the_facility, the_legend, the_topic); exitif; endif; an_index := get_info (eve$$x_widget_help_arrays, "next"); endloop; case eve$$x_cs_handler [WINDOW]: eve$clear_message; eve$$x_help_mode := 0; ! save context only if entering help for first time eve$help_setup ("", (get_info (eve$prompt_window, "buffer") <> eve$help_prompt_buffer)); eve$help_text (the_facility, the_topic); eve$help_enter_prompt (message_text (EVE$_HELPPROMPT, 1)); eve$$x_ctx_sensitive_help := TRUE; [WIDGET]: the_library := eve$get_help_item (eve$k_help_library, the_facility); the_arg_list := eve$get_help_item (eve$k_help_arg_list, the_facility); eve$help_widget (eve$x_widget, the_library, the_topic, the_arg_list); eve$$x_help_mode := 0; eve$$x_ctx_sensitive_help := TRUE; endcase; [OTHERWISE]: endcase; else an_array := get_info (eve$$x_widget_arrays, "first"); loop exitif an_array = tpu$k_unspecified; ! silence if no widget matches an_array := eve$$x_widget_arrays {an_array}; the_program := an_array {eve$x_widget_tag}; if the_program <> tpu$k_unspecified then ! See if this is an EVE or menu-extension widget callback ! NOTE: The following assumes that applications layering ! on EVE use a facility code different from ! EVE$X_USER_WIDGET_BASE for widgets added to ! their menu pulldowns. an_index := get_info (an_array, "first"); if (int (EVE$_FACILITY) = ((an_index AND %X0FFFF0000) / 65536)) or (((eve$x_user_widget_base AND %X0FFFF0000) / 65536) = ((an_index AND %X0FFFF0000) / 65536)) then if eve$$x_position_lost then ! Grab focus and execute grab routine so that we have ! control of the interface when processing the widget ! callback below. Note that if the callback manages a ! dialog box, the input focus grab event will cause TPU ! to take focus from the widget... set (INPUT_FOCUS); ! queues up the request eve$input_focus_grab; ! take position now endif; endif; if the_program <> 0 then ! not all widgets expect a callback if eve$$x_ctx_sensitive_help then ! remove context-sensitive help eve$help_cleanup; endif; execute (the_program); eve$$found_post_filter; ! in case menu function moved cursor endif; exitif; endif; an_array := get_info (eve$$x_widget_arrays, "next"); endloop endif; eve$$x_state_array {eve$$k_command_line_flag} := eve$k_invoked_by_key; return; endprocedure; ! eve$callback_dispatch ! EVE$MENUS.TPU Page 6 procedure eve$help_widget ! Help displayed in Help Widget (widget_id, library, topic; arg_list) ! ! This procedure is invoked when help is to be displayed using the DECwindows ! help widget. It returns if we are not in that environment. ! ! Note that the unmap callback will be the routine that marks help widgets in ! the array as being available. ! local status, help_id, shell_widget_id, widget_class; ! ! If the help widget array is unspecified, then create the arrays. ! if get_info (eve$$x_help_widget_shell, "TYPE") <> ARRAY then eve$$x_help_widget_shell := create_array; endif; ! ! Compute the widget identifier of the shell of the widget passed in. We are ! making an assumption that all widgets and gadgets have a shell somewhere as ! an ancestor. The main window is a shell, and all dialog box class widgets ! have a hidden shell. ! shell_widget_id := widget_id; if eve$x_shell_class = tpu$k_unspecified then eve$x_shell_class := define_widget_class ("shellclassrec"); endif; loop if shell_widget_id = 0 then return (FALSE); endif; widget_class := get_info (shell_widget_id, "class"); exitif (get_info (shell_widget_id, "is_subclass", eve$x_shell_class) and (widget_class <> "DwtMenu") and (widget_class <> "SText") and (widget_class <> "PopupMenu")); shell_widget_id := get_info (shell_widget_id, "parent"); endloop; ! ! Go through the array looking for a widget identifier that is available. If ! we find an available widget, then we see if the shell value is the same. ! ! If upon leaving this loop, the index is of type unspecified, then we know we ! didn't find an available one. ! help_id := get_info (eve$$x_help_widget_shell, "FIRST"); loop exitif help_id = tpu$k_unspecified; exitif (eve$$x_help_widget_shell {help_id} = shell_widget_id); help_id := get_info (eve$$x_help_widget_shell, "NEXT"); endloop; ! ! If we don't have a widget identifier, then create a new widget and set the ! shell dedicated to this help widget. Do the assignment here since widgets ! cannot be reparented. ! if get_info (help_id, "TYPE") <> WIDGET then help_id := create_widget ("HELP_DIALOG", eve$x_widget_hierarchy, shell_widget_id, eve$kt_callback_routine); eve$$x_help_widget_shell {help_id} := shell_widget_id; endif; ! ! Set the arg_list information if passed by the user. ! if arg_list <> tpu$k_unspecified then status := set (WIDGET, help_id, arg_list); endif; ! ! Next set the library and topic that are required. ! status := set (WIDGET, help_id, "firstTopic", topic, "librarySpec", library); manage_widget (help_id); endprocedure; ! eve$help_widget ! EVE$MENUS.TPU Page 7 procedure eve$$help_widget_unmapped ! Unmap the Help Widget ! This procedure is called when a help widget is unmapped. The procedure ! would simply mark the help widget as being available for reuse if a policy ! of not reusing widgets were adopted. ! endprocedure; ! eve$$help_widget_unmapped ! EVE$MENUS.TPU Page 8 procedure eve$$set_responder ! Supercede widget program (widget_id, ! integer id for the widget (see eve$constants.sdl), ! must be unique among all widgets (EVE or layered ones) compile_string) ! the string to be compiled and bound to the widget ! Supersede the program bound to a widget. local an_array, the_index; on_error [OTHERWISE]: endon_error; if not eve$x_decwindows_active then return (FALSE); endif; the_index := get_info (eve$$x_widget_arrays, "first"); loop exitif the_index = tpu$k_unspecified; an_array := eve$$x_widget_arrays {the_index}; if an_array {widget_id} <> tpu$k_unspecified then an_array {widget_id} := compile (compile_string); return (TRUE); endif; the_index := get_info (eve$$x_widget_arrays, "next"); endloop; eve$message (EVE$_ILLEGALWIDGET, 0, widget_id, "EVE$$SET_RESPONDER"); return (FALSE); endprocedure; ! eve$$set_responder ! EVE$MENUS.TPU Page 9 procedure eve$invalid_event ! Invalid menu/mouse event (widget_id) ! The following procedure should be bound to widgets involved in ! prompting for things other than command arguments. The procedures that do ! the prompts will dynamically supersede the widget programs with ones that ! either: (1) call the prompting procedure again (if no info need be obtained ! from the dialog box), or (2) call an eve$$widget_xxx procedure (that first ! get info from the widget, and then call the prompting procedure). local an_array, the_index; on_error [OTHERWISE]: endon_error; the_index := get_info (eve$$x_widget_help_arrays, "first"); loop exitif the_index = tpu$k_unspecified; an_array := eve$$x_widget_help_arrays {the_index}; if an_array {widget_id} <> tpu$k_unspecified then eve$message (EVE$_ILLEGALEVENT, 0, widget_id, eve$$x_widget_help_array {widget_id}); return (TRUE); endif; the_index := get_info (eve$$x_widget_help_arrays, "next"); endloop; eve$message (EVE$_ILLEGALWIDGET, 0, widget_id, "EVE$INVALID_EVENT"); return (FALSE); endprocedure; ! eve$invalid_event ! EVE$MENUS.TPU Page 10 !+ ! At build time the following procedures are compiled into programs ! and loaded into the eve$$x_widget_key_map. During startup, the programs ! are moved from the key_map to the eve$$x_widget_array. The programs are ! executed by eve$callback_dispatch when a widget event causes a ! non-help callback. !- procedure eve$$widget_new_ok ! Ok callback on New Dialog if eve$$widget_new_apply <> eve$k_async_prompting then ! don't unmanage modeless box if was managed again asking for a ! buffer name that doesn't already exist eve$unmanage_widget (eve$x_new_dialog); endif; endprocedure; ! eve$$widget_new_ok procedure eve$$widget_new_apply ! Apply callback on New Dialog ! must return status value from eve$new1 so eve$$widget_new_ok can ! correctly manage/unmanage the NEW dialog box local buffer_name; ! the name of the new buffer ! get buffer name from text widget buffer_name := get_info (get_info (WIDGET, "widget_id", eve$x_new_dialog, "NEW_DIALOG.NEW_TEXT"), "text"); if buffer_name = "" then eve$message (EVE$_NOBUFFCREA); return (FALSE); endif; return (eve$new1 (buffer_name)); endprocedure; ! eve$$widget_new_apply procedure eve$$widget_new_cancel ! CANCEL button in NEW dialog box eve$unmanage_widget (eve$x_new_dialog); eve$message (EVE$_NOBUFFCREA); endprocedure; ! eve$$widget_new_cancel ! EVE$MENUS.TPU Page 11 procedure eve$$widget_open_file_selection ! OK/CANCEL in OPEN file_sel box local status, file_name; ! the name of the file to open if eve$x_widget_reason = eve$x_callback_array {eve$k_cr_cancel} then eve$unmanage_widget (eve$x_open_file_selection); eve$message (EVE$_NOFILESPEC); return; endif; if eve$x_widget_reason = eve$x_callback_array {eve$k_cr_ok} then eve$unmanage_widget (eve$x_open_file_selection); ! get file name from file_selection widget status := get_info (eve$x_open_file_selection, "widget_info", eve$x_resource_array {eve$k_ndirspec}, file_name); if (file_name = "") then eve$message (EVE$_NOFILESPEC); return; endif; eve$open1 (file_name); endif; endprocedure; ! eve$$widget_open_file_selection ! EVE$MENUS.TPU Page 12 procedure eve$$widget_openbuffer_ok ! Ok callback open buffer (get_file_name) eve$unmanage_widget (eve$x_openbuffer_dialog); eve$$widget_openbuffer_apply (get_file_name); endprocedure; ! eve$$widget_openbuffer_ok procedure eve$$widget_openbuffer_apply ! Apply callback open buf (get_file_name) local buffer_name; ! name of new buffer to open file into buffer_name := get_info (get_info (WIDGET, "widget_id", eve$x_openbuffer_dialog, "OPENBUFFER_DIALOG.OPENBUFFER_TEXT"), "text"); if buffer_name = "" then return; endif; eve$get_file1 (get_file_name, buffer_name); endprocedure; ! eve$$widget_openbuffer_apply procedure eve$$widget_openbuffer_cancel ! CANCEL button in OPENBUFFER dialog eve$unmanage_widget (eve$x_openbuffer_dialog); eve$message (EVE$_NOBUFFCREA); endprocedure; ! eve$$widget_openbuffer_cancel ! EVE$MENUS.TPU Page 13 procedure eve$$widget_include ! INCLUDE local widget_ht, status; if get_info (eve$x_include_file_selection, "type") <> WIDGET then eve$x_include_file_selection := create_widget ("INCLUDE_FILE_SELECTION", eve$x_widget_hierarchy, SCREEN, eve$kt_callback_routine); status := get_info (eve$x_include_file_selection, "widget_info", eve$x_resource_array {eve$k_nheight}, widget_ht); ! Shorten the fileselection widget if too big to fit on screen. if widget_ht >= get_info (SCREEN, "pixel_length") then set (WIDGET, eve$x_include_file_selection, eve$x_resource_array {eve$k_nlistvisitemcount}, 2); endif; endif; eve$manage_widget (eve$x_include_file_selection); eve$set_min_widget_size (eve$x_include_file_selection); endprocedure; ! eve$$widget_include procedure eve$$widget_include_file_selection ! OK/CANCEL in INCLUDE file_sel box local status, file_name; ! the name of the new file if eve$x_widget_reason = eve$x_callback_array {eve$k_cr_cancel} then eve$unmanage_widget (eve$x_include_file_selection); eve$message (EVE$_NOFILEINCL); return; endif; if eve$x_widget_reason = eve$x_callback_array {eve$k_cr_ok} then eve$unmanage_widget (eve$x_include_file_selection); ! get file name from file_selection widget status := get_info (eve$x_include_file_selection, "widget_info", eve$x_resource_array {eve$k_ndirspec},file_name); if (file_name = "") then eve$message (EVE$_NOFILEINCL); return; endif; eve_include_file (file_name); endif; endprocedure; ! eve$$widget_include_file_selection ! EVE$MENUS.TPU Page 14 procedure eve$$widget_reallyquit_dialog ! Modified buffers exist, save changes? eve$unmanage_widget (eve$x_reallyquit_dialog); ! The buttons are re-labelled to agree with EVE's semantics if eve$x_widget_reason = eve$x_callback_array {eve$k_cr_ok} then eve$exit; ! process all buffers endif; if eve$x_widget_reason = eve$x_callback_array {eve$k_cr_cancel} then quit (OFF, 1) ! quit endif; if eve$x_widget_reason = eve$x_callback_array {eve$k_cr_help} then eve$message (TPU$_CANCELQUIT); ! cancel endif;; endprocedure; ! eve$$widget_reallyquit_dialog procedure eve$$widget_replace_ok ! Ok callback in Replace dialog local new_string, old_string; eve$unmanage_widget (eve$x_replace_dialog); ! get the replace strings from the eve$$k_replace_new_[old]text widgets old_string := get_info (get_info (WIDGET, "widget_id", eve$x_replace_dialog, "REPLACE_DIALOG.REPLACE_OLD_TEXT"), "text"); ! test only the old string (new can be "") if old_string = "" then eve$message (EVE$_NOREPLSTR); return; endif; new_string := get_info (get_info (WIDGET, "widget_id", eve$x_replace_dialog, "REPLACE_DIALOG.REPLACE_NEW_TEXT"), "text"); if new_string = "" then eve$$replace1 (old_string, new_string, 1); else eve$$replace1 (old_string, new_string); endif; endprocedure; ! eve$$widget_replace_ok procedure eve$$widget_replace_cancel ! Cancel callback Replace dialog eve$unmanage_widget (eve$x_replace_dialog); eve$message (EVE$_NOREPLSTR); endprocedure; ! eve$$widget_replace_cancel procedure eve$$widget_replace_all ! All toggle callback in Replace dialog local status, the_value; status := get_info (get_info (WIDGET, "widget_id", eve$x_replace_dialog, "REPLACE_DIALOG.REPLACE_ALL"), "widget_info", eve$x_resource_array {eve$k_nset}, the_value); if the_value then eve$message (EVE$_REPLALLON); else eve$message (EVE$_REPLALLOFF); endif; endprocedure; ! eve$$widget_replace_all ! EVE$MENUS.TPU Page 15 procedure eve$$widget_replace_each_ok ! OK callback replace each dialog on_error [TPU$_CONTROLC]: eve$message (EVE$_REPLCTRLC, 0, eve$$x_replace_array {eve$$k_replace_occurrences}); eve$$replace_error_handler; eve$learn_abort; abort; [OTHERWISE]: eve$$replace_error_handler; endon_error; set (INPUT_FOCUS); ! grab focus so ^C will be caught eve$$replace_loop (0, eve$x_yes); endprocedure; ! eve$$widget_replace_each_ok procedure eve$$widget_replace_each_no ! No callback replace each dialog on_error [TPU$_CONTROLC]: eve$message (EVE$_REPLCTRLC, 0, eve$$x_replace_array {eve$$k_replace_occurrences}); eve$$replace_error_handler; eve$learn_abort; abort; [OTHERWISE]: eve$$replace_error_handler; endon_error; set (INPUT_FOCUS); ! grab focus so ^C will be caught eve$$replace_loop (0, eve$x_no); endprocedure; ! eve$$widget_replace_each_no procedure eve$$widget_replace_each_last ! Last callback replace each dialog on_error [TPU$_CONTROLC]: eve$message (EVE$_REPLCTRLC, 0, eve$$x_replace_array {eve$$k_replace_occurrences}); eve$$replace_error_handler; eve$learn_abort; abort; [OTHERWISE]: eve$$replace_error_handler; endon_error; set (INPUT_FOCUS); ! grab focus so ^C will be caught eve$$replace_loop (0, eve$x_last); endprocedure; ! eve$$widget_replace_each_last procedure eve$$widget_replace_each_all ! ALL callback replace each dialog on_error [TPU$_CONTROLC]: eve$message (EVE$_REPLCTRLC, 0, eve$$x_replace_array {eve$$k_replace_occurrences}); eve$$replace_error_handler; eve$learn_abort; abort; [OTHERWISE]: eve$$replace_error_handler; endon_error; set (INPUT_FOCUS); ! grab focus so ^C will be caught eve$$replace_loop (0, eve$x_all); endprocedure; ! eve$$widget_replace_each_all procedure eve$$widget_replace_each_quit ! Quit callback replace each dialog on_error [TPU$_CONTROLC]: eve$message (EVE$_REPLCTRLC, 0, eve$$x_replace_array {eve$$k_replace_occurrences}); eve$$replace_error_handler; eve$learn_abort; abort; [OTHERWISE]: eve$$replace_error_handler; endon_error; set (INPUT_FOCUS); ! grab focus so ^C will be caught eve$$replace_no; eve$$replace_clean_up; endprocedure; ! eve$$widget_replace_each_quit procedure eve$$widget_replace_go_each_ok ! Ok go other direction (replace) on_error [TPU$_CONTROLC]: eve$message (EVE$_REPLCTRLC, 0, eve$$x_replace_array {eve$$k_replace_occurrences}); eve$$replace_error_handler; eve$learn_abort; abort; [OTHERWISE]: eve$$replace_error_handler; endon_error; eve$unmanage_widget (eve$x_replace_go_each_dialog); ! go to the find string (eve$find_target's in eve$$replace_search_fail do not ! position to the string, just find it) position (eve$$x_replace_array {eve$$k_replace_range}); if eve$$x_replace_array {eve$$k_other_direction} = FORWARD then ! flip dir for next find eve$$x_replace_array {eve$$k_other_direction} := REVERSE; else eve$$x_replace_array {eve$$k_other_direction} := FORWARD; endif; eve$$replace_loop (0); endprocedure; ! eve$$widget_replace_go_each_ok procedure eve$$widget_replace_go_each_no ! No go other direction (replace) on_error [TPU$_CONTROLC]: eve$message (EVE$_REPLCTRLC, 0, eve$$x_replace_array {eve$$k_replace_occurrences}); eve$$replace_error_handler; eve$learn_abort; abort; [OTHERWISE]: eve$$replace_error_handler; endon_error; eve$unmanage_widget (eve$x_replace_go_each_dialog); eve$$x_replace_array {eve$$k_highlight_range} := 0; update (current_window); eve$$replace_clean_up; endprocedure; ! eve$$widget_replace_go_each_no ! EVE$MENUS.TPU Page 16 procedure eve$$widget_writedelprompt_ok ! get file before delete (buffer_name, remove_flag, answer) ! get file name for writing buffer before deleting it local status, file_name; eve$unmanage_widget (eve$x_writedelprompt_dialog); ! get the filename from the eve$$k_writedelprompt_text widget file_name := get_info (get_info (WIDGET, "widget_id", eve$x_writedelprompt_dialog, "WRITEDELPROMPT_DIALOG.WRITEDELPROMPT_TEXT"), "text"); ! test the file name if file_name = "" then eve$message (EVE$_NOBUFDELED); return; endif; eve$delete_buffer (eve$find_buffer (buffer_name), remove_flag, answer, file_name); endprocedure; ! eve$$widget_writedelprompt_ok ! EVE$MENUS.TPU Page 17 procedure eve$$widget_save_file_as_ok ! OK callback save file as dialog eve$unmanage_widget (eve$x_save_file_as_dialog); eve$$widget_save_file_as_apply; endprocedure; ! eve$$widget_save_file_as_ok procedure eve$$widget_save_file_as_apply ! APPLY callback save file as db local the_file; ! Name of file to write buffer to ! get the file name from the text widget the_file := get_info (get_info (WIDGET, "widget_id", eve$x_save_file_as_dialog, "SAVE_FILE_AS_DIALOG.SAVE_FILE_AS_TEXT"), "text"); ! make sure we got one if (the_file = "") then eve$message (EVE$_NOFILESPEC); return (TRUE); ! harmless return if no filename endif; eve$save_file_as1 (the_file); endprocedure; ! eve$$widget_save_file_as_apply procedure eve$$widget_save_file_as_cancel ! CANCEL callback save file as eve$unmanage_widget (eve$x_save_file_as_dialog); eve$message (EVE$_NOFILESPEC); endprocedure; ! eve$$widget_save_file_as_cancel ! EVE$MENUS.TPU Page 18 procedure eve$$widget_needfilename_ok ! OK callback - got filename (loop_flag) ! true if called from eve$$exit_loop local the_file; ! name of the file to write buffer to eve$unmanage_widget (eve$x_needfilename_dialog); ! get the filename from the text widget eve$$x_exit_array {"the_file"} := get_info (get_info (WIDGET, "widget_id", eve$x_needfilename_dialog, "NEEDFILENAME_DIALOG.NEEDFILENAME_TEXT" ), "text"); ! test the file name if (eve$$x_exit_array {"the_file"} = 0) or (eve$$x_exit_array {"the_file"} = "") then ! change message box OK button program to finish the exit eve$$set_responder (eve$$k_message_ok, "eve$$widget_nofilespecexit_ok(" + str (loop_flag) + ")"); eve$popup_message (message_text (EVE$_NOFILESPECEXIT, 0, eve$$x_exit_array {"the_buffer_name"})); return; endif; eve$$x_exit_array {"state"} := 1; if loop_flag then eve$$exit_loop; ! go write all buffers in a loop else eve$$exit1; ! write current buffer endif; endprocedure; ! eve$$widget_needfilename_ok procedure eve$$widget_needfilename_cancel ! Cancel - No filename (loop_flag) ! true if called from eve$$exit_loop ! change message box OK button program to finish the exit eve$unmanage_widget (eve$x_needfilename_dialog); eve$$set_responder (eve$$k_message_ok, "eve$$widget_nofilespecexit_ok(" + str (loop_flag) + ")"); eve$popup_message (message_text (EVE$_NOFILESPECEXIT, 0, eve$$x_exit_array {"the_buffer_name"})); endprocedure; ! eve$$widget_needfilename_cancel procedure eve$$widget_nofilespecexit_ok ! OK to exit - no filename (loop_flag) ! Called when user clicks in message box OK for EVE$_NOFILESPECEXIT eve$unmanage_widget (eve$x_message_dialog); ! change ok button program to the default eve$$set_responder (eve$$k_message_ok, "eve$unmanage_widget(eve$x_message_dialog)"); eve$$x_exit_array {"state"} := 2; if loop_flag then eve$$x_exit_array {"the_buffer"} := get_info (BUFFERS, "next"); eve$$exit_loop; ! go write next buffer else ! state = 2 causes eve$$exit2 to be a nop for the current buffer, and ! then eve$$exit_loop to start looping thru the buffers eve$$exit1; endif; endprocedure; ! eve$$widget_nofilespecexit_ok ! EVE$MENUS.TPU Page 19 procedure eve$$widget_writebuf_yes ! Write buffer (exit) eve$$x_exit_array {"state"} := 0; ! eve$$exit_loop will call eve$$exit2 eve$$exit_loop; ! go write the_buffer in loop endprocedure; ! eve$$widget_writebuf_yes procedure eve$$widget_writebuf_no ! Don't write buffer (exit) eve$$x_exit_array {"state"} := 2; ! eve$$exit_loop will go to next buffer eve$$x_exit_array {"the_buffer"} := get_info (BUFFERS, "next"); eve$$exit_loop; ! go write next buffer endprocedure; ! eve$$widget_writebuf_no ! EVE$MENUS.TPU Page 20 procedure eve$$widget_writefileprompt_ok ! OK callback (buffer_name, ! buffer to write the_format) ! arg for eve$write_file ! Called only from EVE_WRITE_FILE (not from EXIT procedures because there ! eve$$get_write_file insures eve$write_file need not prompt for a filespec) local the_file; ! name of the file to write buffer to eve$unmanage_widget (eve$x_writefileprompt_dialog); ! get the filename from the text widget the_file := get_info (get_info (WIDGET, "widget_id", eve$x_writefileprompt_dialog, "WRITEFILEPROMPT_DIALOG.WRITEFILEPROMPT_TEXT"), "text"); if (the_file = "") then eve$message (EVE$_NOFILESPEC); return; endif; eve$write_file (get_info (BUFFERS, "find_buffer", buffer_name), the_file, the_format); endprocedure; ! eve$$widget_writefileprompt_ok procedure eve$$widget_writefileprompt_cancel ! CANCEL callback eve$unmanage_widget (eve$x_writefileprompt_dialog); eve$message (EVE$_NOFILESPEC); endprocedure; ! eve$$widget_writefileprompt_cancel ! EVE$MENUS.TPU Page 21 procedure eve$$widget_find_ok ! OK callback FIND (replacing; ! 0 called by find, [1 by replace,] 2 by wildcard_find old_find) ! 1 if called by eve$find, else tpu$k_unspecified ! get find string local new_target; if replacing = 2 then eve$unmanage_widget (eve$x_wildcard_find_dialog); else eve$unmanage_widget (eve$x_find_dialog); endif; ! get the find string from the eve$$k_find_text widget if replacing = 2 then new_target := get_info (get_info (WIDGET, "widget_id", eve$x_wildcard_find_dialog, "WILDCARD_FIND_DIALOG.WILDCARD_FIND_TEXT") , "text"); else new_target := get_info (get_info (WIDGET, "widget_id", eve$x_find_dialog, "FIND_DIALOG.FIND_TEXT"), "text"); endif; ! test the target if new_target = "" then eve$x_target := ""; ! user erased the find string eve$message (EVE$_NOFIND); return; endif; if replacing = 2 then eve_wildcard_find (new_target); else if old_find <> tpu$k_unspecified then eve$find (new_target, replacing); else eve_find (new_target); endif; endif; endprocedure; ! eve$$widget_find_ok ! EVE$MENUS.TPU Page 22 procedure eve$$widget_find_each_yes ! Find in opposite direction (replacing, ! 0 called by find, [1 by replace,] 2 by wildcard_find move_flag, ! 1 to move to found range, 0 to not move new_direction; ! 1 for FORWARD, 0 for REVERSE old_find) ! 1 called by eve$find, else tpu$k_unspecified ! go ahead and find next occurrence of eve$x_target in other direction local saved_direction; on_error [TPU$_CONTROLC]: if (saved_direction <> current_direction) and (get_info (saved_direction, "type") = KEYWORD) then set (saved_direction, current_buffer); endif; eve$learn_abort; abort; [OTHERWISE]: if (saved_direction <> current_direction) and (get_info (saved_direction, "type") = KEYWORD) then set (saved_direction, current_buffer); endif; endon_error; eve$unmanage_widget (eve$x_find_each_dialog); saved_direction := current_direction; if move_flag then if new_direction then set (FORWARD, current_buffer); else set (REVERSE, current_buffer); endif; eve$position_in_middle (beginning_of (eve$$x_saved_found_range)); eve$x_old_find_direction := current_direction; set (saved_direction, current_buffer); endif; if (replacing = 0) and (old_find <> tpu$k_unspecified) then return; endif; eve$remember_found (eve$$x_saved_found_range); endprocedure; ! eve$$widget_find_each_yes ! EVE$MENUS.TPU Page 23 procedure eve$$widget_global_attr ! GLOBAL ATTR menu item ! Set toggle values to match current values, save current values, & manage the ! dialog box. Apply widgets at each press. Cancel restores saved values. local status; if get_info (eve$$x_global_attr_array, "type") <> ARRAY then eve$$x_global_attr_array := create_array (eve$$k_global_attr_array_length, eve$$k_state_array_indexes); eve$$x_global_attr_array {TYPE} := eve$$k_global_attr_context; endif; eve$$x_global_attr_array {eve$$k_global_attr_scroll_on} := eve$x_scrolling; eve$$x_global_attr_array {eve$$k_global_attr_scroll_jump} := eve$x_jump; eve$$x_global_attr_array {eve$$k_global_attr_cursor} := eve$x_bound_cursor; eve$$x_global_attr_array {eve$$k_global_attr_tab_mode} := eve$x_tab_mode; eve$$x_global_attr_array {eve$$k_global_attr_search} := eve$get_find_case_sensitivity; eve$$x_global_attr_array {eve$$k_global_attr_clipboard} := eve$$x_state_array {eve$$k_clipboard}; eve$$x_global_attr_array {eve$$k_global_attr_pending} := eve$$x_state_array {eve$$k_pending_delete_enabled}; ! assume user used EVE's SET TABS [IN]VISIBLE, not SET(TEXT,...) on a window eve$$x_global_attr_array {eve$$k_global_attr_tabs} := get_info (current_window, "text"); eve$$x_global_attr_array {eve$$k_global_attr_box_select} := eve$x_box_select_flag; eve$$x_global_attr_array {eve$$k_global_attr_box_pad} := eve$x_box_pad_flag; if get_info (eve$x_global_dialog, "type") <> WIDGET then eve$x_global_dialog := eve$create_widget ("GLOBAL_DIALOG"); endif; ! set widgets to the current values status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_SCROLL_ON.SCROLL_ON"), eve$x_resource_array {eve$k_nset}, (eve$x_scrolling = ON)); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_SCROLL_ON.SCROLL_OFF"), eve$x_resource_array {eve$k_nset}, (eve$x_scrolling = OFF)); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_SCROLL_JUMP.SCROLL_SMOOTH"), eve$x_resource_array {eve$k_nset}, (eve$x_jump = SMOOTH)); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_SCROLL_JUMP.SCROLL_JUMP"), eve$x_resource_array {eve$k_nset}, (eve$x_jump = JUMP)); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_CURSOR.FREE_CURSOR"), eve$x_resource_array {eve$k_nset}, (eve$x_bound_cursor = FALSE)); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_CURSOR.BOUND_CURSOR"), eve$x_resource_array {eve$k_nset}, (eve$x_bound_cursor = TRUE)); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_TAB_MODE.TAB_INSERT"), eve$x_resource_array {eve$k_nset}, (eve$x_tab_mode = 0)); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_TAB_MODE.TAB_SPACES"), eve$x_resource_array {eve$k_nset}, (eve$x_tab_mode = 1)); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_TAB_MODE.TAB_MOVEMENT"), eve$x_resource_array {eve$k_nset}, (eve$x_tab_mode = 2)); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_TABS"), eve$x_resource_array {eve$k_nset}, (eve$$x_global_attr_array {eve$$k_global_attr_tabs} = GRAPHIC_TABS)); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_CLIPBOARD"), eve$x_resource_array {eve$k_nset}, (eve$$x_global_attr_array {eve$$k_global_attr_clipboard} = TRUE)); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_PENDING_DELETE"), eve$x_resource_array {eve$k_nset}, (eve$$x_global_attr_array {eve$$k_global_attr_pending} = TRUE)); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_SEARCH"), eve$x_resource_array {eve$k_nset}, (eve$get_find_case_sensitivity)); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_BOX_SELECT"), eve$x_resource_array {eve$k_nset}, (eve$x_box_select_flag)); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_BOX_PAD"), eve$x_resource_array {eve$k_nset}, (eve$x_box_pad_flag)); eve$manage_widget (eve$x_global_dialog); endprocedure; ! eve$$widget_global_attr ! EVE$MENUS.TPU Page 24 procedure eve$$widget_scroll_on ! GLOBAL ATTR SCROLL ON local status, the_value; status := get_info (get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_SCROLL_ON.SCROLL_ON"), "widget_info", eve$x_resource_array {eve$k_nset}, the_value); if the_value then eve_set_scroll_on; endif; endprocedure; ! eve$$widget_scroll_on procedure eve$$widget_scroll_off ! GLOBAL ATTR SCROLL OFF local status, the_value; status := get_info (get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_SCROLL_ON.SCROLL_OFF"), "widget_info", eve$x_resource_array {eve$k_nset}, the_value); if the_value then eve_set_scroll_off; endif; endprocedure; ! eve$$widget_scroll_off procedure eve$$widget_scroll_smooth ! GLOBAL ATTR SCROLL SMOOTH local status, the_value; status := get_info (get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_SCROLL_JUMP.SCROLL_SMOOTH"), "widget_info", eve$x_resource_array {eve$k_nset}, the_value); if the_value then eve_set_scroll_smooth; endif; endprocedure; ! eve$$widget_scroll_smooth procedure eve$$widget_scroll_jump ! GLOBAL ATTR SCROLL JUMP local status, the_value; status := get_info (get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_SCROLL_JUMP.SCROLL_JUMP"), "widget_info", eve$x_resource_array {eve$k_nset}, the_value); if the_value then eve_set_scroll_jump; endif; endprocedure; ! eve$$widget_scroll_jump procedure eve$$widget_free_cursor ! GLOBAL ATTR FREE CURSOR local status, the_value; status := get_info (get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_CURSOR.FREE_CURSOR"), "widget_info", eve$x_resource_array {eve$k_nset}, the_value); if the_value then eve_set_cursor_free; endif; endprocedure; ! eve$$widget_free_cursor procedure eve$$widget_bound_cursor ! GLOBAL ATTR BOUND CURSOR local status, the_value; status := get_info (get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_CURSOR.BOUND_CURSOR"), "widget_info", eve$x_resource_array {eve$k_nset}, the_value); if the_value then eve_set_cursor_bound; endif; endprocedure; ! eve$$widget_bound_cursor procedure eve$$widget_tab_insert ! GLOBAL ATTR TAB INSERT local status, the_value; status := get_info (get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_TAB_MODE.TAB_INSERT"), "widget_info", eve$x_resource_array {eve$k_nset}, the_value); if the_value then eve_set_tabs (message_text (EVE$_INSERT)); endif; endprocedure; ! eve$$widget_tab_insert procedure eve$$widget_tab_spaces ! GLOBAL ATTR TAB SPACES local status, the_value; status := get_info (get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_TAB_MODE.TAB_SPACES"), "widget_info", eve$x_resource_array {eve$k_nset}, the_value); if the_value then eve_set_tabs (message_text (EVE$_SPACES)); endif; endprocedure; ! eve$$widget_tab_spaces procedure eve$$widget_tab_movement ! GLOBAL ATTR TAB MOVEMENT local status, the_value; status := get_info (get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_TAB_MODE.TAB_MOVEMENT"), "widget_info", eve$x_resource_array {eve$k_nset}, the_value); if the_value then eve_set_tabs (message_text (EVE$_MOVEMENT)); endif; endprocedure; ! eve$$widget_tab_movement procedure eve$$widget_global_tabs ! GLOBAL ATTR GLOBAL TABS (vis/invis) local status, the_value; status := get_info (get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_TABS"), "widget_info", eve$x_resource_array {eve$k_nset}, the_value); if the_value then eve_set_tabs (message_text (EVE$_VISIBLE)); else eve_set_tabs (message_text (EVE$_INVISIBLE)); endif; endprocedure; ! eve$$widget_global_tabs procedure eve$$widget_global_clipboard ! GLOBAL ATTR CLIPBOARD local status, the_value; status := get_info (get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_CLIPBOARD"), "widget_info", eve$x_resource_array {eve$k_nset}, the_value); if the_value then eve_set_clipboard; else eve_set_noclipboard; endif; endprocedure; ! eve$$widget_global_clipboard procedure eve$$widget_global_pending_delete ! GLOBAL ATTR PENDING_DELETE local status, the_value; status := get_info (get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_PENDING_DELETE"), "widget_info", eve$x_resource_array {eve$k_nset}, the_value); if the_value then eve_set_pending_delete; else eve_set_nopending_delete; endif; endprocedure; ! eve$$widget_global_pending_delete procedure eve$$widget_global_search ! GLOBAL ATTR GLOBAL SEARCH (ex/noexact) local status, the_value; status := get_info (get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_SEARCH"), "widget_info", eve$x_resource_array {eve$k_nset}, the_value); if the_value then eve$set_find_case_sensitivity (TRUE); eve$message (EVE$_FINDEXACT); else eve$set_find_case_sensitivity (FALSE); eve$message (EVE$_FINDNOEXACT); endif; endprocedure; ! eve$$widget_global_search procedure eve$$widget_global_box_select ! GLOBAL ATTR BOX_SELECT local status, the_value; status := get_info (get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_BOX_SELECT"), "widget_info", eve$x_resource_array {eve$k_nset}, the_value); if the_value then eve_set_box_select; else eve_set_box_noselect; endif; endprocedure; ! eve$$widget_global_box_select procedure eve$$widget_global_box_pad ! GLOBAL ATTR BOX_PAD local status, the_value; status := get_info (get_info (WIDGET, "widget_id", eve$x_global_dialog, "GLOBAL_DIALOG.GLOBAL_BOX_PAD"), "widget_info", eve$x_resource_array {eve$k_nset}, the_value); if the_value then eve_set_box_pad; else eve_set_box_nopad; endif; endprocedure; ! eve$$widget_global_box_pad ! EVE$MENUS.TPU Page 25 procedure eve$$widget_global_cancel ! GLOBAL ATTR CANCEL eve$unmanage_widget (eve$x_global_dialog); if eve$$x_global_attr_array {eve$$k_global_attr_scroll_on} <> eve$x_scrolling then if eve$$x_global_attr_array {eve$$k_global_attr_scroll_on} = ON then eve_set_scroll_on; else eve_set_scroll_off; endif; endif; if eve$$x_global_attr_array {eve$$k_global_attr_scroll_jump} <> eve$x_jump then if eve$$x_global_attr_array {eve$$k_global_attr_scroll_jump} = JUMP then eve_set_scroll_jump; else eve_set_scroll_smooth; endif; endif; if eve$$x_global_attr_array {eve$$k_global_attr_cursor} <> eve$x_bound_cursor then if eve$$x_global_attr_array {eve$$k_global_attr_cursor} then eve_set_cursor_bound; else eve_set_cursor_free; endif; endif; if eve$$x_global_attr_array {eve$$k_global_attr_tabs} <> get_info (current_window, "text") then if eve$$x_global_attr_array {eve$$k_global_attr_tabs} = BLANK_TABS then eve_set_tabs (message_text (EVE$_INVISIBLE)); else eve_set_tabs (message_text (EVE$_VISIBLE)); endif; endif; if eve$$x_global_attr_array {eve$$k_global_attr_clipboard} <> eve$$x_state_array {eve$$k_clipboard} then if eve$$x_global_attr_array {eve$$k_global_attr_clipboard} then eve_set_clipboard; else eve_set_noclipboard; endif; endif; if eve$$x_global_attr_array {eve$$k_global_attr_pending} <> eve$$x_state_array {eve$$k_pending_delete_enabled} then if eve$$x_global_attr_array {eve$$k_global_attr_pending} then eve_set_pending_delete; else eve_set_nopending_delete; endif; endif; if eve$$x_global_attr_array {eve$$k_global_attr_tab_mode} <> eve$x_tab_mode then case eve$$x_global_attr_array {eve$$k_global_attr_tab_mode} [0]: ! INSERT eve_set_tabs (message_text (EVE$_INSERT)); [1]: ! SPACES eve_set_tabs (message_text (EVE$_SPACES)); [2]: ! MOVEMENT eve_set_tabs (message_text (EVE$_MOVEMENT)); endcase; endif; if eve$$x_global_attr_array {eve$$k_global_attr_search} <> eve$get_find_case_sensitivity then eve$set_find_case_sensitivity (eve$$x_global_attr_array {eve$$k_global_attr_search}); endif; eve$message (EVE$_NOGLOBALCHNG); endprocedure; ! eve$$widget_global_cancel ! EVE$MENUS.TPU Page 26 procedure eve$$widget_attr ! SAVE ATTRIBUTES menu entry logic (;system_attr) ! Boolean: 1 = set title to Save System Attributes ! (unspecd)0 = set title to Save Attributes ! This implements the logic which creates, formats, and displays the user ! attributes dialog box as invoked from the SAVE ATTRIBUTES menu entry. local status, system_flag, temp, widget_ht, screen_ht, subform, sublist, the_widget_id, ! List box widget id list_box_attributes; ! DECwindows argument list for list box if get_info (eve$x_attr_dialog, "type") <> WIDGET then eve$x_attr_dialog := eve$create_widget ("ATTR_DIALOG"); endif; ! ! set widgets to reflect current values ! status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_attr_dialog, "ATTR_DIALOG.SAVE_ATTR_BOX.ATTR_SECTION"), eve$x_resource_array {eve$k_nset}, (eve$$x_prompt_for_section = TRUE)); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_attr_dialog, "ATTR_DIALOG.SAVE_ATTR_BOX.ATTR_COMMAND"), eve$x_resource_array {eve$k_nset}, (eve$$x_prompt_for_section <> TRUE)); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_attr_dialog, "ATTR_DIALOG.SAVE_ATTR_BOX.ATTR_DONT_SAVE"), eve$x_resource_array {eve$k_nset}, FALSE); status := set (TEXT, get_info (WIDGET, "widget_id", eve$x_attr_dialog, "ATTR_DIALOG.ATTR_SECTION_TEXT"), eve$$x_section_default); status := set (TEXT, get_info (WIDGET, "widget_id", eve$x_attr_dialog, "ATTR_DIALOG.ATTR_COMMAND_TEXT"), eve$$get_default_command_file); ! ! Show the current user settings by loading them into the list box ! list_box_attributes := create_array; list_box_attributes {eve$x_resource_array {eve$k_nselected_count}} := 0; list_box_attributes {eve$x_resource_array {eve$k_nitems_count}} := eve$$x_display_array; temp := "ATTR_DIALOG.ATTR_SUBFORM"; subform := get_info (WIDGET, "widget_id", eve$x_attr_dialog, temp); temp := temp + ".CURRENT_ATTRSSW.CURRENT_ATTRS"; sublist := get_info (WIDGET, "widget_id", eve$x_attr_dialog, temp); ! Shorten the widget + list box if too big to fit on screen. status := get_info (eve$x_attr_dialog, "widget_info", eve$x_resource_array {eve$k_nheight}, widget_ht); screen_ht := get_info (SCREEN, "pixel_length"); if widget_ht >= screen_ht then set (WIDGET, eve$x_attr_dialog, eve$x_resource_array {eve$k_nheight}, screen_ht); set (WIDGET, sublist, eve$x_resource_array {eve$k_nvisitemcount}, 2); ! Match Motif subform height to new list box size set (WIDGET, subform, eve$x_resource_array {eve$k_nheight}, 80); endif; the_widget_id := get_info (WIDGET, "widget_id", eve$x_attr_dialog, temp); set (WIDGET, the_widget_id, list_box_attributes); if system_attr <> tpu$k_unspecified then if system_attr then system_flag := TRUE; endif; endif; if system_flag then status := set (widget, eve$x_attr_dialog, eve$x_resource_array {eve$k_ndialogtitle}, message_text (EVE$_ATTR_SYS_TITLE, 1)); else status := set (widget, eve$x_attr_dialog, eve$x_resource_array {eve$k_ndialogtitle}, message_text (EVE$_ATTR_TITLE, 1)); endif; eve$manage_widget (eve$x_attr_dialog, "ATTR_DIALOG"); endprocedure; ! eve$$widget_attr ! EVE$MENUS.TPU Page 27 procedure eve$$widget_attr_ok ! Callback: user attr dialog ! Handle both OK and cancel button callbacks from the user attributes ! save dialog box (my_action); local status, saved_window, saved_mark, results, ! of attribute building. Not used. attrs_range, ! holds previous settings code in command file file_to_save_to, !-- All these should_save_as_command, !-- settings gotten should_save_as_section, !-- from the widgets in bypass_save_attributes; !-- the user attributes box on_error [OTHERWISE]: if get_info (eve$x_attr_dialog, "type") = WIDGET then eve$unmanage_widget (eve$x_attr_dialog); endif; if get_info (saved_window, "type") = WINDOW then eve$$restore_position (saved_window, saved_mark); else eve$$restore_position (saved_mark); endif; return; endon_error; saved_window := current_window; saved_mark := mark (FREE_CURSOR); eve$unmanage_widget (eve$x_attr_dialog); case my_action [1]: ! OK button was pressed - lets take a look at the widget values status := get_info (get_info (WIDGET, "widget_id", eve$x_attr_dialog, "ATTR_DIALOG.SAVE_ATTR_BOX.ATTR_DONT_SAVE"), "widget_info", eve$x_resource_array {eve$k_nset}, bypass_save_attributes); if not bypass_save_attributes then ! ! We should save the user's modified attributes ! status := get_info (get_info (WIDGET, "widget_id", eve$x_attr_dialog, "ATTR_DIALOG.SAVE_ATTR_BOX.ATTR_SECTION"), "widget_info", eve$x_resource_array {eve$k_nset}, should_save_as_section); if should_save_as_section then ! ! We should save modified attributes in a section file ! return not (eve_save_extended_eve (get_info (get_info (WIDGET, "widget_id", eve$x_attr_dialog, "ATTR_DIALOG.ATTR_SECTION_TEXT"), "text"))); else ! ! We should save modified attributes in a command file ! status := get_info (get_info (WIDGET, "widget_id", eve$x_attr_dialog, "ATTR_DIALOG.SAVE_ATTR_BOX.ATTR_COMMAND" ), "widget_info", eve$x_resource_array {eve$k_nset}, should_save_as_command); if should_save_as_command then file_to_save_to := get_info (get_info (WIDGET, "widget_id", eve$x_attr_dialog, "ATTR_DIALOG.ATTR_COMMAND_TEXT"), "text"); attrs_range := eve$$locate_eve_generated_attrs; if beginning_of (attrs_range) <> end_of (attrs_range) then erase (attrs_range); ! Get rid of old code endif; eve$$build_attr_code (beginning_of (attrs_range), results); eve$write_file (get_info (BUFFER, "find_buffer", "$LOCAL$INI$"), file_to_save_to, 0); else ! Radio box MUST have been set to one of the above... ! we're in real trouble eve$message (EVE$_COMMANDSTOP); endif; ! should_save_as_command endif; ! should_save_as_section endif; ! bypass_save_attributes [0]: ! Cancel button was pressed - forget about any processing endcase; if get_info (saved_window, "type") = WINDOW then eve$$restore_position (saved_window, saved_mark); else eve$$restore_position (saved_mark); endif; endprocedure; ! eve$$widget_attr_ok ! EVE$MENUS.TPU Page 28 procedure eve$$widget_clear_attr ! SAVE SYSTEM ATTRIBUTES menu entry logic eve$$accum_all_attr; ! If we're accumulating attributes, save current ones eve$$widget_attr (1); ! Now call common logic in SAVE ATTRIBUTES menu entry endprocedure ! eve$$widget_clear_attr procedure eve_save_system_attributes ! for menu entry of same name eve$$accum_all_attr; ! If we're accumulating attributes, save the current ones eve_save_attributes; ! Now call common logic endprocedure ! eve_save_system_attributes procedure eve$$accum_all_attr ! Accumulate all of the current attributes local attr_index; ! Index into attrs array ! ! If we're accumulating attributes, save the current ones into the ! accumuated attributes array before we zap them all ! if eve$$x_accumulate_attrs then if get_info (eve$$x_attrs_array, 'type') = ARRAY then attr_index := get_info (eve$$x_attrs_array, "first"); loop exitif attr_index = 0; if get_info (eve$$x_accum_attrs_array {attr_index}, 'type') <> STRING then eve$$x_accum_attrs_array {attr_index} := eve$$x_attrs_array {attr_index}; eve$$x_accum_display_array {attr_index} := eve$$x_display_array {attr_index}; endif; endloop; endif; eve$$x_saved_attrs_modified := eve$$x_attrs_modified; endif; eve$$x_attrs_array := create_array; eve$$x_display_array := create_array; eve$$x_attrs_modified := FALSE; endprocedure ! eve$$accum_all_attr ! EVE$MENUS.TPU Page 29 procedure eve$$widget_set_margins ! Set Margins callback routine local status; if get_info (eve$x_set_margins_dialog, "type") <> WIDGET then eve$x_set_margins_dialog := eve$create_widget ("SET_MARGINS_DIALOG"); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_set_margins_dialog, "SET_MARGINS_DIALOG.SET_MARGINS_LLABEL"), eve$x_resource_array {eve$k_nlabel}, message_text (EVE$_LEFTPROMPT)); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_set_margins_dialog, "SET_MARGINS_DIALOG.SET_MARGINS_RLABEL"), eve$x_resource_array {eve$k_nlabel}, message_text (EVE$_RIGHTPROMPT)); endif; status := set (TEXT, get_info (WIDGET, "widget_id", eve$x_set_margins_dialog, "SET_MARGINS_DIALOG.SET_MARGINS_L_TEXT"), str (get_info (current_buffer, "left_margin"))); status := set (TEXT, get_info (WIDGET, "widget_id", eve$x_set_margins_dialog, "SET_MARGINS_DIALOG.SET_MARGINS_R_TEXT"), str (get_info (current_buffer, "right_margin"))); eve$manage_widget (eve$x_set_margins_dialog); endprocedure; ! eve$$widget_set_margins ! EVE$MENUS.TPU Page 30 procedure eve$$widget_set_margins_ok ! OK callback Set Margins eve$unmanage_widget (eve$x_set_margins_dialog); eve$$widget_set_margins_apply; endprocedure; ! eve$$widget_set_margins_ok procedure eve$$widget_set_margins_apply ! Apply callback Set Margins local the_left_margin, the_right_margin; the_left_margin := get_info (get_info (WIDGET, "widget_id", eve$x_set_margins_dialog, "SET_MARGINS_DIALOG.SET_MARGINS_L_TEXT"), "text"); the_right_margin := get_info (get_info (WIDGET, "widget_id", eve$x_set_margins_dialog, "SET_MARGINS_DIALOG.SET_MARGINS_R_TEXT") , "text"); if (the_left_margin = "") and (the_right_margin = "") then eve$message (EVE$_MARGINSNOTCHNG); return; endif; if (the_left_margin <> "") and (the_left_margin <> 0) then eve_set_left_margin (the_left_margin); endif; if (the_right_margin <> "") and (the_right_margin <> 0) then eve_set_right_margin (the_right_margin); endif; endprocedure; ! eve$$widget_set_margins_apply procedure eve$$widget_set_margins_cancel ! CANCEL callback Set Margins eve$unmanage_widget (eve$x_set_margins_dialog); eve$message (EVE$_MARGINSNOTCHNG); endprocedure; ! eve$$widget_set_margins_cancel ! EVE$MENUS.TPU Page 31 procedure eve$$widget_buffer_attr ! BUFFER ATTR menu item ! Set toggle values to match current values, save current values, & manage the ! dialog box. Apply widgets at each press, and CANCEL restores saved values, ! except for LEFT/RIGHT MARGIN which are applied at OK, and ignored at CANCEL. local what_tab_stops, temp, status; if get_info (eve$$x_buffer_attr_array, "type") <> ARRAY then eve$$x_buffer_attr_array := create_array (eve$$k_buffer_attr_array_length, eve$$k_state_array_indexes); eve$$x_buffer_attr_array {TYPE} := eve$$k_buffer_attr_context; endif; eve$$x_buffer_attr_array {eve$$k_buffer_left} := get_info (current_buffer, "left_margin"); eve$$x_buffer_attr_array {eve$$k_buffer_right} := get_info (current_buffer, "right_margin"); eve$$x_buffer_attr_array {eve$$k_buffer_para_indent} := eve$$x_paragraph_indent {current_buffer}; eve$$x_buffer_attr_array {eve$$k_buffer_wrap} := get_info (current_buffer, "right_margin_action"); eve$$x_buffer_attr_array {eve$$k_buffer_attr_modifiable} := get_info (current_buffer, "modifiable"); eve$$x_buffer_attr_array {eve$$k_buffer_attr_readonly} := get_info (current_buffer, "no_write"); what_tab_stops := get_info (current_buffer, "tab_stops"); if get_info (what_tab_stops, "type") = INTEGER then eve$$x_buffer_attr_array {eve$$k_buffer_tabs_every} := what_tab_stops; eve$$x_buffer_attr_array {eve$$k_buffer_tabs_at} := tpu$k_unspecified; else eve$$x_buffer_attr_array {eve$$k_buffer_tabs_at} := what_tab_stops; eve$$x_buffer_attr_array {eve$$k_buffer_tabs_every} := tpu$k_unspecified; endif; if get_info (eve$x_buffer_dialog, "type") <> WIDGET then eve$x_buffer_dialog := eve$create_widget ("BUFFER_DIALOG"); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_buffer_dialog, "BUFFER_DIALOG.BUF_LEFT_MARGIN_LABEL"), eve$x_resource_array {eve$k_nlabel}, message_text (EVE$_LEFTPROMPT)); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_buffer_dialog, "BUFFER_DIALOG.BUF_RIGHT_MARGIN_LABEL"), eve$x_resource_array {eve$k_nlabel}, message_text (EVE$_RIGHTPROMPT)); endif; ! set widgets to the current values status := set (TEXT, get_info (WIDGET, "widget_id", eve$x_buffer_dialog, "BUFFER_DIALOG.BUF_LEFT_MARGIN_TEXT"), str (eve$$x_buffer_attr_array {eve$$k_buffer_left})); status := set (TEXT, get_info (WIDGET, "widget_id", eve$x_buffer_dialog, "BUFFER_DIALOG.BUF_RIGHT_MARGIN_TEXT"), str (eve$$x_buffer_attr_array {eve$$k_buffer_right})); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_buffer_dialog, "BUFFER_DIALOG.BUFFER_WORD_WRAP"), eve$x_resource_array {eve$k_nset}, (eve$$x_buffer_attr_array {eve$$k_buffer_wrap} <> tpu$k_unspecified)); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_buffer_dialog, "BUFFER_DIALOG.BUFFER_MODIFIABLE"), eve$x_resource_array {eve$k_nset}, (eve$$x_buffer_attr_array {eve$$k_buffer_attr_modifiable} = TRUE)); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_buffer_dialog, "BUFFER_DIALOG.BUFFER_READONLY"), eve$x_resource_array {eve$k_nset}, (eve$$x_buffer_attr_array {eve$$k_buffer_attr_readonly} = TRUE)); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_buffer_dialog, "BUFFER_DIALOG.BUFFER_TABS_AT_EVERY.BUFFER_SET_TABS_EVERY" ), eve$x_resource_array {eve$k_nset}, (eve$$x_buffer_attr_array {eve$$k_buffer_tabs_every} <> tpu$k_unspecified)); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_buffer_dialog, "BUFFER_DIALOG.BUFFER_TABS_AT_EVERY.BUFFER_SET_TABS_AT" ), eve$x_resource_array {eve$k_nset}, (eve$$x_buffer_attr_array {eve$$k_buffer_tabs_at} <> tpu$k_unspecified)); if get_info (what_tab_stops, "type") = INTEGER then what_tab_stops := str (what_tab_stops); endif; status := set (TEXT, get_info (WIDGET, "widget_id", eve$x_buffer_dialog, "BUFFER_DIALOG.BUFFER_SET_TABS_TEXT"), what_tab_stops); if eve$$x_paragraph_indent {current_buffer} = tpu$k_unspecified then temp := "0"; else temp := str (eve$$x_paragraph_indent {current_buffer} - get_info (current_buffer, "left_margin")); endif; status := set (TEXT, get_info (WIDGET, "widget_id", eve$x_buffer_dialog, "BUFFER_DIALOG.BUFFER_PARA_INDENT_TEXT"), temp); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_buffer_dialog, "BUFFER_DIALOG.BUFFER_LABEL"), eve$x_resource_array {eve$k_nlabel}, message_text (EVE$_BUFFERSETTINGS, 0, get_info (current_buffer, "name"))); eve$manage_widget (eve$x_buffer_dialog, "BUFFER_DIALOG"); endprocedure; ! eve$$widget_buffer_attr ! EVE$MENUS.TPU Page 32 procedure eve$$widget_buffer_word_wrap ! Word Wrap callback routine local status, the_value; status := get_info (get_info (WIDGET, "widget_id", eve$x_buffer_dialog, "BUFFER_DIALOG.BUFFER_WORD_WRAP"), "widget_info", eve$x_resource_array {eve$k_nset}, the_value); if the_value then eve_set_wrap; else eve_set_nowrap; endif; endprocedure; ! eve$$widget_buffer_word_wrap procedure eve$$widget_buffer_modifiable ! Buffer Modifiable callback local status, the_value; status := get_info (get_info (WIDGET, "widget_id", eve$x_buffer_dialog, "BUFFER_DIALOG.BUFFER_MODIFIABLE"), "widget_info", eve$x_resource_array {eve$k_nset}, the_value); if the_value then eve_set_buffer (eve$x_modifiable); else eve_set_buffer (eve$x_unmodifiable); endif; endprocedure; ! eve$$widget_buffer_modifiable procedure eve$$widget_buffer_readonly ! Buffer Read-only callback local status, temp; status := get_info (get_info (WIDGET, "widget_id", eve$x_buffer_dialog, "BUFFER_DIALOG.BUFFER_READONLY"), "widget_info", eve$x_resource_array {eve$k_nset}, temp); if temp then eve_set_buffer (eve$x_nowrite); temp := FALSE; else eve_set_buffer (eve$x_write); temp := TRUE; endif; status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_buffer_dialog, "BUFFER_DIALOG.BUFFER_MODIFIABLE"), eve$x_resource_array {eve$k_nset}, temp); endprocedure; ! eve$$widget_buffer_readonly ! EVE$MENUS.TPU Page 33 procedure eve$$widget_buffer_apply ! Apply callback buffer attrs local the_value, temp, temp1, temp_margin, which_tab, tab_value; ! set tabs ! get value of text widget tab_value := get_info (get_info (WIDGET, "widget_id", eve$x_buffer_dialog, "BUFFER_DIALOG.BUFFER_SET_TABS_TEXT"), "text"); which_tab := get_info (get_info (WIDGET, "widget_id", eve$x_buffer_dialog, "BUFFER_DIALOG.BUFFER_TABS_AT_EVERY.BUFFER_SET_TABS_AT" ), "widget_info", eve$x_resource_array {eve$k_nset}, the_value); if tab_value = "" then tab_value := "0"; ! 0 gets rejected by both SET TAB commands endif; if the_value ! Set tabs AT then if tab_value <> eve$$x_buffer_attr_array {eve$$k_buffer_tabs_at} then eve$$x_buffer_attr_array {eve$$k_buffer_tabs_at} := tab_value; eve$$x_buffer_attr_array {eve$$k_buffer_tabs_every} := tpu$k_unspecified; eve_set_tabs (message_text (EVE$_AT) + " " + tab_value); endif; else if tab_value <> eve$$x_buffer_attr_array {eve$$k_buffer_tabs_every} then eve$$x_buffer_attr_array {eve$$k_buffer_tabs_every} := tab_value; eve$$x_buffer_attr_array {eve$$k_buffer_tabs_at} := tpu$k_unspecified; eve_set_tabs (message_text (EVE$_EVERY) + " " + tab_value); endif; endif; ! left and right margins, paragraph indent temp := get_info (get_info (WIDGET, "widget_id", eve$x_buffer_dialog, "BUFFER_DIALOG.BUF_LEFT_MARGIN_TEXT"), "text"); if temp = "" then temp := "0"; endif; temp := int (temp); if temp <> eve$$x_buffer_attr_array {eve$$k_buffer_left} then eve$$x_buffer_attr_array {eve$$k_buffer_left} := temp; eve_set_left_margin (temp); endif; temp := get_info (get_info (WIDGET, "widget_id", eve$x_buffer_dialog, "BUFFER_DIALOG.BUF_RIGHT_MARGIN_TEXT"), "text"); if temp = "" then temp := "0"; endif; temp := int (temp); if temp <> eve$$x_buffer_attr_array {eve$$k_buffer_right} then eve$$x_buffer_attr_array {eve$$k_buffer_right} := temp; eve_set_right_margin (temp); endif; temp_margin := get_info (current_buffer, "left_margin"); temp := get_info (get_info (WIDGET, "widget_id", eve$x_buffer_dialog, "BUFFER_DIALOG.BUFFER_PARA_INDENT_TEXT"), "text"); if temp = "" then temp := "0"; endif; temp := int (temp); temp1 := eve$$x_buffer_attr_array {eve$$k_buffer_para_indent}; if temp1 = tpu$k_unspecified then temp1 := 0; else temp1 := temp1 - temp_margin; endif; if temp <> temp1 then eve$$x_buffer_attr_array {eve$$k_buffer_para_indent} := temp + temp_margin; eve_set_paragraph_indent (temp); endif; endprocedure; ! eve$$widget_buffer_apply ! EVE$MENUS.TPU Page 34 procedure eve$$widget_buffer_ok ! OK callback buffer attrs eve$unmanage_widget (eve$x_buffer_dialog); eve$$widget_buffer_apply; endprocedure; ! eve$$widget_buffer_ok ! EVE$MENUS.TPU Page 35 procedure eve$$widget_buffer_cancel ! CANCEL callback buffer attrs local temp; eve$unmanage_widget (eve$x_buffer_dialog); if eve$$x_buffer_attr_array {eve$$k_buffer_wrap} <> get_info (current_buffer, "right_margin_action") then if eve$$x_buffer_attr_array {eve$$k_buffer_wrap} <> tpu$k_unspecified then set (RIGHT_MARGIN_ACTION, current_buffer, eve$$x_buffer_attr_array {eve$$k_buffer_wrap}); else set (RIGHT_MARGIN_ACTION, current_buffer); endif; endif; if eve$$x_buffer_attr_array {eve$$k_buffer_attr_modifiable} <> get_info (current_buffer, "modifiable") then if eve$$x_buffer_attr_array {eve$$k_buffer_attr_modifiable} then eve_set_buffer (eve$x_modifiable); else eve_set_buffer (eve$x_unmodifiable); endif; endif; if eve$$x_buffer_attr_array {eve$$k_buffer_attr_readonly} <> get_info (current_buffer, "no_write") then if eve$$x_buffer_attr_array {eve$$k_buffer_attr_readonly} then eve_set_buffer (eve$x_nowrite); else eve_set_buffer (eve$x_write); endif; endif; eve$message (EVE$_NOBUFFERCHNG); endprocedure; ! eve$$widget_buffer_cancel ! EVE$MENUS.TPU Page 36 procedure eve$$widget_set_width ! Set Width callback local status; if get_info (eve$x_set_width_dialog, "type") <> WIDGET then eve$x_set_width_dialog := eve$create_widget ("SET_WIDTH_DIALOG"); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_set_width_dialog, "SET_WIDTH_DIALOG.SET_WIDTH_LABEL"), eve$x_resource_array {eve$k_nlabel}, message_text (EVE$_WIDTHPROMPT)); endif; status := set (TEXT, get_info (WIDGET, "widget_id", eve$x_set_width_dialog, "SET_WIDTH_DIALOG.SET_WIDTH_TEXT"), str (get_info (current_window, "width"))); eve$manage_widget (eve$x_set_width_dialog); endprocedure; ! eve$$widget_set_width procedure eve$$widget_set_width_ok ! OK callback Set Width eve$unmanage_widget (eve$x_set_width_dialog); eve$$widget_set_width_apply; endprocedure; ! eve$$widget_set_width_ok procedure eve$$widget_set_width_apply ! APPLY callback Set Width local the_width; the_width := get_info (get_info (WIDGET, "widget_id", eve$x_set_width_dialog, "SET_WIDTH_DIALOG.SET_WIDTH_TEXT"), "text"); if (the_width = "") then eve$message (EVE$_WIDNOTCHNG); else eve_set_width (the_width); endif; endprocedure; ! eve$$widget_set_width_apply procedure eve$$widget_set_width_cancel ! CANCEL callback Set Width eve$unmanage_widget (eve$x_set_width_dialog); eve$message (EVE$_WIDNOTCHNG); endprocedure; ! eve$$widget_set_width_cancel ! EVE$MENUS.TPU Page 37 procedure eve$$widget_set_para_indent ! Set Paragraph Indent local temp, status; if get_info (eve$x_set_para_indent_dialog, "type") <> WIDGET then eve$x_set_para_indent_dialog := eve$create_widget ("SET_PARA_INDENT_DIALOG"); endif; if eve$$x_paragraph_indent {current_buffer} = tpu$k_unspecified then temp := "0"; else temp := str (eve$$x_paragraph_indent {current_buffer} - get_info (current_buffer, "left_margin")); endif; status := set (TEXT, get_info (WIDGET, "widget_id", eve$x_set_para_indent_dialog, "SET_PARA_INDENT_DIALOG.SET_PARA_INDENT_TEXT"), temp); eve$manage_widget (eve$x_set_para_indent_dialog); endprocedure; ! eve$$widget_set_para_indent procedure eve$$widget_set_para_indent_ok ! OK Set Paragraph Indent eve$unmanage_widget (eve$x_set_para_indent_dialog); eve$$widget_set_para_indent_apply; endprocedure; ! eve$$widget_set_para_indent_ok procedure eve$$widget_set_para_indent_apply ! Apply callback set para indent local the_indent; the_indent := get_info (get_info (WIDGET, "widget_id", eve$x_set_para_indent_dialog, "SET_PARA_INDENT_DIALOG.SET_PARA_INDENT_TEXT") , "text"); if (the_indent = "") then ! disable it eve_set_paragraph_indent (0); else eve_set_paragraph_indent (the_indent); endif; endprocedure; ! eve$$widget_set_para_indent_apply procedure eve$$widget_set_para_indent_cancel ! Cancel callback set para ind. eve$unmanage_widget (eve$x_set_para_indent_dialog); eve$message (EVE$_NOPINDENTSET); endprocedure; ! eve$$widget_set_para_indent_cancel ! EVE$MENUS.TPU Page 38 procedure eve$$widget_split_window_ok ! OK callback split window eve$unmanage_widget (eve$x_split_window_dialog); eve$$widget_split_window_apply; endprocedure; ! eve$$widget_split_window_ok procedure eve$$widget_split_window_apply ! Apply callback split window local n; n := get_info (get_info (WIDGET, "widget_id", eve$x_split_window_dialog, "SPLIT_WINDOW_DIALOG.SPLIT_WINDOW_TEXT"), "text"); if (n = "") then eve$message (EVE$_NOTSPLIT); else eve_split_window (int (n)); endif; endprocedure; ! eve$$widget_split_window_apply procedure eve$$widget_split_window_cancel ! Cancel callback split window eve$unmanage_widget (eve$x_split_window_dialog); eve$message (EVE$_NOTSPLIT); endprocedure; ! eve$$widget_split_window_cancel ! EVE$MENUS.TPU Page 39 procedure eve$$widget_extend ! Extend callback local status; if get_info (eve$x_extend_dialog, "type") <> WIDGET then eve$x_extend_dialog := eve$create_widget ("EXTEND_DIALOG"); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_extend_dialog, "EXTEND_DIALOG.EXTEND_LABEL"), eve$x_resource_array {eve$k_nlabel}, message_text (EVE$_PROCPROMPT)); endif; eve$manage_widget (eve$x_extend_dialog); endprocedure; ! eve$$widget_extend procedure eve$$widget_extend_ok ! OK callback Extend eve$unmanage_widget (eve$x_extend_dialog); eve$$widget_extend_apply; endprocedure; ! eve$$widget_extend_ok procedure eve$$widget_extend_apply ! Apply callback Extend local extend_arg; extend_arg := get_info (get_info (WIDGET, "widget_id", eve$x_extend_dialog, "EXTEND_DIALOG.EXTEND_TEXT"), "text"); if (extend_arg = "") then eve$message (EVE$_NOTEXTEND); else eve_extend_eve (extend_arg); endif; endprocedure; ! eve$$widget_extend_apply procedure eve$$widget_extend_cancel ! Cancel callback Extend eve$unmanage_widget (eve$x_extend_dialog); eve$message (EVE$_NOTEXTEND); endprocedure; ! eve$$widget_extend_cancel ! EVE$MENUS.TPU Page 40 procedure eve$$widget_save_extended ! Save extended callback local status; if get_info (eve$x_save_extended_dialog, "type") <> WIDGET then eve$x_save_extended_dialog := eve$create_widget ("SAVE_EXTENDED_DIALOG"); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_save_extended_dialog, "SAVE_EXTENDED_DIALOG.SAVE_EXTENDED_LABEL"), eve$x_resource_array {eve$k_nlabel}, message_text (EVE$_SAVEPROMPT)); endif; eve$manage_widget (eve$x_save_extended_dialog); endprocedure; ! eve$$widget_save_extended procedure eve$$widget_save_extended_ok ! OK callback save extended eve$unmanage_widget (eve$x_save_extended_dialog); eve$$widget_save_extended_apply; endprocedure; ! eve$$widget_save_extended_ok procedure eve$$widget_save_extended_apply ! Apply callback save extended local extend_arg; extend_arg := get_info (get_info (WIDGET, "widget_id", eve$x_save_extended_dialog, "SAVE_EXTENDED_DIALOG.SAVE_EXTENDED_TEXT"), "text"); if (extend_arg = "") then eve$message (EVE$_NOTSAVED); else eve_save_extended_eve (extend_arg); endif; endprocedure; ! eve$$widget_save_extended_apply procedure eve$$widget_save_extended_cancel ! Cancel callback save extended eve$unmanage_widget (eve$x_save_extended_dialog); eve$message (EVE$_NOTSAVED); endprocedure; ! eve$$widget_save_extended_cancel ! EVE$MENUS.TPU Page 41 procedure eve$$widget_at_eve_file ! @EVE file callback local status; if get_info (eve$x_at_eve_file_dialog, "type") <> WIDGET then eve$x_at_eve_file_dialog := eve$create_widget ("AT_EVE_FILE_DIALOG"); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_at_eve_file_dialog, "AT_EVE_FILE_DIALOG.AT_EVE_FILE_LABEL"), eve$x_resource_array {eve$k_nlabel}, message_text (EVE$_INITFILEPROMPT)); endif; eve$manage_widget (eve$x_at_eve_file_dialog); endprocedure; ! eve$$widget_at_eve_file procedure eve$$widget_at_eve_file_ok ! @EVE file OK callback eve$unmanage_widget (eve$x_at_eve_file_dialog); eve$$widget_at_eve_file_apply; endprocedure; ! eve$$widget_at_eve_file_ok procedure eve$$widget_at_eve_file_apply ! @EVE file APPLY callback local the_file; the_file := get_info (get_info (WIDGET, "widget_id", eve$x_at_eve_file_dialog, "AT_EVE_FILE_DIALOG.AT_EVE_FILE_TEXT"), "text"); if (the_file = "") then eve$message (EVE$_NOFILESPEC); else eve__at_file (the_file); endif; endprocedure; ! eve$$widget_at_eve_file_apply procedure eve$$widget_at_eve_file_cancel ! @EVE file CANCEL callback eve$unmanage_widget (eve$x_at_eve_file_dialog); eve$message (EVE$_NOFILESPEC); endprocedure; ! eve$$widget_at_eve_file_cancel ! EVE$MENUS.TPU Page 42 procedure eve$$widget_mark ! Mark callback local status; if get_info (eve$x_mark_dialog, "type") <> WIDGET then eve$x_mark_dialog := eve$create_widget ("MARK_DIALOG"); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_mark_dialog, "MARK_DIALOG.MARK_LABEL"), eve$x_resource_array {eve$k_nlabel}, message_text (EVE$_MARKPROMPT)); endif; eve$manage_widget (eve$x_mark_dialog); endprocedure; ! eve$$widget_mark procedure eve$$widget_mark_ok ! OK callback Mark local mark_name; eve$unmanage_widget (eve$x_mark_dialog); mark_name := get_info (get_info (WIDGET, "widget_id", eve$x_mark_dialog, "MARK_DIALOG.MARK_TEXT"), "text"); if (mark_name = "") then eve$message (EVE$_NOTMARKED); else eve_mark (mark_name); endif; endprocedure; ! eve$$widget_mark_ok ! EVE$MENUS.TPU Page 43 procedure eve$$widget_goto ! GOTO callback local status; if get_info (eve$x_goto_dialog, "type") <> WIDGET then eve$x_goto_dialog := eve$create_widget ("GOTO_DIALOG"); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_goto_dialog, "GOTO_DIALOG.GOTO_LABEL"), eve$x_resource_array {eve$k_nlabel}, message_text (EVE$_GOTOPROMPT)); endif; eve$manage_widget (eve$x_goto_dialog); endprocedure; ! eve$$widget_goto procedure eve$$widget_goto_ok ! OK callback goto local mark_name; eve$unmanage_widget (eve$x_goto_dialog); mark_name := get_info (get_info (WIDGET, "widget_id", eve$x_goto_dialog, "GOTO_DIALOG.GOTO_TEXT"), "text"); if (mark_name = "") then eve$message (EVE$_NOMARK); else eve_go_to (mark_name); endif; endprocedure; ! eve$$widget_goto_ok ! EVE$MENUS.TPU Page 44 procedure eve$$widget_extend_menu ! Extend menu callback if get_info (eve$$x_popup_menus, "type") <> ARRAY then eve$init_menu_arrays; endif; eve$manage_widget (eve$x_extend_menu_dialog, "EXTEND_MENU_DIALOG"); endprocedure; ! eve$$widget_extend_menu ! EVE$MENUS.TPU Page 45 procedure eve$$get_selected_item ! get single selected item in list box (widget_name, ! string containing full listbox name selected_item_name) ! string containing selected item ! ABSTRACT: Get the single selected item from a list box. Returns TRUE if there ! is an item selected. If there is no item selected the procedure ! returns FALSE. ! Example: ! eve$$get_selected_item ! ("EXTEND_MENU_DIALOG.EXTEND_MENU_LIST_POPUPS", the_item); ! local temp_array, ! temp array for holding array of selected items the_widget_id, ! the id of the widget item_array, ! the array of item selected (there is only one element) status; the_widget_id := get_info (WIDGET, "widget_id", eve$x_extend_menu_dialog, widget_name); temp_array := create_array; temp_array {eve$x_resource_array {eve$k_nselected_items_count}} := 0; status := get_info (the_widget_id, "widget_info", temp_array); item_array := temp_array {eve$x_resource_array {eve$k_nselected_items_count}}; if get_info (item_array, "first") <> tpu$k_unspecified then selected_item_name := item_array {get_info (item_array, "first")}; return (TRUE); else return (FALSE); endif; endprocedure; ! eve$$get_selected_item ! EVE$MENUS.TPU Page 46 procedure eve$$get_menu_index ! get the index of menu in eve$$x_popup_menus (the_menu, ! the menu name - input the_menu_index; ! the_menu_index - output menu_name) ! name of menu ! Return the index (and optional name) of entry in listbox of available menus local the_index, ! index into menu_array space_index, ! index of a space in which_menu menu_array, ! array holding list of menu names which_menu, ! current menu in list of menus last_index, ! last index into menu array local_menu; ! local copy of the_menu parameter menu_array := eve$$x_popup_menus {eve$x_resource_array {eve$k_nitems_count}}; last_index := get_info (menu_array, "last"); the_index := get_info (menu_array, "first"); local_menu := the_menu; edit (local_menu, COMPRESS, LOWER); loop which_menu := menu_array {the_index}; edit (which_menu, COMPRESS, LOWER); space_index := index (which_menu, " "); ! " Popup" or " Pulldown" exitif (local_menu = which_menu) or (local_menu = substr (which_menu, 1, space_index - 1)); if (the_index = last_index) then return (FALSE); else the_index := get_info (menu_array, "next"); endif; endloop; the_menu_index := the_index; menu_name := menu_array {the_menu_index}; return (TRUE); endprocedure; ! eve$$get_menu_index ! EVE$MENUS.TPU Page 47 procedure eve$$get_menu_array ! get the array of menu entries of a menu (the_index) ! the index returned from eve$$get_menu_index ! ABSTRACT: Procedure eve$$get_menu_array returns the array containing the ! menu entries associated with the input menu case the_index [0]: ! Select Popup return (eve$$x_select_popup_entries); [1]: ! Noselect Popup return (eve$$x_noselect_popup_entries); [2]: ! File Pulldown return (eve$$x_file_pulldown_menu); [3]: ! Edit Pulldown return (eve$$x_edit_pulldown_menu); [4]: ! Format Pulldown return (eve$$x_format_pulldown_menu); [5]: ! Search Pulldown return (eve$$x_search_pulldown_menu); [6]: ! Display Pulldown return (eve$$x_display_pulldown_menu); [7]: ! Customize Pulldown return (eve$$x_custom_pulldown_menu); endcase; endprocedure; ! eve$$get_menu_array ! EVE$MENUS.TPU Page 48 procedure eve$$widget_extmenu_list_popups ! callback for menu extension service local which_menu, ! The popup menu from eve$$x_popup_menus temp_array, ! Scratch array for setting list box values function_array, ! Scratch array for setting list box values menu_entry_array, ! Scratch array for setting list box values the_widget_id, ! Temp for holding widget id the_menu, ! The popup menu selected in the list box temp_index, ! Index into menu entry array temp, status; ! get menu label that was selected temp := "EXTEND_MENU_DIALOG.EXTEND_SUBFORM2." + "EXTEND_MENU_LIST_POPUPSSW.EXTEND_MENU_LIST_POPUPS"; if not eve$$get_selected_item (temp, the_menu) then return (FALSE); endif; eve$$get_menu_index (the_menu, temp_index); temp_array := eve$$get_menu_array (temp_index); menu_entry_array := temp_array {eve$x_resource_array {eve$k_nitems_count}}; ! change the contents of extmenu_list_contents list box temp := "EXTEND_MENU_DIALOG.EXTEND_SUBFORM3." + "EXTEND_MENU_LIST_CONTENTSSW.EXTEND_MENU_LIST_CONTENTS"; eve$$set_list_box (menu_entry_array, temp); endprocedure; ! eve$$widget_extmenu_list_popups ! EVE$MENUS.TPU Page 49 procedure eve$$find_command_index ! get index of cmd in available commands (the_command; ! the command selected - really LABEL delete_command_flag) ! flag whether to delete command entry ! ABSTRACT: This procedure gets the index of a command in the command array ! (eve$$x_eve_commands) or the label array (eve$$x_eve_command_label) ! so we can get the corresponding label to the command. ! The optional parameter is used as a flag and indicates whether to ! delete the command from the eve$$x_eve_commands array. local the_index, ! current index into eve$$x_eve_commands last_index, ! last index in eve$$x_eve_commands which_command; ! current command in eve$$x_eve_commands ! Find index into eve$$x_eve_commands and eve$$x_eve_command_label the_index := get_info (eve$$x_eve_commands, "first"); loop ! loop thru both arrays at once which_command := eve$$x_eve_commands {the_index}; if (which_command = the_command) or (eve$$x_eve_command_label {the_index} = the_command) then if delete_command_flag = TRUE then eve$$x_eve_commands {the_index} := tpu$k_unspecified; eve$$x_eve_command_label {the_index} := tpu$k_unspecified; endif; return (the_index); endif; the_index := get_info (eve$$x_eve_commands, "next"); endloop; endprocedure; ! eve$$find_command_index ! EVE$MENUS.TPU Page 50 procedure eve$$get_command ! get a command from available commands (the_index) ! index into eve$$x_eve_commands array return (eve$$x_eve_commands {the_index}); endprocedure; ! eve$$get_command ! EVE$MENUS.TPU Page 51 procedure eve$$widget_extmenu_list_commands ! Select an available entry ! Process Single selection callback, put selection into command and label ! text widgets local the_widget_id, ! Id of the command list box the_index, ! Index into temp array the_label, ! The command selected - actually the label the_command, ! The command which_entry_label, ! Menu entry label temp; ! get the menu label selected temp := "EXTEND_MENU_DIALOG.EXTEND_SUBFORM1." + "EXTEND_MENU_LIST_COMMANDSSW.EXTEND_MENU_LIST_COMMANDS"; if not eve$$get_selected_item (temp, the_label) then return (FALSE); endif; ! find the index into eve$$x_eve_commands the_index := eve$$find_command_index (the_label); ! now get the corresponding command associated with the menu label the_command := eve$$get_command (the_index); ! set the widgets the_widget_id := get_info (WIDGET, "widget_id", eve$x_extend_menu_dialog, "EXTEND_MENU_DIALOG.EXTEND_MENU_COMMAND_TEXT"); set (WIDGET, the_widget_id, eve$x_resource_array {eve$k_nvalue}, the_command); the_widget_id := get_info (WIDGET, "widget_id", eve$x_extend_menu_dialog, "EXTEND_MENU_DIALOG.EXTEND_MENU_LABEL_TEXT"); set (WIDGET, the_widget_id, eve$x_resource_array {eve$k_nvalue}, the_label); endprocedure; ! eve$$widget_extmenu_list_commands ! EVE$MENUS.TPU Page 52 procedure eve$$widget_extmenu_enter ! callback menu extension service local status, temp, the_widget_id, ! Id of text widget eve_command, ! EVE command specified in text widget upper_label, ! Menu entry label upper-cased command_label; ! Menu entry label specified in text widget ! get the EVE command eve_command := get_info (get_info (WIDGET, "widget_id", eve$x_extend_menu_dialog, "EXTEND_MENU_DIALOG.EXTEND_MENU_COMMAND_TEXT" ), "text"); ! get the label the_widget_id := get_info (WIDGET, "widget_id", eve$x_extend_menu_dialog, "EXTEND_MENU_DIALOG.EXTEND_MENU_LABEL_TEXT"); command_label := get_info (the_widget_id, "text"); edit (eve_command, COMPRESS, TRIM); if (eve_command = " ") or (eve_command = "") then ! no command, get out eve$message (EVE$_NOEVECMD); eve$learn_abort; return (FALSE); endif; edit (command_label, COMPRESS, TRIM); if (command_label = " ") or (command_label = "") ! no label but command then command_label := eve_command; ! command is label set (WIDGET, the_widget_id, eve$x_resource_array {eve$k_nvalue}, command_label); endif; upper_label := command_label; change_case (upper_label, UPPER); if eve$$x_eve_command_label {upper_label} = tpu$k_unspecified then eve$$x_eve_command_label {upper_label} := command_label; eve$$x_eve_commands {upper_label} := eve_command; else ! it already exists in Available Entries listbox command_label := eve$$x_eve_command_label {upper_label}; ! hi-lite endif; ! Put entry into Available Entries list box in exact case as entered, but ! compressed and trimmed. Adding to menu caps the entry. temp := "EXTEND_MENU_DIALOG.EXTEND_SUBFORM1." + "EXTEND_MENU_LIST_COMMANDSSW.EXTEND_MENU_LIST_COMMANDS"; eve$$set_list_box (eve$$x_eve_command_label, temp, command_label); endprocedure; ! eve$$widget_extmenu_enter ! EVE$MENUS.TPU Page 53 procedure eve$$set_list_box ! set the contents of a list box (the_array, ! array to put into the list box the_listbox_name; ! name of the list box the_label) ! optional name of label to highlight local temp_array, last_index, function_array; ! Update the contents of the list box function_array := create_array; if the_label <> 0 ! label is specified then temp_array := create_array; ! selected item must be string table temp_array {0} := the_label; function_array {eve$x_resource_array {eve$k_nselected_items_count}} := temp_array; else ! don't want anything selected function_array {eve$x_resource_array {eve$k_nselected_count}} := 0; endif; function_array {eve$x_resource_array {eve$k_nitems_count}} := the_array; set (WIDGET, get_info (WIDGET, "widget_id", eve$x_extend_menu_dialog, the_listbox_name), function_array); endprocedure; ! eve$$set_list_box ! EVE$MENUS.TPU Page 54 procedure eve$$widget_extmenu_delete ! callback menu extension service local the_index, ! Index into temp array the_command, ! The command selected temp; ! get label of menu item selected to be deleted temp := "EXTEND_MENU_DIALOG.EXTEND_SUBFORM1." + "EXTEND_MENU_LIST_COMMANDSSW.EXTEND_MENU_LIST_COMMANDS"; if not eve$$get_selected_item (temp, the_command) then return (FALSE); endif; ! find the index into eve$$x_eve_command_label and delete from both arrays the_index := eve$$find_command_index (the_command, 1); ! update the contents of the list box eve$$set_list_box (eve$$x_eve_command_label, temp); ! set the command and label text widgets to empty (actually a space) set (WIDGET, get_info (WIDGET, "widget_id", eve$x_extend_menu_dialog, "EXTEND_MENU_DIALOG.EXTEND_MENU_COMMAND_TEXT"), eve$x_resource_array {eve$k_nvalue}, " "); set (WIDGET, get_info (WIDGET, "widget_id", eve$x_extend_menu_dialog, "EXTEND_MENU_DIALOG.EXTEND_MENU_LABEL_TEXT"), eve$x_resource_array {eve$k_nvalue}, " "); endprocedure; ! eve$$widget_extmenu_delete ! EVE$MENUS.TPU Page 55 procedure eve$$widget_extmenu_add ! callback menu extension service local selected_label, ! the command (label) selected upper_label, ! Selected label upper-cased eve_command, ! the command parsed into eve_ format the_command, ! the command selected the_menu, ! the menu selected the_label, ! the corresponding label to the command selected the_message, ! error message status, parsed_label, ! Label into facility topic legend separator_value,! boolean indicating value of separator toggle sep, ! "Y" or "N" depending of value of separator_value the_index, ! index into list of menus menu_array, ! array containing menu entries menu_entry_array, ! menu entries of selected menu temp; ! get command that was selected from eve command list box temp := "EXTEND_MENU_DIALOG.EXTEND_SUBFORM1." + "EXTEND_MENU_LIST_COMMANDSSW.EXTEND_MENU_LIST_COMMANDS"; if not eve$$get_selected_item (temp, selected_label) then return (FALSE); endif; ! get the corresponding label upper_label := selected_label; change_case (upper_label, UPPER); the_label := eve$$x_eve_command_label {upper_label}; the_command := eve$$x_eve_commands {upper_label}; ! get the menu selected from the popup list box so know which menu to add to temp := "EXTEND_MENU_DIALOG.EXTEND_SUBFORM2." + "EXTEND_MENU_LIST_POPUPSSW.EXTEND_MENU_LIST_POPUPS"; if not eve$$get_selected_item (temp, the_menu) then return (FALSE); endif; ! get the value of the separator toggle status := get_info (get_info (WIDGET, "widget_id", eve$x_extend_menu_dialog, "EXTEND_MENU_DIALOG.EXTEND_MENU_SEPARATOR"), "widget_info", eve$x_resource_array {eve$k_nset}, separator_value); eve$$get_menu_index (the_menu, the_index); menu_array := eve$$get_menu_array (the_index); ! get the menu array if separator_value then sep := eve$x_yes; else sep := eve$x_no; endif; eve$$x_state_array {eve$$k_help_active} := 1; ! prevent choices display eve_command := eve$$parse (the_command); ! have to parse command eve$$x_state_array {eve$$k_help_active} := 0; if eve_command = "" then if eve$$x_state_array {eve$$k_ambiguous_parse} then ! ambiguous command the_message := message_text (EVE$_AMBCMD, 1, the_command); eve$$x_state_array {eve$$k_ambiguous_parse} := FALSE; else ! illegal command the_message := message_text (EVE$_DONTUNDERCMD, 1, the_command); endif; ! make user acknowledge the error eve$popup_message (the_message); eve$learn_abort; return (FALSE); endif; case the_index [0]: the_menu := "select"; [1]: the_menu := "noselect"; [2]: the_menu := "file"; [3]: the_menu := "edit"; [4]: the_menu := "format"; [5]: the_menu := "search"; [6]: the_menu := "view"; [7]: the_menu := "option"; endcase; ! Make facility, topic and legend out of the label parsed_label := "EVE " + the_label + " (" + the_label + ")"; if eve$define_user_menu_entry (the_menu, parsed_label, eve_command, sep) then ! add the new command label to the specific menu menu_entry_array := menu_array {eve$x_resource_array {eve$k_nitems_count}}; temp := "EXTEND_MENU_DIALOG.EXTEND_SUBFORM3." + "EXTEND_MENU_LIST_CONTENTSSW.EXTEND_MENU_LIST_CONTENTS"; eve$$set_list_box (menu_entry_array, temp, the_label); endif; endprocedure; ! eve$$widget_extmenu_add ! EVE$MENUS.TPU Page 56 procedure eve$$widget_extmenu_remove ! callback menu extension service local the_command, ! the command label that is selected to be removed the_menu, ! the menu selected to have entry deleted from the_index, ! the index into the array of menus menu_array, ! the menu menu_entry_array, ! the array of menu entries temp, temp1; ! get command (label) that was selected from menu_entry list box temp := "EXTEND_MENU_DIALOG.EXTEND_SUBFORM3." + "EXTEND_MENU_LIST_CONTENTSSW.EXTEND_MENU_LIST_CONTENTS"; if not eve$$get_selected_item (temp,the_command) then return (FALSE); endif; ! get the menu selected from the menu list box so know which menu to delete from temp := "EXTEND_MENU_DIALOG.EXTEND_SUBFORM2." + "EXTEND_MENU_LIST_POPUPSSW.EXTEND_MENU_LIST_POPUPS"; if not eve$$get_selected_item (temp1, the_menu) then return (FALSE); endif; eve$$get_menu_index (the_menu, the_index); menu_array := eve$$get_menu_array (the_index); ! get the menu array case the_index [0]: eve$undefine_menu_entry ("select", the_command); [1]: eve$undefine_menu_entry ("noselect", the_command); [2]: eve$undefine_menu_entry ("file", the_command); [3]: eve$undefine_menu_entry ("edit", the_command); [4]: eve$undefine_menu_entry ("format", the_command); [5]: eve$undefine_menu_entry ("search", the_command); [6]: eve$undefine_menu_entry ("view", the_command); [7]: eve$undefine_menu_entry ("option", the_command); endcase; ! Remove command from listbox containing entries in selected menu menu_entry_array := menu_array {eve$x_resource_array {eve$k_nitems_count}}; eve$$set_list_box (menu_entry_array, temp); endprocedure; ! eve$$widget_extmenu_remove ! EVE$MENUS.TPU Page 57 procedure eve$undefine_menu_entry ! guts of undefine a menu entry (the_menu, ! the menu name to delete menu entry from the_label) ! the label of the menu entry to delete local parent_widget, ! Parent widget of menu entry to delete num_children, ! Number of menu entries (children) of parent widget temp_label, ! Label of current menu entry (child) edited_label, ! Edited version of temp_label label_string, ! Local copy of the_label (input) capitalized menu_string, ! Holds popup menu variable loop_index, ! Loop indexing variable widget_to_delete, ! Widget to be deleted from popup the_menu_array, ! Select or Noselect menu entry array status, ! Dummy variable for get_info's the_index, ! Index into menu entry arrays menu_array, ! Temp array for menu entries which_menu, ! The menu (Select or NoSelect) to undefine entry from ct, ! Count for keeping track of separator number upper_separator_label, separator_flag, ! Boolean true if deleting a separator temp_array; ! Temp array for holding children of parent widget on_error [TPU$_CONTROLC]: eve$learn_abort; abort; [TPU$_NONAMES]: ! needed for when try to get label of separator [OTHERWISE]: endon_error; ! initialize the menu arrays if they have not been already if get_info (eve$$x_popup_menus, "type") <> ARRAY then if not eve$init_menu_arrays then return (FALSE); endif; endif; if not eve$$get_menu_index (the_menu, the_index) then eve$message (EVE$_NOMENU, 0, the_menu); eve$learn_abort; return (FALSE); endif; the_menu_array := eve$$get_menu_array (the_index); ! get the menu array parent_widget := eve$$get_parent_widget (the_index); ! get the widget ! initialize temp_array := 0; widget_to_delete := 0; temp_label := ""; edited_label := ""; ! get children of menu widget num_children := get_info (WIDGET, "children", parent_widget, temp_array); ct := 1; separator_flag := FALSE; upper_separator_label := eve$$x_separator_label; edit (upper_separator_label, COMPRESS, UPPER); if num_children > 0 then label_string := eve$$edit (the_label); loop_index := 1; loop exitif loop_index > num_children; status := get_info (temp_array {loop_index}, "widget_info", eve$x_resource_array {eve$k_nlabel}, temp_label); if temp_label <> "" ! not a separator widget then edited_label := eve$$edit (temp_label); if (edited_label = label_string) then widget_to_delete := temp_array {loop_index}; exitif; endif; edited_label := ""; temp_label := ""; else if label_string = upper_separator_label + str (ct) then widget_to_delete := temp_array {loop_index}; separator_flag := TRUE; exitif; else ct := ct + 1; endif; endif; loop_index := loop_index + 1; endloop; else eve$message (EVE$_NOMOREENT); return (FALSE); endif; if widget_to_delete <> 0 then delete (widget_to_delete); widget_to_delete := 0; eve$$delete_menu_array_entry (the_label, the_menu_array); if separator_flag then eve$$renum_separators (ct, the_menu_array); ct := eve$$update_separator_count (the_menu, TRUE); endif; eve$message (EVE$_ENTRYUNDEF, 0, the_label); eve$define_attr ("eve$menu_entry " + (substr ('0000', 1, 4 - length (str (eve$$x_save_menu_count))) + str (eve$$x_save_menu_count)), "eve$undefine_menu_entry ('" + the_menu + "','" + the_label + "');", message_text (EVE$_ENTRYUNDEF, 0, the_label)); eve$$x_save_menu_count := eve$$x_save_menu_count + 1; else eve$message (EVE$_NOENTRY, 0, the_label); endif; endprocedure; ! eve$undefine_menu_entry ! EVE$MENUS.TPU Page 58 procedure eve$$edit ! edit label - compress and strip trailing ... (the_label) ! label to be edited ! ABSTRACT: This procedure compresses and uppercases a label and strips it of ! any "..." at the end. It also strips any "->". local new_label, the_index; ! index of trailing ... new_label := the_label; edit (new_label, COMPRESS, UPPER); the_index := index (new_label, "..."); if the_index = 0 then the_index := index (new_label, " ->"); ! UIL file MUST have a space endif; ! " " + "-" + ">" if the_index <> 0 then return (substr (new_label, 1, length (new_label) - 3)); else return (new_label); endif; endprocedure; ! eve$$edit ! EVE$MENUS.TPU Page 59 procedure eve$$update_separator_count ! Update separator ct (the_menu, delete_flag) local menu_name, sep_index; eve$$get_menu_index (the_menu, sep_index, menu_name); if delete_flag then eve$$x_menu_separator_count {menu_name} := eve$$x_menu_separator_count {menu_name} - 1; else eve$$x_menu_separator_count {menu_name} := eve$$x_menu_separator_count {menu_name} + 1; endif; return (eve$$x_menu_separator_count {menu_name}); endprocedure; ! eve$$update_separator_count ! EVE$MENUS.TPU Page 60 procedure eve$$renum_separators ! renumber the separator widgets (the_sep_deleted, ! number of the separator deleted the_menu_array) ! the array of menu entries to update local last_index, ! last menu entry in menu temp_index, ! current menu entry in menu count, ! number of separators entry_array; ! array of menu entries entry_array := the_menu_array {eve$x_resource_array {eve$k_nitems_count}}; last_index := get_info (entry_array, "last"); temp_index := get_info (entry_array, "first"); ! first element not always 0 count := 1; loop ! leave seps before one deleted alone exitif count >= the_sep_deleted; if entry_array {temp_index} = eve$$x_separator_label + str (count) then count := count + 1; endif; temp_index := temp_index + 1; exitif temp_index > last_index; endloop; loop exitif temp_index > last_index; if entry_array {temp_index} = eve$$x_separator_label + str (count + 1) then entry_array {temp_index} := eve$$x_separator_label + str (count); count := count + 1; endif; temp_index := temp_index + 1; endloop; endprocedure; ! eve$$renum_separators ! EVE$MENUS.TPU Page 61 procedure eve$$get_parent_widget ! Get the parent widget id of a menu (the_index) ! The shell widget parent is the first pulldown in menu bar, popup_FILE_MENU case the_index [0]: return (eve$x_select_popup); [1]: return (eve$x_no_select_popup); [2]: return (get_info (WIDGET, "widget_id", eve$x_menu_bar, "EVE_MENU_BAR.popup_FILE_MENU.FILE_MENU")); [3]: return (get_info (WIDGET, "widget_id", eve$x_menu_bar, "EVE_MENU_BAR.popup_FILE_MENU.EDIT_MENU")); [4]: return (get_info (WIDGET, "widget_id", eve$x_menu_bar, "EVE_MENU_BAR.popup_FILE_MENU.FORMAT_MENU" )); [5]: return (get_info (WIDGET, "widget_id", eve$x_menu_bar, "EVE_MENU_BAR.popup_FILE_MENU.SEARCH_MENU" )); [6]: return (get_info (WIDGET, "widget_id", eve$x_menu_bar, "EVE_MENU_BAR.popup_FILE_MENU.DISPLAY_MENU" )); [7]: return (get_info (WIDGET, "widget_id", eve$x_menu_bar, "EVE_MENU_BAR.popup_FILE_MENU.CUSTOMIZE_MENU" )); endcase; endprocedure; ! eve$$get_parent_widget ! EVE$MENUS.TPU Page 62 procedure eve$$delete_menu_array_entry ! delete menu entry from popup (the_command, ! The label (command) to delete the_menu) ! The popup menu to delete entry from local last_index, ! last index in array of menu entries the_index, ! current index in array of menu entries found, ! boolean flag - true if found the_command command_string, ! local copy of the_command which_command, ! current command we are comparing to the_command menu_entry_array; ! The array of menu entries menu_entry_array := the_menu {eve$x_resource_array {eve$k_nitems_count}}; command_string := the_command; change_case (command_string, LOWER); last_index := get_info (menu_entry_array, "last"); the_index := get_info (menu_entry_array, "first"); found := FALSE; loop which_command := menu_entry_array {the_index}; if which_command <> tpu$k_unspecified then change_case (which_command, LOWER); endif; if which_command = command_string then menu_entry_array {the_index} := tpu$k_unspecified; found := TRUE; endif; exitif found; exitif the_index = last_index; the_index := get_info (menu_entry_array, "next"); endloop; if not found then eve$message (EVE$_NOENTRY, 0, the_command); return (FALSE); endif; return (TRUE); endprocedure; ! eve$$delete_menu_array_entry ! EVE$MENUS.TPU Page 63 procedure eve_define_menu_entry ! Add a menu entry to EVE menu (the_menu, ! string containing the name of the popup the_eve_command, ! the EVE command to bind the menu entry to the_label; ! the label that appears on the menu entry the_separator); ! 'yes' or 'no' to add separator widget before entry ! ABSTRACT: This is the command procedure to implement adding a new menu entry ! to an EVE popup menu bound to MB2 or to a pulldown menu off the EVE menu bar. ! New menu entries can currently only be added to the bottom of a menu. ! All parameters must be contained in QUOTES. ! ! Examples: DEFINE MENU ENTRY "SELECT POPUP" "REPLACE" "SEARCH AND REPLACE" ! DEFINE MENU ENTRY "FILE" "CUT" "CLIP" "Y" local menu_string, ! Local copy of the menu name label_string, ! Local copy of the label string eve_command, ! Command string in EVE_ form command_string; ! Local copy of the command to bind entry to on_error [TPU$_CONTROLC]: eve$learn_abort; abort; [OTHERWISE]: endon_error; if not eve$x_decwindows_active ! kickout if DECwindows is not active then eve$message (TPU$_REQUIRESDECW, 0); eve$learn_abort; return (FALSE); endif; if not eve$prompt_string (the_menu, menu_string, message_text (EVE$_MENUPROMPT, 1), message_text (EVE$_NOENTRYDEF, 0)) then eve$learn_abort; return (FALSE); endif; if not (eve$prompt_string (the_eve_command, command_string, message_text (EVE$_EVECMDPROMPT, 1), message_text (EVE$_NOENTRYDEF, 0))) then eve$learn_abort; return (FALSE); endif; label_string := the_label; if label_string = "" then ! use command if label not specified label_string := command_string; endif; eve_command := eve$$parse (command_string); if eve_command = "" then ! ambiguous or bogus command eve$learn_abort; return (FALSE); endif; if eve$insist_y_n (message_text (EVE$_SEPARATORPROMPT, 1), the_separator, 1) then if eve$define_user_menu_entry (menu_string, label_string, eve_command, eve$x_yes) then return (TRUE); endif; else if eve$define_user_menu_entry (menu_string, label_string, eve_command) then return (TRUE); endif; endif; return (FALSE); endprocedure; ! eve_define_menu_entry ! EVE$MENUS.TPU Page 64 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!! This procedure is being superseded by EVE$DEFINE_USER_MENU_ENTRY. !!!!!! !!!! This procedure should no longer be used. !!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! procedure eve$define_menu_entry ! Guts of define menu entry (the_menu, ! the name of the menu to add entry to the_callback, ! the name of the callback routine to execute the_label, ! menu entry label: [facility] topic [(legend)], ! topic may have underscores or spaces the_closure; ! closure integer value the_separator); ! 'yes' or 'no' to add separator widget before entry local new_widget, ! New widget created widget_name, ! Name of the widget the_menu_array, ! Name of popup menu entry array - select or noselect the_index, ! Index in menu entry array menu_array, ! Array of menu entries which_menu, ! Which menu was specified - select or noselect local_separator,! Local copy of the_separator local_closure, ! Local copy of the_closure do_separator, ! Boolean - TRUE if separator was specified eve_command, ! The parsed command bound to new widget an_index, ! Index into array the_facility, ! Facility parsed off the_label the_topic, ! Topic parsed off the_label the_legend, ! Legend parsed off the_label the_message, ! For parser error parent_widget; ! Widget id of the eve menu (this is the parent widget) on_error [TPU$_CONTROLC]: eve$learn_abort; abort; [OTHERWISE]: endon_error; ! initialize the menu arrays if they have not been already if get_info (eve$$x_popup_menus, "type") <> ARRAY then if not eve$init_menu_arrays then return (FALSE); endif; endif; if not eve$$get_menu_index (the_menu, the_index) then eve$message (EVE$_NOMENU, 0, the_menu); eve$learn_abort; return (FALSE); endif; the_menu_array := eve$$get_menu_array (the_index); ! get the menu array parent_widget := eve$$get_parent_widget (the_index); ! get the parent widget ! parse the label eve$$parse_comment (the_label, "", the_facility, the_legend, the_topic); translate (the_topic, " ", "_"); ! get rid of "_" ! check to make sure menu entry is not already in menu if eve$$is_entry_defined (the_menu_array, the_legend) then eve$message (EVE$_ENTRYALDEF, 0, the_legend); eve$learn_abort; return (FALSE); endif; if get_info (the_closure, "type") <> INTEGER then eve$message (EVE$_BADCLOSURE); eve$learn_abort; return (FALSE); endif; local_closure := str (the_closure); ! for passing ! Problem: get the parsed command to bind to the widget callback. ! First try finding the label in the list of available labels, and parse ! the corresponding command. If that fails, then just parse the label ! (even tho it may be just garbage). an_index := get_info (eve$$x_eve_command_label, "last"); loop exitif an_index = tpu$k_unspecified; eve_command := eve$$x_eve_command_label {an_index}; change_case (eve_command, LOWER); if eve_command = the_topic ! no underscores then eve_command := eve$$x_eve_commands {an_index}; eve$$x_state_array {eve$$k_help_active} := 1; ! prevent choices eve_command := eve$$parse (eve_command); eve$$x_state_array {eve$$k_help_active} := 0; if eve_command = "" then ! ambiguous or bogus command eve$learn_abort; return (FALSE); endif; exitif; endif; an_index := get_info (eve$$x_eve_command_label, "previous"); endloop; if an_index = tpu$k_unspecified then eve$$x_state_array {eve$$k_help_active} := 1; ! prevent choices eve_command := eve$$parse (the_topic); eve$$x_state_array {eve$$k_help_active} := 0; if eve_command = "" then if eve$$x_state_array {eve$$k_ambiguous_parse} then ! ambiguous command if eve$$x_state_array {eve$$k_command_line_flag} = eve$k_invoked_by_menu then the_message := message_text (EVE$_AMBCMD, 1, the_topic); else the_message := ""; endif; eve$$x_state_array {eve$$k_ambiguous_parse} := FALSE; else ! illegal command the_message := message_text (EVE$_DONTUNDERCMD, 1, the_topic); endif; if eve$$x_state_array {eve$$k_command_line_flag} = eve$k_invoked_by_menu then ! make user acknowledge the error eve$popup_message (the_message); else if the_message <> "" then eve$message (the_message, eve$k_error); endif; endif; eve$learn_abort; return (FALSE); endif; endif; ! conditionally define the pushbutton widget class if get_info (eve$kt_pushbutton_class, 'type') <> INTEGER then eve$kt_pushbutton_class := define_widget_class (eve$kt_pushbuttonwidgetclass, "dwt$push_button_create"); endif; ! Create the widgets do_separator := 0; if the_separator <> tpu$k_unspecified then local_separator := the_separator; edit (local_separator, COMPRESS, LOWER, TRIM); if local_separator = substr (eve$x_yes, 1, length (local_separator)) then do_separator := 1; if get_info (eve$kt_separator_class, 'type') <> INTEGER then eve$kt_separator_class := define_widget_class (eve$kt_separatorwidgetclass, "dwt$separator_create"); endif; new_widget := create_widget (eve$kt_separator_class, "", parent_widget); manage_widget (new_widget); endif; endif; new_widget := create_widget (eve$kt_pushbutton_class, the_legend, parent_widget, the_callback, the_closure, eve$kt_nactivate_callback, 0, eve$kt_nhelp_callback, 0, eve$x_resource_array {eve$k_nlabel}, the_legend); manage_widget (new_widget); ! need to manage the widget ! Put new_widget into the widget dispatch arrays. eve$define_widget (eve_command, the_closure, substr (eve_command, 5)); ! update the arrays eve$$add_menu_array (the_legend, the_menu_array, do_separator, the_menu); eve$message (EVE$_ENTRYDEF, 0, the_legend); ! Define attribute to recreate the menu entry. Specify all parameters, e.g.: ! eve$define_user_menu_entry('display','Foo bar','eve_foo_bar','yes',111, ! 'eve$callback_dispatch'); eve$capitalize_string (the_topic); ! caps only 1st word if do_separator then do_separator := "','" + eve$x_yes + "'"; else do_separator := "',"; endif; eve$define_attr ("eve$menu_entry " + (substr ('0000', 1, 4 - length (str (eve$$x_save_menu_count))) + str (eve$$x_save_menu_count)), "eve$define_user_menu_entry('" + the_menu + "','" + the_topic + "','" + eve_command + do_separator + "," + local_closure + ",'" + the_callback + "');", message_text (EVE$_ENTRYDEF, 0, the_topic)); eve$$x_save_menu_count := eve$$x_save_menu_count + 1; return (TRUE); endprocedure; ! eve$define_menu_entry ! EVE$MENUS.TPU Page 65 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!! This procedure replaces EVE$DEFINE_MENU_ENTRY !!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! procedure eve$define_user_menu_entry ! Guts of define menu entry (the_menu, ! the name of the menu to add entry to the_label, ! the label of the menu entry the_program; ! the parsed (name of) code source to execute, e.g., ! "eve_change_direction" the_separator, ! "yes" or "no" (def) to add separator widget the_closure, ! closure value (default = use eve$x_user_widget_base ! and then increment it by one), type INTEGER only the_callback) ! callback routine name (def = eve$kt_callback_routine) local new_widget, ! New widget created widget_name, ! Name of the widget the_menu_array, ! Name of popup menu entry array - select or noselect the_index, ! Index in menu entry array menu_array, ! Array of menu entries which_menu, ! Which menu was specified - select or noselect local_callback, ! Local copy of the_callback local_separator,! Local copy of the_separator local_closure, ! Local of the_closure, default=eve$x_user_widget_base do_separator, ! Boolean - TRUE if separator was specified the_facility, ! Facility parsed off the_label the_topic, ! Topic parsed off the_label the_legend, ! Legend parsed off the_label parent_widget; ! Widget id of the eve menu (this is the parent widget) on_error [TPU$_CONTROLC]: eve$learn_abort; abort; [OTHERWISE]: endon_error; ! initialize the menu arrays if they have not been already if get_info (eve$$x_popup_menus, "type") <> ARRAY then if not eve$init_menu_arrays then return (FALSE); endif; endif; if not eve$$get_menu_index (the_menu, the_index) then eve$message (EVE$_NOMENU, 0, the_menu); eve$learn_abort; return (FALSE); endif; the_menu_array := eve$$get_menu_array (the_index); ! get the menu array parent_widget := eve$$get_parent_widget (the_index); ! get the parent widget ! parse the label eve$$parse_comment (the_label, "", the_facility, the_legend, the_topic); eve$capitalize_string (the_topic); ! Caps only 1st word ! check to make sure menu entry is not already in menu if eve$$is_entry_defined (the_menu_array, the_legend) then eve$message (EVE$_ENTRYALDEF, 0, the_legend); eve$learn_abort; return (FALSE); endif; ! EVE's callback dispatcher works only with closure values of type INTEGER. ! (closure is the tag identifying the calling widget, see EVE$CONSTANTS.SDL) if the_closure = tpu$k_unspecified then local_closure := eve$x_user_widget_base; eve$x_user_widget_base := eve$x_user_widget_base + 1; else ! insure it's an integer if get_info (the_closure, "type") <> INTEGER then eve$message (EVE$_BADCLOSURE); eve$learn_abort; return (FALSE); endif; local_closure := the_closure; endif; if the_callback = tpu$k_unspecified then local_callback := eve$kt_callback_routine else local_callback := the_callback; endif; ! conditionally define the pushbutton widget class if get_info (eve$kt_pushbutton_class, 'type') <> INTEGER then eve$kt_pushbutton_class := define_widget_class (eve$kt_pushbuttonwidgetclass, "XmCreatePushButton"); endif; ! Create the widgets do_separator := 0; if the_separator <> tpu$k_unspecified then local_separator := the_separator; edit (local_separator, COMPRESS, LOWER, TRIM); if local_separator = substr (eve$x_yes, 1, length (local_separator)) then do_separator := 1; if get_info (eve$kt_separator_class, 'type') <> INTEGER then eve$kt_separator_class := define_widget_class (eve$kt_separatorwidgetclass, "XmCreateSeparatorGadget"); endif; new_widget := create_widget (eve$kt_separator_class, "", parent_widget); manage_widget (new_widget); endif; endif; new_widget := create_widget (eve$kt_pushbutton_class, the_legend, parent_widget, local_callback, local_closure, eve$kt_nactivate_callback, 0, eve$kt_nhelp_callback, 0, eve$x_resource_array {eve$k_nlabel}, the_legend); manage_widget (new_widget); ! need to manage the widget ! put new_widget into the widget dispatch arrays eve$define_widget (the_program, local_closure, substr (the_program, 5)); ! update the arrays eve$$add_menu_array (the_legend, the_menu_array, do_separator, the_menu); eve$message (EVE$_ENTRYDEF, 0, the_legend); ! Define attribute to recreate the call to this procedure, leaving ! unspecified parameters as unspecified. if the_closure = tpu$k_unspecified then local_closure := ""; else local_closure := str (local_closure); endif; if the_callback = tpu$k_unspecified then local_callback := ""; else local_callback := "'" + local_callback + "'"; endif; if do_separator then do_separator := "','" + eve$x_yes + "'"; else do_separator := "',"; endif; eve$define_attr ("eve$menu_entry " + (substr ('0000', 1, 4 - length (str (eve$$x_save_menu_count))) + str (eve$$x_save_menu_count)), "eve$define_user_menu_entry('" + the_menu + "','" + the_topic + "','" + the_program + do_separator + "," + local_closure + "," + local_callback + ");", message_text (EVE$_ENTRYDEF, 0, the_topic)); eve$$x_save_menu_count := eve$$x_save_menu_count + 1; return (TRUE); endprocedure; ! eve$define_user_menu_entry ! EVE$MENUS.TPU Page 66 procedure eve$$is_entry_defined ! Check if entry is already in menu (the_array, ! the array of menu entries the_label) ! the label of the menu entry ! ABSTRACT: This procedure checks to see whether the menu entry is already in ! the menu or not. It returns TRUE if the menu entry is already defined or ! FALSE if it is not. local the_index, ! current index into menu entry array last_index, ! last index into the menu entry array lower_element, ! lower-cased menu label lower_label, ! local copy of the_label lower-cased for comparison temp_array; ! array of menu entries lower_label := the_label; edit (lower_label, COMPRESS, LOWER); ! lowercase for comparison temp_array := the_array {eve$x_resource_array {eve$k_nitems_count}}; last_index := get_info (temp_array, "last"); the_index := get_info (temp_array, "first"); loop lower_element := temp_array {the_index}; edit (lower_element, COMPRESS, LOWER); ! lowercase for comparison if lower_element = lower_label then return (TRUE); endif; exitif (the_index = last_index); the_index := get_info (temp_array, "next"); endloop; return (FALSE); ! Menu entry has not been defined endprocedure; ! eve$$is_entry_defined ! EVE$MENUS.TPU Page 67 procedure eve$$add_menu_array ! Add menu entry to menu array (the_label, ! Label of the menu entry to add the_array, ! Array of menu entries to add the_label to the_separator, ! Boolean to add a separator widget (or not) the_menu) ! ABSTRACT: This procedure adds an entry to a menu array. If a separator widget ! was specified a separator is added to the array as well. local last_index, ! Last index in the menu entry array num, ! Number to add to separator widget label menu_array; ! The array of menu entries menu_array := the_array {eve$x_resource_array {eve$k_nitems_count}}; last_index := get_info (menu_array, "last") + 1; if the_separator then num := eve$$update_separator_count (the_menu, FALSE); menu_array {last_index} := eve$$x_separator_label + str (num); last_index := last_index + 1; endif; menu_array {last_index} := the_label; endprocedure; ! eve$$add_menu_array ! EVE$MENUS.TPU Page 68 procedure eve_undefine_menu_entry ! Delete a menu entry from a menu (the_menu, ! string containing name of menu the_label) ! string containing entry label to delete ! ABSTRACT: This is the command procedure to implement deleting a menu entry. ! ! Both of these parameters are required and must be in quotes if > 1 word. ! If give three args without quotes, like x y z, then the menu will be "x" ! and the label "y z". ! ! Can not delete entry from a submenu - can only delete the entire submenu ! local label_string, ! Local copy of the_label (input) the_index, ! Index into menu array - check if valid menu name in menu_string; ! Local copy of the_pulldown_menu (input) on_error [TPU$_CONTROLC]: eve$learn_abort; abort; [OTHERWISE]: endon_error; if not eve$x_decwindows_active ! kickout if DECwindows is not active then eve$message (TPU$_REQUIRESDECW, 0); eve$learn_abort; return (FALSE); endif; if not eve$prompt_string (the_menu, menu_string, message_text (EVE$_MENUPROMPT, 1), message_text (EVE$_NOENTRYUNDEF, 0)) then eve$learn_abort; return (FALSE); endif; if not eve$prompt_string (the_label, label_string, message_text (EVE$_LABELDELPROMPT, 1), message_text (EVE$_NOENTRYUNDEF, 0)) then eve$learn_abort; return (FALSE); endif; return (eve$undefine_menu_entry (menu_string, label_string)); endprocedure; ! eve_undefine_menu_entry ! EVE$MENUS.TPU Page 69 procedure eve$$widget_on_context ! Enter Motif on-context help mode ! Enter On Context context-sensitive help mode. Don't limit cursor to ! our top level widget. set (widget_context_help, get_info (screen, "widget"), 0); endprocedure; ! eve$$widget_on_context ! EVE$MENUS.TPU Page 70 ! ! Module initialization code: ! eve$x_user_widget_base := %x08000000; ! base for user widgets endmodule; ! EVE$MENUS.TPU Page 71 eve$$require ("eve$terminals"); ! Build dependencies eve$$require ("eve$windows"); ! Build dependencies eve$$require ("eve$decwindows"); ! Build dependencies