! LSE$MENUS.TPU
!
! VAX Language-Sensitive Editor
!
!*************************************************************************
!									 *
! © Copyright 2005 Hewlett-Packard Development Company, L.P.		 *
!									 *
! Confidential computer software. Valid license  from  HP  required  for *
! possession, use or copying. Consistent with  FAR  12.211  and  12.212, *
! Commercial Computer Software,  Computer  Software  Documentation,  and *
! Technical  Data  for  Commercial  Items  are  licensed  to  the   U.S. *
! Government under vendor's standard commercial license.		 *
!									 *
!*************************************************************************
!
!++
! FACILITY:
!	VAX Language-Sensitive Editor (VAXLSE)
!
! ABSTRACT:
!	This is the source program for the LSE interface DECwindow menu
!	and widget functions.
!
! ENVIRONMENT:
!	VAX/VMS
!
!Author: Glenn J. Joyce
!
! CREATION DATE: 21-Aug-1988
!
! MODIFIED BY:
!   X2.3-1  GJJ	12-Sep-88   Added LSE$$CMS_PREF_ACTIVATE routine.
!   X2.3-2  CCC 16-Sep-88   Added SEARCH, REPLACE AND SEARCH PREFERENCE.
!   X2.3-3  GJJ	20-Sep-88   Added LSE$$WIDGET_OPEN_FILE_SELECTION routine
!			    to hook GOTO FILE into the OPEN dialog box.
!   X2.3-4  GHL 21-Sep-88   Add procedures that support the "Change
!			    Indentation" dialog box.
!   X2.3-5  CCC 22-Sep-88   Fixed search pref dialog
!   X2.3-6  CCC 23-Sep-88   Remove eve$$widget_find_each_yes...
!   X2.3-7  CCC 26-Sep-88   Add default qualifier "CONFIRM" in
!			    lse$$widget_replace_ok
!   X2.3-8  CCC 27-Sep-88   Add callback routines for "SET INTERFACE" dialog box
!   X2.3-9  CCC 27-Sep-88   Allow replace null string in replace dialog box
!   X2.3-10 GJJ	27-Sep-88   Added LSE$$WIDGET_INCLUDE_FIL, the section file
!			    dispatch routine for LSE's INCLUDE dialog box.
!   X2.3-11 CCC 27-Sep-88   Add pending_delete for SET INTERFACE widget
!   X2.3-12 WCC 16-Sep-88   Added callback routines for
!				define key pull down
!   X2.3-13 CCC 28-Sep-88   Add forward/reverse button for FIND widget
!   X2.3-14 WCC 03-Oct-88   Added callback routines for SAVE FILE AS menu item.
!   X2.3-15 CCC 13-Oct-88   Add lse$$widget_replace_apply, make to unmange
!			    widget first before doing anything in cancel/ok
!   X2.3-16 GJJ	17-Oct-88   Added missing LOCAL declarations for STATUS and
!			    LEARN_VALUE.
!   X2.3-17 DAS 18-Oct-88   Removed eve$dwt$c_crunmap_callback reason codes 
!                           like EVE$MENUS.TPU
!   X2.3-18 CCC	18-Oct-88   Added missing LOCAL declarations for CMD
!   X2.3-19 DAS	20-Oct-88   Added missing LOCAL declarations for learn_value to
!                           routine lse$$widget_define_key_cancel
!   X2.3-20 CCC	24-Oct-88   Added to toggle search pref ULTRIX button
!   X2.3-21 CCC	24-Oct-88   Added to toggle SET INTERFACE EVE button
!   X2.3-22 CCC	01-Nov-88   Remove eve$dwt$c_nsensitive stuff and routines
!   X2.3-23 WCC 04-Nov-88   Rearrange unmanage_widget in lse$$widget_define_key_
!				cancel and lse$$savE_file_as
!   X2.3-24 CCC	07-Nov-88   Add routine lse$$widget_find_each_cancel
!   X2.3-25 CCC	07-Nov-88   Remove deletion of widget FIND_EACH_YES
!   X2.3-26 CCC	09-Nov-88   Restore current screen width when fail to
!			    set screen width in lse$$widget_setint_apply
!   X2.3-27 CCC	07-Dec-88   Add lse$$set_undo_object
!   X2.3-28 CCC	07-Dec-88   Remove resetting screen width when input width
!			    is out of range.(lse$$widget_setint_apply)
!   X2.3-29 WCC 09-Dec-88   Call lse$convert_keyname for defining key.  This
!				prevents some invalid keynames that EVE
!				generates from eve$key_name routine.
!
!   X2.3-30 DAS 21-Dec-88   Changed UNMANAGE_WIDGET to EVE$UNMANAGE_WIDGET.
!			    Changed some CREATE/MANAGE to use EVE's second
!			    parameter to EVE$MANAGE_WIDGET.
!   X2.3-31 WCC 22-Dec-88   Add parameter OFF for EDIT(keyname,UPPER) so that
!				TPU won't issue msg missing quote for a keyname
!				with quote or apostrophes.
!   X2.3-32 CCC	19-Jan-89   Add lse$$set_big_font,little_font,normal_font,...
!   X2.3-33 CCC	19-Jan-89   Add lse$$x_mode_font_width and modify font stuff
!   X2.3-34 DAS 21-Jan-89   Added routine lse$$widget_split_window that first
!			    sets the text field to 2 and then manages.
!   X2.3-35 CCC	23-Jan-89   Improve code in SEARCH and REPLACE, so, it wouldn't
!			    wipe out the previous search string, if input
!			    search string is NULL.
!   X2.3-36 CCC	27-Jan-89   Add window_attributtes dialog box.
!   X2.3-37 CCC	30-Jan-89   Add lse$$set_screen_length
!   X2.3-38 CCC	30-Jan-89   Fix typos and add 1989 copy right
!   X2.3-39 CCC	 3-Feb-89   Add to reset initial value in BELL toggle button
!   X2.3-40 CCC	 9-Feb-89   Rename lse$$set_screen_length to .._height and change
!			    argument to string instead of integer.
!   X2.3-41 CCC	10-Feb-89   Move to set up font variables into those
!			    lse$$set_xxx_font routnes.
!   X2.3-42 CCC	10-Feb-89   Add to delete find_each_dialog each time, so 
!			    it can be created by either SCREEN or FIND_DIALOG.
!   X2.3-43 CCC	13-Feb-89   Change to delete find_each_dialog only when its
!			    parent is SCREEN.
!   X2.3-44 CCC	16-Feb-89   Set window width/height must be done before setting
!			    fonts. ( Otherwise, it will enter infinite loop.)
!   X2.3-45 CCC	17-Feb-89   Add to initialize patten toggle button in REPLACE
!			    dialog box when seting up initial search_string 
!   X2.3-46 WC3 21-Feb-89   Override eve$$widget_split_window_apply so it uses
!			    SPLIT WINDOW instead of EVE directly.
!   X2.3-47 DAS 24-Feb-89   Removed SPLIT WINDOW dialog box support routines.
!   X2.3-48 DAS 10-Mar-89   Supercede EVE$CALLBACK_DISPATCH to not dispatch
!			    callbacks when in command window.
!   X2.3-49 WCC 10-Mar-89   fix key command strings not to uppercase the commandd
!			        in lse$widget_define_key_ok.
!   X2.3-50 CCC	24-Mar-89   Add number_of_windows and maximum_number_of_windows
!			    in Window Attributes dialog box and routine
!			    lse$$widget_update_height_width for resize callback
!   X2.3-51 WCC 18-Apr-89   Set text to null as the initial value for all text
!				widgets in define key dialog box
!   X2.3-52 CCC	21-Apr-89   Remove lse$$set_big_font,lse$$set_little_font,
!			    and lse$$set_normal_font and lse$$set_condensed_font
!			    Instead, add lse$$set_font to make code cleaned.
!			    Also comment out eve$message (EVE$_REPLALLON);
!		    
!   X2.3-53 CCC	28-Apr-89   Add back four old lse$$set_xxx_font routines
!			    used by the bliss file set.b32
!   X2.3-54 WCC 02-May-89   Fix lse$$widget_define_key by using
!				eve$$parse_comment instead of parsing a
!				comment string itself to get legend and topic.
!			    also check if we have input focus or not to begin
!				with. If not, don't display dialog box at all.
!			    check if we lost the input focus or not after
!				calling eve$prompt_key.  If yes, don't display
!				dialog box, just return.
!   X2.3-55 WCC 03-May-89   Add local legal_key in lse$$widget_define_key which
!				got left out in last editing.
!   X3.0-01 CCC 18-May-89   Redid SUBSTITUTION dialog box, added more callback
!			    routines for REPLACE_DIALOG box such as
!			    lse$$widget_replace_replace, lse$$widget_replace_
!			    find_next,etc. Also created many routines to work
!			    with this new REPLACE dialog box such as
!			    lse$$widget_replace_init,etc. Also removed
!			    lse$$widget_replace_apply & lse$$widget_replace_all
!			    and lse$$widget_replace_yes.
!   X3.0-02 CCC 24-May-89   Remove bold range eve$$x_replace_array
!			    {eve$$k_highlight_range} 
!   X3.0-03 CCC 16-May-89   Add SEARCH auto_reversing interface.
!   X3.0-04 CCC 22-Jun-89   Modify lse$$set_font used by LSE command and
!			    callback of window attributes widget.
!			    So,removed lse$$set_big/little/cond/norm_fonts.
!   X3.0-05 WC3	10-Jul-89   Change the global variable LSE$GZ_BALANCE_WINDOWS
!			    LSE$GZ_BALANCE_WINDOWS_MODE to resolve naming
!			    conflict
!   X3.0-06 DAS 12-Jul-89   Fixed LSE$$SET_UNDO_OBJECT to work under both
!		            DECwindows V1 and V2.
!   X3.0-07 CCC 10-Aug-89   Pick up EVE 2.4 Routines modified are:
!			    eve$callback_dispatch, eve$widget_replace_go_each_ok
!			    eve$widget_find_each_yes.			    
!   X3.0-08 CCC 17-Aug-89   Remove select popup in the extend menu list box.   
!   X3.0-09 CCC 21-Aug-89   Add review and query popup menu extension service
!   X3.0-10 CCC 21-Aug-89   Change extend menu index "noselect" to "user_buffer"
!   X3.0-11 CCC 30-Aug-89   Merge 76e4 eve24 into main line
!   X3.0-12 DAS 30-Aug-89   Modified lse$$set_undo_object to use new routine
!			    lse$$decwindows_v1.
!   X3.0-13 CCC 08-Sep-89   Add to supersede eve$$widgets_attr
!   X3.0-14 CCC 21-Sep-89   Add SAVE ATTRIBUTES features
!   X3.0-15 CCC 22-Sep-89   Fixed bug for wildcard replacement.
!   X3.0-16 CCC 28-Sep-89   Add to restore original current_direction after
!			    search is completed in lse$$widget_replace_action,
!			    lse$$widget_replace_find_next and
!			    lse$$widget_find_apply
!   X3.0-17 CCC 29-Sep-89   Modify lse$$widget_find and lse$$widget_replace
!			    to use one common routine lse$$widget_set_find_
!			    direction to set up search direction and direction
!			    toggle buttons.
!   X3.0-18 CCC 03-Oct-89   Remove DONT SAVE push button in SAVE ATTRIBUTES
!			    dialog box.
!   X3.0-19 CCC 04-Oct-89   Add to supersed eve$$widget_needfilename_ok
!			    and eve$$widget_needfilename_cancel and
!			    add lse$$widget_nofilespecexit_cancel.
!   X3.0-20 CCC 09-Oct-89   Fix bug found in lse$$widget_replace2
!			    change to saved the array eve$$x_replace_array
!			    {eve$$k_replace_saved_direction} with
!			    CURRENT_DIRECTION;
!   X3.0-21 CCC 10-Oct-89   Modified lse$$widget_window_attributes_apply
!			    to use lse$do_command for setting up heigh/width
!   X3.0-22 CCC 12-Oct-89   Modified lse$define_menu_entry, remove
!		            eve$$parse_comment
!   X3.0-23 CCC 06-Nov-89   Modified eve_define_menu_entry to remove
!			    eve$message (TPU$_REQUIRESDECW, 0);
!   X3.0-24 CCC 13-Nov-89   Fix bug in eve$undefined_menu_entry,
!			    eve$init_menu_arrays and eve$$widget_extmenu_remove
!			    Add to disallow deleting the last entry from menu
!			    Set_Undo_Object needs to handle the user deleting
!			    it from either the pulldown or popup.
!   X3.0-25 CCC 15-Nov-89   Rename lse$x_cantdellastent to lse$x_dellastent
!   X3.0-26 DAS 17-Nov-89   Call the procedure LSE$$DECWINDOWS_V1 when the 
!		            user first attempts to modify the menus.  This 
!			    is due to the fact that decwindows v1/v2 is based
!			    only finding the Undo item on the pulldown menu 
!			    which the user is free to remove!
!   X3.0-27 CCC 21-Nov-89   Fix eve$$get_parent_widget by adding DECW V2 support
!   X3.1-1  DAS 27-Dec-89   Moved superceded EVE procedures to the module
!			    LSE$EVE_MENUS.TPU
!                           Renamed the procedure QUOTE_STRING to conform to 
!			    naming standard LSE$$QUOTE_STRING.
!   X3.1-2  CCC 15-Jan-90   Clean up lse$$widget_set_interface, remove input
!			    argument 'KEYPAD'. Also, added saving keypad and
!			    and tabs (visible/invisible) in Save Current Attrib
!			    menu.
!   X3.1-3  CCC 26-Mar-90   Add lse$$init_attr_array,
!			    add lse$$save_extended_attributes,
!			    add lse$$define_extended_attributes
!			    Cleaned up all stuff for saving attributes..
!   X3.1-4  CCC 10-Apr-90   Modify lse$$save_extended_attributes 
!   X3.2-1  NMC 13-Jul-90   Remove lse$$decwindows_v1 support in 
!                           lse$$set_undo_object
!   X3.2-2  WC3	24-Jul-90   SET FONT grammar inversion
!   X3.2-3  AVH 30-Jul-90   Fix the message response for SEARCH:ATTRIBUTES 
!			    options under the DECwindows dialog mode.
!   X3.2-4  WC3	02-Aug-90   Make scroll margins part of saved attributes
!   X3.2-5  WC3	20-Aug-90   Set screen inversion
!   X3.2-6  WC3	01-Oct-90   Change:
!				use of lse$$x_search_all to SET/GET_INFO
!				use of lse$$x_search_diacritical to SET/GET_INFO
!				use of lse$$x_search_pattern to SET/GET_INFO
!				use of lse$$x_search_span_spac to SET/GET_INFO
!				use of lse$$x_search_case to SET/GET_INFO
!				Many SET/GET_INFO calls to new parameters
!				Search attributes to use portable grammar
!   X3.2-7  WC3	03-OCT-90   Use lse$get_message_text where we never want the
!				%LSE-S-name prefix
!   X3.2-8  WC3	10-Oct-90   Change the way pending delete, bell and tabs
!				visible grammar routines are called
!   X3.2-9  GJJ	 3-Nov-90   Changed LSE$VMS to LSE$OS_VMS, LSE$ULTRIX to
!				LSE$OS_ULTRIX
!   X3.2-10 AVH 15-Nov-90   Change ref lse$$search to lse$search_util and 
!			    lse$$search_next to lse$search_util_next.
!   X3.2-10 DAS	10-Nov-90   Removed open_file_selection dialog box support
!			    Removed include_file_selection dialog box support
!   X3.2-11 AVH	29-Nov-90   Changed lse$$widget_replace to lse$$substitute_dialog
!   X3.2-12 SHE	08-Jan-91   Make all 2nd args to MESSAGE/EVE$MESSAGE 0.
!   X3.2-13 GJJ	28-Feb-91   Converted resource and callback reason names to
!			    conform to the TPU 3.0 FT3 scheme; updated the
!			    copyright notice.
!   X3.2-14 AVH	17-Apr-91   Added HH to procedure lse$define_menu_entry.
!   X4.0-1  WC3	15-May-91   Portable language consistency
!   X4.0-2  SHE	04-Jun-91   Motif conversion.
!   X4.0-3  SHE	11-Jun-91   lse$$widget*find* routines renamed to search.
!   X4.0-4  AVH 18-Jun-91   Fix setting screen height and width during the 
!			    execution of SAVE SECTION command.
!   X4.0-5  AVH 27-Jun-91   Delete lse$$widget_substitute_direction, trim
!			    lse$$substitute_dialog, 
!			    lse$$widget_set_search_direction
!   X4.0-6  LRH 1-Jul-91    Added support for the reallyquit dialog box
!                           for buttons, yes, no, cancel.
!   X4.0-7  DAS 11-Jul-91   Bugs in QUIT
!   X4.0-8  SHE	16-Jul-91   Added primary selection model to the 
!				Global Attributes dialog box.
!   X4.0-9  SHE	18-Jul-91   Modified lse$$substitute_dialog to call
!				lse$$widget_set_search_direction		
!   X4.0-10 AVH 26-Jul-91   Fix SEARCH direction bug in lse$$widget_search_apply.
!   X4.0-11 SHE	01-Aug-91   Changed calls to CREATE_WIDGET to calls to
!				lse$create_dialog_box to getting min. widths
!				and heights for resizeable dialog boxes.
!   X4.0-12 SHE	12-Aug-91   Fixed lse$$widget_global_attributes to set
!			        the selection_based_focus_model toggle
!   X4.0-13 LRH 30-Aug-91   Removed cms_preference related procedures.
!   X4.0-14 SHE	18-Sep-91   Added menu customization worker routines
!   X4.0-15 SHE	18-Sep-91   Integrated changes made to LSE$WIDGETS.UIL since
!			      menu customization work began
!   X4.0-16 SHE	18-Sep-91   Renamed lse$$get_selection, since the name is already
!			      used.  Renamed lse$$set_selection too.
!   X4.0-17 SHE	20-Sep-91   Modified lse$$initialize_menu_system to bracket
!			      widget class and resource declaration with
!			      check for decwindows.
!   X4.0-18 SHE	25-Sep-91   Modified return value of lse$$create_pulldown_entry
!			    Superseded eve$init_menu_arrays will null
!			      procedure.
!   X4.0-19 SHE	26-Sep-91   Added "On Commands ..." to Help Pulldown
!   X4.0-20 SHE	01-Oct-91   Fixed unexpected errors when Menus... list items
!			    are de-selected.  Clear text fields when label is
!			    deselected.
!   X4.0-21 SHE	06-Oct-91   DECSet UI Consistency work
!			    Added lse$$make_item_visible
!   X4.0-22 SHE	07-Oct-91   Call lse$$add_popup before lse$$set_menubar_insert_position
!   X4.0-23 LRH 07-Oct-91   change search_pattern substitute_pattern to 
!                           search_wildcard, substitute_wildcard
!   X4.0-24 SHE	09-Oct-91   Declared status as a local in lse$$make_item_visible
!   X4.0-25 SHE	16-Oct-91   Modified Cut, Copy, and Paste menu entries to
!			      automatically use the clipboard.
!			    Added "On Context" to Help Pulldown.
!			    Added lse$$cs_help and lse$$widget_help_on_context.
!   X4.0-26 SHE	18-Oct-91   Fix internal error when all menu entries are deleted.
!			    Leave "edit labels arrow" on all the time.
!   X4.0-27 LRH 21-Oct-91   Added lse$$compile_buffer
!   X4.0-28 AHH 24-Oct-91   Added code to lse$$define_extended_attributes so
!			    that LSE writes version to saved TPU command file.
!   X4.0-29 SHE	25-Oct-91   Removed lse$$create_default_menu_system, replaced
!			      by lse$$load_menus.
!			    Broke up the functionality of lse$$output_menu_system
!			      into that routine plus lse$$restore_menu_system.
!			    Modified subform names.
!   X4.0-30 SHE	28-Oct-91   Added missing local declarations
!   X4.0-31 SHE	31-Oct-91   Use lse$$popup_message in menu cust. worker procs.
!			    Error when Menus... dialog tries to add entry w/o
!			      a menu selected
!			    Toggle Remove Entry button on entry select/deselect.
!   X4.0-32 SHE	04-Nov-91   Split CREATE_WIDGET call for pushbuttons into a
!			    CREATE_WIDGET call, and then a SET for the resources.
!   X4.0-33 SHE	05-Nov-91   Renamed lse$$quote_string to lse$$quote_key_string.
!   X4.0-34 LRH 06-Nov-91   Removed lse$do_command from lse$$widget_define_key_ok
!   X4.0-35 WC3	12-Nov-91   Re-write SEARCH
!   X4.0-36 DAS	14-Nov-91   Empty module init
!   X4.0-37 WC3	21-Nov-91   Change lse_wildcard* to lse_pattern*
!   X4.0-38 SHE	03-Dec-91   Make separator just added visible.
!			    Catch bad status from eve$define_widget.
!			    Added procedures to replace eve$$k_* functionality.
!   X4.0-39 SHE 05-Dec-91   Moved superseded eve$init_menu_arrys to 
!			    lse$eve_menus.
!   X4.0-40 WC3	16-Dec-91   Add Compile Review to menus
!			    Move lse$$create_menu_system here from LSESECINI
!
!   X4.0-41 WC3	13-Jan-92   Re-write Extended attribute support.
!   X4.0-42 WC3	11-Feb-92   Apply of search dialog w/o changing the search 
!				string is search next.
!   X4.0-43 WC3	27-Feb-92   Add lse_set_prompt_expandmenu to section file saving
!   X4.0-44 SHE	27-Feb-92   Made Goto Declaration, Find Occurrences, and
!				Goto Source menu entries use key procedures
!   X4.0-45 SAA 28-Feb-92   fix grammar-prefix in lse$$copy_current_global_settings
!   X4.0-46 SHE	10-Apr-92   Added calls to lse$add_minimum_size_to_dialog
!				for dialogs with text fields
!			    Turn off Remove Entry button when menu entry
!				is de-selected
!   X4.0-47 SHE	25-Apr-92   Added lse$$save_menu_label, lse$$restore_menu_label
!   X4.0-48 SHE	27-Apr-92   Add call to lse$$load_menus to new worker routines
!			    Handle undefined menu label in get_menu_label_info
!   X4.0-49 WC3	08-May-92   Added missing local declarations
!   X4.0-50 SHE 19-May-92   Added lse_set_save_related_Buffers to the
!			      extended attributes for save section
!   X4.0-51 SHE	28-May-92   Modified lse$$restore_menu_label to delete 
!			      just the element restored instead of the entire
!			      array.
!   X4.0-52 SHE	10-Jun-92   Added CMS-related menu entries, and support 
!			      procedures for CMS... dialog box.
!   X4.3-1  RKB 22-Aug-94   Added entries for UNDO and REDO in EDIT menu
!   X4.3-2  RAM	30-Aug-94   Added hyperhelp label to the help menu.
!   X4.3-3  RAM	22-Feb-95   Commented out hyperhelp label in the help menu.
!   X4.3-4  RKB 14-Mar-95   Correct SUBSTITUTE bug in DECW
!    4.5-1  CJH 14-Aug-96   DECset V12.2 GUI Enhancements.
!    4.5-1  AFW 14-Oct-96   Fix bug 2152, LSE$SOURCE for VMS command language.
!    4.6-1  JBL 10-Nov-97   Add support for TABS_HARD and UNDO
!   V5.1-01 SS012209		Shahina Shaik		22-Jan-2009
!	    Fix for QXCM1000841808. Updated two variables names, which 
!	    were modified while fixing a problem to avoid uil complier 
!	    warnings with long variables names
!				

procedure lse$menus_module_ident 

    return "V5.1-01";

endprocedure;


procedure lse$$widget_nofilespecexit_cancel	  ! cancel to exit - no filename
    (loop_flag)
local
!    status,
    the_prompt,
    yesno;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_nofilespecexit_cancel ");
ENDON_ERROR;


the_prompt := lse$get_message_text (EVE$_NOFILESPECEXIT, 0,
				 eve$$x_exit_array {"the_buffer_name"});

!status := lse$$prompt_yesno(the_prompt, yesno);

lse$prompt_boolean_decw (tpu$k_unspecified,
			 yesno,
			 the_prompt,
			 "",
			 "",
			 FALSE);

if yesno 
then
    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;
else
    eve$$x_exit_array {"state"} := 0;
    eve$$exit2(loop_flag);
endif;

return;
endprocedure;		! lse$$widget_nofilespecexit_cancel


!+
! This code is called when the SUBSTITUTE... is selected from the menu.
!-
procedure lse$$substitute_dialog

local
    status;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$substitute_dialog");
ENDON_ERROR;

lse$create_dialog_box ("SUBSTITUTE_DIALOG", lse$x_replace_dialog);

if lse$$search_string <> ""
then
    status := set (TEXT,
		   get_info (WIDGET, "widget_id",
		     lse$x_replace_dialog,
		     "SUBSTITUTE_DIALOG.SUBSTITUTE_OLD_TEXT"),
		     str(lse$$search_string) );
endif;

if lse$$replace_string <> ""
then
    status := set (TEXT,
		   get_info (WIDGET, "widget_id",
		     lse$x_replace_dialog,
		     "SUBSTITUTE_DIALOG.SUBSTITUTE_NEW_TEXT"),
		     str(lse$$replace_string) );
endif;

!+
! To begin with, pick up direction from the current buffer.
!-
status := set ( WIDGET, get_info (WIDGET, "widget_id",
		lse$x_replace_dialog,
		"SUBSTITUTE_DIALOG.SUBSTITUTE_DIRECTION.SUBSTITUTE_FORWARD"),
		eve$x_resource_array {eve$k_nset},
		(CURRENT_DIRECTION = FORWARD) );

status := set ( WIDGET, get_info (WIDGET, "widget_id",
		lse$x_replace_dialog,
		"SUBSTITUTE_DIALOG.SUBSTITUTE_DIRECTION.SUBSTITUTE_REVERSE"),
		eve$x_resource_array {eve$k_nset},
		(CURRENT_DIRECTION = REVERSE) );

eve$manage_widget(lse$x_replace_dialog);

lse$add_minimum_size_to_dialog (lse$x_replace_dialog);

endprocedure;

!
! Read input data from the SUBSTITUTE dialog box.
!
procedure lse$$widget_substitute_info
local
    the_value,
    qualifier,
    case_match,
    status,
    search_string,
    replace_string;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_substitute_info");
ENDON_ERROR;


!!set (INPUT_FOCUS);	! grab focus so ^C will be caught

! get the replace strings from the eve$$k_replace_new_[old]text widgets

search_string := get_info (get_info (WIDGET, "widget_id", lse$x_replace_dialog,
			  "SUBSTITUTE_DIALOG.SUBSTITUTE_OLD_TEXT"),
			"text");

! test only the old string (new can be "")

if search_string = ""
then
    eve$message (EVE$_NOREPLSTR);
    return;
else
    lse$$search_string := search_string;
endif;

lse$$replace_string := get_info (get_info (WIDGET, "widget_id", lse$x_replace_dialog,
		  "SUBSTITUTE_DIALOG.SUBSTITUTE_NEW_TEXT"),
		"text");

!+
!  LSE SETUP SUBS_TYPE, QUALIFIFERS,.....
!
!-
qualifier := "";

status := get_info ( get_info (WIDGET, "widget_id",
			      lse$x_replace_dialog,
			      "SUBSTITUTE_DIALOG.SUBSTITUTE_CASE_MATCH"),
			      "widget_info",eve$x_resource_array {eve$k_nset},the_value);
if the_value
then
    qualifier := qualifier + "CASE_MATCHING";
endif;

status := get_info ( get_info (WIDGET, "widget_id", lse$x_replace_dialog,
			    "SUBSTITUTE_DIALOG.SUBSTITUTE_WILDCARD"),
			    "widget_info",eve$x_resource_array {eve$k_nset}, the_value);

if the_value
then     
    if lse$$x_search_type <> 2 then
       lse$$x_search_attribute_changed := 1;
    endif;              
    lse$$x_search_type := 2;
    qualifier := qualifier + "PATTERN";
else
    if lse$$x_search_type <> 0 then
       lse$$x_search_attribute_changed := 1;
    endif;              
    lse$$x_search_type := 0;
endif;

lse$$subs_qual_string := qualifier;

return TRUE;
endprocedure;

!
! Main routine to do SUBSTITUTION.
!
! Find_flag: If it is 1, then find the next string after replacement is doen.
! 
!
procedure lse$$widget_substitute_action(find_flag)
local
    saved_all,
    saved_direction,
    len,
    current_string,
    current_range,
    found_string,
    mark2,
    new_pos,
    old_search_string,
    subs_type,
    status,
    saved_mark,
    at_beginning,
    search_status,
    saved_find_direction;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_substitute_action");
ENDON_ERROR;

!
! Before we get any information from the dialog box, we save the current
! search string.
!
old_search_string := lse$$search_string;

!
!Now, get information from the substitute dialog box.
!
if not lse$$widget_substitute_info
then
     return FALSE;
endif;

subs_type := lse$$widget_substitute_init("SINGLE");

!
! If the found range is not located in the current buffer, then we should
! remove it and re-create a new found range.
!
if get_info (eve$x_found_range, "type") = RANGE
then
    eve$$remove_found_range;
endif;

!
! We may not have any found range , but we can create a found range
! if the current word is the same as the search string.
!
if get_info (eve$x_found_range, "type") <> RANGE
then
    saved_mark := mark(none);

    !
    ! We don't allow SEARCH to search both forward and reverse direction.
    ! 
    saved_all := set( lse$auto_reverse, lse$search, 0 );

    !
    ! We move back one cusor position and search again
    !
    lse$$save_inserted_text();
    at_beginning := (saved_mark = beginning_of (current_buffer));

    saved_direction := current_direction;
    saved_find_direction := eve$x_old_find_direction;

    if (at_beginning) and (eve$x_old_find_direction = FORWARD)
    then
       ! To allow a successful find when positioned on an occurrence
       ! of the search string at the beginning of the buffer.
       !
       set (REVERSE, current_buffer);
       eve$x_old_find_direction := REVERSE;
    endif;

    lse$$reset_search_position;

    IF lse$$x_search_type = 2
    THEN
	search_status := LSE_PATTERN_SEARCH( lse$$search_string, 1 );
    ELSE
	search_status := LSE_SEARCH( lse$$search_string, 1 );
    ENDIF;

    set (saved_direction, current_buffer);
    eve$x_old_find_direction := saved_find_direction;

    set( lse$auto_reverse, lse$search, saved_all );

    if get_info (eve$x_found_range, "type") <> RANGE
    then
	MESSAGE("Cursor position is not on a search string");
        position(saved_mark);
	return FALSE;
    endif;

    !
    ! If the string is found,then we need to check if the string
    ! is located at the current cursor position.
    !

    position(saved_mark);

    if (not search_status)
    or (mark(none) <> beginning_of(eve$x_found_range))
    then
	MESSAGE("Cursor position is not on a search string");
        eve$$remove_found_range;
	return FALSE;
    endif;
endif;

!
! Because TPU BUILTIN erase_character will erase characters in the found
! range but have next character changed to bold if the video attributes of
! found range is bold.
!
! (Ex. Search a string, then do "DO/TPU erase_character(length(
!	eve$x_found_range)). )
!
! So, we need to get rid of video attributes to the characters in
! the found range.
!
eve$x_found_range := create_range( beginning_of(eve$x_found_range),
			           end_of(eve$x_found_range),
			           none);
!
! Now, do the replacement  
!
status := lse$$widget_substitute1 ( lse$$search_string, lse$$replace_string,
				 1, subs_type, find_flag);

if find_flag = 0
then 
    !
    ! After a replacement, if we don't want to search the string,
    ! then, we need to clean up the found range.
    !
    if get_info (eve$x_found_range, "type") = RANGE
    then
       if current_buffer = get_info(eve$x_found_range,"buffer") 
       then
              eve$$remove_found_range;
       endif;
    endif;
else
    !
    ! if the string is found, then we move cursor to the new found range.
    !
    if status
    then
	position(eve$x_found_range);
    else
        if get_info (eve$x_found_range, "type") = RANGE
        then
           if current_buffer = get_info(eve$x_found_range,"buffer") 
           then
              eve$$remove_found_range;
           endif;
        endif;
    endif;
endif;

!
return TRUE;
endprocedure;


!
! Re-poistion cursor in order to find the string which may be located at
! the current cursor position.
!
procedure lse$$reset_search_position

ON_ERROR
    [TPU$_ENDOFBUF]:
    [OTHERWISE]:
        lse$$unexpected_error( 
            ERROR, ERROR_TEXT, ERROR_LINE, "lse$$reset_search_position");
ENDON_ERROR;

!
! back up position in order to do search.
!

if eve$x_old_find_direction = FORWARD
then
    if mark (none) <> beginning_of (current_buffer)
    then
        move_horizontal (-1);
    endif;
else
    if mark (none) <> end_of (current_buffer)
    then
        move_horizontal (1);
    endif;
endif;

return(mark(none));
endprocedure;


!
! Parsing SUBSTITUTE qualifiers and initialize global variables.
!
procedure lse$$widget_substitute_init(;replace_action)
local
    subs_type;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_substitute_init");
ENDON_ERROR;

!+
! Check to see if the buffer can be modified.
!-
if not get_info(current_buffer,"MODIFIABLE") 
then
    MESSAGE(LSE$_UNMODIFIABLE, 0, "SUBSTITUTE");
    return FALSE;
endif;

if replace_action <> tpu$k_unspecified
then
    lse$$subs_qual_string := lse$$subs_qual_string + replace_action;
endif;

change_case (lse$$subs_qual_string, UPPER);

if index(lse$$subs_qual_string, "CASE_MATCHING") > 0
then
    lse$$case_matching_prog :=
	compile("lse$$actual_replacement_string := lse$$match_strings;");
else
    lse$$case_matching_prog :=
	compile("lse$$actual_replacement_string := lse$$replace_string;");
endif;

!+
! Parse lse$$subs_QUAL_STRING to see if we are doing a /SINGLE, /CONFIRM, or
! /ALL substitution.  Set appropirate variables based on this information.
!-
if index(lse$$subs_qual_string, "CONFIRM") > 0
then
    subs_type := tpu$k_unspecified;
else
    if index(lse$$subs_qual_string, "ALL") > 0
    then
	subs_type := eve$x_all;
    else
        if index(lse$$subs_qual_string, "SINGLE") > 0
	then
	    subs_type := eve$x_last;
	else
	    subs_type := tpu$k_unspecified;
	endif;
    endif;
endif;

!
! Set the search type to 2 if it is pattern search.
!-
if index(lse$$subs_qual_string, "PATTERN") > 0
then
    if lse$$x_search_type <> 2 then
       lse$$x_search_attribute_changed := 1;
    endif;              
    lse$$x_search_type := 2;
else
    !+
    !  default is no_pattern search
    !-
    if lse$$x_search_type <> 0 then
       lse$$x_search_attribute_changed := 1;
    endif;              
    lse$$x_search_type := 0;
endif;

lse$$x_replacement := 1;
!
return subs_type;
endprocedure;


! Main replacement loop.
! Parameters:
!    ignore_null_replacement	Boolean = 1 if replacement_arg can be ""- input

procedure LSE$$widget_substitute1 (target_arg, replacement_arg; ! Replace subprocedure
			 ignore_null_replacement,the_action,search_flag)

local
	find_flag,
	get_replacement,
	action_length,
	the_widget,
	temp_array,
        status;

on_error
    [OTHERWISE]:
	eve$message (EVE$_REPLCTRLC, 0,
		     eve$$x_replace_array {eve$$k_replace_occurrences});
	eve$$replace_error_handler;
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_replace1 ");
endon_error;

if not eve$test_if_modifiable (current_buffer)
then
    eve$learn_abort;
    return (FALSE);
endif;

find_flag := 0;
if find_flag <> tpu$k_unspecified
then
    find_flag := search_flag;
endif;

if get_info (eve$$x_replace_array, "type") = ARRAY
then
    delete (eve$$x_replace_array);
endif;

eve$$x_replace_array := create_array (eve$$k_replace_array_length,
				      eve$$k_state_array_indexes);
eve$$x_replace_array {TYPE} := eve$$k_replace_context;
eve$$x_replace_array {eve$$k_replace_occurrences} := 0;

eve$$x_replace_array {eve$$k_replace_target} := target_arg;
eve$$x_replace_array {eve$$k_replacement} := replacement_arg;

! get the args

if (target_arg = "")
then
    if (eve$$x_state_array {eve$$k_command_line_flag} = eve$k_invoked_by_menu)
	and (eve$$x_state_array {eve$$k_dialog_box})
    then

!%IF eve$x_option_decwindows
!%THEN
	if eve$x_decwindows_active
	then
	    lse$$substitute_dialog;
	endif;
!%ENDIF
	return (eve$k_async_prompting);  
    else
	if not (eve$prompt_string (target_arg,
				   eve$$x_replace_array {eve$$k_replace_target},
				   lse$get_message_text (EVE$_OLDPROMPT, 1),
				   message_text (EVE$_NOREPLSTR, 0)))
	then
	    eve$learn_abort;
	    return (FALSE);
	endif;
    endif;
endif;

eve$$x_replace_array {eve$$k_replacement} := replacement_arg;

if eve$$x_replace_array {eve$$k_replacement} = ""
then
    if ignore_null_replacement <> tpu$k_unspecified
    then
	if ignore_null_replacement <> 1
	then
	    get_replacement := TRUE;
	endif;
    else
	get_replacement := TRUE;
    endif;
endif;
if get_replacement
then
    eve$$x_replace_array {eve$$k_replacement} := replacement_arg;
    if eve$$x_replace_array {eve$$k_replacement} = ""
    then
	eve$$x_replace_array {eve$$k_replacement} :=
						     eve$prompt_line
						     (lse$get_message_text
						      (EVE$_NEWPROMPT, 1),
						      eve$$x_prompt_terminators
						      );
	if eve$$x_replace_array {eve$$k_replacement} = 0
	then
	    eve$learn_abort;
	    return (FALSE);
	endif;
    endif;
endif;


!
! Now store eve$x_found_range into eve$$x_replace_array{eve$$k_replace_range}
! and highlight it
!
eve$$x_replace_array {eve$$k_replace_range}:=
		create_range (beginning_of (eve$x_found_range),
			      end_of (eve$x_found_range),
			      NONE);

status := eve$$replace_init;

!
!
eve$$x_replace_array {eve$$k_replace_asking} := TRUE;

if (NOT status) and (get_info (lse$search, 'lse$pattern') = lse$os_tpu) then
    eve$$replace_error_handler;
    return (FALSE);
endif;

if the_action <> tpu$k_unspecified
then
    eve$$x_replace_array {eve$$k_replace_action} := the_action;
    action_length := length (eve$$x_replace_array {eve$$k_replace_action});
    if (eve$$x_replace_array {eve$$k_replace_action} =
		substr (eve$x_all, 1, action_length))
		and (action_length > 0)
    then
	eve$$x_replace_array {eve$$k_replace_asking} := FALSE;
	eve$$x_replace_array {eve$$k_replace_saved_mark} :=
							    mark
							    (FREE_CURSOR
							     );! return here when done
	set (SCREEN_UPDATE, OFF);
    endif;
endif; 

!%IF eve$x_option_decwindows
!%THEN
if eve$x_decwindows_active
 and
    (eve$$x_state_array {eve$$k_command_line_flag} = eve$k_invoked_by_menu)
then
	if the_action <> tpu$k_unspecified
	then
	    return (lse$$widget_substitute2 (find_flag, the_action));
	else
	    return( lse$$widget_substitute2 (find_flag));
	endif;
else
    if the_action <> tpu$k_unspecified 
    then         
	return (lse$$widget_substitute2 (find_flag, the_action));	! REPLACE /ALL
    else
        return (lse$$widget_substitute2 (find_flag));
    endif;
endif;
!%ELSE
!% if the_action <> tpu$k_unspecified	    !!! eve$x_all 
!% then
!%	return (lse$$widget_replace2 (find_flag, the_action));! REPLACE /ALL
!% else return (lse$$widget_replace2 (find_flag));
!% endif;
!%ENDIF

return TRUE;
endprocedure;


! This routine initialize some variables before doing real action of
! substitution.
!
! Parameters
!    find_flag = 1 if ok to find
!    replace_action = "yes", "no", "quit", "last", "all" (optional)

procedure lse$$widget_substitute2 (find_flag; replace_action)

local
    first_pass,
    saved_all,
    status,
    saved_mark;

on_error
    [OTHERWISE]:
	eve$$replace_error_handler;
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_substitute2 ");
endon_error;

eve$$x_replace_array {eve$$k_replace_asking} := FALSE;

eve$$x_replace_array {eve$$k_replace_saved_direction} := CURRENT_DIRECTION;

set (eve$$x_replace_array {eve$$k_replace_saved_direction},
	 eve$$x_replace_array {eve$$k_replace_this_buffer});

if eve$$x_replace_array {eve$$k_replace_saved_direction} = FORWARD
then
    eve$$x_replace_array {eve$$k_other_direction} := REVERSE;
else
    eve$$x_replace_array {eve$$k_other_direction} := FORWARD;
endif;

eve$$x_replace_array {eve$$k_repeat_find_range} := 0;
eve$$x_replace_array {eve$$k_erasing_pivot_point} := FALSE;

!
! Call start substitute to set up data structures for saving SUBSTITUTE info
! for UNDO
!
lse$$save_inserted_text();
lse$$start_substitute (eve$$x_replace_array {eve$$k_replacement});
status := eve$$replace_action (replace_action);
!
! Call lend substitute to end saving of SUBSTITUTE info for UNDO
!
lse$$end_substitute();

if status = eve$k_async_prompting
then
    return (status);
endif;

if find_flag = 1
then
    eve$$x_this_direction := current_direction;

    saved_mark := mark(none);
    lse$$save_inserted_text();
    lse$$save_old_bpm;
    lse$$reset_search_position;

    saved_all := set( lse$auto_reverse, lse$search, 0 );

    if lse$$x_search_type = 2
    then
        status := lse_pattern_search( '', 1 );
    else
        status := lse_search( '', 1 );
    endif;

    if not status then 
       lse$$free_old_bpm;
       position (saved_mark); 
    else
       lse$$save_new_bpm;
    endif;

    set( lse$auto_reverse, lse$search, saved_all );

    if ( eve$x_found_range = 0 )
    then
        status := eve$$replace_search_fail;
        if status = eve$k_warning
        then		! no more occurrences
        	eve$$replace_clean_up;
        	return (status);
        endif;
        if status = eve$k_async_prompting
        then		! more occurrences, dialog box prompt
		eve$$replace_clean_up;
        	return (status);
        endif;
     endif;
endif;

eve$$replace_clean_up;

return (TRUE);

endprocedure;
!+
! callback routine of "Find Next " push button in SUBSTITUTE dialog box.
!-

procedure lse$$widget_substitute_search_next
local
    status,
    saved_direction,
    old_search_string;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_substitute_search_next");
ENDON_ERROR;

old_search_string := lse$$search_string;

if not lse$$widget_substitute_info
then
     return FALSE;
endif;

saved_direction := CURRENT_DIRECTION;
if  (old_search_string = lse$$search_string)
and (lse$$x_search_attribute_changed <> 1)
then
    if lse$$x_search_type = 2
    then
        status := lse_pattern_search( '');
    else
        status := lse_search( '' );
    endif;
else
    set (eve$x_old_find_direction, current_buffer);
    IF lse$$x_search_type = 2
    THEN
	status := LSE_PATTERN_SEARCH( lse$$search_string );
    ELSE
	status := LSE_SEARCH( lse$$search_string );
    ENDIF;
endif;
set (saved_direction, current_buffer);
return(status);
endprocedure;


!+
! callback routine of "Replace" push button.
!-
procedure lse$$widget_substitute_replace
local
    status;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_substitute_replace");
ENDON_ERROR;


status := lse$$widget_substitute_action(0);
!
return status;
endprocedure;

!+
! callback routine of "ALL" push button in REPLACE dialog box.
!-

procedure lse$$widget_substitute_replace_all

local
     subs_type,
     command_prompt;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_substitute_replace_all");
ENDON_ERROR;

if not lse$$widget_substitute_info
then
     return FALSE;
endif;

subs_type := lse$$widget_substitute_init("ALL");

!+
! Initialize the search direction using the buffer direction if command is
! input at the LSE command prompt.
!-
command_prompt := TRUE;

if eve$x_decwindows_active and
   (eve$$x_state_array {eve$$k_command_line_flag} = eve$k_invoked_by_menu) and
    (eve$$x_state_array {eve$$k_dialog_box})
then
     command_prompt := FALSE;
endif;

if (command_prompt)
then
   if eve$x_old_find_direction <> CURRENT_DIRECTION
   then
        eve$x_old_find_direction := current_direction;
        !
        ! It needs to update direction widget in FIND/REPLACE dialog box
        ! in the DECWindows mode.
        !
        lse$$widget_set_search_direction;
   endif;
endif;

eve_replace (lse$$search_string,lse$$replace_string, subs_type);

return TRUE;
endprocedure;


!+
! callback routine of "Replace and Find Next" push button.
!-
procedure lse$$widget_substitute_replace_find_next
local
    status;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_substitute_replace_find_next");
ENDON_ERROR;

status := lse$$widget_substitute_action(1);
!
return status;
endprocedure;

procedure lse$$widget_substitute_apply

LOCAL
    status,
    saved_mark;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_substitute_apply");
ENDON_ERROR;
!
! In case cursor is on what is being searched for, must reset search position
! before "finding next".  Otherwise, the range at the current cursor position
! will not be replaced.
!
saved_mark := mark(none);
lse$$save_inserted_text();
lse$$reset_search_position;
!
!   Find string then replace
!
status := lse$$widget_substitute_search_next;

if status = 0 
then 
    position (saved_mark);
else
    lse$$widget_substitute_action(0);
endif;

endprocedure;

procedure lse$$widget_substitute_ok
local
    saved_mark,
    status;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_substitute_ok");
ENDON_ERROR;

! In case cursor is on what is being searched for, must reset search position
! before "finding next".  Otherwise, the range at the current cursor position
! will not be replaced.
saved_mark := mark(none);
lse$$save_inserted_text();
lse$$reset_search_position;
status := lse$$widget_substitute_search_next;
if status = 0
then 
    position (saved_mark);
else 
    lse$$widget_substitute_action(0);
endif;
eve$unmanage_widget(lse$x_replace_dialog);
endprocedure;

procedure lse$$widget_substitute_cancel

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_substitute_cancel");
ENDON_ERROR;

eve$unmanage_widget(lse$x_replace_dialog);
!eve$unmanage_widget(lse$x_substitute_apply_dialog);

endprocedure;


procedure lse$$widget_search_each_cancel;

!+
! Delete find_each_dialog instead of using
! eve$unmanage_widget (lse$x_find_each_dialog)
! because that find_each_dialog can be created by
! three different parent. The main concern is input focus.
!-

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_search_each_cancel;");
ENDON_ERROR;

!if get_info (lse$x_search_dialog, "type") <> WIDGET
!then

!   delete(lse$x_find_each_dialog);

!endif;

endprocedure;


!+
!
!-
procedure lse$$widget_search_label
local
    the_prompt,
    status;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_search_label");
ENDON_ERROR;


!%IF eve$x_option_decwindows
!%THEN
	if eve$x_decwindows_active
	then             
	    if get_info(lse$x_search_dialog, "type") = WIDGET
	    then                                        
	    	    if current_direction = FORWARD
		    then
			the_prompt := "Forward Search "
		    else                     
			the_prompt := "Reverse Search "
		    endif;
	    	    status := set (WIDGET,
	    			   get_info (WIDGET, "widget_id",
				     lse$x_search_dialog,
				     "SEARCH_DIALOG.SEARCH_LABEL"),
	    			   eve$x_resource_array {eve$k_nlabel},
	    			   the_prompt);
	    endif;
	endif;
!%ENDIF
endprocedure;

!+
!
!-
procedure lse$$widget_search( default_text, wildcard_flag )
local
    status;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_search");
ENDON_ERROR;


!%IF eve$x_option_decwindows
!%THEN
	if eve$x_decwindows_active
	then             

	    lse$create_dialog_box ("SEARCH_DIALOG", lse$x_search_dialog);

	    ! Poke the default search string
	    !
	    if (default_text <> "")  AND
	       (default_text <> tpu$k_unspecified)
	    then
		status := set (TEXT,
			       get_info (WIDGET, "widget_id",
				 lse$x_search_dialog,
				 "SEARCH_DIALOG.SEARCH_TEXT"),
			         default_text );
	    endif;

	    ! Poke the wildcard toggle
	    !
	    status := set( WIDGET, 
			   get_info(WIDGET, 
				    "widget_id",
				    lse$x_search_dialog,
				    "SEARCH_DIALOG.SEARCH_WILDCARD"),
			   eve$x_resource_array{ eve$k_nset }, 
			   wildcard_flag );

	    !+
	    ! Pick up direction from the buffer and set up 
	    ! search widgets in both FIND and REPLACE dialog boxes.
	    !-
	    status := set ( WIDGET, get_info (WIDGET, "widget_id",
			    lse$x_search_dialog,
			    "SEARCH_DIALOG.SEARCH_DIRECTION.SEARCH_FORWARD"),
			    eve$x_resource_array {eve$k_nset},
			    (CURRENT_DIRECTION = FORWARD) );
    
	    status := set ( WIDGET, get_info (WIDGET, "widget_id",
			    lse$x_search_dialog,
			    "SEARCH_DIALOG.SEARCH_DIRECTION.SEARCH_REVERSE"),
			    eve$x_resource_array {eve$k_nset},
			    (CURRENT_DIRECTION = REVERSE) );

	    eve$manage_widget(lse$x_search_dialog);
	    lse$add_minimum_size_to_dialog (lse$x_search_dialog);

	endif;
!%ENDIF
endprocedure;


procedure lse$$widget_set_search_direction

local
    status,
    the_value;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_set_search_direction");
ENDON_ERROR;

if eve$x_decwindows_active
then             
     if get_info(lse$x_search_dialog, "type") = WIDGET
     then
	  status := set ( WIDGET, get_info (WIDGET, "widget_id",
			  lse$x_search_dialog,
			  "SEARCH_DIALOG.SEARCH_DIRECTION.SEARCH_FORWARD"),
			  eve$x_resource_array {eve$k_nset},
			  (CURRENT_DIRECTION = FORWARD) );

	  status := set ( WIDGET, get_info (WIDGET, "widget_id",
			  lse$x_search_dialog,
			  "SEARCH_DIALOG.SEARCH_DIRECTION.SEARCH_REVERSE"),
			  eve$x_resource_array {eve$k_nset},
			  (CURRENT_DIRECTION = REVERSE) );
     endif;

     if get_info(lse$x_replace_dialog, "type") = WIDGET
     then
	  status := set ( WIDGET, get_info (WIDGET, "widget_id",
			  lse$x_replace_dialog,
			  "SUBSTITUTE_DIALOG.SUBSTITUTE_DIRECTION.SUBSTITUTE_FORWARD"),
			  eve$x_resource_array {eve$k_nset},
			  (CURRENT_DIRECTION = FORWARD) );

	  status := set ( WIDGET, get_info (WIDGET, "widget_id",
			  lse$x_replace_dialog,
			  "SUBSTITUTE_DIALOG.SUBSTITUTE_DIRECTION.SUBSTITUTE_REVERSE"),
			  eve$x_resource_array {eve$k_nset},
			  (CURRENT_DIRECTION = REVERSE) );
     endif;
endif;

endprocedure;

procedure lse$$widget_search_apply
local
    status,
    the_value,
    search_string;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_search_apply");
ENDON_ERROR;

! Get search string
!
search_string := get_info( get_info(WIDGET, 
				    "widget_id", 
				    lse$x_search_dialog,
				    "SEARCH_DIALOG.SEARCH_TEXT"),
			   "text");

! Test for no string
!
if search_string = ""
then
    eve$message(EVE$_NOFIND);
    return;
endif;

! Get the direction
!
status := get_info( get_info(WIDGET, 
			     "widget_id",
			     lse$x_search_dialog,
			     "SEARCH_DIALOG.SEARCH_DIRECTION.SEARCH_FORWARD"),
		    "widget_info", 
		    eve$x_resource_array{ eve$k_nset },
		    the_value );
if the_value = 0
then
    set( reverse, current_buffer );
else
    set( forward, current_buffer );
endif;

! Get wildcard toggle
!
status := get_info( get_info(WIDGET, 
			     "widget_id",
			     lse$x_search_dialog,
			     "SEARCH_DIALOG.SEARCH_WILDCARD"),
		    "widget_info", 
		    eve$x_resource_array{ eve$k_nset },
		    the_value );
if the_value <> 0
then
    ! Wildcard search
    !
    if search_string = lse$$search_string
    then
        status := lse_pattern_search( '' );
    else
	status := lse_pattern_search( search_string );
    endif;
else
    if search_string = lse$$search_string
    then
        status := lse_search( '' );
    else
	status := lse_search( search_string );
    endif;
endif;

return status;

endprocedure;

procedure lse$$widget_search_ok

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_search_ok");
ENDON_ERROR;

eve$unmanage_widget(lse$x_search_dialog);
lse$$widget_search_apply;

endprocedure;

procedure lse$$widget_search_cancel

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_search_cancel");
ENDON_ERROR;

eve$unmanage_widget(lse$x_search_dialog);
!!!! eve$message(EVE$_NOFIND);

endprocedure;

procedure lse$$widget_global_attributes
local
    the_width,
    status,
    the_value;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_global_attributes");
ENDON_ERROR;


!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_cursor} := 
!    GET_INFO( lse$system, 'lse$cursor_bound' );
!eve$$x_global_attr_array {eve$$k_global_attr_tab_mode} := eve$x_tab_mode;
!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}
!    := GET_INFO( lse$system, 'lse$pending_delete' );

lse$create_dialog_box ("GLOBAL_ATTRIBUTES_DIALOG", lse$x_set_interface_dialog);

! set widgets to the current values

status := set (WIDGET,
	       get_info (WIDGET, "widget_id", lse$x_set_interface_dialog,
			 "GLOBAL_ATTRIBUTES_DIALOG.SETINT_CURSOR.FREE_CURSOR"),
	       eve$x_resource_array {eve$k_nset}, (GET_INFO( lse$system, 'lse$cursor_bound' ) =
				  FALSE));

status := set (WIDGET,
	       get_info (WIDGET, "widget_id", lse$x_set_interface_dialog,
		"GLOBAL_ATTRIBUTES_DIALOG.SETINT_CURSOR.BOUND_CURSOR"),
	       eve$x_resource_array {eve$k_nset}, GET_INFO( lse$system, 'lse$cursor_bound' ));

status := set (WIDGET,
	       get_info (WIDGET, "widget_id", lse$x_set_interface_dialog,
	      "GLOBAL_ATTRIBUTES_DIALOG.SETINT_TABS_VISI_BOX"),
	       eve$x_resource_array {eve$k_nset},GET_INFO( lse$window, 'lse$tabs_visible' ) );

status := set (WIDGET,
	       get_info (WIDGET, "widget_id", lse$x_set_interface_dialog,
	      "GLOBAL_ATTRIBUTES_DIALOG.SETINT_TABS_HARD_BOX"),
	       eve$x_resource_array {eve$k_nset},GET_INFO( lse$window, 'lse$tabs_hard' ) );

status := set (WIDGET,
	       get_info (WIDGET, "widget_id", lse$x_set_interface_dialog,
	      "GLOBAL_ATTRIBUTES_DIALOG.SETINT_SELECT_MODEL_PREF_BOX.FOCUS_BASED_SELECT_MODEL"),
	       eve$x_resource_array {eve$k_nset}, 
	       GET_INFO (LSE$SYSTEM, 'lse$focus_based_select'));


status := set (WIDGET,
	       get_info (WIDGET, "widget_id", lse$x_set_interface_dialog,
	      "GLOBAL_ATTRIBUTES_DIALOG.SETINT_SELECT_MODEL_PREF_BOX.SELECTION_BASED_SELECT_MODEL"),
	       eve$x_resource_array {eve$k_nset}, 
	       GET_INFO (LSE$SYSTEM, 'lse$focus_based_select') = 0);

status := set (WIDGET,
	       get_info (WIDGET, "widget_id", lse$x_set_interface_dialog,
			 "GLOBAL_ATTRIBUTES_DIALOG.SETINT_BELL"),
	       eve$x_resource_array {eve$k_nset}, (GET_INFO( SYSTEM, 'bell' ) = ALL));

status := set (WIDGET,
	       get_info (WIDGET, "widget_id", lse$x_set_interface_dialog,
			 "GLOBAL_ATTRIBUTES_DIALOG.SETINT_PENDING_DELETE"),
	       eve$x_resource_array {eve$k_nset}, GET_INFO( lse$system, 'lse$pending_delete' ));

status := set(widget, get_info (WIDGET, "widget_id",
	      lse$x_set_interface_dialog,
	      "GLOBAL_ATTRIBUTES_DIALOG.SETINT_KEYPAD_PREF_BOX.SETINT_KEYPAD_EDT"),
	      eve$x_resource_array {eve$k_nset}, (GET_INFO( lse$system, 'lse$keypad' ) = lse$edt ));

status := set(widget, get_info (WIDGET, "widget_id",
	      lse$x_set_interface_dialog,
	      "GLOBAL_ATTRIBUTES_DIALOG.SETINT_KEYPAD_PREF_BOX.SETINT_KEYPAD_EVE"),
	      eve$x_resource_array {eve$k_nset}, (GET_INFO( lse$system, 'lse$keypad' ) = lse$eve ));

status := set(widget, get_info (WIDGET, "widget_id",
	      lse$x_set_interface_dialog,
	      "GLOBAL_ATTRIBUTES_DIALOG.SETINT_COMMAND_LANG_PREF_BOX.VMSLSE_COMMAND_LANGUAGE"),
	      eve$x_resource_array {eve$k_nset}, 
              GET_INFO( lse$system, 'lse$cli_parser' ));

status := set(widget, get_info (WIDGET, "widget_id",
	      lse$x_set_interface_dialog,
	      "GLOBAL_ATTRIBUTES_DIALOG.SETINT_COMMAND_LANG_PREF_BOX.PORTABLE_COMMAND_LANGUAGE"),
	      eve$x_resource_array {eve$k_nset}, 
              (GET_INFO( lse$system, 'lse$cli_parser' ) = 0 ));

status := set(TEXT, get_info (WIDGET, "widget_id",
	      lse$x_set_interface_dialog,
	      "GLOBAL_ATTRIBUTES_DIALOG.SETINT_SCROLL_MARGIN_TOP_TEXT"),
              STR(GET_INFO( lse$window, 'lse$top_scroll_margin' )) + '%');

status := set(TEXT, get_info (WIDGET, "widget_id",
	      lse$x_set_interface_dialog,
	      "GLOBAL_ATTRIBUTES_DIALOG.SETINT_SCROLL_MARGIN_BOT_TEXT"),
              STR(GET_INFO( lse$window, 'lse$bottom_scroll_margin' )) + '%');

status := set (WIDGET,
	       get_info (WIDGET, "widget_id", lse$x_set_interface_dialog,
               "GLOBAL_ATTRIBUTES_DIALOG.SETINT_CLIPBOARD"),
	       eve$x_resource_array {eve$k_nset}, 
               GET_INFO( lse$system, 'lse$clipboard' ));

status := set (WIDGET,
	       get_info (WIDGET, "widget_id", lse$x_set_interface_dialog,
               "GLOBAL_ATTRIBUTES_DIALOG.SETINT_UNDO_REDO"),
	       eve$x_resource_array {eve$k_nset}, 
               GET_INFO( lse$window, 'lse$undo' ));

status := set (WIDGET,
	       get_info (WIDGET, "widget_id", lse$x_set_interface_dialog,
	       "GLOBAL_ATTRIBUTES_DIALOG.SETINT_SAVE_RELATED_BUFFERS"),
	       eve$x_resource_array {eve$k_nset}, 
               GET_INFO( lse$system, 'lse$save_related_buffers' ));

eve$manage_widget(lse$x_set_interface_dialog);
                                 
endprocedure;


procedure lse$$widget_select_file (
   the_widget, the_parent, prompt, title, routine)
LOCAL
    status,
    current_dirmask,
    dialog_created;

on_error
    [OTHERWISE]:
       lse$post_command_proc;
       lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, 
                                 "lse$$widget_select_file");
endon_error;

dialog_created := lse$create_dialog_box (
                     "SELECT_FILE", the_widget, the_parent);

if dialog_created
then
    SET (WIDGET, the_widget, eve$x_resource_array {eve$k_ndirmask}, 
                    lse$x_file_selection_dirmask);

    lse$$set_dialog_title (the_widget, title); 
    MANAGE_WIDGET (the_widget);
    lse$add_minimum_size_to_dialog (the_widget);
else
    ! Using the current file filter in the file selection box, force a
    ! re-evaluation so the dialog box reflects the current contents of the
    ! directory.
    !
    status := GET_INFO (the_widget, "widget_info", 
	eve$x_resource_array {eve$k_ndirmask}, current_dirmask);
    SET (WIDGET, the_widget, eve$x_resource_array {eve$k_ndirmask}, current_dirmask);
    MANAGE_WIDGET (the_widget);
endif;

lse$$menus_associate_command (the_widget, routine);
endprocedure;


procedure lse$$widget_select_file_ok
LOCAL
   status,
   file_spec;

status := GET_INFO (eve$x_widget, "widget_info", 
                       eve$x_resource_array {eve$k_ndirspec}, file_spec);
!MESSAGE ("Select_file_OK " + str(file_spec));
execute (lse$$menus_get_associated_command (eve$x_widget) +
            '(''' + file_spec + ''');');
eve$unmanage_widget (eve$x_widget);
endprocedure;


procedure lse$$widget_select_file_cancel
eve$unmanage_widget (eve$x_widget);
endprocedure;



procedure lse$$widget_select_string (
             the_widget, the_parent, prompt_str, title, list_array, routine)

LOCAL the_widget_label,
      the_widget_text,
      list,
      dummy;

on_error
    [OTHERWISE]:
       lse$post_command_proc;
       lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, 
                                 "lse$$widget_select_string");
endon_error;
 
lse$create_dialog_box ("SELECT_STRING", the_widget, the_parent);
lse$$remove_help_button (the_widget);
lse$$remove_button(the_widget, "Apply");

list  := CREATE_ARRAY;
list {eve$x_resource_array {eve$k_nlist_items_count}}:= list_array;
                                              
set (widget, the_widget, list);
SET (WIDGET, the_widget, "selectionLabelString", prompt_str);
if title <> tpu$k_unspecified
then
    SET (WIDGET, the_widget, "dialogTitle", title);
endif;

!SET (WIDGET, the_widget, "textString", default_string);

lse$$set_dialog_title (the_widget); 
manage_widget (the_widget);

lse$$menus_associate_command (the_widget, routine);
lse$add_minimum_size_to_dialog (the_widget);
endprocedure;


procedure lse$$widget_select_string_ok
LOCAL
   status,
   the_string;

status := get_info (eve$x_widget, "widget_info", "textString", the_string);
!MESSAGE ("Select_string_OK " + str(the_string));
execute (lse$$menus_get_associated_command (eve$x_widget) +
            '(''' + the_string + ''');');
eve$unmanage_widget (eve$x_widget);
endprocedure;


procedure lse$$widget_select_string_cancel
eve$unmanage_widget (eve$x_widget);
endprocedure;



procedure lse$$build_language_name_array

LOCAL
    i,
    language_name_array,
    loop_language,
    language_name;

    language_name_array := CREATE_ARRAY;

    language_name_array {0} := 'NONE';
    i := 1;
    loop_language := get_info(lse$system, "first", lse$language);
    loop
	exitif loop_language = 0; 
        language_name := get_info( loop_language, 'lse$name' );
        language_name_array {i} := language_name;
        i := i + 1;
	loop_language := get_info(lse$system, "next", lse$language);
    endloop;
    return language_name_array;
endprocedure;



procedure lse$$build_buffer_name_array

LOCAL
    i,
    buffer_name_array,
    loop_buffer,
    buffer_name;

    buffer_name_array := CREATE_ARRAY;

    i := 0;
    loop_buffer := get_info (BUFFERS, "last") ;
    loop
	exitif loop_buffer = 0; 
        buffer_name := get_info( loop_buffer, "name");
        buffer_name_array {i} := buffer_name;
        i := i + 1;
        loop_buffer := get_info (BUFFERS, "previous");
    endloop;
    return buffer_name_array;
endprocedure;


procedure lse$$widget_buffer_attributes_update_readonly (
   readonly, unmodifiable);

! If the buffer is 'Read Only' then 'Unmodifiable' is set on by default.
! If the buffer is set to 'Write', 'Unmodifiable' is disabled.

LOCAL
   status,
   insertmode,
   overstrikemode;

if readonly then
   lse$$x_ba_write := false;
   lse$$menus_turn_on (lse$$x_ba_array {'unmodifiable'});
   if unmodifiable then
      insertmode := false;
      overstrikemode := false;
   else
      insertmode := get_info(lse$$x_ba_buffer,"mode") = INSERT;
      overstrikemode := get_info(lse$$x_ba_buffer,"mode") = OVERSTRIKE;
   endif;
else
   lse$$x_ba_write := true;
   lse$$menus_turn_off (lse$$x_ba_array {'unmodifiable'});
   insertmode := get_info(lse$$x_ba_buffer,"mode") = INSERT;
   overstrikemode := get_info(lse$$x_ba_buffer,"mode") = OVERSTRIKE;
endif;

status := set (WIDGET, lse$$x_ba_array {'readonly'},
	       eve$x_resource_array {eve$k_nset}, readonly);
status := set (WIDGET, lse$$x_ba_array {'write'},
	       eve$x_resource_array {eve$k_nset}, lse$$x_ba_write);

status := set (WIDGET, lse$$x_ba_array {'unmodifiable'},
	       eve$x_resource_array {eve$k_nset}, unmodifiable);

status := set (WIDGET, lse$$x_ba_array {'insert'},
	       eve$x_resource_array {eve$k_nset}, insertmode);
status := set (WIDGET, lse$$x_ba_array {'overstrike'},
	       eve$x_resource_array {eve$k_nset}, overstrikemode);

endprocedure;



procedure lse$$widget_buffer_read_only_toggle_changed
    LOCAL
       write_value,
       status;

    ! Call back for Read Only toggle change, but no action unless state
    ! of Write toggle has changed.

    status := get_info (lse$$x_ba_array {'write'}, "widget_info", 
                           eve$x_resource_array {eve$k_nset}, write_value);
    if write_value <> lse$$x_ba_write then
        if write_value then
           lse$$widget_buffer_attributes_update_readonly (false, false);
        else
           lse$$widget_buffer_attributes_update_readonly (true, true);
        endif;
    endif;
endprocedure;


procedure lse$$widget_buffer_language_select
    LOCAL
       the_widget,
       the_list;

    ON_ERROR
        [OTHERWISE]:
            lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, 
                               "lse$$widget_buffer_language_select");
    ENDON_ERROR;

    the_list := lse$$build_language_name_array;

    lse$$widget_select_string (
       the_widget, lse$x_buffer_attributes_dialog,
       'Language Name', 'Buf Attr : Language', the_list,
       'lse$$widget_buffer_language_select_ok');

    lse$$x_ba_array {'language_widget'} := the_widget;
endprocedure;


procedure lse$$widget_buffer_language_select_ok(the_string)
    LOCAL
       status;
   status := set (TEXT, lse$$x_ba_array {'language_text'}, the_string);
endprocedure;



procedure lse$$widget_buffer_buffer_select
    LOCAL
       the_widget,
       the_list;

    ON_ERROR
        [OTHERWISE]:
            lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, 
                               "lse$$widget_buffer_buffer_select");
    ENDON_ERROR;

    the_list := lse$$build_buffer_name_array;

    lse$$widget_select_string (
       the_widget, lse$x_buffer_attributes_dialog,
       'Buffer Name', 'Buf Attr : Buffer', the_list,
       'lse$$widget_buffer_buffer_select_ok');

    lse$$x_ba_array {'buffer_widget'} := the_widget;
endprocedure;



procedure lse$$widget_buffer_buffer_select_ok(the_string)
    LOCAL
       status;
   status := set (TEXT, lse$$x_ba_array {'buffer_text'}, the_string);
endprocedure;



procedure lse$$widget_buffer_outputfile_select
    LOCAL
       the_widget;

    ON_ERROR
        [OTHERWISE]:
            lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, 
                               "lse$$widget_buffer_outputfile_select");
    ENDON_ERROR;

    lse$$widget_select_file (
       the_widget, lse$x_buffer_attributes_dialog,
       'Output File Name', 'Buf Attr : Output File',
       'lse$$widget_buffer_outputfile_select_ok');

    lse$$x_ba_array {'outputfile_widget'} := the_widget;
endprocedure;



procedure lse$$widget_buffer_outputfile_select_ok(the_string)
    LOCAL
       status;
   status := set (TEXT, lse$$x_ba_array {'outputfile_text'}, the_string);
endprocedure;



procedure lse$$widget_buffer_attributes_update
local
    outputfile,
    language,
    readonly,
    unmodifiable,
    status;

outputfile := get_info (lse$$x_ba_buffer, "output_file");
if outputfile = 0 then outputfile := ''; endif;
status := set (TEXT, lse$$x_ba_array {'outputfile_text'}, outputfile);

language := get_info (lse$$x_ba_buffer, 'lse$language');
if language = 0 then language := 'NONE'; endif;
status := set (TEXT, lse$$x_ba_array {'language_text'}, language);

status := set (TEXT, lse$$x_ba_array {'leftmargin_text'},
	       str (get_info (lse$$x_ba_buffer, "lse$left_margin")));

status := set (TEXT, lse$$x_ba_array {'rightmargin_text'},
	       str (get_info (lse$$x_ba_buffer, "right_margin")));

status := set (TEXT, lse$$x_ba_array {'tabincrement_text'},
	       str (get_info (lse$$x_ba_buffer, 'lse$tab_increment')));

status := set (TEXT, lse$$x_ba_array {'maxundo_text'},
	       str (lse$$show_max_undo(get_info (lse$$x_ba_buffer, "name"))));

status := set (WIDGET, lse$$x_ba_array {'autoerase'},
	       eve$x_resource_array {eve$k_nset}, 
               GET_INFO( lse$$x_ba_buffer, 'lse$auto_erase' ));

status := set (WIDGET, lse$$x_ba_array {'journaling'},
	       eve$x_resource_array {eve$k_nset}, 
               GET_INFO( lse$$x_ba_buffer, 'journaling'));

status := set (WIDGET, lse$$x_ba_array {'wrap'},
	       eve$x_resource_array {eve$k_nset}, 
               GET_INFO( lse$$x_ba_buffer, 'lse$wrap' ));

status := set (WIDGET, lse$$x_ba_array {'overview'},
	       eve$x_resource_array {eve$k_nset}, 
               GET_INFO( lse$$x_ba_buffer, 'lse$overviews' ));

readonly := get_info ( lse$$x_ba_buffer, 'lse$read_only');
if readonly then
   unmodifiable := (get_info ( lse$$x_ba_buffer, 'modifiable') = 0);
else
   unmodifiable := false;
endif;
lse$$widget_buffer_attributes_update_readonly (readonly, unmodifiable);

status := set (WIDGET, lse$$x_ba_array {'forward'},
	       eve$x_resource_array {eve$k_nset}, 
               (GET_INFO(lse$$x_ba_buffer,"direction")=FORWARD));
status := set (WIDGET, lse$$x_ba_array {'reverse'},
	       eve$x_resource_array {eve$k_nset}, 
               (GET_INFO(lse$$x_ba_buffer,"direction")=REVERSE));
endprocedure;


procedure lse$$widget_buffer_attributes_set_sensitivity (the_value);
   set (widget, lse$$x_ba_array {'outputfile_label'},   "sensitive", the_value);
   set (widget, lse$$x_ba_array {'outputfile_text'},    "sensitive", the_value);
   set (widget, lse$$x_ba_array {'outputfile_select'},  "sensitive", the_value);
   set (widget, lse$$x_ba_array {'language_label'},     "sensitive", the_value);
   set (widget, lse$$x_ba_array {'language_text'},      "sensitive", the_value);
   set (widget, lse$$x_ba_array {'language_select'},    "sensitive", the_value);
   set (widget, lse$$x_ba_array {'leftmargin_label'},   "sensitive", the_value);
   set (widget, lse$$x_ba_array {'leftmargin_text'},    "sensitive", the_value);
   set (widget, lse$$x_ba_array {'rightmargin_label'},  "sensitive", the_value);
   set (widget, lse$$x_ba_array {'rightmargin_text'},   "sensitive", the_value);
   set (widget, lse$$x_ba_array {'tabincrement_label'}, "sensitive", the_value);
   set (widget, lse$$x_ba_array {'tabincrement_text'},  "sensitive", the_value);
   set (widget, lse$$x_ba_array {'maxundo_label'},      "sensitive", the_value);
   set (widget, lse$$x_ba_array {'maxundo_text'},       "sensitive", the_value);
   set (widget, lse$$x_ba_array {'write'},              "sensitive", the_value);
   set (widget, lse$$x_ba_array {'readonly'},           "sensitive", the_value);
   set (widget, lse$$x_ba_array {'unmodifiable'},       "sensitive", the_value);
   set (widget, lse$$x_ba_array {'insert'},             "sensitive", the_value);
   set (widget, lse$$x_ba_array {'overstrike'},         "sensitive", the_value);
   set (widget, lse$$x_ba_array {'autoerase'},          "sensitive", the_value);
   set (widget, lse$$x_ba_array {'journaling'},         "sensitive", the_value);
   set (widget, lse$$x_ba_array {'wrap'},               "sensitive", the_value);
   set (widget, lse$$x_ba_array {'overview'},           "sensitive", the_value);
   set (widget, lse$$x_ba_array {'forward'},            "sensitive", the_value);
   set (widget, lse$$x_ba_array {'reverse'},            "sensitive", the_value);
   set (widget, lse$$x_ba_array {'ok'},                 "sensitive", the_value);
   set (widget, lse$$x_ba_array {'apply'},              "sensitive", the_value);
endprocedure;



procedure lse$$widget_buffer_buffer_text_changed
    LOCAL
        the_buffer,
        the_buffer_name;

    the_buffer_name := get_info (lse$$x_ba_array {'buffer_text'}, "text");

    the_buffer := get_info (buffer, "find_buffer", the_buffer_name);

    if the_buffer = 0 then
       if lse$$x_ba_sensitive then
          lse$$widget_buffer_attributes_set_sensitivity (false);
          lse$$x_ba_sensitive := false;
       endif;
    else
       if not lse$$x_ba_sensitive then
          lse$$widget_buffer_attributes_set_sensitivity (true);
          lse$$x_ba_sensitive := true;
       endif;
       if lse$$x_ba_buffer <> the_buffer then
          lse$$x_ba_buffer := the_buffer;
          lse$$widget_buffer_attributes_update;
       endif;
    endif;
endprocedure;


procedure lse$$widget_buffer_deleted (buffer_ptr)
    !Called from lse_delete_buffer

    if (buffer_ptr = lse$$x_ba_buffer)
    and (lse$x_buffer_attributes_dialog <> tpu$k_unspecified) then
       if get_info (lse$x_buffer_attributes_dialog, "is_managed")
       and lse$$x_ba_sensitive then
          lse$$widget_buffer_attributes_set_sensitivity (false);
          lse$$x_ba_sensitive := false;
      endif;
    endif;
endprocedure;


procedure lse$$widget_buffer_attributes
local
    dialog_created,
    outputfile,
    language,
    readonly,
    mode,
    status;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, 
                               "lse$$widget_buffer_attributes");
ENDON_ERROR;


dialog_created := lse$create_dialog_box (
                    "BUFFER_ATTRIBUTES_DIALOG", lse$x_buffer_attributes_dialog);

if lse$$x_ba_array = tpu$k_unspecified then
    lse$$x_ba_array := CREATE_ARRAY;
    lse$$x_ba_array {'buffer_label'} :=
	       get_info (WIDGET, "widget_id",
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_BUFFER_TEXT_LABEL");
    lse$$x_ba_array {'buffer_text'} :=
	       get_info (WIDGET, "widget_id",
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_BUFFER_TEXT");
    lse$$x_ba_array {'buffer_select'} :=
	       get_info (WIDGET, "widget_id",
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_BUFFER_SELECT");
    lse$$x_ba_array {'outputfile_label'} :=
	       get_info (WIDGET, "widget_id",
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_OUTPUTFILE_TEXT_LABEL");
    lse$$x_ba_array {'outputfile_text'} :=
	       get_info (WIDGET, "widget_id",
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_OUTPUTFILE_TEXT");
    lse$$x_ba_array {'outputfile_select'} :=
	       get_info (WIDGET, "widget_id",
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_OUTPUTFILE_SELECT");
    lse$$x_ba_array {'language_label'} :=
	       get_info (WIDGET, "widget_id",
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_LANGUAGE_TEXT_LABEL");
    lse$$x_ba_array {'language_text'} :=
	       get_info (WIDGET, "widget_id",
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_LANGUAGE_TEXT");
    lse$$x_ba_array {'language_select'} :=
	       get_info (WIDGET, "widget_id",
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_LANGUAGE_SELECT");
    lse$$x_ba_array {'leftmargin_label'} :=
	       get_info (WIDGET, "widget_id",
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_LEFT_MARGIN_TEXT_LABEL");
    lse$$x_ba_array {'leftmargin_text'} :=
	       get_info (WIDGET, "widget_id",
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_LEFT_MARGIN_TEXT");
    lse$$x_ba_array {'rightmargin_label'} :=
	       get_info (WIDGET, "widget_id",
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_RIGHT_MARGIN_TEXT_LABEL");
    lse$$x_ba_array {'rightmargin_text'} :=
	       get_info (WIDGET, "widget_id",
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_RIGHT_MARGIN_TEXT");
    lse$$x_ba_array {'tabincrement_label'} :=
	       get_info (WIDGET, "widget_id",
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_TAB_INCREMENT_TEXT_LABEL");
    lse$$x_ba_array {'tabincrement_text'} :=
	       get_info (WIDGET, "widget_id",
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_TAB_INCREMENT_TEXT");
    lse$$x_ba_array {'maxundo_label'} :=
	       get_info (WIDGET, "widget_id",
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_MAX_UNDO_TEXT_LABEL");
    lse$$x_ba_array {'maxundo_text'} :=
	       get_info (WIDGET, "widget_id",
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_MAX_UNDO_TEXT");
    lse$$x_ba_array {'autoerase'} :=
	       get_info (WIDGET, "widget_id", 
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_AUTO_ERASE");
    lse$$x_ba_array {'journaling'} :=
	       get_info (WIDGET, "widget_id", 
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_JOURNALING");
    lse$$x_ba_array {'wrap'} :=
	       get_info (WIDGET, "widget_id", 
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_WRAP");
    lse$$x_ba_array {'overview'} :=
	       get_info (WIDGET, "widget_id", 
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_OVERVIEW");
    lse$$x_ba_array {'readonly'} :=
	       get_info (WIDGET, "widget_id", 
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_WRITE_STATUS.BUFFER_READ_ONLY_TOGGLE");
    lse$$x_ba_array {'write'} :=
	       get_info (WIDGET, "widget_id", 
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_WRITE_STATUS.BUFFER_WRITE_TOGGLE");
    lse$$x_ba_array {'unmodifiable'} :=
               get_info (widget, "widget_id", 
                  lse$x_buffer_attributes_dialog,
                  "BUFFER_ATTRIBUTES_DIALOG.BUFFER_MODIFICATION_STATUS.BUFFER_UNMODIFIABLE_TOGGLE");
    lse$$x_ba_array {'insert'} :=
   	       get_info (WIDGET, "widget_id", 
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_MODIFICATION_STATUS.BUFFER_INSERT_TOGGLE");
    lse$$x_ba_array {'overstrike'} :=
   	       get_info (WIDGET, "widget_id", 
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_MODIFICATION_STATUS.BUFFER_OVERSTRIKE_TOGGLE");
    lse$$x_ba_array {'forward'} :=
	       get_info (WIDGET, "widget_id", 
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_DIRECTION_STATUS.BUFFER_FORWARD_TOGGLE");
    lse$$x_ba_array {'reverse'} :=
	       get_info (WIDGET, "widget_id", 
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_DIRECTION_STATUS.BUFFER_REVERSE_TOGGLE");
    lse$$x_ba_array {'ok'} :=
	       get_info (WIDGET, "widget_id", 
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_OK");
    lse$$x_ba_array {'apply'} :=
	       get_info (WIDGET, "widget_id", 
	          lse$x_buffer_attributes_dialog,
	          "BUFFER_ATTRIBUTES_DIALOG.BUFFER_APPLY");
endif;

lse$$x_ba_sensitive := true;
lse$$x_ba_buffer := current_buffer;
status := set (TEXT, lse$$x_ba_array {'buffer_text'},
    	       get_info (lse$$x_ba_buffer, "name"));
lse$$widget_buffer_attributes_update;

eve$manage_widget(lse$x_buffer_attributes_dialog);
                                 
endprocedure;


procedure lse$$widget_setint_apply
local
    status,
    the_width,
    the_value,
    the_value2;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_setint_apply");
ENDON_ERROR;

status := get_info (get_info (WIDGET, "widget_id",
			      lse$x_set_interface_dialog,
			      "GLOBAL_ATTRIBUTES_DIALOG.SETINT_CURSOR.BOUND_CURSOR"),
		    "widget_info", eve$x_resource_array {eve$k_nset}, the_value);

if the_value <> GET_INFO( lse$system, 'lse$cursor_bound' )
then
    if the_value 
    then
	lse_set_cursor( lse$list_extract( lse$_cursordelimit,
					  lse$_cursorlist,
					  lse$$k_cursor_bound ) );
    else
	lse_set_cursor( lse$list_extract( lse$_cursordelimit,
					  lse$_cursorlist,
					  lse$$k_cursor_free ) );
    endif;
endif;

status := get_info (get_info (WIDGET, "widget_id",
	      lse$x_set_interface_dialog,
	      "GLOBAL_ATTRIBUTES_DIALOG.SETINT_TABS_VISI_BOX"),
 	      "widget_info", eve$x_resource_array {eve$k_nset}, the_value);

if GET_INFO( lse$window, 'lse$tabs_visible' ) <> the_value
then
    lse_set_tabs_visible (the_value);
endif;

status := get_info (get_info (WIDGET, "widget_id",
	      lse$x_set_interface_dialog,
	      "GLOBAL_ATTRIBUTES_DIALOG.SETINT_TABS_HARD_BOX"),
 	      "widget_info", eve$x_resource_array {eve$k_nset}, the_value);

if GET_INFO( lse$window, 'lse$tabs_hard' ) <> the_value
then
    lse_set_tabs_hard (the_value);
endif;

status := get_info (get_info (WIDGET, "widget_id",
			      lse$x_set_interface_dialog,
			      "GLOBAL_ATTRIBUTES_DIALOG.SETINT_PENDING_DELETE"),
		    "widget_info", eve$x_resource_array {eve$k_nset}, the_value);

if GET_INFO( lse$system, 'lse$pending_delete' ) <> the_value
then
    lse_set_pending_delete( the_value );
endif;

status := get_info ( get_info (WIDGET, "widget_id",
	      lse$x_set_interface_dialog,
	      "GLOBAL_ATTRIBUTES_DIALOG.SETINT_KEYPAD_PREF_BOX.SETINT_KEYPAD_EDT"),
	      "widget_info",eve$x_resource_array {eve$k_nset},the_value);

if GET_INFO( lse$system, 'lse$keypad' ) <> the_value
then
    if the_value
then
	lse_set_keypad( lse$list_extract( lse$_keypaddelimit,
					  lse$_keypadlist,
					  lse$$k_keypad_edt ) ); 
    else
	lse_set_keypad( lse$list_extract( lse$_keypaddelimit,
					  lse$_keypadlist,
					  lse$$k_keypad_eve ) ); 
    endif;
endif;

status := get_info ( get_info (WIDGET, "widget_id",
	      lse$x_set_interface_dialog,
	      "GLOBAL_ATTRIBUTES_DIALOG.SETINT_SELECT_MODEL_PREF_BOX.FOCUS_BASED_SELECT_MODEL"),
	      "widget_info",eve$x_resource_array {eve$k_nset},the_value);

if GET_INFO (lse$system, 'lse$focus_based_select') <> the_value
then
    if the_value
    then
	lse_set_primary_selection_model (lse$list_extract ( lse$_selmodeldelimit,
							    lse$_selmodellist,
							    lse$$k_sel_model_focus));
    else
	lse_set_primary_selection_model (lse$list_extract ( lse$_selmodeldelimit,
							    lse$_selmodellist,
							    lse$$k_sel_model_selection));
    endif;
endif;

status := get_info (get_info (WIDGET, "widget_id",
	      lse$x_set_interface_dialog,
              "GLOBAL_ATTRIBUTES_DIALOG.SETINT_COMMAND_LANG_PREF_BOX.VMSLSE_COMMAND_LANGUAGE"),
	      "widget_info", eve$x_resource_array {eve$k_nset}, 
              the_value);

if the_value <> GET_INFO( lse$system, 'lse$cli_parser' )
then
    if the_value 
    then
	lse_set_command_language( 
                        lse$list_extract( lse$_cmdlngdelimit,
					  lse$_cmdlnglist,
					  lse$$k_cmdlng_lse ) );
    else
	lse_set_command_language( 
                        lse$list_extract( lse$_cmdlngdelimit,
					  lse$_cmdlnglist,
					  lse$$k_cmdlng_plse ) );
    endif;
endif;

the_value  := get_info (get_info(WIDGET, "widget_id", lse$x_set_interface_dialog,
                       "GLOBAL_ATTRIBUTES_DIALOG.SETINT_SCROLL_MARGIN_TOP_TEXT"),
		       "text");

the_value2 := get_info (get_info(WIDGET, "widget_id", lse$x_set_interface_dialog,
                       "GLOBAL_ATTRIBUTES_DIALOG.SETINT_SCROLL_MARGIN_BOT_TEXT"),
		       "text");

if (the_value  <> get_info( lse$window, 'lse$top_scroll_margin' ))
or (the_value2 <> get_info( lse$window, 'lse$bottom_scroll_margin' ))
then
    lse_set_scroll_margins ( the_value, the_value2 );
endif;

status := get_info (get_info (WIDGET, "widget_id", lse$x_set_interface_dialog,
               "GLOBAL_ATTRIBUTES_DIALOG.SETINT_CLIPBOARD"),
	       "widget_info", eve$x_resource_array {eve$k_nset}, 
               the_value);

if GET_INFO( lse$system, 'lse$clipboard' ) <> the_value
then
    lse_set_clipboard( the_value );
endif;

status := get_info (get_info (WIDGET, "widget_id",
	      lse$x_set_interface_dialog,
	      "GLOBAL_ATTRIBUTES_DIALOG.SETINT_UNDO_REDO"),
 	      "widget_info", eve$x_resource_array {eve$k_nset}, the_value);

if GET_INFO( lse$window, 'lse$undo' ) <> the_value
then
    lse_set_undo (the_value);
endif;

status := get_info (get_info (WIDGET, "widget_id", lse$x_set_interface_dialog,
	       "GLOBAL_ATTRIBUTES_DIALOG.SETINT_SAVE_RELATED_BUFFERS"),
	       "widget_info", eve$x_resource_array {eve$k_nset}, 
               the_value);

if GET_INFO( lse$system, 'lse$save_related_buffers' ) <> the_value
then
    lse_set_save_related_buffers( the_value );
endif;

status := get_info ( get_info (WIDGET, "widget_id",
	      lse$x_set_interface_dialog,
	      "GLOBAL_ATTRIBUTES_DIALOG.SETINT_BELL"),
	      "widget_info",eve$x_resource_array {eve$k_nset},the_value);

lse_set_bell_all( the_value );

return;
endprocedure;


procedure lse$$widget_setint_ok

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_setint_ok");
ENDON_ERROR;

eve$unmanage_widget(lse$x_set_interface_dialog);
lse$$widget_setint_apply;

return;
endprocedure;


procedure lse$$widget_setint_cancel

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_setint_cancel");
ENDON_ERROR;

eve$unmanage_widget(lse$x_set_interface_dialog);

endprocedure;


procedure lse$$str_to_int (string)
ON_ERROR
    [TPU$_NULLSTRING, TPU$_INVNUMSTR]:
        MESSAGE (ERROR_TEXT);
        return tpu$k_unspecified;
ENDON_ERROR;

    return int(string);
endprocedure;



procedure lse$$widget_buffer_apply
local
    status,
    the_width,
    the_value,
    result,
    saved_current_buffer;

ON_ERROR
    [TPU$_NULLSTRING, TPU$_INVNUMSTR]:
        MESSAGE (ERROR_TEXT);
        result := false;
    [TPU$_WINDNOTVIS]:
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, 
                                  "lse$$widget_buffer_apply");
ENDON_ERROR;


result := true;
saved_current_buffer := current_buffer;

if lse$$x_ba_buffer <> saved_current_buffer then
   !MESSAGE ("buffer changed");
   lse$$push_position;
   position (lse$$x_ba_buffer);
endif;

the_value := get_info (lse$$x_ba_array {'outputfile_text'}, "text");

if the_value <> get_info (lse$$x_ba_buffer, 'output_file') then
    if (the_value <> '') or  (get_info (lse$$x_ba_buffer, 'output_file') <> 0) then
       result := result AND lse_set_buffer_output_file (the_value);
    endif;
endif;

the_value := get_info (lse$$x_ba_array {'language_text'}, "text");
if the_value = 'NONE' then the_value := ''; endif;

if the_value <> get_info (lse$$x_ba_buffer, 'lse$language') then
    result := result AND lse_set_buffer_language (the_value);
endif;

the_value := lse$$str_to_int (
                get_info (lse$$x_ba_array {'leftmargin_text'}, "text"));

if the_value = tpu$k_unspecified then
   result := false;
else
   if the_value <> get_info (lse$$x_ba_buffer, 'lse$left_margin') then
       result := result AND lse_set_buffer_left_margin (the_value);
   endif;
endif;

the_value := lse$$str_to_int (
                get_info (lse$$x_ba_array {'rightmargin_text'}, "text"));

if the_value = tpu$k_unspecified then
   result := false;
else
   if the_value <> get_info (lse$$x_ba_buffer, 'right_margin') then
       result := result AND lse_set_buffer_right_margin (the_value);
   endif;
endif;

the_value := lse$$str_to_int (
                get_info (lse$$x_ba_array {'tabincrement_text'}, "text"));

if the_value = tpu$k_unspecified then
   result := false;
else
   if the_value <> get_info (lse$$x_ba_buffer, 'lse$tab_increment') then
       result := result AND lse_set_buffer_tab_increment (the_value);
   endif;
endif;

the_value := lse$$str_to_int (
                get_info (lse$$x_ba_array {'maxundo_text'}, "text"));

if the_value = tpu$k_unspecified then
   result := false;
else
   if the_value <> lse$$show_max_undo (get_info (lse$$x_ba_buffer, "name")) then
       result := result AND lse_set_max_undo (the_value);
   endif;
endif;

status := get_info (lse$$x_ba_array {'autoerase'}, "widget_info", 
                       eve$x_resource_array {eve$k_nset}, the_value);

if the_value = tpu$k_unspecified then
   result := false;
else
   if the_value <> get_info ( lse$$x_ba_buffer, 'lse$auto_erase') then
       result := result AND lse_set_buffer_auto_erase (the_value);
   endif;
endif;

status := get_info (lse$$x_ba_array {'journaling'}, "widget_info", 
                       eve$x_resource_array {eve$k_nset}, the_value);

if the_value <> get_info ( lse$$x_ba_buffer, 'journaling') then
    result := result AND lse_set_buffer_journaling (the_value);
endif;

status := get_info (lse$$x_ba_array {'wrap'}, "widget_info", 
                       eve$x_resource_array {eve$k_nset}, the_value);

if the_value <> get_info ( lse$$x_ba_buffer, 'lse$wrap') then
    result := result AND lse_set_buffer_wrap (the_value);
endif;

status := get_info (lse$$x_ba_array {'overview'}, "widget_info", 
                       eve$x_resource_array {eve$k_nset}, the_value);

if the_value <> get_info ( lse$$x_ba_buffer, 'lse$overviews') then
    result := result AND lse_set_buffer_overview (the_value);
endif;

status := get_info (lse$$x_ba_array {'readonly'}, "widget_info", 
                       eve$x_resource_array {eve$k_nset}, the_value);

if the_value <> get_info ( lse$$x_ba_buffer, 'lse$read_only') then
    if the_value then
       result := result AND lse_set_buffer_close ('readonly');
    else
       result := result AND lse_set_buffer_close ('write');
    endif;
endif;

status := get_info (lse$$x_ba_array {'unmodifiable'}, "widget_info", 
                       eve$x_resource_array {eve$k_nset}, the_value);

if the_value = get_info ( lse$$x_ba_buffer, 'modifiable') then
    result := result AND lse_set_buffer_modifiable (not the_value);
endif;

status := get_info (lse$$x_ba_array {'insert'}, "widget_info", 
                       eve$x_resource_array {eve$k_nset}, the_value);

if the_value <> (get_info ( lse$$x_ba_buffer, 'mode') = INSERT) then
    result := result AND lse_toggle_insert_overstrike;
endif;

status := get_info (lse$$x_ba_array {'forward'}, "widget_info", 
                       eve$x_resource_array {eve$k_nset}, the_value);

if the_value <> (get_info ( lse$$x_ba_buffer, 'direction') = FORWARD) then
    if the_value then
       result := result AND lse_set_buffer_direction (FORWARD);
    else
       result := result AND lse_set_buffer_direction (REVERSE);
    endif;
endif;

if lse$$x_ba_buffer <> saved_current_buffer then
   !MESSAGE ("buffer changed back");
   lse$$pop_position;
endif;

if not result then
   lse$$popup_message (
      "Invalid value(s), see message buffer for more information", 
      lse$x_buffer_attributes_dialog);
endif;

endprocedure;


procedure lse$$widget_buffer_ok

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, 
                                  "lse$$widget_buffer_ok");
ENDON_ERROR;

eve$unmanage_widget(lse$x_buffer_attributes_dialog);
lse$$widget_buffer_apply;

endprocedure;


procedure lse$$widget_buffer_cancel

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, 
                                  "lse$$widget_buffer_cancel");
ENDON_ERROR;

if lse$$x_ba_array {'buffer_widget'} <> tpu$k_unspecified then
   eve$unmanage_widget (lse$$x_ba_array {'buffer_widget'});
endif;
if lse$$x_ba_array {'outputfile_widget'} <> tpu$k_unspecified then
   eve$unmanage_widget (lse$$x_ba_array {'outputfile_widget'});
endif;
if lse$$x_ba_array {'language_widget'} <> tpu$k_unspecified then
   eve$unmanage_widget (lse$$x_ba_array {'language_widget'});
endif;

eve$unmanage_widget(lse$x_buffer_attributes_dialog);

endprocedure;


procedure lse$$widget_update_height_width
local
    the_width,
    the_length,
    status;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_update_height_width");
ENDON_ERROR;

!+
!   Note: Setting height/width must be done befoe setting fonts.
!         Otherwise, it could enter a infinite loop.
!-

if get_info(lse$x_window_attributes_dialog, "type") = WIDGET     
then
    ! set widgets to the current values

    the_length := get_info (SCREEN, "new_length");
    status := set (TEXT, get_info (WIDGET, "widget_id",
		 lse$x_window_attributes_dialog,
		 "WINDOW_ATTRIBUTES_DIALOG.SCREEN_ROWS_TEXT"),
	         STR(the_length));

    the_width := GET_INFO(SCREEN, "new_width");
    status := set (TEXT, get_info (WIDGET, "widget_id",
		 lse$x_window_attributes_dialog,
		 "WINDOW_ATTRIBUTES_DIALOG.SCREEN_WIDTH_TEXT"),
	         str(the_width));
endif;

endprocedure;

procedure lse$$widget_window_attributes
local
    status;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_window_attributes");
ENDON_ERROR;


!+
!   Note: Setting height/width must be done befoe setting fonts.
!         Otherwise, it could enter a infinite loop.
!-

lse$create_dialog_box ("WINDOW_ATTRIBUTES_DIALOG", lse$x_window_attributes_dialog);

! set widgets to the current values

status := set (TEXT, get_info (WIDGET, "widget_id",
		 lse$x_window_attributes_dialog,
		 "WINDOW_ATTRIBUTES_DIALOG.SCREEN_ROWS_TEXT"),
	         STR(get_info (SCREEN, "visible_length")));

status := set (TEXT, get_info (WIDGET, "widget_id",
		 lse$x_window_attributes_dialog,
		 "WINDOW_ATTRIBUTES_DIALOG.SCREEN_WIDTH_TEXT"),
	         STR(GET_INFO(lse$window, "lse$width")) );

status := set (TEXT, get_info (WIDGET, "widget_id",
		 lse$x_window_attributes_dialog,
		 "WINDOW_ATTRIBUTES_DIALOG.NUMBER_OF_WINDOWS_TEXT"),
	         STR(get_info(lse$window, 'lse$num_of_windows')));

status := set (TEXT, get_info (WIDGET, "widget_id",
		 lse$x_window_attributes_dialog,
		 "WINDOW_ATTRIBUTES_DIALOG.MAX_NUMBER_OF_WINDOWS_TEXT"),
	         STR(get_info( lse$window, 'lse$max_windows' )) );

status := set (TEXT, get_info (WIDGET, "widget_id",
		 lse$x_window_attributes_dialog,
		 "WINDOW_ATTRIBUTES_DIALOG.PANES_MIN_ROWS_TEXT"),
	         STR( get_info( lse$window, 'lse$min_window_len' )) );

status := set(widget, get_info (WIDGET, "widget_id",
	      lse$x_window_attributes_dialog,
	      "WINDOW_ATTRIBUTES_DIALOG.PANES_BALANCE"),
	      eve$x_resource_array {eve$k_nset}, (get_info( lse$window, 'lse$balance_windows' )) );

status := set(widget, get_info (WIDGET, "widget_id",
	      lse$x_window_attributes_dialog,
	      "WINDOW_ATTRIBUTES_DIALOG.FONT_PREF_BOX.FONT_BIG"),
	      eve$x_resource_array {eve$k_nset}, (GET_INFO( lse$window, 'lse$font_little' ) = 0));

status := set(widget, get_info (WIDGET, "widget_id",
	      lse$x_window_attributes_dialog,
	      "WINDOW_ATTRIBUTES_DIALOG.FONT_PREF_BOX.FONT_LITTLE"),
	      eve$x_resource_array {eve$k_nset}, GET_INFO( lse$window, 'lse$font_little' ));

status := set(widget, get_info (WIDGET, "widget_id",
	      lse$x_window_attributes_dialog,
	      "WINDOW_ATTRIBUTES_DIALOG.FONT_WIDTH_PREF_BOX.FONT_NORMAL"),
	      eve$x_resource_array {eve$k_nset}, (GET_INFO( lse$window, 'lse$font_condensed' ) = 0));

status := set(widget, get_info (WIDGET, "widget_id",
	      lse$x_window_attributes_dialog,
	      "WINDOW_ATTRIBUTES_DIALOG.FONT_WIDTH_PREF_BOX.FONT_CONDENSED"),
	      eve$x_resource_array {eve$k_nset}, GET_INFO( lse$window, 'lse$font_condensed' ));

eve$manage_widget(lse$x_window_attributes_dialog);

lse$add_minimum_size_to_dialog (lse$x_window_attributes_dialog);
                                 
endprocedure;


procedure lse$$widget_window_attributes_apply
local
    status,
    the_value;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_window_attributes_apply");
ENDON_ERROR;


!+
!   Height (rows)
!-
the_value := get_info (get_info(WIDGET, "widget_id", lse$x_window_attributes_dialog,
			 "WINDOW_ATTRIBUTES_DIALOG.SCREEN_ROWS_TEXT"),
		       "text");

if int(the_value) <> get_info( screen, 'visible_length' )
then
    lse_set_height( the_value );
endif;

!+
!   width
!-
the_value := get_info (get_info(WIDGET, "widget_id", lse$x_window_attributes_dialog,
			 "WINDOW_ATTRIBUTES_DIALOG.SCREEN_WIDTH_TEXT"),
		       "text");

if int(the_value) <> get_info( lse$window, 'lse$width' )
then
    lse_set_width( the_value );
endif;

!+
!   Maximum number of windows
!-
the_value := get_info (get_info(WIDGET, "widget_id", lse$x_window_attributes_dialog,
			 "WINDOW_ATTRIBUTES_DIALOG.MAX_NUMBER_OF_WINDOWS_TEXT"),
		       "text");

if int(the_value) <> get_info( lse$window, 'lse$max_windows' )
then
    lse_set_maximum_windows( the_value );
endif;

!+
!   Number of windows
!-
the_value := get_info (get_info(WIDGET, "widget_id", lse$x_window_attributes_dialog,
			 "WINDOW_ATTRIBUTES_DIALOG.NUMBER_OF_WINDOWS_TEXT"),
		       "text");

if int(the_value) <> get_info( lse$window, 'lse$num_of_windows' )
then
    lse_set_number_of_windows( the_value );
endif;

!+
!   Balance
!-
status := get_info (get_info(WIDGET, "widget_id",
			 lse$x_window_attributes_dialog,
			 "WINDOW_ATTRIBUTES_DIALOG.PANES_BALANCE"),
		      "widget_info",eve$x_resource_array {eve$k_nset},the_value);

if the_value <> get_info( lse$window, 'lse$balance_windows' )
then
    lse_set_balance_windows( the_value );
endif;

!+
!   Minimum rows
!-
the_value := get_info (get_info(WIDGET, "widget_id", lse$x_window_attributes_dialog,
			 "WINDOW_ATTRIBUTES_DIALOG.PANES_MIN_ROWS_TEXT"),
		       "text");

if int(the_value) <> get_info( lse$window, 'lse$min_window_len' )
then
    lse_set_minimum_window_length( the_value );
endif;

!+
!   Big or little font
!-
status := get_info ( get_info (WIDGET, "widget_id",
	      lse$x_window_attributes_dialog,
	      "WINDOW_ATTRIBUTES_DIALOG.FONT_PREF_BOX.FONT_LITTLE"),
	      "widget_info",eve$x_resource_array {eve$k_nset},the_value);

IF the_value <> get_info( lse$window, 'lse$font_little' )
THEN
    IF the_value
    THEN
	lse_set_font( lse$list_extract( lse$_fontdelimit,
					lse$_fontlist,
					lse$$k_font_little ) );
    else
	lse_set_font( lse$list_extract( lse$_fontdelimit,
					lse$_fontlist,
					lse$$k_font_big ) );
    ENDIF;
ENDIF;

!+
!   Normal or condensed font
!-
status := get_info ( get_info (WIDGET, "widget_id",
	      lse$x_window_attributes_dialog,
	      "WINDOW_ATTRIBUTES_DIALOG.FONT_WIDTH_PREF_BOX.FONT_CONDENSED"),
	      "widget_info",eve$x_resource_array {eve$k_nset},the_value);

IF the_value <> get_info( lse$window, 'lse$font_condensed' )
THEN
    IF the_value
    THEN
	lse_set_font( lse$list_extract( lse$_fontdelimit,
					lse$_fontlist,
					lse$$k_font_condensed ) );
    else
	lse_set_font( lse$list_extract( lse$_fontdelimit,
					lse$_fontlist,
					lse$$k_font_normal ) );
    ENDIF;
ENDIF;

! We're done
!
return TRUE;

endprocedure;

procedure lse$$widget_window_attributes_ok

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_window_attributes_ok");
ENDON_ERROR;

eve$unmanage_widget(lse$x_window_attributes_dialog);
lse$$widget_window_attributes_apply;

return;
endprocedure;

procedure lse$$widget_window_attributes_cancel

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_window_attributes_cancel");
ENDON_ERROR;

eve$unmanage_widget(lse$x_window_attributes_dialog);

endprocedure;

procedure lse$$widget_set_search_pref
local
    status;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_set_search_pref");
ENDON_ERROR;

status := set ( widget, get_info (WIDGET, "widget_id",
	      lse$x_search_pref_dialog,
	      "SEARCH_PREF_DIALOG.SEARCH_PREF_PATTERN_BOX.SEARCH_PREF_VMS"),
	      eve$x_resource_array {eve$k_nset},
              (GET_INFO( lse$search, 'lse$pattern' ) = lse$os_vms));

status := set ( widget, get_info (WIDGET, "widget_id",
	      lse$x_search_pref_dialog,
	      "SEARCH_PREF_DIALOG.SEARCH_PREF_PATTERN_BOX.SEARCH_PREF_ULTRIX"),
	      eve$x_resource_array {eve$k_nset},
              (GET_INFO( lse$search, 'lse$pattern' ) = lse$os_ultrix));

status := set ( widget, get_info (WIDGET, "widget_id",
	      lse$x_search_pref_dialog,
	      "SEARCH_PREF_DIALOG.SEARCH_PREF_PATTERN_BOX.SEARCH_PREF_TPU"),
	      eve$x_resource_array {eve$k_nset},
              (GET_INFO( lse$search, 'lse$pattern' ) = lse$os_tpu));

status := set ( widget, get_info (WIDGET, "widget_id",
              lse$x_search_pref_dialog,
              "SEARCH_PREF_DIALOG.SEARCH_PREF_SPAN_SPACE"),
              eve$x_resource_array {eve$k_nset},(GET_INFO( lse$search, 'lse$span_space' ) = 1));

status := set ( widget, get_info (WIDGET, "widget_id",
              lse$x_search_pref_dialog,
              "SEARCH_PREF_DIALOG.SEARCH_PREF_CASE_SENSE"),
	      eve$x_resource_array {eve$k_nset},(GET_INFO( lse$search, 'lse$case_sensitive' ) = 1));

status := set( widget, get_info (WIDGET, "widget_id",
	      lse$x_search_pref_dialog,
	      "SEARCH_PREF_DIALOG.SEARCH_PREF_DIACRITICAL"),
	      eve$x_resource_array {eve$k_nset},(GET_INFO( lse$search, 'lse$diacritical' ) = 1));

status := set( widget, get_info (WIDGET, "widget_id",
	      lse$x_search_pref_dialog,
	      "SEARCH_PREF_DIALOG.SEARCH_PREF_AUTO_REVERSE"),
	      eve$x_resource_array {eve$k_nset},(get_info( lse$search, 'lse$auto_reverse' ) = 1));

return;
endprocedure;

procedure lse$$widget_search_preferences

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_search_preferences");
ENDON_ERROR;

lse$create_dialog_box ("SEARCH_PREF_DIALOG", lse$x_search_pref_dialog);

lse$$widget_set_search_pref;

eve$manage_widget(lse$x_search_pref_dialog);
                                 
endprocedure;


procedure lse$$widget_search_pref_apply
local
    status,
    the_value,
    current_setting;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_search_pref_apply");
ENDON_ERROR;

current_setting := GET_INFO( lse$search, 'lse$pattern' );

status := get_info ( get_info (WIDGET, "widget_id",
	      lse$x_search_pref_dialog,
	      "SEARCH_PREF_DIALOG.SEARCH_PREF_PATTERN_BOX.SEARCH_PREF_VMS"),
	      "widget_info",eve$x_resource_array {eve$k_nset},the_value);

if (the_value) then
    if (current_setting <> lse$os_vms) then 
        SET( lse$pattern, lse$search, lse$os_vms );
    endif;
else
    status := get_info ( get_info (WIDGET, "widget_id",
              lse$x_search_pref_dialog,
              "SEARCH_PREF_DIALOG.SEARCH_PREF_PATTERN_BOX.SEARCH_PREF_ULTRIX"),
              "widget_info",eve$x_resource_array {eve$k_nset},the_value);
    if (the_value) then
        if (current_setting <> lse$os_ultrix) then
            SET( lse$pattern, lse$search, lse$os_ultrix );
        endif;
    else
        status := get_info ( get_info (WIDGET, "widget_id",
                  lse$x_search_pref_dialog,
                  "SEARCH_PREF_DIALOG.SEARCH_PREF_PATTERN_BOX.SEARCH_PREF_TPU"),
                  "widget_info",eve$x_resource_array {eve$k_nset},the_value);
        if (the_value) then 
            if (current_setting <> lse$os_tpu) then
   	        SET( lse$pattern, lse$search, lse$os_tpu );
            endif;
        endif;
    endif;
endif;

status := get_info ( get_info (WIDGET, "widget_id",
			      lse$x_search_pref_dialog,
			      "SEARCH_PREF_DIALOG.SEARCH_PREF_SPAN_SPACE"),
			      "widget_info",eve$x_resource_array {eve$k_nset},the_value);

if  GET_INFO( lse$search, 'lse$span_space' )  <>  the_value
then
    lse_set_search_span_space( the_value );
endif;

status := get_info ( get_info (WIDGET, "widget_id",
			      lse$x_search_pref_dialog,
			      "SEARCH_PREF_DIALOG.SEARCH_PREF_CASE_SENSE"),
			      "widget_info",eve$x_resource_array {eve$k_nset},the_value);

if GET_INFO( lse$search, 'lse$case_sensitive' )  <>  the_value
then
    lse_set_search_case_sensitive( the_value );
endif;

status := get_info ( get_info (WIDGET, "widget_id",
			      lse$x_search_pref_dialog,
			      "SEARCH_PREF_DIALOG.SEARCH_PREF_DIACRITICAL"),
			      "widget_info",eve$x_resource_array {eve$k_nset},the_value);

if GET_INFO( lse$search, 'lse$diacritical' )  <>  the_value
then 
    lse_set_search_diacritical( the_value );
endif;

status := get_info ( get_info (WIDGET, "widget_id",
			      lse$x_search_pref_dialog,
			      "SEARCH_PREF_DIALOG.SEARCH_PREF_AUTO_REVERSE"),
			      "widget_info",eve$x_resource_array {eve$k_nset},the_value);

if get_info( lse$search, 'lse$auto_reverse' )  <>  the_value
then 
    lse_set_search_auto_reverse( the_value );
endif;

return;
endprocedure;

procedure lse$$widget_search_pref_ok
local
    status,
    the_value;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_search_pref_ok");
ENDON_ERROR;

eve$unmanage_widget(lse$x_search_pref_dialog);
lse$$widget_search_pref_apply;

return;
endprocedure;

procedure lse$$widget_search_pref_cancel

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_search_pref_cancel");
ENDON_ERROR;

eve$unmanage_widget(lse$x_search_pref_dialog);

endprocedure;


procedure lse$$widget_indentation
!+
! LSE$$WIDGET_INDENTATION - Displays the "Change Indentation" dialog box.
! This procedure is called when the "Indentation..." menu item is activated.
!-

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_indentation");
ENDON_ERROR;

eve$manage_widget (lse$$x_indentation_dialog, "INDENTATION_DIALOG");

endprocedure;

procedure LSE$$CALLBACK_UNMANAGE_INDENTATION
!+
! This routine simply UNMANAGES the widget passed to it and nothing else.
!-
eve$unmanage_widget (lse$$x_indentation_dialog);
endprocedure;


procedure lse$$widget_undo
   lse_undo;
endprocedure;


procedure lse$$widget_redo
   lse_redo;
endprocedure;


procedure lse$$widget_undo_redo
!+
! LSE$$WIDGET_INDENTATION - Displays the "Undo/Redo" dialog box.
! This procedure is called when the "Undo/Redo..." menu item is activated.
!-

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_undo_redo");
ENDON_ERROR;

eve$manage_widget (lse$$x_undo_redo_dialog, "UNDO_REDO_DIALOG");

endprocedure;

procedure LSE$$CALLBACK_UNMANAGE_UNDO_REDO
!+
! This routine simply UNMANAGES the widget passed to it and nothing else.
!-
eve$unmanage_widget (lse$$x_undo_redo_dialog);
endprocedure;


procedure lse$menu_compile

if get_info(system, "lse$cli_parser")
then
    lse$do_command("compile")
else
    lse_compile
endif;

endprocedure;

procedure lse$menu_compile_review

if get_info(system, "lse$cli_parser")
then
    lse$do_command("compile/review")
else
    lse_compile_review;
endif;

endprocedure;

!**** for DEFINE KEY  *****
procedure lse$$widget_define_key
local
     status,
     eve_key,
     the_key,		! the keyword that user pressed and want to be defined
     eve_key_name,	! eve's equivalent keyname for tpu keyname
     key_widget,	! widget instance for key input
     the_text,		! the comment string with the key
     topic,
     legend,
     command,
     remark,
     ptr,
     ptr1,
     ptr2,
     learn_value,
     legal_key,
     facility;
on_error
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_define_key");
endon_error;


! check if we have input focus or not.  
if not get_info(SCREEN, "input_focus")
then
    message('Editor must have input focus to define key.');
    return;
endif;

! initialize all string null
command := " ";
legend  := "";
topic  := "";
remark := "";


! read a key to be defined 
the_key := eve$prompt_key("Press the key to be defined: ");

! if we lost input focus while prompting, the_key is not valid any more,
! we don't do anything.
if the_key = 0
then
    return;
endif;

! get the eve key name for the key
eve_key_name := eve$key_name(the_key);

! call lse$convert_keyname in case of E1 to E6 keys
eve_key_name := lse$convert_keyname(eve_key_name);

!+
! Specail check again. 
! for the keyname GOLD/'"' or GTRL/'"' or '"', we need
! delete single quotes around before pass the keyname for the followng
! eve$$parse_keystring to get the key.  
! Simply pressing GOLd/", EVE return name as GOLD/'"', not GOLD/", but
! passing GOLd/'"' to eve$$parse_keystring will result in invalid keyname
!-
ptr := substr(eve_key_name, length(eve_key_name)-2, 1);
ptr1 := substr(eve_key_name, length(eve_key_name)-1, 1);
ptr2 := substr(eve_key_name, length(eve_key_name), 1);
IF (ptr="'") AND (ptr1='"') AND (ptr2="'")
THEN
    eve_key_name := substr(eve_key_name, 1, length(eve_key_name)-3);
    eve_key_name := eve_key_name + '"';
ENDIF;

!+
! check if the key is legal or not.  If it is, EVE$$PARSE_KEYSTRING should     
! return a key as same as the key got from EVE$PROMPT_KEY
!-
eve_key := eve$$parse_keystring(eve_key_name);

!+
! the following check is necessary because eve$$parse_keystring will return
! integer value as eve_key for the key like ctrl/f11
! For the CTRL/FS, CTRL/GS, CTRL/RS AND CTRL/US keys, eve$$parse_keystring will
! generate the key which is DIFFERENT from the original key pressed in.  We
! treat those key as legal keys anyway even the_key <> eve_key.
! Press a to z key will result in different key returned (it returns uppercase
! key name), we treat those keys as legal keys again.
!-
legal_key := false;
IF eve_key <> the_key
then
    if get_info(eve_key,"type")<>INTEGER
    then
	legal_key := true;
	if get_info(eve_key,"key_type") <> PRINTING	! ctrl/fs etc keys
	then
	    eve_key_name := EVE$KEY_NAME(eve_key);
	    eve_key_name := lse$convert_keyname(eve_key_name);
	endif;
    endif;
endif;


IF (eve_key = the_key)
	OR (legal_key = true)
THEN

    lse$create_dialog_box ("DEFINE_KEY_DIALOG", lse$$x_define_key_dialog);

    ! get the comment string if the key has definition already and put the
    ! comment string in dialog box
    the_text := LOOKUP_KEY(the_key,COMMENT);
    ptr := index(the_text, "");
    if ( ptr <> 0)
    then
	the_text := substr(the_text, ptr+1,9999);
	ptr := index(the_text, "");
	if (ptr <> 0)
	then
	    command := substr(the_text,1,ptr-1);
	    remark := substr(the_text,ptr+1,9999);
	endif;
    endif;
    eve$$parse_comment(the_key,'tpu$key_map_list',facility,legend,topic);


    ! set keyvalue to widget define_key_key_text; and each comment string to
    ! corresponding widget
    status := set(text,
		    get_info(WIDGET, "widget_id",
		    lse$$x_define_key_dialog,
		    "DEFINE_KEY_DIALOG.DEFINE_KEY_KEY_TEXT"),
		  EVE_key_name);

    if (command <> "Learn Sequence")
    then
	status := set(text,
			  get_info(WIDGET, "widget_id",
			  lse$$x_define_key_dialog,
			  "DEFINE_KEY_DIALOG.DEFINE_KEY_COMMAND_TEXT"),
		      command);
    endif;

    status := set(text,
		    get_info(WIDGET, "widget_id",
		    lse$$x_define_key_dialog,
		    "DEFINE_KEY_DIALOG.DEFINE_KEY_TOPIC_TEXT"),
		  topic);

    status := set(text,
		    get_info(WIDGET, "widget_id",
		    lse$$x_define_key_dialog,
		    "DEFINE_KEY_DIALOG.DEFINE_KEY_LEGEND_TEXT"),
		  legend);

    status := set(text,
		    get_info(WIDGET, "widget_id",
		    lse$$x_define_key_dialog,
		    "DEFINE_KEY_DIALOG.DEFINE_KEY_REMARK_TEXT"),
		  remark);

    ! ***** have to set learn toggle button if topic string is "sequence" ***
    ! how to set toggle value??
    if command = "Learn Sequence"
    then
	learn_value := 1;
	status := set( WIDGET, get_info ( WIDGET, "widget_id",
			      lse$$x_define_key_dialog,
			      "DEFINE_KEY_DIALOG.DEFINE_KEY_LEARN"),
			      eve$x_resource_array {eve$k_nset},learn_value);

    endif;

    eve$manage_widget(lse$$x_define_key_dialog);

    lse$add_minimum_size_to_dialog (lse$$x_define_key_dialog);

else
    message('the key is not definable');
endif;

endprocedure;

procedure LSE$$DEFINE_DIALOG_KEY(key_string, key_cmd, learn_state, topic,
					legend, remark)
local
    status,
    a_key_string,
    learn_value;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$define_dialog_key");
ENDON_ERROR;

!+
! this procedure does the similar thing as lse$$widget_define_key.  It got
! all information for the key to be defined and put them into dialog box,
! and manage the dialog box
!-

lse$create_dialog_box ("DEFINE_KEY_DIALOG", lse$$x_define_key_dialog);

if key_string <> ""
then
    a_key_string := key_string;
    a_key_string := lse$convert_keyname(a_key_string);
else
    a_key_string := "";
endif;

status := set(text,
	    get_info(WIDGET, "widget_id",
	    lse$$x_define_key_dialog,
	    "DEFINE_KEY_DIALOG.DEFINE_KEY_KEY_TEXT"),
	    a_key_string);

if ( learn_state <> "/LEARN")
then
    status := set(text,
		      get_info(WIDGET, "widget_id",
		      lse$$x_define_key_dialog,
		      "DEFINE_KEY_DIALOG.DEFINE_KEY_COMMAND_TEXT"),
		  key_cmd);
endif;

status := set(text,
		get_info(WIDGET, "widget_id",
		lse$$x_define_key_dialog,
		"DEFINE_KEY_DIALOG.DEFINE_KEY_TOPIC_TEXT"),
	      topic);
status := set(text,
		get_info(WIDGET, "widget_id",
		lse$$x_define_key_dialog,
		"DEFINE_KEY_DIALOG.DEFINE_KEY_LEGEND_TEXT"),
	      legend);
status := set(text,
		get_info(WIDGET, "widget_id",
		lse$$x_define_key_dialog,
		"DEFINE_KEY_DIALOG.DEFINE_KEY_REMARK_TEXT"),
	      remark);

if learn_state = "/LEARN"
then
    learn_value := 1;
    status := set( WIDGET, get_info ( WIDGET, "widget_id",
			  lse$$x_define_key_dialog,
			  "DEFINE_KEY_DIALOG.DEFINE_KEY_LEARN"),
			  eve$x_resource_array {eve$k_nset},learn_value);

endif;

eve$manage_widget(lse$$x_define_key_dialog);

endprocedure;

procedure lse$$widget_define_key_ok
local
     key_string,	! key name to be defined
     key_command,	! the command bound to key to be defined
     legend,
     topic,
     remark,
     learn_value,
     temp1,
     temp2,
     temp3,
     status;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_define_key_ok");
ENDON_ERROR;


eve$unmanage_widget(lse$$x_define_key_dialog);
key_string := get_info (get_info (WIDGET, "widget_id",
				lse$$x_define_key_dialog,
				"DEFINE_KEY_DIALOG.DEFINE_KEY_KEY_TEXT"),
			        "text");

! convert keystring in case user types "NEXT SCREEN" instead of "E6"
key_string := lse$convert_keyname(key_string);

key_command := get_info (get_info (WIDGET, "widget_id",
				lse$$x_define_key_dialog,
				"DEFINE_KEY_DIALOG.DEFINE_KEY_COMMAND_TEXT"),
			        "text");

topic := get_info (get_info (WIDGET, "widget_id",
				lse$$x_define_key_dialog,
				"DEFINE_KEY_DIALOG.DEFINE_KEY_TOPIC_TEXT"),
			        "text");

legend := get_info (get_info (WIDGET, "widget_id",
				lse$$x_define_key_dialog,
				"DEFINE_KEY_DIALOG.DEFINE_KEY_LEGEND_TEXT"),
			        "text");

remark := get_info (get_info (WIDGET, "widget_id",
				lse$$x_define_key_dialog,
				"DEFINE_KEY_DIALOG.DEFINE_KEY_REMARK_TEXT"),
			        "text");

status := get_info ( get_info (WIDGET, "widget_id",
			      lse$$x_define_key_dialog,
			      "DEFINE_KEY_DIALOG.DEFINE_KEY_LEARN"),
			      "widget_info",eve$x_resource_array {eve$k_nset},learn_value);

!+
!***** we have to quote eve keyname so that cli$get_value in Bliss
! lse$$define_key won't complain. for example, a key ctrl/d has to be
! "ctrl/d".
! However, uppercAse every keynAme unless A single key. TPU V2 AlwAys uppercAses
! keynAme before defining the key.
! eg, define key b will define B;
!     define key "b"  will define b
!
! Special case:  for defining key ", we have to make the keystring as """"
!-  
if key_string = '"'
then
    key_string := '""""';	! this make a single " got defined in BLISS
else

if length (key_String) > 1	    ! TPU differs lower single character from
				! upper case.  so don't uppercase it.
then
    temp1 := substr(key_string, 1,1);
    temp2 := length(key_string);
    temp3 := substr(key_string, temp2, 1);
    if (temp1 = '"') AND (temp3 = '"')
    then
        key_string := substr(key_string, 2, temp2-2);
    endif;

endif;    
endif;

if length (key_command) > 1
then
    temp1 := substr(key_command, 1,1);
    temp2 := length(key_command);
    temp3 := substr(key_command, temp2, 1);
    if (temp1 = '"') AND (temp3 = '"')
    then
        key_command := substr(key_command, 2, temp2-2);
    endif;

endif;    

if learn_value
then
    lse_new_learn_key(key_string)
else
    lse_new_key(key_string,
     	        key_command,
    	        topic,
             	remark,
                legend);
endif;

endprocedure;



!+
! quote the key_string by searching each character to pair the quote
! characters.
!-
procedure lse$$quote_key_string(key_string, quote)
local
    a_string,
    sub_string,
    ptr,
    prev_String,
    pos_string;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$quote_key_string");
ENDON_ERROR;

    
sub_string := key_string;
a_string := '';

loop
    ptr := index(sub_string, quote);
    if ptr <> 0
    then
        prev_String := substr(sub_string,1,ptr);
        pos_string := substr(sub_string, ptr+1,9999);
        a_string := a_string + prev_String + quote;
        sub_string := pos_string;
    else
	a_string := a_string + sub_string;
    endif;
    exitif ptr= 0;
endloop;
key_string := a_string;

if length(key_string) > 1
then
    EDIT(key_string,OFF);
endif;

endprocedure


procedure lse$$widget_define_key_cancel
local
     status,
     learn_value;

ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_define_key_cancel");
ENDON_ERROR;



	eve$unmanage_widget(lse$$x_define_key_dialog);

	status := set(text,
		    get_info(WIDGET, "widget_id",
		    lse$$x_define_key_dialog,
		    "DEFINE_KEY_DIALOG.DEFINE_KEY_KEY_TEXT"),
		  "");

	status := set(text,
			  get_info(WIDGET, "widget_id",
			  lse$$x_define_key_dialog,
			  "DEFINE_KEY_DIALOG.DEFINE_KEY_COMMAND_TEXT"),
		      "");

	status := set(text,
			get_info(WIDGET, "widget_id",
			lse$$x_define_key_dialog,
			"DEFINE_KEY_DIALOG.DEFINE_KEY_TOPIC_TEXT"),
		      "");

	status := set(text,
			get_info(WIDGET, "widget_id",
			lse$$x_define_key_dialog,
			"DEFINE_KEY_DIALOG.DEFINE_KEY_LEGEND_TEXT"),
		      "");

	status := set(text,
			get_info(WIDGET, "widget_id",
			lse$$x_define_key_dialog,
			"DEFINE_KEY_DIALOG.DEFINE_KEY_REMARK_TEXT"),
		      "");

	learn_value := 0;
	status := set( WIDGET, get_info ( WIDGET, "widget_id",
			      lse$$x_define_key_dialog,
			      "DEFINE_KEY_DIALOG.DEFINE_KEY_LEARN"),
			      eve$x_resource_array {eve$k_nset},learn_value);

endprocedure;



procedure lse$$save_extended_attributes
local
	saved_window,
	saved_mark,
	default_save_parameter,	! Used in deterining if a default spec exists
	results,		! of attribute building. Not used.
	saved_informational,	! Keyword for display of informational messages
	saved_success;		! Keyword for display of success messages

on_error
    [TPU$_COMPILEFAIL]:
	eve$message (EVE$_ATTRNOTSAVED);
	! Define the procedure as null since the attributes code won't
	! compile - we need to be able to execute this procedure on startup.
	compile ("procedure lse$$restore_mode_settings; endprocedure");
    [OTHERWISE]:
	if (get_info( saved_window, 'type' ) = window)  and
	   (get_info( saved_mark, 'type' ) = marker)
	then
	    eve$$restore_position (saved_window, saved_mark);
	endif;
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$save_extended_attributes");
endon_error;

position (search (ANCHOR, FORWARD));		! prevent padding
saved_mark := mark (FREE_CURSOR);
saved_window := current_window;

!+
!  Build EVE's procedure EVE$SET_SECTION_ATTRIBUTES
!-
if eve$$reserve_scratch_buffer
then
    set (INSERT, eve$$x_scratch_buffer);
    erase (eve$$x_scratch_buffer);
    position (eve$$x_scratch_buffer);
    copy_text ("procedure eve$set_section_attributes;");
    eve$$build_attr_code (end_of (eve$$x_scratch_buffer), results);
    position (buffer_end);
    copy_text ("endprocedure;");
    compile (eve$$x_scratch_buffer);
    eve$$release_scratch_buffer;
    eve$$restore_position (saved_window, saved_mark);
endif;

!+
!   Save GOLD and DO key arrays
!-
eve$$save_settings;

!+
!  Build/compile LSE's procedure LSE$$RESTORE_MODE_SETTINGS
!-

!+
! Save user attributes in the section file by overriding the
! eve$build_attrs procedure with the attributes code
!-
if eve$$reserve_scratch_buffer
then
    set (INSERT, eve$$x_scratch_buffer);
    erase (eve$$x_scratch_buffer);
    position (eve$$x_scratch_buffer);
    copy_text ("PROCEDURE lse$$restore_mode_settings");
    SPLIT_LINE;
    lse$$copy_current_global_settings(true);
    position (buffer_end);
    SPLIT_LINE;
    copy_text ("ENDPROCEDURE;");

    compile (eve$$x_scratch_buffer);
    eve$$release_scratch_buffer;
endif;

eve$$restore_position (saved_window, saved_mark);

return (TRUE);
endprocedure; ! lse$$save_extended_attributes


PROCEDURE lse$$build_save_section_cmd( proc_name; 
				       p1, p2, p3, p4, p5, p6, p7, p8, p9 )
!
!   FUNCTION:
!   
!	Worker routine for lse$$copy_current_global_settings.
!	Builds the procedure call with it's parameters.
!
!   INPUT:
!
!	proc_name   - Procedure name to use
!	p#	    - Parameters for the procedure
!
!   OUTPUT:
!
!	The current buffer is modified with a line for the procedure call
!

    ON_ERROR
	[OTHERWISE]:
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$build_save_section_cmd");
    ENDON_ERROR;

    SPLIT_LINE;
    COPY_TEXT( '    ' );
    COPY_TEXT( proc_name );
    COPY_TEXT( '( ' );
    IF p1 <> tpu$k_unspecified
    THEN
	COPY_TEXT( '"' );
	COPY_TEXT( STR( P1 ) );
	COPY_TEXT( '"' );
    ENDIF;

    IF p2 <> tpu$k_unspecified
    THEN
	COPY_TEXT( ', "' );
	COPY_TEXT( STR( P2 ) );
	COPY_TEXT( '"' );
    ENDIF;

    IF p3 <> tpu$k_unspecified
    THEN
	COPY_TEXT( ', "' );
	COPY_TEXT( STR( p3 ) );
	COPY_TEXT( '"' );
    ENDIF;

    IF p4 <> tpu$k_unspecified
    THEN
	COPY_TEXT( ', "' );
	COPY_TEXT( STR( p4 ) );
	COPY_TEXT( '"' );
    ENDIF;

    IF p5 <> tpu$k_unspecified
    THEN
	COPY_TEXT( ', "' );
	COPY_TEXT( STR( p5 ) );
	COPY_TEXT( '"' );
    ENDIF;

    IF p6 <> tpu$k_unspecified
    THEN
	COPY_TEXT( ', "' );
	COPY_TEXT( STR( p6 ) );
	COPY_TEXT( '"' );
    ENDIF;

    IF p7 <> tpu$k_unspecified
    THEN
	COPY_TEXT( ', "' );
	COPY_TEXT( STR( p7 ) );
	COPY_TEXT( '"' );
    ENDIF;

    IF p8 <> tpu$k_unspecified
    THEN
	COPY_TEXT( ', "' );
	COPY_TEXT( STR( p8 ) );
	COPY_TEXT( '"' );
    ENDIF;

    IF p9 <> tpu$k_unspecified
    THEN
	COPY_TEXT( ', "' );
	COPY_TEXT( STR( p9 ) );
	COPY_TEXT( '"' );
    ENDIF;

    COPY_TEXT( ' );' );

ENDPROCEDURE;


PROCEDURE lse$$copy_current_global_settings(section_file)
!
!   FUNCTION:
!   
!	lse$$copy_current_global_settings generates the appropriate LSE_
!	calls to set all the global setting.  It is used to generate a 
!	procedure to be called during LSE's initialization.
!
!   INPUT:
!
!	LSE's global state
!	CURRENT_BUFFER - The caller is responsible for preparing that buffer
!
!   OUTPUT:
!
!	The current buffer will contain the body of a TPU procedure.
!	The caller is responsible for the PROCEDURE and ENDPROCEDURE statements.
!	i.e. naming the procedure.
!

    LOCAL
	curr,
	i,
	last,
	library,
	result;

    ON_ERROR
	[OTHERWISE]:
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$copy_current_global_settings");
    ENDON_ERROR;


    ! Set up the procedure
    !
    COPY_TEXT( '! Generated by LSE ' );
    COPY_TEXT( get_info(lse$system, "lse$version") );
    SPLIT_LINE;
    COPY_TEXT( '!' );
    SPLIT_LINE;
    COPY_TEXT( '    LOCAL' );
    SPLIT_LINE;
    COPY_TEXT( '	saved_init_flag;' );
    SPLIT_LINE;
    SPLIT_LINE;
    COPY_TEXT( '    ON_ERROR' );
    SPLIT_LINE;
    COPY_TEXT( '	[OTHERWISE]:' );
    SPLIT_LINE;
    COPY_TEXT( '	    eve$$x_state_array {eve$$k_in_init_file} := false;' );
    SPLIT_LINE;
    COPY_TEXT( '	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "Generated init procedure");' );
    SPLIT_LINE;
    COPY_TEXT( '    ENDON_ERROR;' );
    SPLIT_LINE;
    SPLIT_LINE;
    COPY_TEXT( '    saved_init_flag := eve$$x_state_array {eve$$k_in_init_file};' );
    SPLIT_LINE;
    COPY_TEXT( '    eve$$x_state_array {eve$$k_in_init_file} := true;' );
    SPLIT_LINE;

    ! Directory readonly
    !
    curr := get_info( lse$system, 'first', lse$directory_read_only );
    loop
	exitif curr = 0;
	SPLIT_LINE;
	COPY_TEXT( '    lse$set_directory_read_only( "' );
	COPY_TEXT( curr );
	COPY_TEXT( '", 1 );' );
	curr := get_info( lse$system, 'next', lse$directory_read_only );
    endloop;

    ! Directory source
    !
    curr := GET_INFO( SYSTEM, 'lse$directory_source' );
    IF not(curr = '')
    THEN
       lse$$build_save_section_cmd( 'lse_set_directory_source', curr );
    ENDIF;

    ! Bell
    !
    curr := GET_INFO( SYSTEM, 'bell' );
    IF curr = 0
    THEN
	lse$$build_save_section_cmd( 'lse_set_bell_all', 'OFF' );
    ELSE
	IF curr = ALL
	THEN
	    lse$$build_save_section_cmd( 'lse_set_bell_all', 'ON' );
	ELSE
	    IF curr = BROADCAST
	    THEN
		lse$$build_save_section_cmd( 'lse_set_bell_broadcast', 'ON' );
	    ENDIF;
	ENDIF;
    ENDIF;

    ! Cursor
    !
    IF GET_INFO( lse$system, 'lse$cursor_bound' )
    THEN
	lse$$build_save_section_cmd( 'lse_set_cursor',
				     lse$list_extract( lse$_cursordelimit,
						       lse$_cursorlist,
						       lse$$k_cursor_bound ) );
    ELSE
	lse$$build_save_section_cmd( 'lse_set_cursor',
				     lse$list_extract( lse$_cursordelimit,
						       lse$_cursorlist,
						       lse$$k_cursor_free ) );
    ENDIF;

    ! Command language
    !
    IF GET_INFO( lse$system, 'lse$cli_parser' )
    THEN
	lse$$build_save_section_cmd( 'lse_set_command_language',
				     lse$list_extract( lse$_cmdlngdelimit,
						       lse$_cmdlnglist,
						       lse$$k_cmdlng_vmslse ) );
    ELSE
	lse$$build_save_section_cmd( 'lse_set_command_language',
				     lse$list_extract( lse$_cmdlngdelimit,
						       lse$_cmdlnglist,
						       lse$$k_cmdlng_portable));
    ENDIF;	

    ! Primary selection model
    !
    IF GET_INFO( lse$system, 'lse$focus_based_select' )
    THEN
	lse$$build_save_section_cmd( 'lse_set_primary_selection_model',
				     lse$list_extract( lse$_selmodeldelimit,
						       lse$_selmodellist,
						       lse$$k_sel_model_focus));
    ELSE
	lse$$build_save_section_cmd( 'lse_set_primary_selection_model',
				     lse$list_extract( lse$_selmodeldelimit,
						       lse$_selmodellist,
						       lse$$k_sel_model_selection ) );
    ENDIF;

    ! Keypad
    !
    CASE GET_INFO( lse$system, 'lse$keypad' )
	[lse$edt]: lse$$build_save_section_cmd( 'lse_set_keypad', 'EDT' );
	[lse$eve]: lse$$build_save_section_cmd( 'lse_set_keypad', 'EVE' );
	[OTHERWISE]: eve$message( lse$_internerrln, 
				  0, 
				  "Generated init procedure",
				  0 );
    ENDCASE;
	

    ! Clipboard
    !
    lse$$build_save_section_cmd( 'lse_set_clipboard',
				 GET_INFO( lse$system, 'lse$clipboard' ) );

    ! Pending delete
    !
    lse$$build_save_section_cmd( 'lse_set_pending_delete',
				 GET_INFO( lse$system, 'lse$pending_delete' ) );

    ! Tabs visible
    !
    lse$$build_save_section_cmd( 'lse_set_tabs_visible',
				 GET_INFO( lse$window, 'lse$tabs_visible' ) );

    ! Tabs hard
    !
    lse$$build_save_section_cmd( 'lse_set_tabs_hard',
				 GET_INFO( lse$window, 'lse$tabs_hard' ) );

    ! UNDO enabled
    !
    lse$$build_save_section_cmd( 'lse_set_undo',
				 GET_INFO( lse$window, 'lse$undo' ) );

    ! This call inits a clean, empty stack
    !
    lse$$build_save_section_cmd('lse$init_prefix_stack','');

    ! This loop enables the grammar prefixes and their help libraries
    !
    i      := get_info (lse$$x_prefix_stack, "first");
    result := lse$$x_prefix_stack {i};
    LOOP
	library := eve$get_help_item (eve$k_help_library, result);

	lse$$build_save_section_cmd( 'lse_enable_grammar_prefix',
				     result,
				     library );

	i := get_info (lse$$x_prefix_stack, "next");
	exitif i = tpu$k_unspecified;
	result := lse$$x_prefix_stack {i};
    ENDLOOP;

    ! Terminators
    !
    curr := GET_INFO( lse$$x_prompt_terminator_keys, 'first' );
    LOOP
	EXITIF curr = tpu$k_unspecified;
	lse$$build_save_section_cmd( 'lse_set_prompt_terminator',
				     eve$key_name( curr ) );
	curr := GET_INFO( lse$$x_prompt_terminator_keys, 'next' );
    ENDLOOP;

    ! Alterminators
    !
    curr := GET_INFO( lse$$x_prompt_alterminator_keys, 'first' );
    LOOP
	EXITIF curr = tpu$k_unspecified;
	lse$$build_save_section_cmd( 'lse_set_prompt_alterminator',
				     eve$key_name( curr ) );
	curr := GET_INFO( lse$$x_prompt_alterminator_keys, 'next' );
    ENDLOOP;

    ! Abort
    !
    curr := GET_INFO( lse$$x_prompt_abort_keys, 'first' );
    LOOP
	EXITIF curr = tpu$k_unspecified;
	lse$$build_save_section_cmd( 'lse_set_prompt_abort',
				     eve$key_name( curr ) );
	curr := GET_INFO( lse$$x_prompt_abort_keys, 'next' );
    ENDLOOP;

    ! Dialog
    !
    lse$$build_save_section_cmd( 'lse_set_prompt_dialog',
				 lse$list_extract( lse$_pdialogdelimit,
						    lse$_pdialoglist,
						     lse$$x_use_dialog ) );

    ! Prompt keyad
    !
    lse$$build_save_section_cmd( 'lse_set_prompt_keypad',
				 lse$list_extract( lse$_pkeypaddelimit,
						   lse$_pkeypadlist,
						   lse$$x_use_keypad ) );
    ! Prompt expandmenu
    !
    lse$$build_save_section_cmd( 'lse_set_prompt_expandmenu',
				 lse$list_extract( lse$_pkeypaddelimit,
						   lse$_pkeypadlist,
						   lse$$x_use_expandmenu ) );

    ! Auto reverse
    !
    lse$$build_save_section_cmd( 'lse_set_search_auto_reverse',
				 GET_INFO( lse$search, 'lse$auto_reverse' ) );

    ! Case sensitive
    !
    lse$$build_save_section_cmd( 'lse_set_search_case_sensitive',
				 GET_INFO( lse$search, 'lse$case_sensitive' ) );

    ! Diacritical
    !
    lse$$build_save_section_cmd( 'lse_set_search_Diacritical',
				 GET_INFO( lse$search, 'lse$diacritical' ) );

    ! Pattern
    !
    CASE GET_INFO( lse$search, 'lse$pattern' )
	[lse$os_vms]   : 
	    lse$$build_save_section_cmd( 'lse_set_search_pattern',
					 lse$get_message_text( lse$_vms ) );
	[lse$os_ultrix]: 
	    lse$$build_save_section_cmd( 'lse_set_search_pattern',
					 lse$get_message_text( lse$_ultrix ) );
	[lse$os_tpu]: 
	    lse$$build_save_section_cmd( 'lse_set_search_pattern',
					 lse$get_message_text( lse$_tpu ) );
	[OTHERWISE]: eve$message( lse$_internerrln, 
				  0, 
				  "Generated init procedure",
				  1 );
    ENDCASE;

    ! Span space
    !
    lse$$build_save_section_cmd( 'lse_set_search_span_space',
				 GET_INFO( lse$search, 'lse$span_space' ) );

    ! Balance windows
    !
    lse$$build_save_section_cmd( 'lse_set_balance_windows',
				 GET_INFO( lse$window, 'lse$balance_windows' ) );

    ! Font attributes
    !
    IF GET_INFO( lse$window, 'lse$font_condensed' )
    THEN
	lse$$build_save_section_cmd( 'lse_set_font',
				     lse$list_extract( lse$_fontdelimit,
						       lse$_fontlist,
						       lse$$k_font_condensed));
    ELSE
	lse$$build_save_section_cmd( 'lse_set_font',
				     lse$list_extract( lse$_fontdelimit,
						       lse$_fontlist,
						       lse$$k_font_normal ) );
    ENDIF;

    IF GET_INFO( lse$window, 'lse$font_little' )
    THEN
	lse$$build_save_section_cmd( 'lse_set_font',
				     lse$list_extract( lse$_fontdelimit,
						       lse$_fontlist,
						       lse$$k_font_little ) );
    ELSE
	lse$$build_save_section_cmd( 'lse_set_font',
				     lse$list_extract( lse$_fontdelimit,
						       lse$_fontlist,
						       lse$$k_font_big ) );
    ENDIF;

    ! Max windows
    !
    lse$$build_save_section_cmd( 'lse_set_maximum_windows',
				 GET_INFO( lse$window, 'lse$max_windows' ) );

    ! Min window len
    !
    lse$$build_save_section_cmd( 'lse_set_minimum_window_length',
				 GET_INFO( lse$window, 'lse$min_window_len' ) );

    ! Top scroll margin
    !
    lse$$build_save_section_cmd( 
	'lse_set_scroll_margins',
	STR( GET_INFO( lse$window, 'lse$top_scroll_margin' ) ) + '%',
	STR( GET_INFO( lse$window, 'lse$bottom_scroll_margin' ) ) + '%' );

    ! Save Related Buffers
    !
    lse$$build_save_section_cmd( 'lse_set_save_related_buffers',
				GET_INFO( lse$system, 'lse$save_related_buffers' ) );


    ! Height and width
    !
    SPLIT_LINE;
    IF section_file THEN
      COPY_TEXT( '    IF  (eve$x_decwindows_active)' );
      COPY_TEXT( '    AND (GET_INFO( SCREEN, "visible_length" ) = 24)' );
      COPY_TEXT( '    AND (GET_INFO( lse$window, "lse$width" ) = 80) THEN' );
    ELSE
      COPY_TEXT( '    IF  (eve$x_decwindows_active) THEN' );
    ENDIF;
    lse$$build_save_section_cmd( 'lse_set_height',
				 GET_INFO( SCREEN, 'visible_length' ) );
    lse$$build_save_section_cmd( 'lse_set_width',
				 GET_INFO( lse$window, 'lse$width' ) );
    SPLIT_LINE;
    COPY_TEXT( '    ENDIF;' );
    
    ! Clean-up
    !
    SPLIT_LINE;
    COPY_TEXT( '    eve$$x_state_array {eve$$k_in_init_file} := saved_init_flag;' );

ENDPROCEDURE;



procedure lse$$init_attr_array
local   
	tmp_attr,
	saved_window,
	saved_mark,
	attr_index;	! index into the array of code

on_error
    [OTHERWISE]:
	if (get_info( saved_window, 'type' ) = window)  and
	   (get_info( saved_mark, 'type' ) = marker)
	then
	    eve$$restore_position (saved_window, saved_mark);
	endif;
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$init_attr_array");
endon_error;

!+
!
!  This is to initialize two array lse$$x_attrs_array
!  and lse$$x_display_array (used in Save Current Attributes dialog box.)
!
!  Because LSE doesn't know the changes made for each pulldown menu,
!  the implemention is needed for saving all current pulldown menu in order
!  to work properly in the future release.  
!
!  For now, we just initalize lse$$x_display_array and lse$$x_attrs_array
!  with current extended menu.
!-

!+
!   Save all menu extended into attributes array.
!-
tmp_attr := create_array;

attr_index := get_info (lse$$x_attrs_array, "first");
loop    
    exitif get_info (attr_index, "type") <> STRING;
    if ( substr(lse$$x_attrs_array {attr_index},1,15) = "eve_define_menu" )
    	or
	( substr(lse$$x_attrs_array {attr_index},1,17) = "eve$undefine_menu" )
    then
	tmp_attr {attr_index} := lse$$x_attrs_array {attr_index};
    endif;
    attr_index := get_info (lse$$x_attrs_array, "next");
endloop;

!+
!  Restore all menu extended back in display array.
!-
attr_index := get_info (tmp_attr, "first");
lse$$x_attrs_array := create_array;
loop
    exitif get_info (attr_index, "type") <> STRING;
    lse$$x_attrs_array {attr_index} := tmp_attr {attr_index};
    attr_index := get_info (tmp_attr, "next");
endloop;

!+
!   Save all menu extended into display array
!-
tmp_attr := create_array;

attr_index := get_info (lse$$x_display_array, "first");
loop
    exitif get_info (attr_index, "type") <> STRING;
    if substr(lse$$x_display_array {attr_index},1,4) = "Menu" 
    then
	tmp_attr {attr_index} := lse$$x_display_array {attr_index};
    endif;
    attr_index := get_info (lse$$x_display_array, "next");
endloop;
!+
!  Restore all menu extended back in display array.
!-
attr_index := get_info (tmp_attr, "first");
lse$$x_display_array := create_array;
loop
    exitif get_info (attr_index, "type") <> STRING;
    lse$$x_display_array {attr_index} := tmp_attr {attr_index};
    attr_index := get_info (tmp_attr, "next");
endloop;
                                       
eve$$restore_position (saved_window, saved_mark);
endprocedure;


! DATA STRUCTURES USED FOR MENU CUSTMOIZATION
! -------------------------------------------
! 
! lse$$x_menus_by_name -  Stores menu-specific data indexed by the name of the
!	menu.  The {lse$k_index} value can be used to index into
!	lse$$x_menus_by_number.
!
! lse$$x_menus_by_number -  Index the menus numerically, in the order that they
!	appear on the menubar.  Index 1 represents the left-most menu.		
!
! lse$$x_pulldown_labels_by_name - Stores label-specific data indexed by the name
!	of the label.  The closure value is used by EVE to correlate a
!	specific widget to the code that should be executed when that widget
!	is activated.
!
! lse$$x_pulldown_contents_by_name - Stores information about the entries that
!	are included in each menu.  The array is indexed first by the name
!	of the menu, and that sub-array is indexed by the names of the entries.
!	The {lse$k_index} value for an entry can be used to index into
!	lse$$x_pulldown_contents_by_number.
!
! lse$$x_pulldown_contents_by_number - Index the menu entries numerically, in
!	the order that the entries appear.  The array indexed first by the
!	number of the pulldown, and then by the number of the entry in the
!	pulldown, counting from the top of the menu down.		 
!	
!
!                            lse$$x_menus_by_name
!			    /
!			   /
!                      {"File"} ....
!			|
!			|
!		    menu_info - {lse$k_sep_count}
!				{lse$k_widget}
!				{lse$k_index}
!				{lse$k_mnemonic}
!
!
!                            lse$$x_menus_by_number
!			    /
!			   /
!			{1} ...
!			|
!			|
!			"File"
!
!
!
!                            lse$$x_pulldown_labels_by_name
!			    /
!			   /
!			{"Open File ..."} - {lse$k_def}       ......
!					    {lse$k_closure}
!					    {lse$k_mnemonic}
!
!
!			     lse$$x_pulldown_contents_by_name
!			    /
!			   /
!			{"File"} ....
!			|
!			|
!			entries_by_name 
!		       /
!		      /
!		    {"Open File ..."} ....
!		    |
!		    |
!		    entry_info -    {lse$k_widget}
!				    {lse$k_index}
!
!
!
!			    lse$$x_pulldown_contents_by_number
!			   /
!			  /
!			{1}  .....
!			|
!			|
!			entries_by_number 
!		       /
!		      /
!		    {1} ....
!		    |
!		    |
!		  "Open File ..."
!
!
!


procedure lse$$initialize_menu_system (display_mnemonics)

local
    pulldown_index,
    pulldown_info,
    i;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$initialize_menu_system");
    ENDON_ERROR;

    ! We only want to define widget classes and resource
    ! types once
    !
    if eve$x_decwindows_active
    then
	if get_info (lse$kt_pushbutton_class, "type") <> INTEGER
	then
	    lse$kt_pushbutton_class
		:= define_widget_class (eve$kt_pushbuttonwidgetclass,
					    "XmCreatePushButton");
	    lse$kt_separator_class
		:= define_widget_class (eve$kt_separatorwidgetclass,
					"XmCreateSeparatorGadget");

	    set (widget_resource_types, "int", "mnemonic");
	endif;
    endif;

    SET (lse$menu_mnemonics, lse$system, display_mnemonics);

    lse$$x_menus_by_name := CREATE_ARRAY;
    lse$$x_menus_by_number := CREATE_ARRAY;
    lse$$x_pulldown_labels_by_name := CREATE_ARRAY;
    lse$$x_pulldown_contents_by_name := CREATE_ARRAY;
    lse$$x_pulldown_contents_by_number := CREATE_ARRAY;

    if eve$x_decwindows_active
    then
	lse$$read_menu_bar (eve$x_menu_bar, lse$$x_menus_by_name, 
	    lse$$x_menus_by_number);

	! We can't read the list of popups the way we can with the menu bar.
	! Traversing the children of the widget whom we specified as the popups'
	! parents doesn't yeild us any RowColumn classes.
	!
	lse$$add_popup ("No Select Popup", lse$$x_menus_by_name, lse$$x_menus_by_number);
	lse$$add_popup ("Review Popup", lse$$x_menus_by_name, lse$$x_menus_by_number);
	if not eve$x_ultrix_active 
	then
	    lse$$add_popup ("Query Popup", lse$$x_menus_by_name, lse$$x_menus_by_number);
	endif;

	lse$$add_menubar_mnemonics;
	lse$$set_menubar_insert_position;

    endif;

    ! Set up arrays for the children of each menu.
    !

    i := get_info (lse$$x_menus_by_name, "first");
    
    LOOP
	EXITIF i = tpu$k_unspecified;

	pulldown_info := lse$$x_menus_by_name {i};
	pulldown_index := pulldown_info {lse$k_index};
	
	lse$$x_pulldown_contents_by_name {i} := CREATE_ARRAY;
	lse$$x_pulldown_contents_by_number {pulldown_index} := CREATE_ARRAY;

	i := get_info (lse$$x_menus_by_name, "next");
    ENDLOOP;

endprocedure;


! Add the mnemonics for the menubar.  The UIL file doesn't contain mnemonics
! so that we can allow users to suppress mnemonics if they want to be able
! to use all of the ALT key combinations, which the mnemonics will cosume
! some of.  We can't delete the mnemonic once it's created, because the
! ALT key still won't come through to us.
!
procedure lse$$add_menubar_mnemonics

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$add_menubar_mnemonics");
    ENDON_ERROR;

    if get_info (lse$system, 'lse$menu_mnemonics')
    then
	lse$$add_menubar_mnemonic_for ("File", "F");
	lse$$add_menubar_mnemonic_for ("Edit", "E");
	lse$$add_menubar_mnemonic_for ("View", "V");
	lse$$add_menubar_mnemonic_for ("Search", "S");
	lse$$add_menubar_mnemonic_for ("Source", "r");
	lse$$add_menubar_mnemonic_for ("Show", "w");
	lse$$add_menubar_mnemonic_for ("Options", "O");
	lse$$add_menubar_mnemonic_for ("Navigate", "N");
	lse$$add_menubar_mnemonic_for ("Box", "B");
	lse$$add_menubar_mnemonic_for ("Help", "H");
    endif;

endprocedure;


! Set the insertPosition resource for each of the pulldowns.  When a button
! is added, lse$$get_menu_insert_position will end up being called to
! get the number of entries before the entry to be added.
!
procedure lse$$set_menubar_insert_position

local
    current_menu;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$set_menubar_insert_position");
    ENDON_ERROR;


    current_menu := get_info (lse$$x_menus_by_name, "first");

    loop
	exitif current_menu = tpu$k_unspecified;

	lse$$set_menu_insert_position (current_menu);

	current_menu := get_info (lse$$x_menus_by_name, "next");

    endloop;

endprocedure;


procedure lse$$set_menu_insert_position (pulldown)

local
    widget_id;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$set_menu_insert_position");
    ENDON_ERROR;


    widget_id := lse$$get_pulldown_parent_widget (pulldown);
    lse$$set_insert_position (widget_id);

endprocedure;


procedure lse$$get_menu_insert_position

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$get_menu_insert_position");
    ENDON_ERROR;

    return lse$$x_menu_insert_position;

endprocedure;



procedure lse$$add_menubar_mnemonic_for (menu, mnemonic)

local
    menu_widget,
    menu_info;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$add_menubar_mnemonic_for");
    ENDON_ERROR;

    if eve$x_decwindows_active
    then
	menu_info := lse$$x_menus_by_name {menu};
	menu_widget := menu_info {lse$k_widget};
	set (widget, menu_widget, "mnemonic", ASCII (mnemonic));
    endif;

    menu_info {lse$k_mnemonic} := mnemonic;

endprocedure;


! This procedure sets up the menu-specific arrays needed for each pulldown.
! It's generalized to get the menus from the menu-bar itself, though other
! procedures for menu customization have to be hard-coded.  The generalization
! is in preparation for when users are allowed to customize the contents
! of the menubar too.
!
procedure lse$$read_menu_bar (menu_bar, name_array, number_array)

local
    entry_info,
    current_child,
    child_name,
    child_index,
    child_count,
    status,
    child_array;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$read_menu_bar");
    ENDON_ERROR;

    child_array := CREATE_ARRAY;
    status := GET_INFO (widget, "children", menu_bar, child_array);

    child_count := 1;
    child_index := GET_INFO (child_array, "first");

    LOOP
	EXITIF child_index = tpu$k_unspecified;

	current_child := child_array {child_index};

	status := GET_INFO (current_child, "widget_info", 
	    eve$x_resource_array {eve$k_nlabel}, child_name);

	name_array {child_name} := CREATE_ARRAY;
	number_array {child_count} := child_name;

	entry_info := name_array {child_name};

	entry_info {lse$k_index} := child_count;
	entry_info {lse$k_sep_count} := 0;
	entry_info {lse$k_widget} := current_child;
    
	child_count := child_count + 1;
	child_index := GET_INFO (child_array, "next");	
    
    ENDLOOP;

endprocedure;


! Is there a way to get the current popups dynamincally?  When I traversed
! the children belonging to the widget that we specified as the parent for
! the popups, I couldn't find any candidates.
!
procedure lse$$add_popup (popup, name_array, number_array)

local
    name_info,
    new_entry,
    number_of_entries;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$add_popup");
    ENDON_ERROR;

    number_of_entries := get_info (number_array, "last");
    if number_of_entries = tpu$k_unspecified
    then
	number_of_entries := 0;
    endif;

    new_entry := number_of_entries + 1;

    number_array {new_entry} := popup;
    name_array {popup} := CREATE_ARRAY;
    name_info := name_array {popup};
    name_info {lse$k_index} := new_entry;
    name_info {lse$k_sep_count} := 0;

endprocedure;


procedure lse$$load_menus (;always_load_menus)

    local
	load_menus;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$load_menus");
    ENDON_ERROR;

    load_menus := FALSE;

    ! Always load menus under decwindows, regardless of the value of the
    ! always_load_menus.  If we're in CCT, only load the menus if the
    ! parameter's value is TRUE.
    !
    if eve$x_decwindows_active
    then
	load_menus := TRUE
    else
	if always_load_menus <> tpu$k_unspecified 
	then
	    if always_load_menus = TRUE
	    then
		load_menus := TRUE;
	    endif;
	endif;
    endif;

    if load_menus 
    then
	lse$$create_menu_system;
    endif;

endprocedure;

    
! Return the widget_id of the RowColumn widget who should be the parent
! for any buttons created under the specified pulldown name.
!
procedure lse$$get_pulldown_parent_widget (pulldown)

local
    pulldown_widget,
    parent_widget,
    full_path_name,
    pulldown_name;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$get_pulldown_parent_widget");
    ENDON_ERROR;


    if lse$$is_popup (pulldown)
    then
	pulldown_name := EDIT (pulldown, UPPER, NOT_IN_PLACE);
	TRANSLATE (pulldown_name, '_', ' ');
	full_path_name := "popup_" + pulldown_name + "." + pulldown_name;
	parent_widget := get_info (screen, "pop_up_parent_widget");
    else
	pulldown_name := EDIT (pulldown, UPPER, NOT_IN_PLACE) + "_MENU";
	full_path_name := "EVE_MENU_BAR.popup_FILE_MENU" + "." + pulldown_name;
	parent_widget := eve$x_menu_bar;
    endif;

    pulldown_widget := GET_INFO (widget, "widget_id", parent_widget,
	full_path_name);

    return pulldown_widget;

endprocedure


! Goes through the list of separators for a pulldown, numbering them in
! sequential order.  This is necessary after a separator is added or deleted,
! so that the separator numbering remains accurate and "neat".
!
procedure lse$$renumber_separators (pulldown)

local
    current_label,
    new_label,
    entry_label,
    labels_to_redo,
    sep_count,
    i,
    entries_by_name,
    entries_by_number,
    menu_info;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$renumber_separators");
    ENDON_ERROR;


    menu_info := lse$$x_menus_by_name {pulldown};
    entries_by_number := lse$$x_pulldown_contents_by_number {menu_info {lse$k_index}};
    entries_by_name := lse$$x_pulldown_contents_by_name {pulldown};

    ! Go through the list of separators, renumbering each one in order,
    ! starting with 1
    !
    i := 1;
    sep_count := 0;
    labels_to_redo := CREATE_ARRAY;

    loop    
	entry_label := entries_by_number {i};
	exitif entry_label = tpu$k_unspecified;

	if lse$$is_separator (entry_label) 
	then
	    sep_count := sep_count + 1;
	
	    new_label := lse$k_separator_label + str(sep_count);
	    labels_to_redo {new_label} := CREATE_ARRAY;
	    labels_to_redo {new_label} := entries_by_name {entry_label};

	    entries_by_number {i} := new_label;
	endif;

	i := i + 1;		    

    endloop;

    current_label := get_info (labels_to_redo, "first");

    loop
	exitif current_label = tpu$k_unspecified;
    
	entries_by_name {current_label} := labels_to_redo {current_label};

	current_label := get_info (labels_to_redo, "next");		

    endloop;

endprocedure



! Returns the number of separators in a given pulldown
!
procedure lse$menus_separator_count (pulldown)

local
    menu_info;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$menus_separator_count");
    ENDON_ERROR;

    menu_info := lse$$x_menus_by_name {pulldown};

    if menu_info = tpu$k_unspecified
    then
	return 0;
    endif;

    return menu_info {lse$k_sep_count};

endprocedure;


! Remove the specified separator from the pulldown.  Separators are counted
! so that the top-most separator is considered #1.
!
procedure lse$remove_pulldown_separator (pulldown, sep_number)

local
    sep_num_string,
    menu_info;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$remove_pulldown_separator");
    ENDON_ERROR;
    
    if lse$$x_menus_loaded = tpu$k_unspecified
    then
	lse$$load_menus (TRUE);
    endif;

    menu_info := lse$$x_menus_by_name {pulldown};

    if menu_info = tpu$k_unspecified 
    then
	lse$$popup_message ( FAO (lse$get_message_text (lse$_nopulldown), pulldown), lse$x_menus_dialog);
	return false;
    endif;

    if menu_info {lse$k_sep_count} = 0
    then
	lse$$popup_message ( FAO (lse$get_message_text(lse$_noseparators), pulldown), lse$x_menus_dialog);
	return false;
    endif;

    if sep_number > menu_info {lse$k_sep_count}
    then
	lse$$popup_message ( FAO (lse$get_message_text (lse$_onlynseparators), pulldown, 
	    menu_info {lse$k_sep_count}), lse$x_menus_dialog);
	return false;
    endif;

    sep_num_string := str (sep_number);

    lse$remove_pulldown_entry (pulldown, lse$k_separator_label + sep_num_string);

    menu_info {lse$k_sep_count} := menu_info {lse$k_sep_count} - 1;

    lse$$renumber_separators (pulldown);
    return true;

endprocedure


procedure lse$remove_pulldown_entry (pulldown, label)

local
    entry_index_to_move,
    last_entry_index,
    pulldown_index,
    removed_entry_index,
    label_info,
    pulldown_entry_info,
    pulldown_entries_by_number,
    pulldown_entries_by_name,
    menu_info;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$remove_pulldown_entry");
    ENDON_ERROR;

    if lse$$x_menus_loaded = tpu$k_unspecified
    then
	lse$$load_menus (TRUE);
    endif;

    menu_info := lse$$x_menus_by_name {pulldown};

    if menu_info = tpu$k_unspecified 
    then
	lse$$popup_message ( FAO (lse$get_message_text (lse$_nopulldown), pulldown), lse$x_menus_dialog);
	return false;
    endif;

    pulldown_entries_by_name := lse$$x_pulldown_contents_by_name {pulldown};

    if pulldown_entries_by_name {label} = tpu$k_unspecified
    then
	lse$$popup_message ( FAO (lse$get_message_text (lse$_noentry), label, pulldown), lse$x_menus_dialog);
	return false;
    endif;

    pulldown_entry_info := pulldown_entries_by_name {label};
    
    if eve$x_decwindows_active
    then
	delete (pulldown_entry_info {lse$k_widget});
    endif;

    if not lse$$is_separator (label)
    then
	label_info := lse$$x_pulldown_labels_by_name {label};
	label_info {lse$k_ref_count} := label_info {lse$k_ref_count} - 1;
    endif;

    removed_entry_index := pulldown_entry_info {lse$k_index};
    delete (pulldown_entries_by_name {label});

    pulldown_index := menu_info {lse$k_index};
    pulldown_entries_by_number  := 
	lse$$x_pulldown_contents_by_number {pulldown_index};
    delete (pulldown_entries_by_number {removed_entry_index});

    ! Re-number remaining entries

    last_entry_index := get_info (pulldown_entries_by_number, "last");

    ! If there are no more entries, then there's nothing to move
    !
    if last_entry_index = tpu$k_unspecified 
    then
	return true;
    endif;
	
    entry_index_to_move := removed_entry_index + 1;
    LOOP
	EXITIF entry_index_to_move > last_entry_index;

	pulldown_entries_by_number {entry_index_to_move - 1} :=
	    pulldown_entries_by_number {entry_index_to_move};

	pulldown_entry_info := pulldown_entries_by_name {
	    pulldown_entries_by_number {entry_index_to_move}};
	pulldown_entry_info {lse$k_index} := pulldown_entry_info {lse$k_index}
	    - 1;

	entry_index_to_move := entry_index_to_move + 1;

    ENDLOOP;

    if removed_entry_index < last_entry_index
    then
	delete (pulldown_entries_by_number {last_entry_index});
    endif;

    return true;

endprocedure


!  Add a new separator, preceding the "before" label in the pulldown
!
procedure lse$add_pulldown_separator (pulldown; before)

local
    status;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$add_pulldown_separator");
    ENDON_ERROR;

    if lse$$x_menus_loaded = tpu$k_unspecified
    then
	lse$$load_menus (TRUE);
    endif;

    status := lse$$create_pulldown_entry (pulldown, lse$k_separator_label, before);
    lse$$renumber_separators (pulldown);

    return status;

endprocedure


! Define a new label as executing the 'def' TPU code
!
procedure lse$add_pulldown_label (label, def; mnemonic)

local
    status,
    closure,
    label_info;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$add_pulldown_label");
    ENDON_ERROR;


    if lse$$x_menus_loaded = tpu$k_unspecified
    then
	lse$$load_menus (TRUE);
    endif;

    if lse$$x_pulldown_labels_by_name {label} <> tpu$k_unspecified
    then
	lse$$popup_message ( FAO (lse$get_message_text (lse$_labeldefined), label), lse$x_menus_dialog);
	return FALSE;
    endif;

    if mnemonic <> tpu$k_unspecified 
    then
	if length (mnemonic) <> 1 
	then
	    lse$$popup_message (lse$_mnemonechar, lse$x_menus_dialog);
	    return false;
	endif;

	! This won't catch if the wrong case is specified
	!
	if index (label, mnemonic) = 0
	then
	    lse$$popup_message (lse$_mneminlabel, lse$x_menus_dialog);
	    return false;
	endif;
    endif;
    
    closure := lse$$get_next_closure; 

    status := eve$define_widget (def, closure, "");

    if not status
    then
	lse$$popup_message (lse$_tpucodeinvalid, lse$x_menus_dialog);
	return false;
    endif;

    lse$$x_pulldown_labels_by_name {label} := CREATE_ARRAY;
    label_info := lse$$x_pulldown_labels_by_name {label};
    label_info {lse$k_def} := def;
    label_info {lse$k_mnemonic} := mnemonic;
    label_info {lse$k_ref_count} := 0;
    label_info {lse$k_closure} := closure; 

    return true;

endprocedure



procedure lse$modify_pulldown_label (label, def; mnemonic)

local
    status,
    closure,
    label_info;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$modify_pulldown_label");
    ENDON_ERROR;

    if lse$$x_menus_loaded = tpu$k_unspecified
    then
	lse$$load_menus (TRUE);
    endif;

    label_info := lse$$x_pulldown_labels_by_name {label};
    if label_info = tpu$k_unspecified
    then
	lse$$popup_message ( FAO (lse$get_message_text (lse$_nolabel), label), lse$x_menus_dialog);
	return FALSE;
    endif;

    if mnemonic <> tpu$k_unspecified 
    then
	if length (mnemonic) <> 1 
	then
	    lse$$popup_message (lse$_mnemonechar, lse$x_menus_dialog);
	    return false;
	endif;

	! This won't catch if the wrong case is specified
	!
	if index (label, mnemonic) = 0
	then
	    lse$$popup_message (lse$_mneminlabel, lse$x_menus_dialog);
	    return false;
	endif;

    endif;
    
    label_info {lse$k_def} := def;
    label_info {lse$k_mnemonic} := mnemonic;

    closure := label_info {lse$k_closure};

    status := eve$define_widget (def, closure, "");

    if not status
    then
	lse$$popup_message (lse$_tpucodeinvalid, lse$x_menus_dialog);
	return false;
    endif;

    return true;

endprocedure



procedure lse$remove_pulldown_label (label)

local
    label_info;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$remove_pulldown_label");
    ENDON_ERROR;

    if lse$$x_menus_loaded = tpu$k_unspecified
    then
	lse$$load_menus (TRUE);
    endif;

    label_info := lse$$x_pulldown_labels_by_name {label};

    if label_info = tpu$k_unspecified
    then
	lse$$popup_message ( FAO (lse$get_message_text (lse$_nolabel), label), lse$x_menus_dialog);
	return FALSE;
    endif;

    if label_info {lse$k_ref_count} > 0 
    then
	lse$$popup_message (lse$_cantdellabel, lse$x_menus_dialog);
	return FALSE;
    endif;

    if label_info {lse$k_ref_count} <> 0
    then
	eve$undefine_widget (label_info {lse$k_closure});
    endif;

    delete (label_info);
    return true;

endprocedure;


procedure lse$add_pulldown_entry (pulldown, label; before) 
! 
! The "before" label could be a Separator name, suffixed with a number
! representing which separator.  The separators are numbered 1 to n after
! initialization, if any that are added during the current session are numbered
! n+1, etc.  So, the separators are no longer in order.  When SAVE ATTRIBUTES
! is done, they'll bewritten out as calls to lse$add_pulldown_separator, so
! they'll automatically be re-numbered sequentially.

local
    return_status,
    status,
    mnemonic,
    label_info,
    new_entry;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$add_pulldown_entry");
    ENDON_ERROR;

    if lse$$x_menus_loaded = tpu$k_unspecified
    then
	lse$$load_menus (TRUE);
    endif;

    if not lse$$create_pulldown_entry (pulldown, label, before, new_entry)
    then
	return false;
    endif;

    label_info := lse$$x_pulldown_labels_by_name {label};
    label_info {lse$k_ref_count} := label_info {lse$k_ref_count} + 1;


    if eve$x_decwindows_active
    then
	mnemonic := label_info {lse$k_mnemonic};

	if mnemonic <> tpu$k_unspecified
	then
	    ! We don't check to see if the mnemonic already exists in this menu - that's
	    ! up to the user
	    !
	    if get_info (lse$system, 'lse$menu_mnemonics')
	    then
		status := set (widget, new_entry, "mnemonic", ASCII(mnemonic));
	    endif;
	endif;
    endif;

    return true;

endprocedure;


procedure lse$$create_pulldown_entry (pulldown, label, before; return_widget)

local
    pulldown_entry_info,
    closure,
    label_info,
    menu_entry,
    current_entry_to_move_index,
    last_entry_index,
    before_entry_index,
    before_entry_info,
    pulldown_index,
    pulldown_entries_by_number,
    pulldown_widget,
    pulldown_entries_by_name,
    new_menu_index,
    last_pulldown_index,
    menu_info,
    local_label;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$create_pulldown_entry");
    ENDON_ERROR;

    if lse$$x_menus_loaded = tpu$k_unspecified
    then
	lse$$load_menus (TRUE);
    endif;

    local_label := label;

    menu_info := lse$$x_menus_by_name {pulldown};

    if menu_info = tpu$k_unspecified 
    then
	if not eve$x_decwindows_active
	then
	    ! If we're in CCT mode, we have no way of knowing what a valid
	    ! pulldown name is.  We'll assume it's valid, and add it to the
	    ! appropriate arrays.  If it's not valid, the user will find
	    ! out the next time they bring up DecWindows LSE with their
	    ! section file
	    !
	    lse$$x_menus_by_name {pulldown} := CREATE_ARRAY;
	    menu_info := lse$$x_menus_by_name {pulldown};

	    last_pulldown_index := get_info (lse$$x_menus_by_number, "last");
	    if last_pulldown_index = tpu$k_unspecified 
	    then
		last_pulldown_index := 0;
	    endif;

	    new_menu_index := last_pulldown_index + 1;
	    lse$$x_menus_by_number {new_menu_index} := pulldown;

	    menu_info {lse$k_index} := new_menu_index;
	    menu_info {lse$k_sep_count} := 0;

	    lse$$x_pulldown_contents_by_number {new_menu_index} := CREATE_ARRAY;
	    lse$$x_pulldown_contents_by_name {pulldown} := CREATE_ARRAY;
	else
	    lse$$popup_message (FAO (lse$get_message_text (lse$_nopulldown),
		pulldown), lse$x_menus_dialog);
	    return false;
	endif;
    endif;

    pulldown_entries_by_name := lse$$x_pulldown_contents_by_name {pulldown};

    if not lse$$is_separator (local_label) 
    then
	if pulldown_entries_by_name {local_label} <> tpu$k_unspecified
	then
	    lse$$popup_message (FAO (lse$get_message_text (lse$_entryexists),
		local_label, pulldown), lse$x_menus_dialog);
	    return false;
	endif;
    endif;
    
    if eve$x_decwindows_active
    then
	pulldown_widget := lse$$get_pulldown_parent_widget (pulldown);
    endif;

    pulldown_index := menu_info {lse$k_index};
    pulldown_entries_by_number  := 
	lse$$x_pulldown_contents_by_number {pulldown_index};

    if before <> tpu$k_unspecified
    then
	before_entry_info := pulldown_entries_by_name {before};

	if before_entry_info = tpu$k_unspecified
	then
	    lse$$popup_message ( FAO (lse$get_message_text (lse$_noentry), before, pulldown), lse$x_menus_dialog);
	    return false;
	endif;

	before_entry_index := before_entry_info {lse$k_index};

	last_entry_index := get_info (pulldown_entries_by_number, "last");

	current_entry_to_move_index := last_entry_index;

	! Move up the already-existing menu entries to make room for this
	! One.
	!   
	LOOP
	    EXITIF current_entry_to_move_index < before_entry_index;

	    pulldown_entries_by_number {current_entry_to_move_index + 1} := 
		pulldown_entries_by_number {current_entry_to_move_index};
	    pulldown_entry_info := pulldown_entries_by_name { 
		pulldown_entries_by_number {current_entry_to_move_index}};

	    pulldown_entry_info {lse$k_index} := 
		current_entry_to_move_index + 1;

	    current_entry_to_move_index := current_entry_to_move_index - 1;

	ENDLOOP;

    else
	! If the "before" entry wasn't specified, then we'll make the
	! new entry the last one
	!   
	last_entry_index := get_info (pulldown_entries_by_number, "last");
	if last_entry_index = tpu$k_unspecified 
	then
	    before_entry_index := 1;
	else
	    before_entry_index := last_entry_index + 1;
	endif;
    endif;

    ! The insertPosition callback needs to know the number
    ! of entries before the one we're inserting
    !
    lse$$x_menu_insert_position := before_entry_index - 1;

    IF lse$$is_separator (local_label)
    THEN
	if eve$x_decwindows_active
	then
	    menu_entry := create_widget (lse$kt_separator_class, "", 
		pulldown_widget);
	endif;
    
	menu_info {lse$k_sep_count} := menu_info {lse$k_sep_count} + 1;
	local_label := lse$k_separator_label + str (menu_info {lse$k_sep_count});
	
    ELSE
	label_info := lse$$x_pulldown_labels_by_name {label};

	if label_info = tpu$k_unspecified
	then
	    lse$$popup_message ( FAO (lse$get_message_text (lse$_nolabel), label), lse$x_menus_dialog);
	    return false;
	endif;

	closure := label_info {lse$k_closure};

	if eve$x_decwindows_active
	then
	    menu_entry := create_widget (lse$kt_pushbutton_class,
				 local_label,
				 pulldown_widget,
				 eve$kt_callback_routine,
				 closure);

	    ! This used to be combined with the create_widget builtin above.
	    ! However, the tpu31_23oct TPU pickup seems to demonstrate
	    ! a problem with DecWindows.  The first CREATE_WIDGET w/ resources
	    ! specified gets only 12 resources back as "settable"; after
	    ! doing a CREATE_WIDGET w/o resources, the next time through the
	    ! code above results in 62 settable resources.
	    !
	    set (widget, menu_entry,
		 eve$kt_nactivate_callback, 0,
		 eve$kt_nhelp_callback, 0,
		 eve$x_resource_array {eve$k_nlabel}, local_label);

	endif;
    ENDIF;

    if eve$x_decwindows_active
    then
	manage_widget (menu_entry);
    endif;

    pulldown_entries_by_number {before_entry_index} := local_label;

    pulldown_entries_by_name {local_label} := CREATE_ARRAY;
    pulldown_entry_info := pulldown_entries_by_name {local_label};
    pulldown_entry_info {lse$k_widget} := menu_entry;
    pulldown_entry_info {lse$k_index} := before_entry_index;

    if return_widget <> tpu$k_unspecified 
    then
	return_widget := menu_entry;
    endif;

    return true;

endprocedure


! This procedure currently isn't called.  It would be useful is it's
! decided that SET MENU MNEMONICS OFF should remove the visible portion
! of the mnemonic.  However, the ALT keys still won't come through.
! 
!procedure lse$remove_menu_mnemonics 
!
!    if not eve$x_decwindows_active
!    then
!	return;
!    endif;
!    
!    current_menu_index := get_info (lse$$x_menus_by_number, "first");
!
!    loop
!	exitif current_menu_index = tpu$k_unspecified;
!
!	current_menu := lse$$x_menus_by_number {current_menu_index};
!	menu_info := lse$$x_menus_by_name {current_menu};
!	menu_widget := menu_info {lse$k_widget};
!
!	if not lse$is_popup (current_menu)
!	then
!	    set (widget, menu_widget, "mnemonic", 0);
!	endif;
!
!	entries_by_name := lse$$x_pulldown_contents_by_name {current_menu};
!
!	if entries_by_name <> tpu$k_unspecified
!	then	
!	    current_entry := get_info (entries_by_name, "first");
!	    
!	    loop
!		exitif current_entry = tpu$k_unspecified;
!		
!		entry_info := entries_by_name {current_entry};
!		entry_widget := entry_info {lse$k_widget};
!
!		if not lse$is_separator (current_entry)
!		then	    
!		    set (widget, entry_widget, "mnemonic", 0);
!		endif;
!
!		current_entry := get_info (entries_by_name, "next");
!	    endloop;
!
!	endif;
!
!	current_menu_index := get_info (lse$$x_menus_by_number, "next");
!
!   endloop;
!
!endprocedure



! This procedure adds the mnemonic for each entry in the pulldowns
! 

procedure lse$$add_menu_mnemonics 

local
    label_info,
    entry_widget,
    entry_info,
    current_entry,
    entries_by_name,
    menu_mnemonic,
    menu_widget,
    menu_info,
    current_menu,
    current_menu_index;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$add_menu_mnemonics");
    ENDON_ERROR;

    if not eve$x_decwindows_active
    then
	return;
    endif;

    current_menu_index := get_info (lse$$x_menus_by_number, "first");
    
    loop
	exitif current_menu_index = tpu$k_unspecified;

	current_menu := lse$$x_menus_by_number {current_menu_index};
	menu_info := lse$$x_menus_by_name {current_menu};
	menu_widget := menu_info {lse$k_widget};

	if not lse$$is_popup (current_menu)
	then
	    menu_mnemonic := menu_info {lse$k_mnemonic};
	    set (widget, menu_widget, "mnemonic", ASCII(menu_mnemonic));
	endif;

	entries_by_name := lse$$x_pulldown_contents_by_name {current_menu};

	if entries_by_name <> tpu$k_unspecified
	then	
	    current_entry := get_info (entries_by_name, "first");
	    
	    loop
		exitif current_entry = tpu$k_unspecified;
		
		entry_info := entries_by_name {current_entry};
		entry_widget := entry_info {lse$k_widget};

		if not lse$$is_separator (current_entry)
		then	    

		    label_info := lse$$x_pulldown_labels_by_name {current_entry};

		    set (widget, entry_widget, "mnemonic", 
			ASCII(label_info {lse$k_mnemonic}));
		endif;

		current_entry := get_info (entries_by_name, "next");

	    endloop;
	endif;

	current_menu_index := get_info (lse$$x_menus_by_number, "next");

    endloop;

endprocedure




procedure lse$$get_next_closure

local
    closure;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$get_next_closure");
    ENDON_ERROR;

    closure := eve$x_user_widget_base;
    eve$x_user_widget_base := eve$x_user_widget_base + 1;

    return closure;

endprocedure;


procedure lse$$is_separator (label_name)

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$is_separator");
    ENDON_ERROR;

    if SUBSTR (label_name, 1, length (lse$k_separator_label)) = 
	lse$k_separator_label
    then
	return true;
    else
	return false;
    endif;
    
endprocedure    


procedure lse$$is_popup (label_name)

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$is_popup");
    ENDON_ERROR;

    if SUBSTR (label_name, length(label_name)-length (lse$k_popup_label)+1, 
	length (lse$k_popup_label)) = lse$k_popup_label
    then
	return true;
    else
	return false;
    endif;
    
endprocedure    


! These two procedures output the command necessary to re-create the current
! state of the menu system.  It's intended to be used during the build-up for a
! SAVE SECTION command.
! 
procedure lse$$restore_menu_system (buffer_ptr)

    local
	display_mnemonics;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$restore_menu_system");
    ENDON_ERROR;


    if lse$$x_menus_loaded = tpu$k_unspecified
    then
	lse$$load_menus (TRUE);
    endif;

    lse$$push_position;
    position (end_of(buffer_ptr));

    copy_text ('lse$$initialize_menu_system (');
    display_mnemonics := get_info (lse$system, 'lse$menu_mnemonics');
    if display_mnemonics
    then
	copy_text ('TRUE');
    else
	copy_text ('FALSE');
    endif;

    copy_text (');');
    split_line;

    copy_text ('lse$$load_menus;');
    split_line;
    
    lse$$pop_position;

endprocedure;


procedure lse$$output_menu_system (buffer_ptr)

local
    current_entry,
    current_entry_name,
    entries_by_number,
    menu_number,
    menu_info,
    entries_by_name,
    current_menu,
    mnemonic,
    def,
    label_info,
    current_label;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$output_menu_system");
    ENDON_ERROR;

    if lse$$x_menus_loaded = tpu$k_unspecified
    then
	lse$$load_menus (TRUE);
    endif;

    lse$$push_position;
    position (end_of(buffer_ptr));

    copy_text ('procedure lse$$create_menu_system');
    split_line;

    copy_text ('lse$$x_menus_loaded := TRUE;');
    split_line;

    current_label := get_info (lse$$x_pulldown_labels_by_name, "first");
    
    loop
	exitif current_label = tpu$k_unspecified;
	label_info := lse$$x_pulldown_labels_by_name {current_label};

	def := label_info {lse$k_def};
	mnemonic := label_info {lse$k_mnemonic};

	copy_text ('lse$add_pulldown_label ("' + current_label +
	    '", "' + def + '"');

	if mnemonic <> tpu$k_unspecified
	then
	    copy_text (', "' + mnemonic + '"');
	endif;

	copy_text (');');
	split_line;

	current_label := get_info (lse$$x_pulldown_labels_by_name, "next");

    endloop;

    current_menu := get_info (lse$$x_pulldown_contents_by_name, "first");

    loop
	exitif current_menu = tpu$k_unspecified;
	entries_by_name := lse$$x_pulldown_contents_by_name {current_menu};

	menu_info := lse$$x_menus_by_name {current_menu};
	menu_number := menu_info {lse$k_index};

	entries_by_number := lse$$x_pulldown_contents_by_number {menu_number};
	current_entry := get_info (entries_by_number, "first");

	loop

	    exitif current_entry = tpu$k_unspecified;
	    current_entry_name := entries_by_number {current_entry};

	    if lse$$is_separator (current_entry_name)
	    then
		copy_text ('lse$add_pulldown_separator ("' + current_menu + 
		    '");');
		split_line;
	    else

		copy_text ('lse$add_pulldown_entry ("' + current_menu + 
		    '", "' + current_entry_name + '");');
		split_line;

	    endif;

	    current_entry := get_info (entries_by_number, "next");

	endloop;

	current_menu := get_info (lse$$x_pulldown_contents_by_name, "next"); 	
	    
    endloop;

    copy_text ('endprocedure;');
    split_line;

    lse$$pop_position;

endprocedure;


! Brings up the Menus... dialog box, with the top-most pulldown menu name
! selected.
! 
procedure lse$$widget_menus

local
    status,
    selected_count,
    resource_array,
    temp_array;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_menus");
    ENDON_ERROR;

    lse$create_dialog_box ("MENUS_DIALOG", lse$x_menus_dialog);

    lse$$menus_set_menus;
    lse$$menus_set_labels;

    status := get_info (lse$$get_menu_id, "widget_info", 
	"selectedItemCount", selected_count);

    if selected_count = 0
    then
	! Select the top-most pulldown menu name
	!
	temp_array := CREATE_ARRAY;
	temp_array {1} := lse$$x_menus_by_number {1};
	resource_array := CREATE_ARRAY;
	resource_array {eve$x_resource_array {eve$k_nselected_items_count}} :=
	    temp_array;

	set (widget, lse$$get_menu_id, resource_array);    
    endif;

    lse$$menus_set_entries;
    lse$$menus_cancel_entry_selection;

    eve$manage_widget (lse$x_menus_dialog);

    lse$add_minimum_size_to_dialog (lse$x_menus_dialog);

endprocedure;


procedure lse$$widget_menus_close

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_menus_close");
    ENDON_ERROR;

    eve$unmanage_widget(lse$x_menus_dialog);

endprocedure;


procedure lse$$get_menu_id

local
    menu_list_id;
    
    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$get_menu_id");
    ENDON_ERROR;

    menu_list_id := get_info (widget, "widget_id", lse$x_menus_dialog,
	"MENUS_DIALOG.MENUS_LIST_SUBFORM.MENUS_LISTSW.MENUS_LIST");

    return menu_list_id;

endprocedure;


procedure lse$$get_menu_entries_id

local
    menu_entries_id;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$get_menu_entries_id");
    ENDON_ERROR;


    menu_entries_id := get_info (widget, "widget_id", lse$x_menus_dialog,
	"MENUS_DIALOG.MENUS_ENTRIES_SUBFORM.MENUS_ENTRIESSW.MENUS_ENTRIES");

    return menu_entries_id;

endprocedure;


procedure lse$$get_menu_labels_id

local
    menu_labels_id;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$get_menu_labels_id");
    ENDON_ERROR;

    menu_labels_id := get_info (widget, "widget_id", lse$x_menus_dialog,
	"MENUS_DIALOG.MENUS_LABELS_SUBFORM.MENUS_LABELSSW.MENUS_LABELS");

    return menu_labels_id;

endprocedure;


procedure lse$$get_label_to_edit_id

local
    label_to_edit_id;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$get_label_to_edit_id");
    ENDON_ERROR;

    label_to_edit_id := get_info (widget, "widget_id", lse$x_menus_dialog,
	"MENUS_DIALOG.MENUS_LABEL_TO_EDIT");

    return label_to_edit_id;

endprocedure;


procedure lse$$get_mnemonic_id

local
    mnemonic_id;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$get_mnemonic_id");
    ENDON_ERROR;


    mnemonic_id := get_info (widget, "widget_id", lse$x_menus_dialog,
	"MENUS_DIALOG.MENUS_MNEMONIC");

    return mnemonic_id;

endprocedure;


procedure lse$$get_tpu_code_id

local
    tpu_code_id;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$get_tpu_code_id");
    ENDON_ERROR;


    tpu_code_id := get_info (widget, "widget_id", lse$x_menus_dialog,
	"MENUS_DIALOG.MENUS_TPU_CODE");

    return tpu_code_id;

endprocedure;


procedure lse$$get_add_entry_arrow_id

local
    add_entry_arrow_id;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$get_add_entry_arrow_id");
    ENDON_ERROR;


    add_entry_arrow_id := get_info (widget, "widget_id", lse$x_menus_dialog,
	"MENUS_DIALOG.MENUS_LABELS_TO_ENTRIES_ARROW");

    return add_entry_arrow_id;

endprocedure;


procedure lse$$get_edit_labels_arrow_id

local
    edit_labels_arrow_id;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$get_edit_labels_arrow_id");
    ENDON_ERROR;


    edit_labels_arrow_id := get_info (widget, "widget_id", lse$x_menus_dialog,
	"MENUS_DIALOG.MENUS_EDIT_LABELS_ARROW");

    return edit_labels_arrow_id;

endprocedure;


procedure lse$$get_remove_label_id

local
    remove_label_id;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$get_remove_label_id");
    ENDON_ERROR;

    remove_label_id := get_info (widget, "widget_id", lse$x_menus_dialog,
	"MENUS_DIALOG.MENUS_REMOVE_LABEL");

    return remove_label_id;

endprocedure;


procedure lse$$get_remove_entry_id

local
    remove_entry_id;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$get_remove_entry_id");
    ENDON_ERROR;

    remove_entry_id := get_info (widget, "widget_id", lse$x_menus_dialog,
	"MENUS_DIALOG.MENUS_REMOVE_ENTRY");

    return remove_entry_id;

endprocedure;


procedure lse$$get_text (text_id)

local
    text_value,
    status;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$get_text");
    ENDON_ERROR;

    status := get_info (text_id, "widget_info", 
	eve$x_resource_array {eve$k_nvalue}, text_value);
    return text_value;

endprocedure


procedure lse$$get_list_selection (list_id)

local
    selected_entry,
    select_index,
    select_array,
    status,
    resource_array;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$get_list_selection");
    ENDON_ERROR;


    resource_array := CREATE_ARRAY;
    resource_array {eve$x_resource_array {eve$k_nselected_items_count}} := 0;
    status := get_info (list_id, "widget_info",
	resource_array);

    select_array := resource_array {eve$x_resource_array {
	eve$k_nselected_items_count}};
    select_index := get_info (select_array, "first");
    if select_index = tpu$k_unspecified 
    then
	selected_entry := tpu$k_unspecified;
    else
	selected_entry := select_array {get_info (select_array, "first")};    
    endif;

    return selected_entry;

endprocedure;


procedure lse$$menus_set_entries

local
    menu_entries_id,
    entries_by_number,
    menu_index,
    menu_info,
    list,
    selected_menu;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$menus_set_entries");
    ENDON_ERROR;

    selected_menu := lse$$get_list_selection (lse$$get_menu_id);
    if selected_menu = tpu$k_unspecified 
    then
	return;
    endif;

    list := CREATE_ARRAY;
    menu_info := lse$$x_menus_by_name {selected_menu};
    menu_index := menu_info {lse$k_index};
    entries_by_number := lse$$x_pulldown_contents_by_number {menu_index};
    list {eve$x_resource_array {eve$k_nitems_count}} := entries_by_number;

    menu_entries_id := lse$$get_menu_entries_id;
    set (widget, menu_entries_id, list);

endprocedure;


procedure lse$$menus_set_menus

local
    entries_by_number,
    list,
    menu_list_id;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$menus_set_menus");
    ENDON_ERROR;

    menu_list_id := lse$$get_menu_id;

    list := CREATE_ARRAY;
    entries_by_number := lse$$x_menus_by_number;
    list {eve$x_resource_array {eve$k_nitems_count}} := entries_by_number;

    set (widget, menu_list_id, list);

endprocedure;


procedure lse$$menus_set_labels

local
    menu_labels_list_id,
    list;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$menus_set_labels");
    ENDON_ERROR;


    list := CREATE_ARRAY;
    list {eve$x_resource_array {eve$k_nitems_count}} := 
	lse$$build_numbered_array (lse$$x_pulldown_labels_by_name);

    menu_labels_list_id := lse$$get_menu_labels_id;
    set (widget, menu_labels_list_id, list);

endprocedure;


procedure lse$$menus_cancel_selection (list_id)

local
    resource_array,
    select_array;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$menus_cancel_selection");
    ENDON_ERROR;


    select_array := CREATE_ARRAY;
    resource_array := CREATE_ARRAY;
    resource_array {eve$x_resource_array {eve$k_nselected_items_count}} :=
	select_array;

    set (widget, list_id, resource_array);

endprocedure;


procedure lse$$set_list_selection (list_id, selection)

local
    resource_array,
    select_array;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$set_list_selection");
    ENDON_ERROR;


    select_array := CREATE_ARRAY;
    select_array {1} := selection;
    resource_array := CREATE_ARRAY;
    resource_array {eve$x_resource_array {eve$k_nselected_items_count}} :=
	select_array;

    set (widget, list_id, resource_array);

    lse$$make_item_visible (list_id, lse$$get_single_select_pos (list_id));

endprocedure;


procedure lse$$make_item_visible (list_id, item)

local
    status,
    item_count,
    vis_item_count,
    top_item_index,
    bottom_item_index,
    new_top_vis_index,
    selected_index,
    top_of_bottom_range,
    resource_array;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$make_item_visible");
    ENDON_ERROR;

    resource_array := CREATE_ARRAY;
    resource_array {"itemCount"} := 0;
    resource_array {"visibleItemCount"} := 0;
    resource_array {"topItemPosition"} := 0;
    status := get_info (list_id, "widget_info", resource_array);

    item_count := resource_array {"itemCount"};
    vis_item_count := resource_array {"visibleItemCount"};
    top_item_index := resource_array {"topItemPosition"};
    bottom_item_index := top_item_index + vis_item_count - 1;
    
    if bottom_item_index > item_count 
    then
	bottom_item_index := item_count;
    endif;

    if (item >= top_item_index) and
       (item <= bottom_item_index) 
    then
	return;
    endif;

    ! Check if item is in the portion that is visible when we have scrolled
    ! all the way to the top
    if item <= vis_item_count
    then
	status := set (widget, list_id, "topItemPosition", 1);
	return;
    endif;

    ! Check if item is in the portion that is visible when we have scrolled
    ! all the way to the bottom
    top_of_bottom_range := item_count - vis_item_count + 1;
    if item >= top_of_bottom_range
    then
	status := set (widget, list_id, "topItemPosition", top_of_bottom_range);
	return;
    endif;

    ! Center the item
    !
    new_top_vis_index := item - (vis_item_count / 2);
    status := set (widget, list_id, "topItemPosition", new_top_vis_index);
    
endprocedure;


procedure lse$$menus_clear_label_fields

local
    tpu_code_id,
    mnemonic_id,
    label_to_edit_id;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$menus_clear_label_fields");
    ENDON_ERROR;

    label_to_edit_id := lse$$get_label_to_edit_id;
    mnemonic_id := lse$$get_mnemonic_id;
    tpu_code_id := lse$$get_tpu_code_id;

    set (widget, label_to_edit_id, eve$x_resource_array {eve$k_nvalue}, "");
    set (widget, mnemonic_id, eve$x_resource_array {eve$k_nvalue}, "");
    set (widget, tpu_code_id, eve$x_resource_array {eve$k_nvalue}, "");

endprocedure;



! Called when a label is selected in the Menus... dialog box
! 
procedure lse$$widget_make_label_selection

local
    label_def,
    label_mnemonic,
    label_info,
    tpu_code_id,
    mnemonic_id,
    label_to_edit_id,
    selected_label;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_make_label_selection");
    ENDON_ERROR;

    selected_label := lse$$get_list_selection (lse$$get_menu_labels_id);

    if selected_label = tpu$k_unspecified
    then
	! The only selection was just de-selected
	!
	lse$$menus_cancel_label_selection;
	lse$$menus_clear_label_fields;
	return;
    endif;

    label_to_edit_id := lse$$get_label_to_edit_id;
    mnemonic_id := lse$$get_mnemonic_id;
    tpu_code_id := lse$$get_tpu_code_id;

    label_info := lse$$x_pulldown_labels_by_name {selected_label};
    label_mnemonic := label_info {lse$k_mnemonic};
    label_def := label_info {lse$k_def};

    set (widget, label_to_edit_id, eve$x_resource_array {eve$k_nvalue}, 
	selected_label);

    if label_mnemonic <> tpu$k_unspecified 
    then
	set (widget, mnemonic_id, eve$x_resource_array {eve$k_nvalue},
	    label_mnemonic);
    else
	set (widget, mnemonic_id, eve$x_resource_array {eve$k_nvalue},
	    '');
    endif;

    set (widget, tpu_code_id, eve$x_resource_array {eve$k_nvalue}, 
	label_def);

    lse$$menus_turn_on (lse$$get_add_entry_arrow_id);
    lse$$menus_turn_on (lse$$get_remove_label_id);

endprocedure;


! Called when a menu entry is selected in the Menus... dialog box
! 
procedure lse$$widget_make_entry_selection 
	
    local
	selected_label,
	remove_entry_id;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_make_entry_selection");
    ENDON_ERROR;

    selected_label := lse$$get_list_selection (lse$$get_menu_entries_id);

    remove_entry_id := lse$$get_remove_entry_id;
    if selected_label = tpu$k_unspecified
    then
	! The only selection was just de-selected
	!
	lse$$menus_turn_off (remove_entry_id);
    else
	lse$$menus_turn_on (remove_entry_id);
    endif;

    
endprocedure;


! Called when a menu name is selected in the Menus... dialog box
! 
procedure lse$$widget_make_menu_selection 

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_make_menu_selection");
    ENDON_ERROR;

    lse$$menus_set_entries;
    lse$$menus_cancel_entry_selection;

endprocedure;


! Called when the "add a label to menu" arrow is pushed in the Menus... dialog
! 
procedure lse$$widget_menus_add_label

local
    entries_by_name,
    entry_info,
    new_entry_index,
    selected_entry,
    selected_label,
    selected_menu,
    menu_entries_id;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_menus_add_label");
    ENDON_ERROR;

    menu_entries_id := lse$$get_menu_entries_id;

    selected_menu := lse$$get_list_selection (lse$$get_menu_id);
    selected_label := lse$$get_list_selection (lse$$get_menu_labels_id);
    selected_entry := lse$$get_list_selection (menu_entries_id);

    ! If there isn't a menu selected
    !
    if selected_menu = tpu$k_unspecified
    then
	lse$$popup_message (lse$_nomenuselect, lse$x_menus_dialog);
	return;
    endif;;

    if lse$add_pulldown_entry (selected_menu, selected_label, selected_entry)
    then
	lse$$menus_set_entries;
	lse$$menus_cancel_label_selection;

	entries_by_name := lse$$x_pulldown_contents_by_name {selected_menu};
	entry_info := entries_by_name {selected_label};
	new_entry_index := entry_info {lse$k_index};  
      
	lse$$make_item_visible (menu_entries_id, new_entry_index);
    endif;

endprocedure;


! Called when the "Remove Entry" button is pushed in the Menus... dialog box
! 
procedure lse$$widget_menus_remove_entry

local
    status,
    selected_entry,
    selected_menu,
    menu_labels_id;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_menus_remove_entry");
    ENDON_ERROR;

    menu_labels_id := lse$$get_menu_labels_id;

    selected_menu := lse$$get_list_selection (lse$$get_menu_id);
    selected_entry := lse$$get_list_selection (lse$$get_menu_entries_id);

    status := false;
    if lse$$is_separator (selected_entry)
    then
	selected_entry := selected_entry - lse$k_separator_label;
	status := lse$remove_pulldown_separator (selected_menu, int(selected_entry));
    else
	status := lse$remove_pulldown_entry (selected_menu, selected_entry);
    endif;

    if status 
    then
	lse$$menus_set_entries;
	lse$$menus_cancel_entry_selection;
    endif;

endprocedure;


! Called when the "Remove Label" button is pushed in the Menus... dialog box
! 
procedure lse$$widget_menus_remove_label

local
    selected_label;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_menus_remove_label");
    ENDON_ERROR;

    selected_label := lse$$get_list_selection (lse$$get_menu_labels_id);

    if lse$remove_pulldown_label (selected_label)
    then
	lse$$menus_set_labels;
	lse$$menus_cancel_label_selection;
    endif;

endprocedure;


! Called when the "Add Separator" button is pushed in the Menus... dialog box
! 
procedure lse$$widget_menus_add_separator

local
    menu_entries_id,
    pulldown_entries_by_number,
    pulldown_index,
    pulldown_info,
    new_entry_index,
    entry_info,
    entries_by_name,
    selected_entry,
    selected_label,
    selected_menu;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_menus_add_separator");
    ENDON_ERROR;

    selected_menu := lse$$get_list_selection (lse$$get_menu_id);
    selected_label := lse$$get_list_selection (lse$$get_menu_labels_id);
    selected_entry := lse$$get_list_selection (lse$$get_menu_entries_id);

    if lse$add_pulldown_separator (selected_menu, selected_entry)
    then
	lse$$menus_set_entries;

	if selected_entry <> tpu$k_unspecified
	then
	    entries_by_name := lse$$x_pulldown_contents_by_name {selected_menu};
	    entry_info := entries_by_name {selected_entry};
	    new_entry_index := entry_info {lse$k_index} - 1;
	else
	    pulldown_info := lse$$x_menus_by_name {selected_menu};
	    pulldown_index := pulldown_info {lse$k_index}; 
	    pulldown_entries_by_number :=
		lse$$x_pulldown_contents_by_number {pulldown_index};
	    new_entry_index := get_info (pulldown_entries_by_number, "last");
	endif;

	menu_entries_id := lse$$get_menu_entries_id;
	lse$$make_item_visible (menu_entries_id, new_entry_index);

    endif;

endprocedure;


! Called when the "Edit Label Arrow" button is pushed in the Menus... dialog
! box
!
procedure lse$$widget_menus_label_action

local
    editted_tpu_code,
    editted_mnemonic,
    editted_label;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_menus_label_action");
    ENDON_ERROR;

    editted_label := lse$$get_text (lse$$get_label_to_edit_id);

    if editted_label = ''
    then
	lse$$popup_message (lse$_noblanklabel, lse$x_menus_dialog);
	return false;
    endif;

    editted_mnemonic := lse$$get_text (lse$$get_mnemonic_id);
    if editted_mnemonic = ''
    then
	editted_mnemonic := tpu$k_unspecified;
    endif;

    editted_tpu_code := lse$$get_text (lse$$get_tpu_code_id);
    
    if editted_tpu_code = ''
    then
	lse$$popup_message (lse$_noblanktpucode, lse$x_menus_dialog);
	return false;
    endif;

    ! If the label is already there, then modify it.  If it isn't there,
    ! add it.
    !
    if lse$$x_pulldown_labels_by_name {editted_label} = tpu$k_unspecified
    then
	if not lse$add_pulldown_label ( editted_label, editted_tpu_code, 
					editted_mnemonic)
	then 
	    return;
	endif;
    else
	if not lse$modify_pulldown_label (  editted_label, editted_tpu_code,
					    editted_mnemonic)
	then
	    return;
	endif;
    endif;		

    lse$$menus_set_labels;
    lse$$set_list_selection (lse$$get_menu_labels_id, editted_label);
    lse$$widget_make_label_selection;

endprocedure;


procedure lse$$menus_cancel_label_selection

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$menus_cancel_label_selection");
    ENDON_ERROR;

    lse$$menus_cancel_selection (lse$$get_menu_labels_id);
    lse$$menus_turn_off (lse$$get_add_entry_arrow_id);
    lse$$menus_turn_off (lse$$get_remove_label_id);

endprocedure;


procedure lse$$menus_cancel_entry_selection

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$menus_cancel_entry_selection");
    ENDON_ERROR;

    lse$$menus_cancel_selection (lse$$get_menu_entries_id);
    lse$$menus_turn_off (lse$$get_remove_entry_id);

endprocedure;


procedure lse$$menus_turn_off (button_id)

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$menus_turn_off");
    ENDON_ERROR;

    set (widget, button_id, "sensitive", false);

endprocedure;


procedure lse$$menus_turn_on (button_id)

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$menus_turn_on");
    ENDON_ERROR;

    set (widget, button_id, "sensitive", true);

endprocedure;


! The array used to set the items in the scrolled has to be indexed
! numerically, with the value for each element the string to put into the
! list box.  Sometimes we don't already have this array, so we need to
! build it from an array that's indexed by the strings themselves.
! 
procedure lse$$build_numbered_array (in_array)

local
    current_element,
    i,
    out_array;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$build_numbered_array");
    ENDON_ERROR;

    out_array := CREATE_ARRAY;
    i := 1;
    current_element := get_info (in_array, "first");
    loop
	exitif current_element = tpu$k_unspecified;

	out_array {i} := current_element;

	i := i + 1;
	current_element := get_info (in_array, "next");
    endloop;

    return out_array;

endprocedure;


procedure lse$$cs_help (cs_help_topic)

    local
	the_facility,
	the_legend,
	the_topic;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$cs_help");
    ENDON_ERROR;


    eve$$parse_comment (cs_help_topic, "",
			the_facility, the_legend,
			the_topic);

    lse$$help_widget (the_facility, the_topic);

endprocedure


procedure lse$$widget_help_on_context

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_help_on_context");
    ENDON_ERROR;

    lse$$help_on_context;    

endprocedure;


procedure lse$$widget_hyperhelp

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_hyperhelp");
    ENDON_ERROR;

    lse$$display_hyperhelp;    

endprocedure;

procedure lse$$menus_associate_command (the_widget, the_command)

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$menus_associate_command");
    ENDON_ERROR;

    !
    ! Put the fao_command in the array to be used on the other side.
    !
    IF lse$x_fao_command_array = tpu$k_unspecified
    THEN 
	lse$x_fao_command_array := create_array;
    ENDIF;

    lse$x_fao_command_array {the_widget} := the_command;

endprocedure;



procedure lse$$menus_get_associated_command (the_widget)

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$menus_get_associated_command");
    ENDON_ERROR;

    return lse$x_fao_command_array {the_widget};

endprocedure;



procedure lse$$menus_reallydelbuf_dialog (fao_command)

    local
	write_and_delete_button_id;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$menus_reallydelbuf_dialog");
    ENDON_ERROR;

    lse$create_dialog_box ("REALLYDELBUF_DIALOG", eve$x_reallydelbuf_dialog);

    write_and_delete_button_id := get_info (widget, "widget_id",
	eve$x_reallydelbuf_dialog, 
	"REALLYDELBUF_DIALOG.REALLYDELBUF_CHOICES.REALLYDELBUF_WRITE_AND_DELETE");
    
    ! Make the default to Write and Delete the buffer
    !
    set (widget, write_and_delete_button_id, 
	eve$x_resource_array {eve$k_nset}, true);

    eve$manage_widget (eve$x_reallydelbuf_dialog);

    lse$$menus_associate_command (eve$x_reallydelbuf_dialog, fao_command);

endprocedure;


procedure lse$$menus_reallydelbuf_ok

    local
	status,
	delete_mode,
	buffer_to_delete,
	write_and_delete_button_id,
	write_and_delete;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$menus_reallydelbuf_ok");
    ENDON_ERROR;

    eve$unmanage_widget (eve$x_reallydelbuf_dialog);

    write_and_delete_button_id := get_info (widget, "widget_id",
	eve$x_reallydelbuf_dialog, 
	"REALLYDELBUF_DIALOG.REALLYDELBUF_CHOICES.REALLYDELBUF_WRITE_AND_DELETE");
    
    status := get_info (write_and_delete_button_id, "widget_info",
	eve$x_resource_array {eve$k_nset}, write_and_delete);

    if write_and_delete
    then
	delete_mode := message_text (EVE$_WRITE_FIRST, 1);
    else
	delete_mode := message_text (EVE$_DELETE_ONLY, 1);
    endif;

    buffer_to_delete := lse$$menus_get_associated_command (eve$x_reallydelbuf_dialog);
	
    eve$delete_buffer (eve$find_buffer (buffer_to_delete), true, delete_mode);
	  
    delete (eve$x_reallydelbuf_dialog);
	     
endprocedure;


procedure lse$$menus_reallydelbuf_cancel

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$menus_reallydelbuf_cancel");
    ENDON_ERROR;

    eve$unmanage_widget (eve$x_reallydelbuf_dialog);
    delete (eve$x_reallydelbuf_dialog);    

endprocedure;


procedure lse$$menus_message_ok

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$menus_message_ok");
    ENDON_ERROR;

    eve$unmanage_widget (eve$x_message_dialog);
    delete (eve$x_message_dialog);

endprocedure;


PROCEDURE LSE$$CREATE_MENU_SYSTEM 

    lse$$x_menus_loaded := TRUE;

    lse$add_pulldown_label ("New File ...", "LSE_NEW_FILE", "N");
    lse$add_pulldown_label ("Open File ...", "LSE_OPEN_FILE", "O");
    lse$add_pulldown_label ("Open Selected File", "LSE_OPEN_SELECTED_FILE", "d");
    lse$add_pulldown_label ("View File ...", "LSE_VIEW_FILE", "V");
    lse$add_pulldown_label ("Include File ...", "LSE_INCLUDE_FILE", "I");
    lse$add_pulldown_label ("Save File", "LSE_SAVE_FILE ('')", "S"); 
    lse$add_pulldown_label ("Save As ...", "LSE_SAVE_AS", "A");
    lse$add_pulldown_label ("Close File", "LSE_CLOSE_FILE", "C");
    lse$add_pulldown_label ("Reserve", "LSE$KEY_RESERVE", "R" );
    lse$add_pulldown_label ("Replace", "LSE$KEY_REPLACE", "p");
    lse$add_pulldown_label ("Unreserve", "LSE$KEY_UNRESERVE", "U" );
    lse$add_pulldown_label ("Source Directory ...", "LSE$$WIDGET_SRCDIR", "y" );
    lse$add_pulldown_label ("Read-Only Directories ...", "LSE$$WIDGET_RDODIR", "R" );
    lse$add_pulldown_label ("SCA Library ...", "LSE$$WIDGET_SCADIR", "L" );
    lse$add_pulldown_label ("Quit", "LSE_QUIT", "Q");
    lse$add_pulldown_label ("Exit", "LSE_EXIT", "E");

    lse$add_pulldown_label ("Cut", "LSE$KEY_CUT_TO_CLIPBOARD", "t");
    lse$add_pulldown_label ("Copy", "LSE$KEY_COPY_TO_CLIPBOARD", "C");
    lse$add_pulldown_label ("Paste", "LSE$KEY_PASTE_FROM_CLIPBOARD", "P");
    lse$add_pulldown_label ("Delete", "LSE_ERASE_SELECTION", "D");
    lse$add_pulldown_label ("Undo", "LSE_UNDO", "o");
    lse$add_pulldown_label ("Redo", "LSE_REDO", "R");
    lse$add_pulldown_label ("Undo/Redo ...", "LSE$$WIDGET_UNDO_REDO", "e");
    lse$add_pulldown_label ("Fill", "LSE_FILL", "F");
    lse$add_pulldown_label ("Center Line", "LSE_CENTER_LINE", "n");
    lse$add_pulldown_label ("Align", "LSE_ALIGN", "g");
    lse$add_pulldown_label ("Indentation ...", "LSE$$WIDGET_INDENTATION", "I");
    lse$add_pulldown_label ("Lowercase", "LSE_LOWERCASE", "L");
    lse$add_pulldown_label ("Uppercase", "LSE_UPPERCASE", "U");
    lse$add_pulldown_label ("Capitalize", "LSE_CAPITALIZE", "z");
    lse$add_pulldown_label ("Select All", "LSE_SELECT_ALL", "A");
    lse$add_pulldown_label ("Select_mark", "LSE_SELECT", "m");

    lse$add_pulldown_label ("Overview Source", "LSE_OVERVIEW_SOURCE", "O");
    lse$add_pulldown_label ("View Source", "LSE_VIEW_SOURCE (9999)", "V");
    lse$add_pulldown_label ("Focus", "LSE_FOCUS", "F");
    lse$add_pulldown_label ("Expand", "LSE$KEY_EXPAND", "E");
    lse$add_pulldown_label ("Expand All", "LSE_EXPAND ('ALL')", "x");
    lse$add_pulldown_label ("Collapse", "LSE$KEY_COLLAPSE", "C");
    lse$add_pulldown_label ("Collapse All", "LSE_COLLAPSE('ALL')", "l");
    lse$add_pulldown_label ("New Window", "LSE_NEW_WINDOW", "N");
    lse$add_pulldown_label ("One Window", "LSE_ONE_WINDOW", "O");
    lse$add_pulldown_label ("Delete Window", "LSE_DELETE_WINDOW", "D");
    lse$add_pulldown_label ("Refresh", "LSE_REFRESH", "R");

    lse$add_pulldown_label ("Search ...", "LSE_SEARCH", "h");
    lse$add_pulldown_label ("Search Next", "LSE_SEARCH ('')", "N");
    lse$add_pulldown_label ("Search Selected", "LSE$$SEARCH_SELECTED", "d");
    lse$add_pulldown_label ("Substitute ...", "LSE$$SUBSTITUTE_DIALOG", "b");

    lse$add_pulldown_label ("Compile", "LSE$MENU_COMPILE", "C");
    lse$add_pulldown_label ("Review", "LSE_REVIEW", "R");
    lse$add_pulldown_label ("Compile Review", "LSE$MENU_COMPILE_REVIEW", "v");
    lse$add_pulldown_label ("Find Occurrences", "LSE$KEY_FIND_OCCURRENCES", "F");
    lse$add_pulldown_label ("Goto Declaration", "LSE$KEY_GOTO_DECLARATION", "D");
    lse$add_pulldown_label ("Goto Source", "LSE$KEY_GOTO_SOURCE", "S");
    lse$add_pulldown_label ("Goto Buffer *", "LSE_GOTO_BUFFER ('*')", "B");
    lse$add_pulldown_label ("Next Error", "LSE_NEXT_ERROR", "N");
    lse$add_pulldown_label ("Previous Error", "LSE_PREVIOUS_ERROR", "P");

    lse$add_pulldown_label ("Show Buffer *", "LSE_SHOW_BUFFER ('*')", "u");
    lse$add_pulldown_label ("Show Command *", 
                               "LSE$DO_COMMAND ('SHOW COMMAND *')", "C");
    lse$add_pulldown_label ("Show Key *", "LSE_SHOW_KEY ('*')", "K");
    lse$add_pulldown_label ("Show Mark *", "LSE_SHOW_MARK ('*')", "M");
    lse$add_pulldown_label ("Show Summary", "LSE_SHOW_SUMMARY", "S");
    lse$add_pulldown_label ("Show Version", "LSE_SHOW_VERSION", "V");

    lse$add_pulldown_label ("New Key ...", "LSE$$WIDGET_DEFINE_KEY", "N");
    lse$add_pulldown_label ("Buffer Attributes ...", 
                               "LSE$$WIDGET_BUFFER_ATTRIBUTES", "B");
    lse$add_pulldown_label ("Global Attributes ...", 
                               "LSE_SHOW_ATTRIBUTES", "G");
    lse$add_pulldown_label ("Window Attributes ...", 
                               "LSE_SHOW_WINDOW_ATTRIBUTES", "W");
    lse$add_pulldown_label ("Search Attributes ...", 
                               "LSE_SHOW_SEARCH_ATTRIBUTES", "r");
    lse$add_pulldown_label ("Menus ...", "LSE$$WIDGET_MENUS", "M");
    lse$add_pulldown_label ("CMS ...", "LSE$KEY_CMS", "C");
    lse$add_pulldown_label ("Save Options ...", "LSE$$WIDGET_ATTR", "S");
    lse$add_pulldown_label ("Restore Options", "LSE$$RESTORE_MODE_SETTINGS", "R");
    lse$add_pulldown_label ("Restore System Options", "LSE$$SYSTEM_MODE_SETTINGS", "y");

    lse$add_pulldown_label ("Goto Top", "LSE_TOP", "T");
    lse$add_pulldown_label ("Goto Bottom", "LSE_BOTTOM", "B");
    lse$add_pulldown_label ("Mark ...", "LSE_NEW_MARK", "M");
    lse$add_pulldown_label ("Goto Mark ...", "LSE_GOTO_MARK", "G");
    lse$add_pulldown_label ("Cancel Mark ...", "LSE_DELETE_MARK", "C");

    lse$add_pulldown_label ("Box Copy", "LSE_BOX_COPY", "C");
    lse$add_pulldown_label ("Box Cut", "LSE_BOX_CUT", "u");
    lse$add_pulldown_label ("Box Cut & Pad", "LSE_BOX_CUT_PAD", "t");
    lse$add_pulldown_label ("Box Paste", "LSE_BOX_PASTE", "P");
    lse$add_pulldown_label ("Box Paste Over", "LSE_BOX_PASTE_OVERSTRIKE", "a");
    lse$add_pulldown_label ("Box Draw", "LSE_BOX_DRAW", "D");
    lse$add_pulldown_label ("Box Lowercase", "LSE_BOX_LOWERCASE", "L");
    lse$add_pulldown_label ("Box Uppercase", "LSE_BOX_UPPERCASE", "U");

    lse$add_pulldown_label ("On Overview", "LSE$$HELP_WIDGET ('LSEMENU', 'DECW_Overview')", "O");
    lse$add_pulldown_label ("On Context", "LSE$$WIDGET_HELP_ON_CONTEXT", "C");
    lse$add_pulldown_label ("On Version", "LSE$$HELP_WIDGET ('LSEMENU', 'About_LSE')", "V");
    lse$add_pulldown_label ("On Help", "LSE$$HELP_WIDGET ('LSEMENU', 'DECW_Using_LSE_Help')", "H");
    lse$add_pulldown_label ("On Commands", "LSE$$HELP_WIDGET ('LSEMENU', 'DECW_Command_Line_Interface')", "m");
!-Hyperhelp
!    lse$add_pulldown_label ("Hyperhelp", "LSE$$WIDGET_HYPERHELP", "y");
!-Hyperhelp

    lse$add_pulldown_label ("Restore", "LSE_RESTORE", "R");
    lse$add_pulldown_label ("Close Buffer", "LSE_CLOSE_BUFFER", "C");
    lse$add_pulldown_label ("Previous Occurrence", "LSE$DO_COMMAND ('PREVIOUS OCCURRENCE')", "r");
    lse$add_pulldown_label ("Next Occurrence", "LSE$DO_COMMAND ('NEXT OCCURRENCE')", "e");
    lse$add_pulldown_label ("Delete Query", "LSE$DO_COMMAND ('DELETE QUERY')", "D");
    lse$add_pulldown_label ("Next Symbol", "LSE$DO_COMMAND ('NEXT SYMBOL')", "N");
    lse$add_pulldown_label ("Previous Symbol", "LSE$DO_COMMAND ('PREVIOUS SYMBOL')", "P");
    
    lse$add_pulldown_entry ("File", "New File ...");
    lse$add_pulldown_entry ("File", "Open File ...");
    lse$add_pulldown_entry ("File", "Open Selected File");
    lse$add_pulldown_entry ("File", "View File ...");
    lse$add_pulldown_entry ("File", "Include File ...");
    lse$add_pulldown_separator ("File");
    lse$add_pulldown_entry ("File", "Save File"); 
    lse$add_pulldown_entry ("File", "Save As ...");
    lse$add_pulldown_entry ("File", "Close File");
    lse$add_pulldown_separator ("File");
    lse$add_pulldown_entry ("File", "Reserve");
    lse$add_pulldown_entry ("File", "Replace");
    lse$add_pulldown_entry ("File", "Unreserve");
    lse$add_pulldown_separator ("File");
    lse$add_pulldown_entry ("File", "Source Directory ...");
    lse$add_pulldown_entry ("File", "Read-Only Directories ...");
    lse$add_pulldown_entry ("File", "SCA Library ...");
    lse$add_pulldown_separator ("File");
    lse$add_pulldown_entry ("File", "Quit");
    lse$add_pulldown_entry ("File", "Exit");

    lse$add_pulldown_entry ("Edit", "Cut");
    lse$add_pulldown_entry ("Edit", "Copy");
    lse$add_pulldown_entry ("Edit", "Paste");
    lse$add_pulldown_entry ("Edit", "Delete");
    lse$add_pulldown_separator ("Edit");
    lse$add_pulldown_entry ("Edit", "Fill");
    lse$add_pulldown_entry ("Edit", "Center Line");
    lse$add_pulldown_entry ("Edit", "Align");
    lse$add_pulldown_entry ("Edit", "Indentation ...");
    lse$add_pulldown_separator ("Edit");
    lse$add_pulldown_entry ("Edit", "Lowercase");
    lse$add_pulldown_entry ("Edit", "Uppercase");
    lse$add_pulldown_entry ("Edit", "Capitalize");
    lse$add_pulldown_separator ("Edit");
    lse$add_pulldown_entry ("Edit", "Select All");
    lse$add_pulldown_entry ("Edit", "Select_mark");
    lse$add_pulldown_separator ("Edit");
    lse$add_pulldown_entry ("Edit", "Undo");
    lse$add_pulldown_entry ("Edit", "Redo");
    lse$add_pulldown_entry ("Edit", "Undo/Redo ...");

    lse$add_pulldown_entry ("View", "Expand");
    lse$add_pulldown_entry ("View", "Collapse");
    lse$add_pulldown_entry ("View", "Expand All");
    lse$add_pulldown_entry ("View", "Collapse All");
    lse$add_pulldown_separator ("View");
    lse$add_pulldown_entry ("View", "Overview Source");
    lse$add_pulldown_entry ("View", "View Source");
    lse$add_pulldown_entry ("View", "Focus");
    lse$add_pulldown_separator ("View");
    lse$add_pulldown_entry ("View", "New Window");
    lse$add_pulldown_entry ("View", "One Window");
    lse$add_pulldown_entry ("View", "Delete Window");
    lse$add_pulldown_separator ("View");
    lse$add_pulldown_entry ("View", "Refresh");

    lse$add_pulldown_entry ("Search", "Search ...");
    lse$add_pulldown_entry ("Search", "Search Next");
    lse$add_pulldown_entry ("Search", "Search Selected");
    lse$add_pulldown_entry ("Search", "Substitute ...");

    lse$add_pulldown_entry ("Source", "Compile");
    lse$add_pulldown_entry ("Source", "Review");
    lse$add_pulldown_entry ("Source", "Compile Review");
    lse$add_pulldown_separator ("Source");
    lse$add_pulldown_entry ("Source", "Find Occurrences");
    lse$add_pulldown_entry ("Source", "Goto Declaration");
    lse$add_pulldown_separator ("Source");
    lse$add_pulldown_entry ("Source", "Goto Source");
    lse$add_pulldown_entry ("Source", "Goto Buffer *");
    lse$add_pulldown_separator ("Source");
    lse$add_pulldown_entry ("Source", "Next Error");
    lse$add_pulldown_entry ("Source", "Previous Error");

    lse$add_pulldown_entry ("Show", "Show Buffer *");
    lse$add_pulldown_entry ("Show", "Show Command *");
    lse$add_pulldown_entry ("Show", "Show Key *");
    lse$add_pulldown_entry ("Show", "Show Mark *");
    lse$add_pulldown_entry ("Show", "Show Summary");
    lse$add_pulldown_entry ("Show", "Show Version");

    lse$add_pulldown_entry ("Options", "New Key ...");
    lse$add_pulldown_entry ("Options", "Buffer Attributes ...");
    lse$add_pulldown_entry ("Options", "Global Attributes ...");
    lse$add_pulldown_entry ("Options", "Window Attributes ...");
    lse$add_pulldown_entry ("Options", "Search Attributes ...");
    lse$add_pulldown_entry ("Options", "Menus ...");

    if not eve$x_ultrix_active
    then
	lse$add_pulldown_entry ("Options", "CMS ...");
    endif;

    lse$add_pulldown_separator ("Options");
    lse$add_pulldown_entry ("Options", "Save Options ...");
    lse$add_pulldown_entry ("Options", "Restore Options");
    lse$add_pulldown_entry ("Options", "Restore System Options");

    lse$add_pulldown_entry ("Navigate", "Goto Top");
    lse$add_pulldown_entry ("Navigate", "Goto Bottom");
    lse$add_pulldown_separator ("Navigate");
    lse$add_pulldown_entry ("Navigate", "Mark ...");
    lse$add_pulldown_entry ("Navigate", "Goto Mark ...");
    lse$add_pulldown_entry ("Navigate", "Cancel Mark ...");

    lse$add_pulldown_entry ("Box", "Box Copy");
    lse$add_pulldown_entry ("Box", "Box Cut");
    lse$add_pulldown_entry ("Box", "Box Cut & Pad");
    lse$add_pulldown_entry ("Box", "Box Paste");
    lse$add_pulldown_entry ("Box", "Box Paste Over");
    lse$add_pulldown_separator ("Box");
    lse$add_pulldown_entry ("Box", "Box Draw");
    lse$add_pulldown_separator ("Box");
    lse$add_pulldown_entry ("Box", "Box Lowercase");
    lse$add_pulldown_entry ("Box", "Box Uppercase");

    lse$add_pulldown_entry ("Help", "On Overview");
    lse$add_pulldown_entry ("Help", "On Context");
    lse$add_pulldown_entry ("Help", "On Help");
    lse$add_pulldown_entry ("Help", "On Version");
    lse$add_pulldown_entry ("Help", "On Commands");
!-Hyperhelp
!    lse$add_pulldown_entry ("Help", "Hyperhelp");
!-Hyperhelp

    lse$add_pulldown_entry ("No Select Popup", "Restore");
    lse$add_pulldown_separator ("No Select Popup");
    lse$add_pulldown_entry ("No Select Popup", "Cut");
    lse$add_pulldown_entry ("No Select Popup", "Copy");
    lse$add_pulldown_entry ("No Select Popup", "Paste");
    lse$add_pulldown_separator ("No Select Popup");
    lse$add_pulldown_entry ("No Select Popup", "Search Next");
    lse$add_pulldown_entry ("No Select Popup", "Search Selected");
    lse$add_pulldown_entry ("No Select Popup", "Find Occurrences");
    lse$add_pulldown_entry ("No Select Popup", "Goto Declaration");
    lse$add_pulldown_separator ("No Select Popup");
    lse$add_pulldown_entry ("No Select Popup", "Save File");
    lse$add_pulldown_entry ("No Select Popup", "Close Buffer");

    lse$add_pulldown_entry ("Review Popup", "Previous Error");
    lse$add_pulldown_entry ("Review Popup", "Next Error");
    lse$add_pulldown_entry ("Review Popup", "Goto Source");
    lse$add_pulldown_entry ("Review Popup", "Close Buffer");

    if not eve$x_ultrix_active
    then
	lse$add_pulldown_entry ("Query Popup", "Previous Symbol");
	lse$add_pulldown_entry ("Query Popup", "Previous Occurrence"); 
	lse$add_pulldown_entry ("Query Popup", "Next Symbol");
	lse$add_pulldown_entry ("Query Popup", "Next Occurrence");
	lse$add_pulldown_entry ("Query Popup", "Goto Source");
	lse$add_pulldown_entry ("Query Popup", "Delete Query");
	lse$add_pulldown_entry ("Query Popup", "Expand");
	lse$add_pulldown_entry ("Query Popup", "Collapse");
    endif;

endprocedure


PROCEDURE lse$$widget_attr

    LOCAL
	status;

    ! Create the DB if necessary
    !
    lse$create_dialog_box( "ATTR_DIALOG", eve$x_attr_dialog );

    ! Set the section file widgets
    !
    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 (TEXT,
		   get_info (WIDGET, "widget_id", eve$x_attr_dialog,
			     "ATTR_DIALOG.ATTR_SECTION_TEXT"),
		   eve$$x_section_default);

    ! Set the command file widgets
    !
    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 (TEXT,
		   get_info (WIDGET, "widget_id", eve$x_attr_dialog,
			     "ATTR_DIALOG.ATTR_COMMAND_TEXT"),
		   eve$$get_default_command_file);

    ! Show it
    !
    eve$manage_widget (eve$x_attr_dialog, "ATTR_DIALOG");

    lse$add_minimum_size_to_dialog (eve$x_attr_dialog);

ENDPROCEDURE;


procedure lse$$widget_attr_ok

    LOCAL
	status,
	flag;

    ON_ERROR
	[OTHERWISE]:
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_attr_ok");
    ENDON_ERROR;

    ! Tear it down
    !
    eve$unmanage_widget (eve$x_attr_dialog);

    ! Find out which form of saving
    !
    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},
	    flag);
    if flag
    then
	! Save as section file
	!
	lse_save_section(get_info(get_info (WIDGET, "widget_id",
					    eve$x_attr_dialog,
					    "ATTR_DIALOG.ATTR_SECTION_TEXT"),
				"text"));
    else
	! Save 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},
			    flag);
	if flag
	then
	    lse$$push_position;
	    if eve$$reserve_scratch_buffer
	    then
		set (INSERT, eve$$x_scratch_buffer);
		erase (eve$$x_scratch_buffer);
		position (eve$$x_scratch_buffer);
		lse$$copy_current_global_settings(false);
		lse_save_file( get_info (get_info (WIDGET, "widget_id",
					eve$x_attr_dialog,
					"ATTR_DIALOG.ATTR_COMMAND_TEXT"),
			       "text"));
		eve$$release_scratch_buffer;
	    endif;
	    lse$$pop_position;
	else
	    ! Not possible
	    !
	    lse$$unexpected_error( EVE$_COMMANDSTOP, 
				   message_text( EVE$_COMMANDSTOP ),
				   0, "lse$$widget_attr_ok - not possible");
	endif;

    endif;

return (status);

endprocedure;


procedure lse$$widget_attr_cancel

    ON_ERROR
	[OTHERWISE]:
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$widget_attr_ok");
    ENDON_ERROR;

eve$unmanage_widget (eve$x_attr_dialog);

endprocedure;


procedure lse$$save_menu_label (menu_label)

    local
	menu_def;

    ON_ERROR
	[OTHERWISE]:
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$save_menu_label");
    ENDON_ERROR;

    if get_info (lse$$x_saved_menu_defs, "type") <> ARRAY
    then
	lse$$x_saved_menu_defs := CREATE_ARRAY (2);
    endif;

    menu_def := lse$$menus_get_menu_label_info (menu_label);
    lse$$x_saved_menu_defs {menu_label} := menu_def;

    return true;   

endprocedure;


procedure lse$$restore_menu_label (menu_label)

    local
	menu_def;

    ON_ERROR
	[OTHERWISE]:
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$restore_menu_label");
    ENDON_ERROR;

    if get_info (lse$$x_saved_menu_defs, "type") <> ARRAY
    then
	return false;
    endif;
    
    menu_def := lse$$x_saved_menu_defs {menu_label};

    ! Check if a definition was ever saved for this key
    !
    if menu_def = tpu$k_unspecified
    then
	return false;
    endif;

    lse$$menus_set_menu_label_info (menu_label, menu_def);

    delete (lse$$x_saved_menu_defs {menu_label});

    return true;

endprocedure;


procedure lse$$menus_get_menu_label_info (menu_label)
    
    local
	label_info,
	label_info_copy;

    ON_ERROR
	[OTHERWISE]:
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$menus_get_menu_label_info");
    ENDON_ERROR;

    if lse$$x_menus_loaded = tpu$k_unspecified
    then
	lse$$load_menus (TRUE);
    endif;

    label_info := lse$$x_pulldown_labels_by_name {menu_label};
    label_info_copy := CREATE_ARRAY (2);

    if label_info = tpu$k_unspecified
    then
	label_info_copy := tpu$k_unspecified;
    else    
	label_info_copy {lse$k_def} := label_info {lse$k_def};
	label_info_copy {lse$k_mnemonic} := label_info {lse$k_mnemonic};
    endif;

    return label_info_copy;

endprocedure;    


procedure lse$$menus_set_menu_label_info (menu_label, menu_label_info)

    local
	mnemonic,
	def;

    ON_ERROR
	[OTHERWISE]:
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$menus_set_menu_label_info");
    ENDON_ERROR;

    if lse$$x_menus_loaded = tpu$k_unspecified
    then
	lse$$load_menus (TRUE);
    endif;

    mnemonic := menu_label_info {lse$k_mnemonic};
    def      := menu_label_info {lse$k_def};
    lse$modify_pulldown_label (menu_label, def, mnemonic);

endprocedure;


procedure lse$$cms_pref_activate(confirm_string,
				 concurrent_string,
				 nohistory_string,
				 nonotes_string,
				 generation_string,
				 merge_string,
				 remark_string)
!++
! FUNCTIONAL DESCRIPTION:
!
!   LSE$$CMS_PREF_ACTIVATE activates the CMS preferences dialog, sets the
!   fields within the box to reflect the current CMS settings, and calls
!   EVE$MANAGE_WIDGET to make the CMS preferences dialog box visible.
!
! FORMAL PARAMETERS:
!
!   confirm_string
!	A string containing a "1" or a "0" to indicate that /COMFIRM should
!	be used as a default for CMS commands.
!
!   concurrent_string
!	A string containing a "1" or a "0" to indicate that /CONCURRENT should
!	be used as a default for CMS commands.
!
!   nohistory_string
!	A string containing "1" or "0" to indicate that /NOHISTORY should be
!	used as a default for CMS commands.
!
!   nonotes_string
!	A string containing "1" or "0" to indicate that /NONOTES should be used
!	as a default for CMS commands.
!
!   generation_string
!	A string with the default value for the /GENERATION qualifier on CMS
!	commands.
!
!   merge_string
!	A string with the default value for the /MERGE qualifier on CMS
!	commands.
!
!   remark_string
!	A string with the default value for the /REMARK qualifier on CMS
!	commands.
!
! IMPLICIT INPUTS:
!
!   LSE$$X_CMS_PREFERENCES_DIALOG - a pointer to the CMS preferences dialog box.
!
! IMPLICIT OUTPUTS:
!
!   LSE$$X_CMS_PREFERENCES_DIALOG - a pointer to the CMS preferences dialog box
!   which is created by this routine if an instantiation of the dialog box did
!   not exist.
!
! SIDE EFFECTS:
!
!   The CMS preferences dialog box is made visible.
!--

LOCAL
    status;

lse$create_dialog_box ("CMS_PREFERENCES_DIALOG", 
			lse$$x_cms_preferences_dialog);

!+
! Establish values in each of the fields of the CMS preferences dialog box
! which reflect the current CMS settings.
!-                
status := set(widget,
	      get_info(widget, "widget_id",
		       lse$$x_cms_preferences_dialog,
		       "CMS_PREFERENCES_DIALOG.CMS_PREF_CONFIRM"),
	      eve$x_resource_array{ eve$k_nset} ,
	      (confirm_string = "1"));

status := set(widget,
	      get_info(widget, "widget_id",
		       lse$$x_cms_preferences_dialog,
		       "CMS_PREFERENCES_DIALOG.CMS_PREF_CONCURRENT"),
	      eve$x_resource_array{ eve$k_nset} ,
	      (concurrent_string = "1"));

status := set(widget,
	      get_info(widget, "widget_id",
		       lse$$x_cms_preferences_dialog,
		       "CMS_PREFERENCES_DIALOG.CMS_PREF_HISTORY"),
	      eve$x_resource_array{ eve$k_nset} ,
	      (nohistory_string = "0"));

status := set(widget,
	      get_info(widget, "widget_id",
		       lse$$x_cms_preferences_dialog,
		       "CMS_PREFERENCES_DIALOG.CMS_PREF_NOTES"),
	      eve$x_resource_array{ eve$k_nset} ,
	      (nonotes_string = "0"));

status := set(text,
	      get_info(widget, "widget_id",
		       lse$$x_cms_preferences_dialog,
		       "CMS_PREFERENCES_DIALOG.CMS_PREF_GENERATION_TEXT"),
	      generation_string);

status := set(text,
	      get_info(widget, "widget_id",
		       lse$$x_cms_preferences_dialog,
		       "CMS_PREFERENCES_DIALOG.CMS_PREF_MERGE_TEXT"),
	      merge_string);

status := set(text,
	      get_info(widget, "widget_id",
		       lse$$x_cms_preferences_dialog,
		       "CMS_PREFERENCES_DIALOG.CMS_PREF_REMARK_TEXT"),
	      remark_string);

eve$manage_widget(lse$$x_cms_preferences_dialog);

lse$add_minimum_size_to_dialog (lse$$x_cms_preferences_dialog);

endprocedure;

procedure lse$$widget_cms_pref_apply

local
    status,
    the_command,
    remark_string,
    merge_string,                          
    generation_string,
    confirm_value,
    notes_value,
    concurrent_value,
    history_value;

remark_string := get_info(get_info(widget, "widget_id",
				   lse$$x_cms_preferences_dialog,
				   "CMS_PREFERENCES_DIALOG.CMS_PREF_REMARK_TEXT"),
			  "text");

merge_string := get_info(get_info(widget, "widget_id",
				  lse$$x_cms_preferences_dialog,
				  "CMS_PREFERENCES_DIALOG.CMS_PREF_MERGE_TEXT"),
			 "text");

generation_string := get_info(get_info(widget, "widget_id",
				       lse$$x_cms_preferences_dialog,
				       "CMS_PREFERENCES_DIALOG.CMS_PREF_GENERATION_TEXT"),
			      "text");

status := get_info(get_info(widget, "widget_id",
			    lse$$x_cms_preferences_dialog,
			    "CMS_PREFERENCES_DIALOG.CMS_PREF_CONFIRM"),
		   "widget_info", eve$x_resource_array{ eve$k_nset} , confirm_value);

status := get_info(get_info(widget, "widget_id",
			    lse$$x_cms_preferences_dialog,
			    "CMS_PREFERENCES_DIALOG.CMS_PREF_NOTES"),
		   "widget_info", eve$x_resource_array{ eve$k_nset} , notes_value);

status := get_info(get_info(widget, "widget_id",
			    lse$$x_cms_preferences_dialog,
			    "CMS_PREFERENCES_DIALOG.CMS_PREF_CONCURRENT"),
		   "widget_info", eve$x_resource_array{ eve$k_nset} , concurrent_value);

status := get_info(get_info(widget, "widget_id",
			    lse$$x_cms_preferences_dialog,
			    "CMS_PREFERENCES_DIALOG.CMS_PREF_HISTORY"),
		   "widget_info", eve$x_resource_array{ eve$k_nset} , history_value);

the_command := '';

if remark_string <> ""
then
    the_command := the_command + '/REMARK="' + remark_string + '"';
else
    the_command := the_command + '/NOREMARK';
endif;

if merge_string <> ""
then
    the_command := the_command + '/MERGE="' + merge_string + '"';
else
    the_command := the_command + '/NOMERGE';
endif;

if generation_string <> ""
then
    the_command := the_command + '/GENERATION="' + generation_string + '"';
else
    the_command := the_command + '/GENERATION="1+"';
endif;

if confirm_value
then
    the_command := the_command + '/CONFIRM';
else
    the_command := the_command + '/NOCONFIRM';
endif;

if notes_value
then
    the_command := the_command + '/NOTES';
else
    the_command := the_command + '/NONOTES';
endif;

if concurrent_value
then
    the_command := the_command + '/CONCURRENT';
else
    the_command := the_command + '/NOCONCURRENT';
endif;

if history_value
then
    the_command := the_command + '/HISTORY';
else
    the_command := the_command + '/NOHISTORY';
endif;

vmscms_set_cms (the_command);

endprocedure;

procedure lse$$widget_cms_pref_cancel

eve$unmanage_widget(lse$$x_cms_preferences_dialog);

endprocedure;

procedure lse$$widget_cms_pref_ok

eve$unmanage_widget(lse$$x_cms_preferences_dialog);
lse$$widget_cms_pref_apply;

endprocedure;


procedure lse$$set_directory_append_visibility (the_widget, the_boolean)
    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( 
               ERROR, ERROR_TEXT, ERROR_LINE, 
               "lse$$set_directory_append_visibility ");
    ENDON_ERROR;

    set (widget, get_info (widget, "widget_id", the_widget,
                              "DIRECTORY_DIALOG.DIRECTORY_APPEND"),
         "sensitive", the_boolean);
endprocedure;


procedure lse$$set_directory_visibility (the_widget)
    LOCAL
       selected_entry,
       add_before_selected,
       delete_selected,
       append,
       up_arrow,
       down_arrow,
       directory_id,
       directory,
       list,
       up_arrow_id,
       down_arrow_id;

    ON_ERROR
	[OTHERWISE]:
	    lse$$unexpected_error( 
               ERROR, ERROR_TEXT, ERROR_LINE, 
               "lse$$set_directory_visibility");
    ENDON_ERROR;

    directory_id := get_info (widget, "widget_id", the_widget,
                                 "DIRECTORY_DIALOG.DIRECTORY_TEXT");
    directory := get_info (directory_id, "text");
    change_case (directory, upper);

    selected_entry := lse$$get_directory_list_selection (the_widget);

    if selected_entry = tpu$k_unspecified then
       ! No selection
       add_before_selected := false;
       delete_selected := false;
       up_arrow := false;
       down_arrow := false;
       if directory = "" then append := false; else append := true; endif;
    else
       ! Selection

       list := lse$$get_directory_list (the_widget);

       ! If directory text field is empty or holds a directory that is in
       ! the directory list update to the selected entry.

       if (directory = "")
       or lse$$is_directory_in_list (list, directory) then
          set (TEXT, directory_id, selected_entry);
       endif;

       append := true;
       add_before_selected := true;
       delete_selected := true;
       up_arrow := true;
       down_arrow := true;

       if list {get_info (list, "first")} = selected_entry then
          up_arrow := false;
       else
          if list {get_info (list, "last")} = selected_entry then
             down_arrow := false;
          endif;
       endif;

       if get_info (list, "first") = get_info (list, "last") then
          up_arrow := false;
          down_arrow := false;
       endif;
    endif;
    
    lse$$set_directory_append_visibility (the_widget, append);

    set (widget, get_info (widget, "widget_id", the_widget,
                              "DIRECTORY_DIALOG.DIRECTORY_ADD_BEFORE_SELECTED"),
         "sensitive", add_before_selected);
    set (widget, get_info (widget, "widget_id", the_widget,
                              "DIRECTORY_DIALOG.DIRECTORY_DELETE_SELECTED"),
         "sensitive", delete_selected);

    up_arrow_id := get_info (widget, "widget_id", the_widget,
                              "DIRECTORY_DIALOG.DIRECTORY_UP_ARROW");
    down_arrow_id := get_info (widget, "widget_id", the_widget,
                              "DIRECTORY_DIALOG.DIRECTORY_DOWN_ARROW");

    if get_info (up_arrow_id, "is_managed") then
       if not up_arrow then unmanage_widget (up_arrow_id); endif;
    else
       if up_arrow then manage_widget (up_arrow_id); endif;
    endif;

    if get_info (down_arrow_id, "is_managed") then
       if not down_arrow then unmanage_widget (down_arrow_id); endif;
    else
       if down_arrow then manage_widget (down_arrow_id); endif;
    endif;
endprocedure;


procedure lse$$get_directory_list_id (the_widget)
    return get_info (widget, "widget_id", the_widget,
                         "DIRECTORY_DIALOG.DIRECTORY_LIST_SUBFORM.DIRECTORY_LISTSW.DIRECTORY_LIST");
endprocedure;


procedure lse$$get_directory_list_selection (the_widget)
    return lse$$get_list_selection (lse$$get_directory_list_id (the_widget));
endprocedure;



procedure lse$$get_directory_list (the_widget)
    LOCAL
        parent,
        list_id,
        temp_array,
        the_index,
        status;

    list_id := lse$$get_directory_list_id (the_widget);
    status := get_info (list_id, "widget_info", 
                        eve$x_resource_array {eve$k_nitems_count}, temp_array); 
    return temp_array;
endprocedure;



procedure lse$$set_directory_list (the_widget, the_array)
    LOCAL
        list_id,
        list;

    list  := CREATE_ARRAY;
    list {eve$x_resource_array {eve$k_nitems_count}}:= the_array;
    list_id := lse$$get_directory_list_id (the_widget);
    set (widget, list_id, list);
endprocedure;



procedure lse$$source_directory_title
    return "Source Directory Search List";
endprocedure;



procedure lse$$readonly_directory_title
    return "Read-Only Directory List";
endprocedure;



procedure lse$$sca_directory_title
    return "SCA Library Search List";
endprocedure;


procedure lse$$widget_directory (decw_title, dir_list)
local
    the_widget,
    local_title,
    list,
    list_id,
    i,
    dir_array,
    tmp_array,
    dir,
    temp_index,
    temp_dir_list;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, 
                                      "lse$$widget_directory");
    ENDON_ERROR;

    ! Form directory array.
    !
    dir_array := CREATE_ARRAY;
    tmp_array := CREATE_ARRAY;
    temp_dir_list := dir_list;

    if temp_dir_list <> ""
    then
        i := 0;
        loop
            temp_index := index (temp_dir_list, ",");
            if (temp_index = 0)
            then
	        dir := temp_dir_list;
            else
	        dir := substr (temp_dir_list, 1, temp_index - 1);
            endif;     

            change_case (dir, upper);

            ! Avoid duplicate entries.
            if tmp_array {dir} = tpu$k_unspecified then
               dir_array {i} := dir;
               tmp_array {dir} := i;
               i := i + 1;
            endif;

            temp_dir_list := substr (temp_dir_list, temp_index + 1,
                                                       length(temp_dir_list));
            exitif (temp_index = 0);
            endloop;
    endif;

    IF lse$x_directory_widget_array = tpu$k_unspecified
    THEN lse$x_directory_widget_array := create_array;
    ENDIF;

    if decw_title = tpu$k_unspecified
    then
        local_title := "";
    else
        local_title := decw_title;
    endif;

    the_widget := lse$x_directory_widget_array {local_title};

    dialog_created := lse$create_dialog_box ("DIRECTORY_DIALOG", the_widget);

    lse$x_directory_widget_array {local_title} := the_widget;
    lse$$set_dialog_title (the_widget, decw_title); 

    lse$$set_directory_list (the_widget, dir_array);
    lse$$set_directory_visibility (the_widget);

    MANAGE_WIDGET (the_widget);
    if dialog_created then lse$add_minimum_size_to_dialog (the_widget); endif;

endprocedure;


procedure lse$$widget_srcdir
    lse$$widget_directory (lse$$source_directory_title,
                               get_info(lse$system, "lse$directory_source"));
endprocedure;


procedure lse$$widget_rdodir

local
    dir_list,
    dir;

    dir_list := "";
    dir := get_info( lse$system, 'first', lse$directory_read_only );
    loop
	exitif dir = 0;
        if dir_list = ""
        then dir_list := dir;
        else dir_list := dir_list + ',' + dir;
        endif;
	dir := get_info( lse$system, 'next', lse$directory_read_only );
    endloop;

    lse$$widget_directory (lse$$readonly_directory_title, dir_list);
endprocedure;


procedure lse$$widget_scadir
    LOCAL
        dir_list,
        dir,
        ptr,
        line,
        saved_mark,
        saved_mark2,
        message_buffer,
        brn,
        mrn,
        normal_exit;

    ! Temporary code to extract the current SCA libraries.
    !
    ! The SHOW LIBRARY command is executed and then the information
    ! is extracted from the message buffer.
    !
    ! It is assumed that the output has one of the following forms
    !
    ! a) Your SCA Libraries are 
    !          <first library> 
    !           .............
    !          <last  library>
    !
    !    with each library name starting at position 6 after leading white
    !    space has been removed
    !
    ! b) Your SCA Library is <library>
    !
    ! c) No SCA Library has been set
    !
    ! A mark and a record number test are also used to make sure the
    ! search completes if the expected information is not present.
    !

    lse$$push_position;
    message_buffer := get_info (BUFFER, 'find_buffer', '$MESSAGES');
    position (message_buffer);
    saved_mark := MARK (NONE);
    mrn := get_info (saved_mark, "record_number");
    lse$$pop_position;

    lse$do_command ("SHOW LIBRARY");

    lse$$push_position;
    position (message_buffer);
    saved_mark2 := MARK (NONE);

    normal_exit := true;
    dir_list := "";
    loop
       line := CURRENT_LINE;

       if length (line) > 19 then
          part := substr (line, 1, 19);
          exitif part = "Your SCA Libraries ";
          if part = "No SCA Library has " then
             dir_list := "";
             exitif;
          endif;
          if part = "Your SCA Library is" then
             dir_list := substr (line, 21);
             exitif;
          endif;
       endif;

       brn := get_info (message_buffer, "record_number");
       if brn <= mrn then
          dir_list := "";
          normal_exit := false;
          exitif;
       endif;

       ptr := 1;
       lse$$scan_past_white_space (line, ptr);
       if ptr = 6 then
          dir := substr (line, ptr);
          if dir_list = ""
          then dir_list := dir;
          else dir_list := dir + ',' + dir_list;
          endif;
       endif;
       MOVE_VERTICAL (-1);
    endloop;

    position (saved_mark2);   
    lse$$pop_position;

    if not normal_exit then
       MESSAGE ("SCA Library extraction terminated by record number test "
                + str (brn) + " " + str (mrn));
    endif;

    lse$$widget_directory (lse$$sca_directory_title, dir_list);
endprocedure;



procedure directory_arrow_action (limiting_index, next_index_adjustment)
    LOCAL
        selected_entry,
        temp_array,
        temp,
        selected_index,
        parent;

    parent := get_info (eve$x_widget, "parent");
    selected_entry := lse$$get_directory_list_selection (parent);

    if selected_entry <> tpu$k_unspecified then
        temp_array := lse$$get_directory_list (parent);

        selected_index := get_info (temp_array, "FIRST");
        loop
           exitif temp_array {selected_index} = selected_entry;
           selected_index := get_info (temp_array, "NEXT");
        endloop;

        if selected_index <> get_info (temp_array, limiting_index)
        then
            temp := temp_array {selected_index + next_index_adjustment};
            temp_array {selected_index + next_index_adjustment} := 
                                            temp_array {selected_index};
            temp_array {selected_index} := temp;
            lse$$set_directory_list (parent, temp_array);
            lse$$set_list_selection (
               lse$$get_directory_list_id (parent), 
               temp_array {selected_index + next_index_adjustment});
            lse$$set_directory_visibility (parent);
        endif;
    endif;
endprocedure;



procedure lse$$widget_directory_up_arrow_action
    directory_arrow_action ("FIRST", -1);
endprocedure;



procedure lse$$widget_directory_down_arrow_action
    directory_arrow_action ("LAST", 1);
endprocedure;



procedure lse$$is_directory_in_list (temp_array, dir)
    LOCAL
       temp_index;

    temp_index := get_info (temp_array, "FIRST");
    loop
       if temp_index = tpu$k_unspecified then
          return false;
       endif;
       exitif temp_array {temp_index} = dir;
       temp_index := get_info (temp_array, "NEXT");
    endloop;
    return true;
endprocedure;



procedure lse$$is_directory (the_spec)
    LOCAL
       temp;

    !temp := file_parse (the_spec, "QJXVZ.ZVXJQ;9999", "", NAME, TYPE, VERSION);
    !if (temp = "QJXVZ.ZVXJQ;9999") and (the_spec <> "")
    !then
    !    return true;
    !else
    !    return false;
    !endif;
    
    return true;
endprocedure;



procedure lse$$widget_directory_append
    LOCAL
        parent,
        temp_array,
        last_index,
        directory_id,
        dir;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, 
                                      "lse$$widget_directory_append");
    ENDON_ERROR;

    parent := get_info (eve$x_widget, "parent");
    directory_id := get_info (widget, "widget_id", parent,
                                 "DIRECTORY_DIALOG.DIRECTORY_TEXT");
    dir := get_info (directory_id, "text");
    change_case (dir, upper);

    if not lse$$is_directory (dir)
    then
       lse$$popup_error_message ("Not a directory", parent);
       return;
    endif;

    temp_array := lse$$get_directory_list (parent);

    if lse$$is_directory_in_list (temp_array, dir)
    then
       lse$$popup_error_message ("Already in list", parent);
       return;
    endif;

    last_index := get_info (temp_array, "LAST");
    if last_index = tpu$k_unspecified 
    then 
        temp_array {0} := dir;
    else
        temp_array {last_index + 1} := dir;
    endif;

    lse$$set_directory_list (parent, temp_array);
    lse$$set_list_selection (lse$$get_directory_list_id (parent), dir);
    lse$$set_directory_visibility (parent);
endprocedure;



procedure lse$$widget_directory_add_before_selected
    LOCAL
        parent,
        temp_array,
        selected_index,
        temp_index,
        directory_id,
        dir;

    parent := get_info (eve$x_widget, "parent");
    directory_id := get_info (widget, "widget_id", parent,
                                 "DIRECTORY_DIALOG.DIRECTORY_TEXT");
    dir := get_info (directory_id, "text");
    change_case (dir, upper);

    if not lse$$is_directory (dir)
    then
       lse$$popup_error_message ("Not a directory", parent);
       return;
    endif;

    selected_entry := lse$$get_directory_list_selection (parent);

    if selected_entry = tpu$k_unspecified
    then
       lse$$popup_error_message ("Nothing selected", parent);
       return;
    endif;

    temp_array := lse$$get_directory_list (parent);

    if lse$$is_directory_in_list (temp_array, dir)
    then
       lse$$popup_error_message ("Already in list", parent);
       return;
    endif;

    selected_index := get_info (temp_array, "FIRST");
    loop
       exitif temp_array {selected_index} = selected_entry;
       selected_index := get_info (temp_array, "NEXT");
    endloop;

    temp_index := get_info (temp_array, "LAST");
    loop
       exitif temp_index = selected_index - 1;
       temp_array {temp_index + 1} := temp_array {temp_index};
       temp_index := temp_index - 1;
    endloop;

    temp_array {selected_index} := dir;
    lse$$set_directory_list (parent, temp_array);
    lse$$set_list_selection (lse$$get_directory_list_id (parent), dir);
    lse$$set_directory_visibility (parent);
endprocedure;



procedure lse$$widget_directory_delete_selected
    LOCAL
        parent,
        temp_array,
        the_index,
        selected_index;

    parent := get_info (eve$x_widget, "parent");
    selected_entry := lse$$get_directory_list_selection (parent);

    if selected_entry <> tpu$k_unspecified then
        temp_array := lse$$get_directory_list (parent);

        the_index := get_info (temp_array, "FIRST");
        loop
           exitif temp_array {the_index} = selected_entry;
           the_index := get_info (temp_array, "NEXT");
        endloop;

        if the_index = get_info (temp_array, "LAST") then
           selected_index := the_index - 1;
        else
           selected_index := the_index;
        endif;

        loop
           exitif the_index = get_info (temp_array, "LAST");
           temp_array {the_index} := temp_array {the_index + 1};
           the_index := the_index + 1;
        endloop;
        
        temp_array {the_index} := tpu$k_unspecified;

        lse$$set_directory_list (parent, temp_array);
        lse$$set_list_selection (
           lse$$get_directory_list_id (parent), temp_array {selected_index});
        lse$$set_directory_visibility (parent);
    endif;
endprocedure;



procedure lse$$widget_directory_text_changed
    LOCAL
        parent;

    parent := get_info (eve$x_widget, "parent");

    if get_info (eve$x_widget, "text") <> ""
    then
       lse$$set_directory_append_visibility (parent, true);
    else
       lse$$set_directory_append_visibility (parent, false);
    endif;
endprocedure;



procedure lse$$widget_directory_make_selection
    LOCAL
        parent;

    parent := 
       get_info(get_info (get_info (eve$x_widget,"parent"),"parent"),"parent");
    lse$$set_directory_visibility (parent);
endprocedure;



procedure lse$$widget_directory_select
    LOCAL
       the_widget,
       parent,
       directory_id,
       items_id,
       itemslist_id,
       dir,
       status,
       current_dirmask,
       dialog_created,
       child_array,
       the_index,
       num_children;

    parent := get_info (eve$x_widget, "parent");
    the_widget := lse$x_directory_widget_array (parent);
    dialog_created := lse$create_dialog_box (
                         "SELECT_DIRECTORY", the_widget, parent);
    lse$x_directory_widget_array (parent) := the_widget;

    !directory_id := get_info (widget, "widget_id", parent,
    !                             "DIRECTORY_DIALOG.DIRECTORY_TEXT");
    !dir := file_parse (get_info (directory_id, "text"),
    !                           "", "", NODE, DEVICE, DIRECTORY);
    !set (widget,the_widget, eve$x_resource_array {eve$k_ndirmask}, 
    !                                       lse$x_file_selection_dirmask);

    set (widget,the_widget, eve$x_resource_array {eve$k_ndirmask}, "*.DIR");

    !child_array := 0;
    !num_children := get_info (widget, "children", the_widget, child_array);
    !the_index := get_info (child_array, "first");
    !loop
    !    exitif the_index = tpu$k_unspecified;
    !    MESSAGE ("DS - " + get_info (child_array {the_index}, "name"));
    !    the_index := get_info (child_array, "next");
    !endloop;

    if dialog_created
    then
        items_id := get_info (widget, "widget_id", the_widget,
                                "SELECT_DIRECTORY.Files");
        unmanage_widget (items_id);
        itemslist_id := get_info (widget, "widget_id", the_widget,
                                "SELECT_DIRECTORY.sb_listSW");
        unmanage_widget (itemslist_id);
        manage_widget (the_widget);
        lse$add_minimum_size_to_dialog (the_widget);
    else
        ! Using the current file filter in the file selection box, force a
        ! re-evaluation so the dialog box reflects the current contents of the
        ! directory.
        !
        ! Unecessary if filter set?
        !
        status := GET_INFO (the_widget, "widget_info", 
	              eve$x_resource_array {eve$k_ndirmask}, current_dirmask);
        SET (WIDGET, the_widget, eve$x_resource_array {eve$k_ndirmask}, current_dirmask);
        manage_widget (the_widget);
    endif;
endprocedure;


procedure lse$$widget_select_directory_ok
    LOCAL
        status,
        parent,
        directory_spec,
        directory_id,
        file_spec;

    ON_ERROR
	[TPU$_PARSEFAIL]:
            lse$$popup_error_message (
               "Error from FILE_PARSE when forming directory name from selection", parent);
            return;
    ENDON_ERROR;

    parent := get_info ( get_info (eve$x_widget, "parent"), "parent");
    status := get_info (eve$x_widget, "widget_info", 
                           eve$x_resource_array {eve$k_ndirspec}, file_spec);
    if file_spec <> ""
    then
        directory_spec := file_parse (
                             file_spec, "", "", NODE, DEVICE, DIRECTORY);
        if directory_spec <> ""
        then
            directory_id := get_info (widget, "widget_id", parent,
                                          "DIRECTORY_DIALOG.DIRECTORY_TEXT");
            set (TEXT, directory_id, directory_spec);
        endif;
    endif;

    eve$unmanage_widget(eve$x_widget);
endprocedure;



procedure lse$$widget_select_directory_cancel
    eve$unmanage_widget(eve$x_widget);
endprocedure;



procedure lse$$source_directory_ok (parent)
    LOCAL
        temp_array,
        temp_index,
        directory_spec;

    temp_array := lse$$get_directory_list (parent);
    directory_spec := '';

    temp_index := get_info (temp_array, "FIRST");
    loop
       exitif temp_index = tpu$k_unspecified;
       if directory_spec = ''
       then
           directory_spec := temp_array {temp_index};
       else
           directory_spec := directory_spec + ',' + temp_array {temp_index};
       endif;
       temp_index := get_info (temp_array, "NEXT");
    endloop;

    lse_set_directory_source (directory_spec);
endprocedure;



procedure lse$$readonly_directory_ok (parent)
    LOCAL
        temp_array1,
        temp_array2,
        temp_index,
        dir;

    ! Remove current readonly directories
    !
    temp_array1 := CREATE_ARRAY;
    temp_index := 0;
    dir := get_info( lse$system, 'first', lse$directory_read_only );
    loop
	exitif dir = 0;
        temp_array1 {temp_index} := dir;
        temp_index := temp_index + 1;
	dir := get_info( lse$system, 'next', lse$directory_read_only );
    endloop;
    temp_index := get_info (temp_array1, "first");
    loop
        exitif temp_index = tpu$k_unspecified;
        lse$set_directory_read_only (temp_array1 {temp_index}, false);
        temp_index := get_info (temp_array1, "next");
    endloop;

    ! Add new readonly directories
    !
    temp_array2 := lse$$get_directory_list (parent);
    temp_index := get_info (temp_array2, "FIRST");
    loop
       exitif temp_index = tpu$k_unspecified;
       dir := temp_array2 {temp_index};
       lse$set_directory_read_only (dir, true);
       temp_index := get_info (temp_array2, "NEXT");
    endloop;
endprocedure;



procedure lse$$sca_directory_ok (parent)
    LOCAL
        temp_array,
        temp_index;

    temp_array := lse$$get_directory_list (parent);

    lse$do_command ("SET NOLIBRARY/NOLOG");

    ! Each directory dealt with separately as a list may result in a
    ! command that is too long.

    temp_index := get_info (temp_array, "FIRST");
    loop
       exitif temp_index = tpu$k_unspecified;
       lse$do_command ("SET LIBRARY/NOLOG/AFTER " + temp_array {temp_index});
       temp_index := get_info (temp_array, "NEXT");
    endloop;

endprocedure;



procedure lse$$widget_directory_ok
    LOCAL
        parent;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, 
                                      "lse$$widget_directory_ok");
    ENDON_ERROR;

    ! Action(s) depend on whether source, read-only or sca.

    parent := get_info (eve$x_widget, "parent");

    if lse$x_directory_widget_array {lse$$source_directory_title} = parent
    then
        lse$$source_directory_ok (parent);
    else 
        if lse$x_directory_widget_array {lse$$readonly_directory_title} = parent
        then
            lse$$readonly_directory_ok (parent);
        else 
            if lse$x_directory_widget_array {lse$$sca_directory_title} = parent
            then
                lse$$sca_directory_ok (parent);
            else
                MESSAGE ("lse$$widget_directory_ok - unexpected parent");
            endif;
        endif;
    endif;

    lse$$menus_cancel_selection (lse$$get_directory_list_id (parent));
    eve$unmanage_widget(parent);
endprocedure;



procedure lse$$widget_directory_cancel
    LOCAL
        parent;

    ON_ERROR
	[OTHERWISE]:
	    lse$post_command_proc;
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, 
                                      "lse$$widget_directory_cancel");
    ENDON_ERROR;

    parent := get_info (eve$x_widget, "parent");
    if lse$x_directory_widget_array (parent) <> tpu$k_unspecified
    then
        eve$unmanage_widget(lse$x_directory_widget_array (parent));
    endif;
    lse$$menus_cancel_selection (lse$$get_directory_list_id (parent));
    eve$unmanage_widget(parent);
endprocedure;


procedure lse$$popup_error_message (the_message, parent_widget)
local
    the_message_text;

    lse$create_dialog_box ("ERROR_BOX", lse$$x_error_dialog, parent_widget);

    the_message_text := lse$get_message_text (the_message);

    SET (WIDGET, lse$$x_error_dialog, "messageString", the_message_text);
    lse$$remove_cancel_button (lse$$x_error_dialog);
    lse$$remove_help_button (lse$$x_error_dialog);

    eve$manage_widget (lse$$x_error_dialog);
endprocedure;


procedure lse$$cb_error_box_ok 
    eve$unmanage_widget (lse$$x_error_dialog);
    delete (lse$$x_error_dialog);
endprocedure;



! These variables are intended for use within this module only
!
variable
    lse$$x_menus_by_name,
    lse$$x_menus_by_number,
    lse$$x_pulldown_labels_by_name,
    lse$$x_pulldown_contents_by_name,
    lse$$x_pulldown_contents_by_number;

constant
    lse$k_popup_label := " Popup",
    lse$k_separator_label := "Separator",
    lse$k_widget := "lse$Widget",
    lse$k_index := "lse$Index",
    lse$k_def := "lse$Def",
    lse$k_separator_class := "XmSeparatorGadget",
    lse$k_sep_count := "lse$sep_count",
    lse$k_mnemonic := "lse$mnemonic",
    lse$k_closure := "lse$closure",
    lse$k_ref_count := "lse$ref_count";

variable
    lse$kt_pushbutton_class,
    lse$kt_separator_class;


variable lse$$x_menu_mnemonics;
variable lse$$x_menu_insert_position;
variable lse$x_menus_dialog;
variable lse$$x_menus_loaded;
variable lse$$x_saved_menu_defs;
variable lse$$x_cms_preferences_dialog;
variable lse$x_directory_widget_array;
variable lse$$x_ba_buffer;
variable lse$$x_ba_array;
variable lse$$x_ba_sensitive;
variable lse$$x_ba_write;
variable lse$$x_error_dialog;