! LSE$GRAMMAR_UTIL.TPU
!*************************************************************************
!									 *
! © 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
!
! ABSTRACT:
!       This file contains utility routines to support the Portable LSE
!       grammar routines.
! ENVIRONMENT:
!       Portable/LSE
!
! Author: Diana Carroll, Glenn J. Joyce, Norman M. Chan
!
! CREATION DATE: 06-September-1990
!
! MODIFIED BY:
!
!   X3.2    DEC 06-Sep-90   New Module
!   X3.2-1  GJJ	13-Sep-90   Fix missing comment delimiter.
!   X3.2-2  DAS	03-Oct-90   Change lse$buffer to lse$buffer_util
!   X3.2-3  WC3	08-Oct-90   Add lse$set_directory_read_only
!   X3.2-4  WC3	04-Oct-90   Added lse$get_message_text
!   X3.2-5  DAS 23-Oct-90   Added lse$top and lse$bottom
!   X3.2-6  DAS 23-Oct-90   Added lse$include_file
!   X3.2-7  DAS 27-Oct-90   Added lse$new_buffer
!   X3.2-8  AVH 15-Nov-90   Added lse$expand_user_mark 
!   X3.2-9  AVH 15-Nov-90   Added lse$search_util & lse$search_util_next
!   X3.2-10 DAS 26-Nov-90   Added lse$refresh_show_buffers
!   X3.2-11 DAS 26-Nov-90   Lse$create_buffer to lse$create_buffer_util
!   X3.2-12 SHE 06-Dec-90   Added and cleanup up documentation headers
!   X3.2-13 AVH 26-Dec-90   Use literal lse$$k_mark_prefix instead of assignment
!   X3.2-14 SHE 08-Jan-91   Make all 2nd args to MESSAGE/EVE$MESSAGE 0.
!   X3.2-15 GJJ	17-Jan-91   Add support to LSE$$UNEXPECTED_ERROR to handle
!			    TPU$_REQUIRESULTRIX and TPU$_REQUIRESVMS.
!   X3.2-16 LRH 28-Jan-91   Changed lse$include_file to use a temporary
!                           scratch buffer instead of eve$$scratch_buffer
!   X3.2-17 SHE	28-Feb-91   Added TPU$_NOTMODIFIABLE and LSE$_UNMODIFIABLE to
!			    to lse$include_file.
!   X3.2-18 SAA 12-Mar-91   Added lse$is_continuation_line
!   X3.2-19 DAS 23-Mar-91   Added LSE$$CURRENT_LANGUAGE and the SET routine
!   X4.0    NMC 27-Mar-91   Added lse$get_curr_lang_element, 
!                                 lse$set_curr_lang_element,
!                                 lse$get_valid_lang_elem,
!				  lse$get_lang_elem_message,
!                                 lse$extract_lang_element,
!				  lse$extract_one_lang_element,
!                                 lse$copy_line.
!   X4.0-1  NMC 05-Apr-91   Fix a message bug in lse$extract_lang_element
!   X4.0-2  DEC 08-Apr-91   Added lse$extract_language
!   X4.0-3  DAS  9-Apr-91   Made TPU$_NOTYET expected
!   X4.0-4  LRH 28-Mar-91   Added LSE$$HELP_TEXT
!   X4.0-5  WC3	09-Apr-91   Deleted lse$refresh_show_buffers
!   X4.0-6  NMC	11-Apr-91   Add language wildcard capability back in
!                                 lse$extract_lang_element
!   X4.0-7  NMC	16-Apr-91   Removed lse$$current_language and
!                                   lse$$set_current_language
!   X4.0-8  AVH	17-Apr-91   Added Haley headers to procedures
!			    lse$get_curr_lang_element, lse$set_curr_lang_element
!			    lse$extract_one_lang_element & lse$copy_line
!   X4.0-9  DAS	22-Apr-91   Extract lang "TAB INCREMENT" and not just "TAB"
!   X4.0-10 WC3	29-Apr-91   Add type keyword return to lse$get_lang_elem_message
!			    Fix lse$$current_language to not return deleted 
!				languages
!   X4.0-10 DAS  2-May-91   Removed help routine
!   X4.0-11 SAA  2-May-91   Added lse$checkpoint_buffer
!   X4.0-12 DAS  6-May-91   Comment out lse$parameter_type
!   X4.0-13 WC3	15-May-91   Portable language consistency
!   X4.0-14 NMC	08-May-91   Added extract adjustmenst code to 
!                                lse$extract_one_lang_element
!   X4.0-15 SHE	11-Jun-91   lse$$widget_find renamed to lse$$widget_search.
!			    lse$$widget_set_find_direction renamed to 
!			      lse$$widget_set_search_direction.
!   X4.0-16 NMC	 1-Jul-91   Change adjust pattern to caps in 
!                             lse$exract_one_lang_element
!   X4.0-17 WC3	11-Jul-91   Make unexpected error do pops adn release the
!				scratch buffer.
!   X4.0-18 AVH	26-Jul-91   Fix direction problem in lse$search_util routine.
!   X4.0-19 NMC	 5-Aug-91   Added routine lse$extract_lang_pack
!                           Added routine lse$get_valid_lang_pack_elem
!                           Added routine lse$extract_lang_pack_elem
!   X4.0-20 DEC 08-Aug-91   Added placeholders and tokens to extract routine;
!			       add lse$$wildcard_name, lse$$quote_char and
!			       lse$$quote_name
!   X4.0-21 SHE	09-Aug-91   Fixed references to quote_char procedure to be
!			       lse$$quote_char
!   X4.0-22 NMC	12-Aug-91   Added package support to 
!                              lse$extract_one_lang_element
!   X4.0-23 NMC	13-Aug-91   Convert alias, adjustment and package to use
!                              lse$$quote_string in lse$$extract_one_lang_elem.
!   X4.0-23 DAS	14-Aug-91   LSE$HELP_TEXT
!			       DUPBUFNAME in lse$create_buffer_util
!   X4.0-24 DEC 12-Aug-91   Fixed lse$$extract_pack_lang_element to deal with
!				exact match arguments
!   X4.0-25 NMC	20-Aug-91  Fix bug in lse$$wildcard_name to return correct value
!   X4.0-26 NMC	 9-Sep-91  Fix bug in lse$extract_one_lang_element for adjust def.
!   X4.0-27 DEC 15-Sep-91  Add lse$context case to expand_case in languages
!   X4.0-28 NMC	 9-Sep-91  Fix bug in lse$extract_one_lang_element for adjust 
!                               definition.
!   X4.0-29 NMC	10-Sep-91  Consistency in language element extracted definition.
!                          Moved lse$extract_language code to 
!                              lse$extract_one_lang_element
!   X4.0-30 DAS	18-Sep-91  Extract into unmodifiable now expected
!   X4.0-31 DBH 20-Sep-91  Added lse$close_buffer_all
!   X4.0-32 NMC	10-Sep-91  Consistency in language element extracted definition.
!   X4.0-33 NMC	18-Sep-91  Modified lse$$quote_string to support "!" char.
!   X4.0-34 DAS	22-Sep-91  lse$$quote_string("abc") is "abc" and not "ABC"
!   X4.0-35 DBH  1-Oct-91  Added lse$save_file_all.
!   X4.0-36 SAA  2-Oct-91  Add ROUTINE capabilities to lse$extract_one_lang_elem.
!			   Add lse$compare_lang_pack_elem.
!   X4.0-37 NMC  3-Oct-91  Fix bugs in lse$compare_lang_pack_elem
!   X4.0-38 DEC 10-Oct-91  Speed up lse$extract_lang_pack_elem
!   X4.0-39 DAS 13-Oct-91  LSE$WRITE_FILE returns TPU$_CLOSEOUT if dev full
!   X4.0-40 NMC 10-Oct-91  Move lse$$x_curr_alias here.
!   X4.0-41 NMC 17-Oct-91  Added "not defined" parameter to lse$get_lang_elem_message
!   X4.0-42 SAA	21-Oct-91  New lse$help_text that uses .HLP-files directly
!   X4.0-43 NMC 17-Oct-91  Added lse$delete_lang_pack_elem,
!                                lse$delete_lang_pack,
!                                lse$delete_one_lang_element
!   X4.0-44 DBH 22-Oct-91  lse$close_buffer_all, lse$save_file_all moved to
!                          lse$method.tpu
!   X4.0-45 SAA 25-Oct-91  Add ULTRIX help file lookup to lse$help_text
!   X4.0-46 WC3	30-Oct-91  Add call to lse$renumber_buffer during a compile
!   X4.0-47 WC3	11-Nov-91  Re-write SEARCH
!   X4.0-48 WC3	15-Nov-91  Remove found range highlighting on search
!			   Add found in other direction prompt on auto reverse
!			   Added change to find next direct during auto reverse
!			   Fix auto reverse test for Beginning of buffer
!   X4.0-49 SAA 17-Nov-91  Changes to lse$help_text, lse$$match_topics
!   X4.0-50 DEC 19-NOV-91  Fix EXTRACT PLACEHOLDER|TOKEN|etc *
!   X4.0-51 SAA 25-Nov-91  Fixes to lse$help_text
!   X4.0-52 DEC 27-Nov-91  Change extract to handle new ROUTINE def'n syntax
!   X4.0-53 SAA 12-Dec-91  Add lse$$help_message
!   X4.0-54 NMC  1-Dec-91  Added lse$$first_lang_routine, lse$$next_lang_routine,
!                          lse$$find_lang_routine
!   X4.0-55 WC3	12-Dec-91  Simplified lse$directory_read_only for start up speed
!			   Remove call to lse$$unsuppress_tpu_message, 
!			   no longer exists
!   X4.0-56 SAA 31-Dec-91  Fixed lse$$match_topics to not use SELECT range
!			   or lse$indent.
!   X4.0-56 WC3	19-Dec-91  Fix Auto reverse search to prompt with the correct
!			   direction
!   X4.0-57 DEC 27-Dec-91  Don't extract package tokens and placeholders
!   X4.0-58 DEC 27-DEC-91  Change lse$$quote_char calls to lse$$quote_string
!   X4.0-59 DEC 03-Dec-92  Fix bug with above in extract placeholder
!   X4.0-60 DEC 08-Jan-92  Change set plac/token placeholder to set plac/token
!				inherit
!   X4.0-61 WC3	20-Jan-92  Prevent lse$$unexpected_error from an infinite loop
!			    with lse$$pop_position
!   X4.0-62 WC3	23-Jan-92  Add invalid file name message when user enters 
!			    null file name in checkpoint
!   X4.0-63 WC3	27-Jan-92  Remove LSE$$SEARCH_HOW_EXACT and use 
!				LSE$$X_SEARCH_HOW_EXACT we were using 2 globals
!				for the same thing and they were out of sync.
!   X4.0-64 SHE	31-Jan-92  Protect against CTRL/C coming through
!				lse$$unexpected_error before lse$$position_array_index
!				is defined.
!   X4.0-65 SAA  7-Feb-92  lse$help_text now looks through all help libs and passes
!                          any error message back in lse$$x_help_message_text.
!   X4.0-66 WC3	13-Feb-92  Unset all the curr_lang_elements when the langauge
!			    or package changes
!   X4.0-67 WC3	22-Feb-92  Correct bad uses of TPU$_NOTMODIFIABLE
!   X4.0-68 WC3	24-Feb-92  Add lse$$gs_position
!   X4.0-69 SAA 27-Feb-92  Eliminate use of lse$$x_default_path_ultrix
!   X4.0-70 SHE	 6-Apr-92  Added lse$$compile_buffer
!			   Fixed lse$$build_help_index to require a space after
!			     the topic level, and to use OFF as a parameter to
!			     EDIT for ignoring quotes.
!   X4.0-71 WC3	13-Apr-92  Improve language modification performance and
!			    usablity with EXTRACT by:
!				Eliminating the use of the LSE command
!				Commenting out default values
!				Eliminating the DELETE commmand
!				Using the default language and leng element
!			   Make DELETE lang_elment delete exact match
!			    when wildcards are present
!			   Protect from trailing "-" which causes continuation
!			    lines
!   X4.0-72 SHE	25-Apr-92  Modified lse$$compile_buffer to consider
!			    the SAVE RELATED BUFFERS attribute.
!   X4.0-73 SHE	28-Apr-92  Modified lse$checkpoint_buffer to skip buffers
!			    without input files.
!   X4.0-74 WC3	27-Apr-92  Don't move on searching for the null string
!			   When found is reverse direction is refused,
!			    it is a successful search.  Compatible w/3.1
!   X4.0-75 SHE 30-Apr-92  Prompt for output file for main compile buffer.
!   X4.0-76 WC3	08-May-92   Added missing local declarations
!   X4.0-77 WC3	09-Sep-92   Corrected extract's indentation so overview work
!   X4.3-1  RAM	08-Aug-94  Modified lse$extract_one_lang_element to extract 
!                           hyperhelp information for language, package, 
!                           routine, token and placeholder.
!   X4.3-2  RKB 18-Nov-94  Add initialisation for UNDO command buffers
!   X4.3-3  RKB 13-Feb-95  Add support for UNDO to lse$include_file
!	    		   Add UNDO support for EXTRACT TOKEN
!   X4.3-4  RAM	22-Feb-95  Commented out Hyperhelp commands.
!	    RKB 23-Feb-95  Add call to save OLD_BPM before saving inserted range
!   X4.4-2  RKB 08-Jun-95  Change lse$$save_inserted_range to 
!			   lse$$save_inserted_text in lse$include_file
!	    RKB 13-Jun-95  Add call to reset undo buffers in lse$call
!	    RKB 14-Jun-95  Snap cursor back to text before issuing SEARCH
!			   command to avoid padding of spaces when cursor
!			   is FREE (in LSE$SEARCH_UTIL)
!	    RKB 03-Jul-95  Add call to delete UNDO buffer in lse$include_file
!   X4.4-3  RKB 29-Sep-95  Fix LSE_XBUGS # 2190 (missing /DIAGNOSTICS qualifier
!			   on COMPILE REVIEW command under portable syntax
!   4.5-1   CJH 15-Nov-96  Fix LSE_XBUGS 2207
!                          Disable calls to undo code during execution of
!                          user TPU code.
!


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! NOTE - FOR ADDING PROCEDURES
!
! The following is a documentation template which is used with PDF to
! create documentation.  When creating a new procedure, copy the template
! above the procedure.  The information will be supplied by the documentation
! group.
!
!doc_begin
!
! ONE LINE DEFINITION:
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!

procedure lse$grammar_util_module_ident

return "4.7-4"

endprocedure;


procedure lse$buffer_util (buffer_ptr)
!
!doc_begin
!
! ONE LINE DEFINITION:
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!

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

  map (current_window, buffer_ptr);
  lse$set_status_line (current_window);
  return true;

endprocedure;

procedure lse$create_buffer_util (buffer_name; input, create_flag)
!
!doc_begin
!
! ONE LINE DEFINITION:
!    Creates a buffer using TPU's builtin but also adds LSE semantics in terms
!    of buffer change journaling.  Returns a buffer_ptr or zero.  The template
!    defaults to LSE defaults buffer.  Applies special settings to $main buffer.
!    Will trap file not found errors is the create_file boolean is passed as
!    true.
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!

LOCAL the_input, the_create_flag, the_buffer, open_failed, new_file;

ON_ERROR
    [TPU$_OPENIN,
     LSE$_FILEOPENFAIL]:
	message (error, 0, the_input);
	open_failed := true;

    [TPU$_DUPBUFNAME]:
	eve$message (error_text);	
	eve$learn_abort;
	return false;

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

!
! Default unspecified input file specification
!
IF input <> tpu$k_unspecified
THEN the_input := input;
ELSE the_input := '';
ENDIF;

!
! Default the create_flag to false
!
IF create_flag <> tpu$k_unspecified
THEN the_create_flag := create_flag;
ELSE the_create_flag := false;
ENDIF;

!
! Tell TPU to create the buffer.  
!
the_buffer := LSE$CREATE_BUFFER (buffer_name, the_input, eve$default_buffer);

!
! If opening an existing file failed and we were not to create the buffer, then 
! delete the buffer and leave.
!
if open_failed 
then
    if the_create_flag
    then
	set (output_file, the_buffer, the_input);
	new_file := true;
    else
	delete (the_buffer);
	return 0;
    endif;
endif;

!
! Override defaults buffer settings for the $MAIN buffer only
!
IF ((buffer_name = eve$x_buf_str_main) or (new_file))
THEN
    SET (MODIFIABLE, the_buffer, ON);
    SET (NO_WRITE, the_buffer, OFF);
    SET (EOB_TEXT, the_buffer, lse$get_message_text (lse$_eof));
ENDIF;

!
! Enable buffer change journaling if the buffer is modifiable
! 
IF GET_INFO (the_buffer, 'MODIFIABLE')
THEN lse$$journal_this_buffer (the_buffer);
ENDIF;
!
! Initialise UNDO command buffer --- (Added by RKB)
!
set (lse$max_undo, the_buffer, -1);
!
! Return the buffer pointer
!
RETURN the_buffer;
ENDPROCEDURE;

procedure lse$set_directory_read_only( directory_spec, boolean )
!
!doc_begin
!
! ONE LINE DEFINITION:
!    «TBS»
!   Set or delete one read only directory
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!

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

    set(lse$directory_read_only, 
	lse$system,
	directory_spec,
	boolean );

    return true;

endprocedure;


procedure lse$get_message_text (message_keyword_or_string)
!
!doc_begin
!
! ONE LINE DEFINITION:
!    «TBS»
!   Returns the text portion of a message
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!
    ON_ERROR
	[OTHERWISE]:
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$get_message_text ");
    ENDON_ERROR;

    IF GET_INFO( message_keyword_or_string, 'type' ) = STRING
    THEN
	RETURN message_keyword_or_string;
    ENDIF;

    lse$get_message_text := message_text( message_keyword_or_string, 1 );

endprocedure;

procedure lse$bottom
!
!doc_begin
!
! ONE LINE DEFINITION:
!    Moves the cursor to the end of the current buffer.
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    TOP
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    Cursor
!    «TBS»
!
!doc_end
!

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


  position (buffer_end);

  return TRUE;

endprocedure;

procedure lse$top
!
!doc_begin
!
! ONE LINE DEFINITION:
!    Moves the cursor to the top of the current buffer.
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    BOTTOM
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    Cursor
!    «TBS»
!
!doc_end
!

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


  position (buffer_begin);
  if not lse$is_visible
  then lse$move_vertical (1);
  endif;

  return true;

endprocedure;

procedure lse$include_file (file_spec)
!
!doc_begin
!
! ONE LINE DEFINITION:
!    Worker routine to include a file at the current editing position
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!

    LOCAL saved_mode,
	  saved_pos,
	  temp_pos,
	  temp_buffer,
	  range2;

    ON_ERROR
	[TPU$_OPENIN,
	 LSE$_COMMANDCANCEL,
	 LSE$_FILEOPENFAIL]:
	    eve$message (error, 0, file_spec);
	    if current_buffer = temp_buffer
	    then lse$$pop_position;
	    endif;
            delete(temp_buffer);
	    if saved_mode <> tpu$k_unspecified
	    then set (overstrike, current_buffer);
	    endif;
	    eve$learn_abort;
	    lse$post_command_proc;
	    return false;

	[TPU$_NOTMODIFIABLE,
	 LSE$_UNMODIFIABLE]:
	    EVE$MESSAGE (LSE$_UNMODIFIABLE, 0, 
		lse$get_message_text (lse$_includefile));
	    if current_buffer = temp_buffer
	    then lse$$pop_position;
	    endif;
            delete(temp_buffer);
	    if saved_mode <> tpu$k_unspecified
	    then set (overstrike, current_buffer);
	    endif;
	    eve$learn_abort;
	    lse$post_command_proc;
	    return false;

	[OTHERWISE]:
	    if current_buffer = temp_buffer
	    then lse$$pop_position;
	    endif;
            delete(temp_buffer);
	    if saved_mode <> tpu$k_unspecified
	    then set (overstrike, current_buffer);
	    endif;
	    eve$learn_abort;
	    lse$post_command_proc;
	    return false;

    ENDON_ERROR;

!
! Save position to be used as OLD_BPM before disabling UNDO calls
!
saved_pos := mark(NONE);
!
! Reserve the scratch buffer, position there, and clear it
!
temp_buffer := create_buffer("include_scratch_buffer");
lse$$push_position;
position (temp_buffer);
erase (current_buffer);
lse$$save_current_position;
!
! Disable call to any UNDO routines
!
 lse$$disable_undo_calls ();
!
! Read the file
!
lse$read_file (file_spec);

!
! Position back to the user buffer
!
lse$$pop_position;

!
! Snap the cursor to text and move the scratch buffer contents to this position
!
position (text);

!
! Must copy the text in insert mode.  Saved mode is only given a value if the
! most must be restored to overstrike in the error handler.  For clarity, I
! have put an unnecessary assignment of this variable to tpu$k_unspecified.
!
if (get_info (current_buffer, 'mode') = insert)
then
    saved_mode := tpu$k_unspecified;
    range2 := move_text (temp_buffer);
!
!   Enable calls to any UNDO routines
!
    lse$$enable_undo_calls ();
!
!   Support for UNDO
!
!   Now get the value of saved_pos into old_bpm
!
    temp_pos := mark(NONE);
    position (saved_pos);
    lse$$save_old_bpm;
    position (temp_pos);
    lse$$save_inserted_text;
!    lse$$save_inserted_range (beginning_of (range2), end_of (range2));
    position (beginning_of (range2));
    lse$$save_current_position;
else
    saved_mode := set (insert, current_buffer);
    range2 := move_text (temp_buffer);
!
!   Enable calls to any UNDO routines
!
!    lse$$enable_undo_calls ();
!
!   Support for UNDO
!
!   Now get the value of saved_pos into old_bpm
!
!    temp_pos := mark(NONE);
!    position (saved_pos);
!    lse$$save_old_bpm;
!    position (temp_pos);
!    lse$$save_inserted_text;
!    lse$$save_inserted_range (beginning_of (range2), end_of (range2));
    position (beginning_of (range2));
!    lse$$save_current_position;
    set (overstrike, current_buffer);
endif;

!
! Enable calls to any UNDO routines
!
lse$$enable_undo_calls ();
!
! Unreserve the scratch buffer
!
lse$$delete_undo_buf(temp_buffer);
delete(temp_buffer);

!
! Return the status
!
return true;
endprocedure;

PROCEDURE lse$$unexpected_error( err, err_text, line, proc )
!
! FUNCTION:
!
!   Handles unexpected errors and control C and reports unexpected errors to 
!   the user for SPR submission.
!
!   The followings errors do not say to report an SPR:
!
!	REQUIRESDECW - Feature requires DECwindows
!	REQUIRESTERM - Feature requires a terminal
!	REQUIRESULTRIX - Feature requires the Ultrix operating system
!	REQUIRESVMS  - Feature requires the VMS operating system
!
!
! PARAMETERS:
!
!   err		- error being handled
!
!   error_text	- The error text
!
!   line	- The line number where the error occured
!
!   proc	- The procedure name where the error occured
!
! RETURN VALUE:
!
!   none
!
! REMARKS:
!
!   This is one procedure which must not use EVE$MESSAGE.  This procedure
!   may be called before EVE has been initialized
!

    ON_ERROR
	[OTHERWISE]:
	    message( message_text( lse$_internerrln ), 
		     0, 
		    'lse$$unexpected_error', 
		     ERROR_LINE );
	    RETURN lse$$unexpected_error_abort( err, err_text, line, proc );
    ENDON_ERROR;

    ! So we get messages during startup
    !
    IF (GET_INFO( SYSTEM, 'message_flags' ) AND 3) = 0
    THEN
	SET( MESSAGE_FLAGS, 15 );
    ENDIF;

    ! Pick the right action
    !
    CASE ERR
	[TPU$_CONTROLC]:

	[TPU$_REQUIRESDECW, TPU$_REQUIRESTERM,
	 TPU$_REQUIRESULTRIX, TPU$_REQUIRESVMS,
	 TPU$_NOTYET]:
	    message( err_text );

	[OTHERWISE]:
	    message( err_text + " (" + str(err) + ")");
	    message( message_text( lse$_internerrln ), 0, proc, line );
    ENDCASE;

    ! Make sure we pop out to the top position
    !

    ! Protect against ctrl/c during startup, before lse$$position_array_index
    ! has been initialized
    !
    IF lse$$position_array_index <> tpu$k_unspecified
    THEN
	LOOP
	    EXITIF lse$$position_array_index < lse$$k_position_array_index_min;
	    lse$$pop_position( true );
	ENDLOOP;
    ENDIF;

    ! Make sure the scratch buffer isn't reserved
    !
    eve$$release_scratch_buffer;

    RETURN lse$$unexpected_error_abort( err, err_text, line, proc );

ENDPROCEDURE;

PROCEDURE lse$$unexpected_error_abort( err, err_text, line, proc )
!
! FUNCTION:
!
!   Handles aborting on en unexpected error.
!
!   We don't want to abort during initialization, but rather save some
!   info and continue.
!
! PARAMETERS:
!
!   err		- error being handled
!
!   error_text	- The error text
!
!   line	- The line number where the error occured
!
!   proc	- The procedure name where the error occured
!
! RETURN VALUE:
!
!   success boolean
!

    EVE$LEARN_ABORT;

    ! When we are in initialization we don't want to ABORT
    !
    IF eve$x_post_starting_up = 1
    THEN
	if get_info( lse$$start_up_debug, 'type') <> buffer
	then
	    lse$$start_up_debug := create_buffer( 'lse$$start_up_debug' );
	endif;
	position( end_of(lse$$start_up_debug) );
	split_line;
	if get_info( err_text, 'type' ) <> string
	then
	    err_text := "err_text's type = " + str( get_info( err_text, 'type' ) );
	endif;
	copy_text( 'err_text: ' + err_text );
	split_line;
	if get_info( proc, 'type' ) <> string
	then
	    proc := "proc's type = " + str( get_info( proc, 'type' ) );
	endif;
	copy_text( 'proc: ' + proc );
	split_line;
	if get_info( line, 'type' ) <> integer
	then
	    line := "line's type = " + str( get_info( line, 'type' ) );
	endif;
	copy_text( 'line: ' + str( line ) );
	split_line;
    ELSE
	ABORT;
    ENDIF;

    RETURN true;

ENDPROCEDURE;


procedure lse$expand_user_mark (user_mark)
!
!doc_begin
!
! ONE LINE DEFINITION:
!    «TBS»
!   Returns the text portion of a message
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!

local
    the_lse_mark,
    expanded_name,
    multiple_names;
!
! Error processing
!
on_error
    [tpu$_multiplenames]:
      multiple_names := true;
    [tpu$_nonames]:
      lse$$expand_result := 0;
      eve$learn_abort;
      return false;
    [otherwise]:
      message (LSE$_BADMARKNAME, 0, user_mark);
      eve$learn_abort;
      return false;
endon_error;

!
! Assume no multiple names.
!
multiple_names := false;
lse$$expand_result := 1;

!
! Determine the initial part of the mark name and expand the name
!
the_lse_mark := lse$$k_mark_prefix + user_mark;
change_case (the_lse_mark, upper);
expanded_name := expand_name (the_lse_mark, variables);

!
! If multiple hits were found, let's see if the whole name was presented
!
if multiple_names
then
    expanded_name := expanded_name + ' ';
    if (index (expanded_name, the_lse_mark + ' ') = 0)
    then
	lse$$expand_result := 2;
        eve$learn_abort;
        return false;
    else
        expanded_name := the_lse_mark;
    endif;
endif;

!
! Then return the expanded marker name.
!

return expanded_name;

endprocedure;

PROCEDURE lse$search_util( search_target, how_exact, direction )
!
!doc_begin
!
! ONE LINE DEFINITION:
!    Searches the given string with the type of search indicated by the flag.
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    TOP
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    Cursor
!    «TBS»
!
!doc_end
!

LOCAL
    response,
    saved_mark,
    the_direction,
    the_prompt,
    the_range;

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

! Don't do anything on the null string
!
IF search_target = ''
THEN
    return false;
ENDIF;

! Save for SEARCH NEXT
!
the_direction := direction;
eve$x_target := search_target;
lse$$x_search_how_exact := how_exact;
eve$x_old_find_direction := the_direction;
eve$$remove_found_range;

! Move off the current position and search for it
!   If we can't move off the current position, we can't find it by definition
!
lse$$push_position;
!
!  Fix for bug # 2182 (LSE_XBUGS) snap cursor to TEXT before searching
!  to avoid padding of spaces when cursor is a free cursor
!
POSITION (TEXT);

IF the_direction = FORWARD
THEN
    IF GET_INFO( MARK( NONE ), 'record_number' ) <=
       GET_INFO( CURRENT_BUFFER, 'record_count' )
    THEN
	! We can move
	!
	MOVE_HORIZONTAL( 1 );
	the_range := SEARCH_QUIETLY( search_target, 
				     the_direction,
				     how_exact );
    ENDIF;    				     
ELSE
    IF (GET_INFO( MARK( NONE ), 'record_number' ) > 1) OR
       (GET_INFO( MARK( NONE ), 'offset' ) <> 0)
    THEN
	! We can move
	!
	MOVE_HORIZONTAL( -1 );
	the_range := SEARCH_QUIETLY( search_target, 
				     the_direction,
				     how_exact );
    ENDIF;
ENDIF;

! Look for it
!
IF the_range = 0
THEN
    ! Didn't find in the current direction
    !
    IF GET_INFO( lse$search, 'lse$auto_reverse' )
    THEN
	! Auto reverse is turned on
	!

	! Pop to get us back to the original position
	! then push to save it.  It may seem redundant, but we don't know
	! at this point if we've move off the "current_position" in the
	! code above.
	!
	lse$$pop_position;
	lse$$push_position;

	! Again move off the current position and search for it
	!
	IF the_direction = FORWARD
	THEN
	    IF (GET_INFO( MARK( NONE ), 'record_number' ) > 1) OR
	       (GET_INFO( MARK( NONE ), 'offset' ) <> 0)
	    THEN
		MOVE_HORIZONTAL( -1 );
		the_range := SEARCH_QUIETLY( search_target, 
					    REVERSE, 
					    how_exact );
		eve$x_old_find_direction := REVERSE;
	    ENDIF;
	ELSE
	    IF GET_INFO( MARK( NONE ), 'record_number' ) <=
	       GET_INFO( CURRENT_BUFFER, 'record_count' )
	    THEN
		MOVE_HORIZONTAL( 1 );
		the_range := SEARCH_QUIETLY( search_target, 
					     FORWARD, 
					     how_exact );
		eve$x_old_find_direction := FORWARD;
	    ENDIF;
	ENDIF;

	! Found in opposite direction?
	!
	IF the_range <> 0
	THEN

	    ! Set up the prompt
	    !
	    IF the_direction = FORWARD
	    THEN
		the_prompt := eve$_foundreverse;
	    ELSE
		the_prompt := eve$_foundforward;
	    ENDIF;

	    ! Ask
	    !
	    IF lse$prompt_boolean( ,
				   response,
				   the_prompt,
				   ,
				   'Y')
	    THEN
		IF NOT response
		THEN
		    lse$$pop_position;
		    return true;
		ENDIF;
	    ELSE
		lse$$pop_position;
		return true;
	    ENDIF;
	ENDIF;
	    
    ENDIF;
ENDIF;

! Did we find anything?
!
IF the_range = 0
THEN
    lse$$pop_position;
    RETURN false;
ENDIF;

! Highlight the range
!
eve$remember_found( the_range );

! Position to the range
!
lse$$pop_position;
POSITION( the_range );

RETURN TRUE;

ENDPROCEDURE;


PROCEDURE lse$search_next
!doc_begin
!
! ONE LINE DEFINITION:
!    Does the last search
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end

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

return lse$search_util( eve$x_target, 
			lse$$x_search_how_exact, 
			eve$x_old_find_direction );

ENDPROCEDURE;


procedure lse$get_curr_lang_element(language_element_keyword)
!doc_begin
!
! ONE LINE DEFINITION:
!    This function returns the current language element according to the 
!    keyword specified. 
!    «TBS»
!
! DESCRIPTION:
!    This function returns the current language element according to the 
!    keyword specified. If no current language element is found, this routine 
!    returns the value tpu$k_unspecified.
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!++
! PARAMETERS:
!
!   none
!
! RETURN VALUE:
!
!   LSE$ALIAS_TYPE        - current alias object
!   LSE$AJUSTMENT_TYPE    - current adjustment object
!   LSE$LANGUAGE_TYPE     - current language object
!   LSE$PACKAGE_TYPE      - current package object
!   LSE$PLACEHOLDER_TYPE  - current placeholder object
!   LSE$TOKEN_TYPE        - current token object
!   LSE$PARAMETER_TYPE    - current parameter object
!   LSE$ROUTINE_TYPE      - current routine object
!   LSE$PARAM_STRING_TYPE - current routine parameter object
!
!   TPU$K_UNSPECIFIED
!--
ON_ERROR
    [OTHERWISE]:
	lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$get_curr_lang_element");
ENDON_ERROR;

CASE language_element_keyword

    [ LSE$ALIAS	      ]: return lse$$x_curr_alias;
    [ LSE$ADJUSTMENT  ]: return lse$$x_curr_adjustment;
    [ LSE$LANGUAGE    ]: 
	! If there is no current language, set it to be the
	! language of the current buffer. If the current buffer 
	! has no language, return unspecified.
	!
	if lse$$x_curr_language = tpu$k_unspecified
	then
	    lse$$x_curr_language := get_info(current_buffer, 'lse$language_type');
	endif;
	return lse$$x_curr_language;

    [ LSE$PACKAGE     ]: return lse$$x_curr_package;
    [ LSE$PLACEHOLDER ]: return lse$$x_curr_placeholder;
    [ LSE$TOKEN       ]: return lse$$x_curr_token;
    [ LSE$PARAMETER   ]: return lse$$x_curr_parameter;
    [ LSE$ROUTINE     ]: return lse$$x_curr_routine;
    [ LSE$PARAM_STRING]: return lse$$x_curr_param_string;

    [ OTHERWISE       ]: return tpu$k_unspecified; 

ENDCASE;

endprocedure;


procedure lse$set_curr_lang_element(language_element)
!doc_begin
!
! ONE LINE DEFINITION:
!    This function resets the current language element according to the 
!    type specified.
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!++
! PARAMETERS:
!
!   language_element
!	Language element object to be set as current element.
!
! ACCEPTED INPUT TYPES:
!
!   LSE$ALIAS_TYPE	    LSE$PACKAGE_TYPE   
!   LSE$ADJUSTMENT_TYPE	    LSE$PARAMETER_TYPE   
!   LSE$LANGUAGE_TYPE	    LSE$ROUTINE_TYPE     
!   LSE$PLACEHOLDER_TYPE    LSE$PARAM_STRING_TYPE
!   LSE$TOKEN_TYPE	 
!			    TPU$K_UNSPECIFIED
!
! RETURN VALUE:
!   old language element
!   or FALSE, if a non-valid type was input
!--
ON_ERROR
    [OTHERWISE]:
	lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$set_curr_lang_element");
ENDON_ERROR;

CASE get_info(language_element, 'type')

    [ LSE$ALIAS_TYPE	   ]: lse$set_curr_lang_element := lse$$x_curr_alias;
			      lse$$x_curr_alias         := language_element;

    [ LSE$ADJUSTMENT_TYPE  ]: lse$set_curr_lang_element := lse$$x_curr_adjustment;
			      lse$$x_curr_adjustment    := language_element;

    [ LSE$LANGUAGE_TYPE    ]: if language_element <> lse$$x_curr_language
			      then
				lse$$reset_language_elements;
			      endif;
			      lse$set_curr_lang_element := lse$$x_curr_language;
			      lse$$x_curr_language      := language_element;

    [ LSE$PLACEHOLDER_TYPE ]: lse$set_curr_lang_element := lse$$x_curr_placeholder;
			      lse$$x_curr_placeholder   := language_element;

    [ LSE$TOKEN_TYPE       ]: lse$set_curr_lang_element := lse$$x_curr_token;
			      lse$$x_curr_token         := language_element;

    [ LSE$PACKAGE_TYPE     ]: if language_element <> lse$$x_curr_package
			      then
				lse$$reset_package_elements;
			      endif; 
			      lse$set_curr_lang_element := lse$$x_curr_package;
			      lse$$x_curr_package       := language_element;

    [ LSE$ROUTINE_TYPE     ]: lse$set_curr_lang_element := lse$$x_curr_routine;
			      lse$$x_curr_routine       := language_element;

    [ LSE$PARAM_STRING_TYPE]: lse$set_curr_lang_element := lse$$x_curr_param_string;
			      lse$$x_curr_param_string  := language_element;

    [ OTHERWISE            ]: return FALSE; ! We don't handle other types

ENDCASE;

endprocedure;


procedure lse$unset_curr_lang_element(language_element_keyword)
!doc_begin
!
! ONE LINE DEFINITION:
!    This function resets the current language element according to the 
!    type specified to 0.
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!++
! PARAMETERS:
!
!   language_element_keyword  - a keyword, types supported are:
!			    LSE$ALIAS
!			    LSE$ADJUSTMENT
!			    LSE$LANGUAGE
!			    LSE$PARAMETER
!			    LSE$PACKAGE
!			    LSE$PLACEHOLDER
!			    LSE$TOKEN
!			    LSE$ROUTINE
!			    LSE$PARAM_STRING
!
! RETURN VALUE:
!   TRUE if a valid type was given
!   FALSE otherwise
!
!--
ON_ERROR
    [OTHERWISE]:
	lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$unset_curr_lang_element");
ENDON_ERROR;

CASE language_element_keyword
    [ LSE$ALIAS	      ]: lse$$x_curr_alias        := tpu$k_unspecified;
    [ LSE$ADJUSTMENT  ]: lse$$x_curr_adjustment   := tpu$k_unspecified;
    [ LSE$LANGUAGE    ]: lse$$x_curr_language     := tpu$k_unspecified;
			 lse$$reset_language_elements;
    [ LSE$PARAMETER   ]: lse$$x_curr_parameter	  := tpu$k_unspecified; 
    [ LSE$PARAM_STRING]: lse$$x_curr_param_string := tpu$k_unspecified; 
    [ LSE$PACKAGE     ]: lse$$x_curr_package      := tpu$k_unspecified;
			 lse$$reset_package_elements;
    [ LSE$PLACEHOLDER ]: lse$$x_curr_placeholder  := tpu$k_unspecified;
    [ LSE$ROUTINE     ]: lse$$x_curr_routine      := tpu$k_unspecified;
    [ LSE$TOKEN	      ]: lse$$x_curr_token        := tpu$k_unspecified;
    [ OTHERWISE       ]: return FALSE;	  ! We don't handle other types
ENDCASE;

return TRUE;

endprocedure;

procedure lse$$reset_language_elements

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

    lse$unset_curr_lang_element( LSE$ALIAS );
    lse$unset_curr_lang_element( LSE$ADJUSTMENT );
    lse$unset_curr_lang_element( LSE$PLACEHOLDER );
    lse$unset_curr_lang_element( LSE$TOKEN );

endprocedure;


procedure lse$$reset_package_elements

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

    lse$unset_curr_lang_element( LSE$PARAMETER );
    lse$unset_curr_lang_element( LSE$PARAM_STRING );
    lse$unset_curr_lang_element( LSE$ROUTINE );

endprocedure;


procedure lse$compare_lang_pack_elem(ref_elem, tst_elem)
!
!doc_begin
!
! ONE LINE DEFINITION:
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!
    LOCAL
	ref_type,   ! 'lse$X_type' string
	ref_value,
	tst_value;

    on_error
    [TPU$_BADREQUEST]:	! data type input does not understand this request
	return FALSE;

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

    !
    ! Are elements the same type?
    !
    ref_type := get_info (ref_elem, 'type');
    if ref_type <> get_info (tst_elem, 'type')
    then
	return FALSE;
    endif;

    case ref_type
    !
    ! Only need to compare names
    !
    [LSE$PACKAGE_TYPE,
     LSE$LANGUAGE_TYPE]:
	if get_info (ref_elem, 'lse$name') = get_info (tst_elem, 'lse$name')
	then
	    return TRUE;
	endif;

    [LSE$PARAM_STRING_TYPE]:
	if get_info (ref_elem, 'lse$param_string') = get_info (tst_elem, 'lse$param_string')
	then
	    return TRUE;
	endif;
    !
    ! Compare name and containing package
    !
    [LSE$ROUTINE_TYPE,
     LSE$PARAMETER_TYPE]:
	if get_info (ref_elem, 'lse$name') = get_info (tst_elem, 'lse$name')
	then
	    ref_value := get_info (ref_elem, 'lse$package_type');
	    tst_value := get_info (tst_elem, 'lse$package_type');
	    
	    if get_info (ref_value, 'lse$name') = get_info (tst_value, 'lse$name')
	    then
		return TRUE;
	    endif;
	endif;
    !
    !  Compare name and containing language
    !
    [LSE$ALIAS_TYPE,
     LSE$ADJUSTMENT_TYPE,
     LSE$PLACEHOLDER_TYPE,
     LSE$TOKEN_TYPE]:
	if get_info (ref_elem, 'lse$name') = get_info (tst_elem, 'lse$name')
	then
	    ref_value := get_info (ref_elem, 'lse$language_type');
	    tst_value := get_info (tst_elem, 'lse$language_type');
	    
	    if get_info (ref_value, 'lse$name') = get_info (tst_value, 'lse$name')
	    then
	        return TRUE;
            endif;
	endif;

    [OTHERWISE]:    
	return FALSE;

    endcase;

    return FALSE;

endprocedure;



procedure lse$get_valid_lang_elem (element_name,
			           language_name,
			           lang_elem_kwd;
			           the_element,
			           the_language)
! FUNCTION:
!
!   This function takes a language element name and a language
!   name. Validates them and verifies that the element is associated with the
!   language.
!
! Parameters:
!
!   element_name    - Name of element to be checked
!
!   language_name   - Name of language
!
!   lang_elem_kwd   - Keyword indicating type of language element to check if it
!                     is associated with the language. 
!
!   the_element	    - Language element to be returned
!
!   the_language    - Language to be returned
!
! Return Value:
!
!   True    - Element found and association with language established.
!   False   - Failure message
!
!doc_begin
!
! ONE LINE DEFINITION:
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!
LOCAL
    elem_type_msg,
    find_type_str,
    the_element_name,
    the_lang_name;
    
ON_ERROR
    [OTHERWISE]:
	lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$get_valid_lang_elem");
ENDON_ERROR;

! Get the language and the language element name parameter
!
if lse$prompt_lang_elem_param(element_name, language_name, lang_elem_kwd,
                                               the_element_name, the_lang_name)
then
    ! Determine the "find type string" and "element type message"  for various 
    ! language element type
    !
    lse$get_lang_elem_message(lang_elem_kwd, find_type_str, elem_type_msg,,,,);

    ! Get the language from the language name
    !
    the_language := get_info(the_lang_name, 'lse$language_type');
    if the_language <> tpu$k_unspecified
    then
	! Check to see if the element name is in the language. If yes, the
	! language element is returned
	!
	the_element := get_info(the_language, find_type_str, the_element_name);
	if the_element <> 0 
	then
	    return TRUE;
	else
	    eve$message(lse$_elemnotlang, 0, elem_type_msg, the_element_name,
	                                  get_info(the_language, 'lse$name') );
	endif;
    else
        eve$message (lse$_langnotdef, 0, the_lang_name);
    endif;
endif;

! We can't get a valid language element associated with the language
!
return FALSE;    

endprocedure;   ! lse$get_valid_lang_elem


procedure lse$get_valid_lang_pack_elem ( element_name,
					 lang_elem_kwd,
			                 lang_pack_name,
			                 lang_pack_kwd;
			                 the_element,
			                 the_lang_pack  )
! FUNCTION:
!
!   This function takes a language/package element name and a language/package
!   name. Validates them and verifies that the element is associated with the
!   language or package. 
!
! Parameters:
!
!   element_name    - Name of element to be checked
!
!   lang_elem_kwd   - Keyword supported
!		      Language:
!		         LSE$ALIAS
!			 LSE$ADJUSTMENT
!			 LSE$PLACEHOLDER
!			 LSE$TOKEN
!		      Package:
!			 LSE$ROUTINE
!
!   lang_pack_name  - Name of language or package
!
!   lang_pack_kwd   - Keyword indicating language or package type for the
!		      parameter lang_pack_name. Keyword supported:
!		         LSE$LANGUAGE
!			 LSE$PACKAGE
!
!   the_element	    - Language/Package element to be returned
!
!   the_lang_pack   - Language/Package to be returned
!
! Return Value:
!
!   True    - Element found and association with language/package established.
!   False   - Failure message
!
!doc_begin
!
! ONE LINE DEFINITION:
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!
LOCAL
     find_type_str,
     elem_type_msg,
     find_lang_pack_str,
     lang_pack_msg,
     lang_pack_notdef_msg,
     lang_pack_type_kwd,
     the_element_name,
     the_lang_pack_name;
    
ON_ERROR
    [OTHERWISE]:
	lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE,
                                     	"lse$get_valid_lang_pack_elem");
ENDON_ERROR;

! Get the language/package and the language/package element name parameter.
! Plug in 'current element' or 'current lang/pack' if either is unspecified.
! Verify that the lang/pack exists.
!
if element_name = tpu$k_unspecified
then
    element_name := "";
endif;

if lse$prompt_lang_pack_elem_param( element_name, 
				    lang_elem_kwd,
				    lang_pack_name, 
				    lang_pack_kwd, 
				    the_element_name, 
				    the_lang_pack_name )
then
    ! Determine the "find type string" and "element type message"  for various 
    ! language element type 
    !
    lse$get_lang_elem_message(lang_elem_kwd, 
			      find_type_str, 
			      elem_type_msg,,,,);

    ! Determine the "type string" and "message"  for language or package type
    !
    lse$get_lang_elem_message(lang_pack_kwd, 
			      find_lang_pack_str,,,,
			      lang_pack_notdef_msg,
			      lang_pack_type_kwd);

    ! Get the language/package from the language/package name.
    ! Verify to make sure we have a valid language/package. 
    !
    the_lang_pack := get_info ( lse$system, 
                                find_lang_pack_str, 
                                the_lang_pack_name );
    if the_lang_pack <> 0
    then
	! Verify that the element name is in the language/package. 
	!
	the_element := get_info(the_lang_pack, find_type_str, the_element_name);
	if the_element <> 0 
	then
	    return TRUE;
	else
	    eve$message( lse$_elemnotlang, 
			 0, 
			 elem_type_msg, 
			 the_element_name,
			 the_lang_pack_name );
	endif;
    else
	eve$message(lang_pack_notdef_msg, 0, the_lang_pack_name);
    endif;

endif;

! We didn't get a valid language/package element associated with the
! language/package
!
return FALSE;    

endprocedure;   ! lse$get_valid_lang_pack_elem


procedure lse$get_lang_elem_message (lang_elem_kwd,
			             find_type_str,
			             elem_type_msg,
				     prompt_msg,
				     no_value_msg,
				     notdefine_msg,
				     type_keyword)
! FUNCTION:
!
!   This function takes a language element keyword and returns the following
!   messages associated with that language element type: 1)find type string
!   2)the element type message 3)the prompt message and 4)the no value message
!   used in prompting.
!
! Parameters:
!
!   lang_elem_kwd   - Input keyword indicating type of language element 
!
!   find_type_str   - Returns the string for the language element find type.
!
!   elem_type_msg   - Returns the message associated with the name of the
!                     language element
!
!   prompt_msg      - Returns the prompt string used for the indicated language
!                     element type
!
!   no_value_msg    - Returns the no value message used in prompting for the
!                     indicated language element type.            
!
!   notdefine_msg   - Returns the "language element not defined" message
!
!   type_keyword    - Returns the keyword returned by a get_info on the type
!
! Return Value:
!
!   TRUE  - All return messages are valid
!   FALSE - All return messages are not valid. Unspecified language element
!           keyword not handled.
!   
!doc_begin
!
! ONE LINE DEFINITION:
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!
ON_ERROR
    [OTHERWISE]:
	lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$get_lang_elem_message");
ENDON_ERROR;

CASE lang_elem_kwd

    [ LSE$ALIAS       ]:
	find_type_str := "LSE$FIND_ALIAS";
	elem_type_msg := lse$get_message_text(lse$_aliasword);
	prompt_msg    := lse$get_message_text(lse$_aliasnamprompt);
	no_value_msg  := lse$get_message_text(lse$_aliasnoval);
	notdefine_msg := lse$get_message_text(lse$_aliasnotdef);
	type_keyword  := LSE$ALIAS_TYPE;

    [ LSE$ADJUSTMENT  ]:
	find_type_str := "LSE$FIND_ADJUSTMENT";
	elem_type_msg := lse$get_message_text(lse$_adjword);
	prompt_msg    := lse$get_message_text(lse$_adjnamprompt);
	no_value_msg  := lse$get_message_text(lse$_adjnoval);
	notdefine_msg := lse$get_message_text(lse$_adjustnotdef);
	type_keyword  := LSE$ADJUSTMENT_TYPE;

    [ LSE$LANGUAGE    ]:
	find_type_str := "LSE$FIND_LANGUAGE";
	elem_type_msg := lse$get_message_text(lse$_langword);
	prompt_msg    := lse$get_message_text(lse$_langnamprompt);
	no_value_msg  := lse$get_message_text(lse$_langnoval);
	notdefine_msg := lse$get_message_text(lse$_langnotdef);
	type_keyword  := LSE$LANGUAGE_TYPE;

    [ LSE$PACKAGE     ]:
	find_type_str := "LSE$FIND_PACKAGE";
	elem_type_msg := lse$get_message_text(lse$_packword);
	prompt_msg    := lse$get_message_text(lse$_packnamprompt);
	no_value_msg  := lse$get_message_text(lse$_packnoval);
	notdefine_msg := lse$get_message_text(lse$_packnotdef);
	type_keyword  := LSE$PACKAGE_TYPE;

    [ LSE$PLACEHOLDER ]:
	find_type_str := "LSE$FIND_PLACEHOLDER";
	elem_type_msg := lse$get_message_text(lse$_plaword);
	prompt_msg    := lse$get_message_text(lse$_placnamprompt);
	no_value_msg  := lse$get_message_text(lse$_placnoval);
	notdefine_msg := lse$get_message_text(lse$_plchnotdef);
	type_keyword  := LSE$PLACEHOLDER_TYPE;

    [ LSE$TOKEN       ]:
	find_type_str := "LSE$FIND_TOKEN";
	elem_type_msg := lse$get_message_text(lse$_tokenword);
	prompt_msg    := lse$get_message_text(lse$_tokennamprompt);
	no_value_msg  := lse$get_message_text(lse$_tokennoval);
	notdefine_msg := lse$get_message_text(lse$_tempnotdef);
	type_keyword  := LSE$TOKEN_TYPE;

    [ LSE$PARAMETER   ]:
	find_type_str := "LSE$FIND_PARAMETER";
	elem_type_msg := lse$get_message_text(lse$_paramword);
	prompt_msg    := lse$get_message_text(lse$_paramnamprompt);
	no_value_msg  := lse$get_message_text(lse$_paramnoval);
	notdefine_msg := lse$get_message_text(lse$_paramnotdef);
	type_keyword  := LSE$PARAMETER_TYPE;

    [ LSE$ROUTINE     ]:
	find_type_str := "LSE$FIND_ROUTINE";
	elem_type_msg := lse$get_message_text(lse$_routword);
	prompt_msg    := lse$get_message_text(lse$_routnamprompt);
	no_value_msg  := lse$get_message_text(lse$_routnoval);
	notdefine_msg := lse$get_message_text(lse$_routinenotdef);
	type_keyword  := LSE$ROUTINE_TYPE;

    [ OTHERWISE       ]:
	return FALSE; ! We don't handle other types

ENDCASE;

return TRUE;

endprocedure; ! lse$get_lang_elem_message


procedure lse$extract_lang_element(lang_elem_name, 
				   language_name, 
                                   lang_elem_kwd, 
				   new_only)
!doc_begin
!
! ONE LINE DEFINITION:
!    This function extracts all the attributes for a language element.
!    «TBS»
!
! DESCRIPTION:
!    This function extracts all the attributes for a particular language 
!    element type given a language element and language name pattern and 
!    display them on the current buffer. Wildcard names are accepted for both.
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!++
! Parameters:
!
!   lang_elem_name     - Name of language element. Can contain wildcard.
!
!   language_name      - Name of language. Can contain wildcard.
!
!   lang_elem_kwd      - Keyword indicating type of language element 
!
!   new_only           - TRUE: extract only language element from current
!                              editing session.
!                        FALSE: extract all language elements.
!
! Return Value:
!
!   True    - Extract operation is successful.
!   False   - Error status of extract operation.
!--

return lse$extract_lang_pack_elem(lang_elem_name, 
				  lang_elem_kwd, 
				  language_name, 
				  lse$language, 
				  new_only);
endprocedure; 


procedure lse$extract_lang_pack_elem(lang_pack_elem_name, 
				     lang_elem_kwd, 
                                     lang_pack_name, 
				     lang_pack_kwd, 
				     new_only)
!doc_begin
!
! ONE LINE DEFINITION:
!    This function extracts all the attributes for a language or package element.
!    «TBS»
!
! DESCRIPTION:
!    This function extracts all the attributes for a particular
!    language/package element type given a language/package element and
!    language/package name pattern and display them on the current buffer.
!    Wildcard names are accepted for both.
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!++
! Parameters:
!
!   lang_pack_elem_name - Name of language element. Can contain wildcard.
!
!   lang_elem_kwd       - Keyword indicating type of language/package element 
!		          Language:
!		             LSE$ALIAS
!			     LSE$ADJUSTMENT
!			     LSE$PLACEHOLDER
!			     LSE$TOKEN
!			  Package:
!			     LSE$ROUTINE
!			     LSE$PARAMETER
!
!   lang_pack_name      - Name of language or package. Can contain wildcard.
!
!   lang_pack_kwd       - Keyword indicating language or package type for the
!  			  parameter lang_pack_name. Keyword supported:
!			     LSE$LANGUAGE
!			     LSE$PACKAGE
!
!   new_only            - TRUE: extract only language/package elements from 
!                               current editing session.
!                         FALSE: extract all language/package elements.
!
! Return Value:
!
!   True    - Extract operation is successful.
!   False   - Error status of extract operation.
!--
LOCAL
    find_lang_pack_str,
    find_elem_str,
    loop_lang_pack,
    loop_lang_pack_name,
    loop_lang_elem,
    loop_lang_elem_name,
    exact_lang_pack_match,
    lang_pack_match,
    element_match,
    no_lang_pack_value_msg,
    no_elem_value_msg,
    routine_param,		! true is element is generated by package
    start_mark,
    end_mark;

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

    ! make sure the buffer we are extracting into is modifiable
    !
    if get_info(current_buffer, "modifiable") <> true then
        eve$message(lse$_unmodifiable, 0, 'EXTRACT');
        return false;
    endif;

    !
    ! go to the bottom of the buffer, and start inserting.
    ! save the position so we can return to the point we started
    ! inserting at.
    !
    lse_bottom;
    lse$$push_position;
!
!   Save the start mark and old_bpm to compute the text inserted
!
    lse$$save_old_bpm;
    start_mark := mark (NONE);

    ! get the associated messages
    lse$get_lang_elem_message(lang_pack_kwd, find_lang_pack_str,,,
			      no_lang_pack_value_msg,,);
    lse$get_lang_elem_message(lang_elem_kwd, find_elem_str,,,no_elem_value_msg,,);    

    ! assume from the start that we haven't found either an element or a
    ! language match
    lang_pack_match := false;
    element_match := false;
    exact_lang_pack_match := false;

    ! Check if the language given is an exact match.
    loop_lang_pack := get_info(lse$system, find_lang_pack_str, lang_pack_name);
    if loop_lang_pack = 0
    then
	! it isn't an exact match - check if the name is wildcarded, if
	! not, then a match is impossible - error and return.
	if NOT lse$$wildcard_name(lang_pack_name) then
	    eve$message(no_lang_pack_value_msg);
	    return false;
        endif;
	!
	! it is a wildcard, so get the first language out so we can
	! loop through it.
	!
	loop_lang_pack := get_info(LSE$SYSTEM, "first", lang_pack_kwd);
	exact_lang_pack_match := false;
    else
	! an exact match was found, mark it so
	!
	exact_lang_pack_match := true;
    endif;

    ! Start looping through all languages 
    !
    loop
        exitif loop_lang_pack = 0;
        loop_lang_pack_name := get_info (loop_lang_pack, 'lse$name');
    
        ! Make sure we have a matching language
        !
        if lse$$strmatch_wild (loop_lang_pack_name, lang_pack_name) ! if 3
        then
	    lang_pack_match := true;

            ! Check whether the name is wild-carded or an exact match
	    if NOT lse$$wildcard_name(lang_pack_elem_name)
            then
		! 
		! it must be an exact match.
		!
	        loop_lang_elem := get_info(loop_lang_pack,
                                       find_elem_str,
                                       lang_pack_elem_name);
                if loop_lang_elem <> 0	    ! if 2
		then
		    ! we got an exact match - just extract this one
		    !
		    element_match := true;
		    if new_only 
		    then
			! New only flag set. Make sure the language element is
			! created in the current editing sesssion before we
			! extract it
			!
			if get_info(loop_lang_elem, 'lse$modified')
			then
			    lse$extract_one_lang_element(loop_lang_elem);
			endif;
		    else
			! Extract all language element in the nametable and the 
			! environment files
			!
			lse$extract_one_lang_element(loop_lang_elem);
		    endif;
                endif;              ! if 2
            else
		!
		! It is (or might be) a wildcarded name.
		!
		loop_lang_elem := get_info(loop_lang_pack, "first", lang_elem_kwd);
		loop ! loop through the elements
		    exitif loop_lang_elem = 0;
		    loop_lang_elem_name := get_info (loop_lang_elem, 'lse$name');
		    ! Make sure we have a matching language element
		    !
		    if lse$$strmatch_wild(loop_lang_elem_name, lang_pack_elem_name)
		    then
			! Don't extract routine-tokens or parameter-
			! placeholders
			if get_info(loop_lang_elem, 'type') = lse$token_type
			then
			    routine_param := get_info(loop_lang_elem, 'lse$routine');
			else
			if get_info(loop_lang_elem, 'type') = lse$placeholder_type
                        then
			    routine_param := get_info(loop_lang_elem, 'lse$parameter');
		        endif;
			endif;

			if NOT routine_param
			then
			    element_match := true;
			    if new_only 
			    then
				! New only flag set. Make sure the language element is
				! created in the current editing sesssion before we
				! extract it
				!
				if get_info(loop_lang_elem, 'lse$modified')
				then
				    lse$extract_one_lang_element(loop_lang_elem);
				endif;
			    else
				! Extract all language element in the nametable and the 
				! environment files
				!
				lse$extract_one_lang_element(loop_lang_elem);
			    endif;
			endif;
		    endif;
		    loop_lang_elem := get_info(loop_lang_pack, "next", lang_elem_kwd);
		endloop;	    !loop through all the elements
	    endif;		    ! if 1
        endif;			    ! if 3
	exitif exact_lang_pack_match; 
     	loop_lang_pack := get_info(LSE$SYSTEM, "next", lang_pack_kwd);
    endloop;			    ! loop through all the languages/packages

    if NOT lang_pack_match
    then
	eve$message( no_lang_pack_value_msg );
	return false;
    else
	if NOT element_match
        then
            eve$message( no_elem_value_msg );
            return FALSE;
        else
!
!   	    Save the start mark to compute the text inserted
!
    	    end_mark := END_OF (CURRENT_BUFFER);
!
!	    Save the range in between start_mark and end_mark for UNDO
!
	    if (end_mark > start_mark) then
		lse$$save_inserted_range (start_mark, end_mark);
	    endif;

            return TRUE;
        endif;
    endif;

!
!   Save the start mark to compute the text inserted
!
    end_mark := END_OF (CURRENT_BUFFER);
!
!   Save the range in between start_mark and end_mark for UNDO
!
    if (end_mark > start_mark) then
        lse$$save_inserted_range (start_mark, end_mark);
    endif;

    ! return to original position in buffer
    lse$$pop_position;

endprocedure; !lse$extract_lang_pack_elem


procedure lse$extract_lang_pack(lang_pack_name, lang_pack_kwd, new_only)
!doc_begin
!
! ONE LINE DEFINITION:
!    This function extracts all the attributes for a language or package
!    «TBS»
!
! DESCRIPTION:
!    This function extracts all the attributes for a language or package
!    and display them on the current buffer. Wildcard names are accepted for
!    both.
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!++
! Parameters:
!
!   lang_pack_name - Name of language or package. Can contain wildcard.
!
!   lang_pack_kwd  - LSE$LANGUAGE   A language name is entered
!                    LSE$PACKAGE    A package name is entered 
!
!   new_only       - TRUE: extract only language/package definition created
!                          from current editing session.
!                    FALSE: extract all language/package definition
!
! Return Value:
!
!   True    - Extract operation is successful.
!   False   - Error status of extract operation.
!--
LOCAL
    got_a_match,
    loop_lang_pack,
    loop_lang_pack_name,
    no_value_msg;

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

    ! make sure the buffer we are extracting into is modifiable
    !
    if get_info(current_buffer, "modifiable") <> true then
        eve$message(lse$_unmodifiable, 0, 'EXTRACT');
        return false;
    endif;

    !
    ! go to the bottom of the buffer, and start inserting.
    ! save the position so we can return to the point we started
    ! inserting at.
    !
    lse_bottom;
    lse$$push_position;

    ! Start looping through all languages 
    !
    loop_lang_pack := get_info(LSE$SYSTEM, "first", lang_pack_kwd);
    loop
        exitif loop_lang_pack = 0;
        loop_lang_pack_name := get_info (loop_lang_pack, 'lse$name');
    
        ! Make sure we have a matching language/package
        !
        if lse$$strmatch_wild (loop_lang_pack_name, lang_pack_name)
        then
	    if new_only 
	    then
		! New only flag set. Make sure the language/package is created
		! in the current editing sesssion before we extract it
		!
		if get_info(loop_lang_pack, 'lse$modified')
		then
		    lse$extract_one_lang_element(loop_lang_pack);
		    got_a_match := TRUE;
		endif;
	    else
		! Extract all language/package definitions
		!
		lse$extract_one_lang_element(loop_lang_pack);
		got_a_match := TRUE;
	    endif;
        endif;
	loop_lang_pack := get_info(LSE$SYSTEM, "next", lang_pack_kwd);
    endloop;

    if NOT got_a_match
    then
        lse$get_lang_elem_message(lang_pack_kwd,,,,no_value_msg,,);
	eve$message( no_value_msg );
	return FALSE;
    else
	return TRUE;
    endif;

    ! return to original position in buffer
    lse$$pop_position;

endprocedure; !lse$extract_lang_element


procedure lse$extract_one_lang_element(language_element)
!doc_begin
!
! ONE LINE DEFINITION:
!    This function takes a language element object and generates the 
!    extract display for it.
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!++
! Parameters:
!
!   language_element - A language element object
!
! Return Value:
!
!   none
!--
LOCAL
    the_elem,
    the_elem_name,
    adjust_name,
    alias_name,
    alias_exp_text,
    def_prefix,
    delim,
    exe_prefix,
    i,
    lang_name,
    lang_elem_name,
    work_string,
    pack_name,
    pack_elem_name,
    temp;
    
ON_ERROR
    [TPU$_NOTMODIFIABLE]:
        eve$message(ERROR_TEXT);
	eve$learn_abort;
	lse$post_command_proc;
	return false;

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

def_prefix := '    !';
exe_prefix := '    ';

CASE get_info(language_element, 'type')

    [ LSE$ALIAS_TYPE	   ]: 

	lang_name := ' ' + get_info(get_info(language_element, 'lse$language_type'), 
                              'lse$name');
	alias_name := ' ' +
		      lse$$quote_string(get_info(language_element, 'lse$name'));

	lse$copy_line('NEW ALIAS' + alias_name + lang_name);

	! EXPAND TEXT
	!
	alias_exp_text := get_info(language_element, 'lse$expand_text');
	if alias_exp_text = ''
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line('SET ALIAS EXPAND TEXT ' +
                      lse$$quote_string(alias_exp_text) );

    [ LSE$ADJUSTMENT_TYPE  ]: 

	lang_name := ' ' + get_info( get_info(language_element, 'lse$language_type'),
                               'lse$name');
	adjust_name := ' ' + lse$$quote_string(
				get_info(language_element, 'lse$name') );

	lse$copy_line('NEW ADJUSTMENT' + adjust_name + lang_name);

	! PATTERN
	!
	temp := change_case(get_info(language_element, 'lse$pattern'),upper);
	if (' ' + temp = adjust_name)  OR
	   (' "' + temp + '"' = adjust_name)
	then
	    copy_text( def_prefix );
	    lse$copy_line('SET ADJUSTMENT PATTERN [adjustment_pattern]');
	else
	    copy_text( exe_prefix );
	    lse$copy_line('SET ADJUSTMENT PATTERN ' + lse$$quote_string(temp));
	endif;

	! COMPRESS
	!
	if get_info(language_element, 'lse$compress') = on
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line('SET ADJUSTMENT COMPRESS ' + 
		      str(get_info(language_element, 'lse$compress')) );

	! COUNT
	!
	if get_info(language_element, 'lse$count_lines') = on
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line('SET ADJUSTMENT COUNT ' + 
		      str(get_info(language_element, 'lse$count_lines')) );

	! PREFIX INDENTATION, PREFIX ADJUSTMENT
	!
	if get_info(language_element, 'lse$prefix') = on
	then
	    ! Extract prefix indentation value
	    !
	    copy_text ('    SET ADJUSTMENT PREFIX INDENTATION ');
	    case get_info(language_element, 'lse$prefix_indent')
		[lse$current]   : lse$copy_line( "CURRENT" );
		[lse$following] : lse$copy_line( "FOLLOWING" );
	    endcase;

	    ! Extract prefix adjustment value
	    !
	    copy_text ('    SET ADJUSTMENT PREFIX ADJUSTMENT ');
	    case get_info(language_element, 'lse$prefix_adjust')
		[lse$current]   : lse$copy_line( "CURRENT" );
		[lse$following] : lse$copy_line( "FOLLOWING" );
	    endcase;
	else
	    lse$copy_line( def_prefix +
			   'SET ADJUSTMENT PREFIX INDENTATION [indentation_value]' );
	    lse$copy_line( def_prefix +
			   'SET ADJUSTMENT PREFIX ADJUSTMENT [adjustment_value]' );
	endif;

        ! INHERIT
	!
	if get_info(language_element, 'lse$inherit') = none
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	copy_text ('SET ADJUSTMENT INHERIT ');
	case get_info(language_element, 'lse$inherit')
	    [lse$next]     : lse$copy_line( "NEXT" );
	    [lse$previous] : lse$copy_line( "PREVIOUS" );
	    [lse$minimum]  : lse$copy_line( "MINIMUM" );
	    [lse$maximum]  : lse$copy_line( "MAXIMUM" );
	    [none       ]  : lse$copy_line( "NONE" );
	endcase;

        ! OVERVIEW
	!
	if get_info(language_element, 'lse$overviews') = on
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line('SET ADJUSTMENT OVERVIEW ' +
		      str(get_info(language_element, 'lse$overviews')));

	! UNIT
	!
	if get_info(language_element, 'lse$unit') = off
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line('SET ADJUSTMENT UNIT ' +
		      str(get_info(language_element, 'lse$unit')));

	! CURRENT
	!
	if get_info(language_element, 'lse$current_line') = 0
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
        lse$copy_line('SET ADJUSTMENT CURRENT ' + 
			  str(get_info(language_element, 'lse$current_line')));

	! SUBSEQUENT
	!
	if get_info(language_element, 'lse$subsequent_line') = 0
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line('SET ADJUSTMENT SUBSEQUENT ' +
		      str(get_info(language_element,'lse$subsequent_line')));

    [ LSE$LANGUAGE_TYPE    ]: 
	lang_name := ' ' + get_info(language_element, 'lse$name');

	split_line;
	lse$copy_line ('NEW LANGUAGE ' + lang_name);
   
	! FILE TYPES
	!
	work_string := get_info(language_element, 'first', lse$file_types);
	if work_string = 0
	then
	    lse$copy_line( def_prefix + 'SET LANGUAGE FILE TYPE [text_string] ADD' );
	endif;	    
	loop
	    exitif work_string = 0;
	    lse$copy_line('    SET LANGUAGE FILE TYPE ' + work_string +
                           ' ADD' );
	    work_string := get_info(language_element, 'next', lse$file_types);
	endloop;

	! INITIAL STRING
	!
	work_string := get_info(language_element, 'lse$initial_string');
	if work_string = ''
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line('SET LANGUAGE INITIAL STRING ' + 
		      lse$$quote_string(work_string) );

	! REQUIRED DELIMITERS
	!
	delim := get_info(language_element, 'lse$required_delimit');
	if delim <> 0
	then
	    if (get_info(delim, 'lse$leading_text') = '{')  AND
	       (get_info(delim, 'lse$trailing_text')= '}')
	    then
		copy_text( def_prefix );
	    else
		copy_text( exe_prefix );
	    endif;
	    lse$copy_line('SET LANGUAGE REQUIRED DELIMIT ' + 
		           lse$$quote_string(get_info(delim, 'lse$leading_text')) +
		          ' ' + 
			   lse$$quote_string(get_info(delim, 'lse$trailing_text')) );
	endif;

	! REQUIRED LIST DELIMITERS
	!
	delim := get_info(language_element, 'lse$required_list_delimit');
	if delim <>0 
	then
	    if (get_info(delim, 'lse$leading_text') = '{')  AND
	       (get_info(delim, 'lse$trailing_text')= '}...')
	    then
		copy_text( def_prefix );
	    else
		copy_text( exe_prefix );
	    endif;
	    lse$copy_line('SET LANGUAGE REQUIRED LIST DELIMIT ' + 
			  lse$$quote_string(get_info(delim, 'lse$leading_text')) +
			  ' ' + 
			 lse$$quote_string(get_info(delim, 'lse$trailing_text')) );
	endif;

	! OPTIONAL DELIMITERS
	!
	delim := get_info(language_element, 'lse$optional_delimit');
	if delim <>0 
	then
	    if (get_info(delim, 'lse$leading_text') = '[')  AND
	       (get_info(delim, 'lse$trailing_text')= ']')
	    then
		copy_text( def_prefix );
	    else
		copy_text( exe_prefix );
	    endif;
	    lse$copy_line('SET LANGUAGE OPTIONAL DELIMIT ' + 
			lse$$quote_string(get_info(delim, 'lse$leading_text')) + 
			' ' + 
			lse$$quote_string(get_info(delim, 'lse$trailing_text')) );
	endif;

	! optional list delimiters
	delim := get_info(language_element, 'lse$optional_list_delimit');
	if delim <>0 
	then
	    if (get_info(delim, 'lse$leading_text') = '[')  AND
	       (get_info(delim, 'lse$trailing_text')= ']...')
	    then
		copy_text( def_prefix );
	    else
		copy_text( exe_prefix );
	    endif;
	    lse$copy_line('SET LANGUAGE OPTIONAL LIST DELIMIT ' + 
			lse$$quote_string(get_info(delim, 'lse$leading_text')) + 
			' ' + 
			lse$$quote_string(get_info(delim, 'lse$trailing_text')) );
	endif;

	! pseudocode delimiters
	delim := get_info(language_element, 'lse$pseudocode_delimit');
	if delim <>0
	then
	    if (get_info(delim, 'lse$leading_text') = '')  AND
	       (get_info(delim, 'lse$trailing_text')= '')
	    then
		copy_text( def_prefix );
	    else
		copy_text( exe_prefix );
	    endif;
	    lse$copy_line('SET LANGUAGE PSEUDOCODE DELIMIT ' +
			lse$$quote_string(get_info(delim, 'lse$leading_text')) + 
			' ' + 
			lse$$quote_string(get_info(delim, 'lse$trailing_text')) );
	endif;

	! COMMENT ASSOCIATION
	!
	if get_info(language_element, 'lse$comment_association') = lse$next
	then
	    lse$copy_line('    SET LANGUAGE COMMENT ASSOCIATION NEXT' );
	else
	    lse$copy_line('    !SET LANGUAGE COMMENT ASSOCIATION PREVIOUS' );
	endif;

	! EXPAND CASE
	!
	if get_info(language_element, 'lse$expand_case') = lse$case_as_is
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	copy_text ('SET LANGUAGE EXPAND CASE ');
        case get_info(language_element, 'lse$expand_case')
            [lse$uppercase] : lse$copy_line( 'UPPER' );
            [lse$lowercase] : lse$copy_line( 'LOWER' );
            [lse$case_as_is]: lse$copy_line( 'AS_IS' );
        endcase;

	! FORTRAN
	!
	if get_info(language_element, 'lse$fortran')
	then
	    lse$copy_line( '    SET LANGUAGE FORTRAN ON' );
	else
	    lse$copy_line( '    !SET LANGUAGE FORTRAN OFF' );
	endif;

	! ANSI FORTRAN
	!
	if get_info(language_element, 'lse$ansi_fortran') 
	then
	    lse$copy_line( '    SET LANGUAGE ANSI FORTRAN ON' );
	else
	    lse$copy_line( '    !SET LANGUAGE ANSI FORTRAN OFF' );
	endif;
    
	! DIAGNOSTICS
	!
	if get_info(language_element, 'lse$diagnostics') 
	then
	    lse$copy_line('    SET LANGUAGE DIAGNOSTICS ON' );
	else
	    lse$copy_line('    !SET LANGUAGE DIAGNOSTICS OFF' );
	endif;

	! COMPILE COMMAND
	!
	work_string := get_info(language_element, 'lse$compile_command');
	if work_string = ''
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line('SET LANGUAGE COMPILE COMMAND ' + 
		       lse$$quote_string(work_string) );

	! HELP LIBRARY
	!
	work_string := get_info(language_element, 'lse$help_library');
	if work_string = ''
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line('SET LANGUAGE HELP LIBRARY ' + 
		      lse$$quote_string(work_string) );

	! OVERVIEW MINIMUM LINES
	!
	if get_info(language_element, 'lse$min_overview_lines') = 1
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line('SET LANGUAGE OVERVIEW MINIMUM LINES ' + 
		      str(get_info(language_element,'lse$min_overview_lines')));

	! OVERVIEW TAB RANGE
	!
	if (get_info(language_element, 'lse$overview_min_tab_rng') = 4)  AND
	   (get_info(language_element, 'lse$overview_max_tab_rng') = 8)
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line('SET LANGUAGE OVERVIEW TAB RANGE ' +
	    	str(get_info(language_element, 'lse$overview_min_tab_rng')) + 
		' ' + 
		str(get_info(language_element, 'lse$overview_max_tab_rng')) );
    
	! BRACKETTED COMMENTS
	!
	delim := get_info(language_element, 'first', lse$bracketed_comments);
	if delim = 0
	then
	    lse$copy_line ('    !SET LANGUAGE BRACKETED COMMENTS [begin_string] [end_string] ADD' );
	endif;
	loop
	    exitif delim = 0;
	    lse$copy_line ('    SET LANGUAGE BRACKETED COMMENTS ' +
		       lse$$quote_string(get_info(delim, 'lse$leading_text')) + 
		       ' ' +
		       lse$$quote_string(get_info(delim, 'lse$trailing_text')) +
                       ' ADD' );
	    delim := get_info(language_element, 'next', lse$bracketed_comments);
	endloop;

	! FIXED COMMENTS
	!
	delim := get_info(language_element, 'first', lse$fixed_comments);
	if delim = 0
	then
	    lse$copy_line ('    !SET LANGUAGE FIXED COMMENTS [text_string] [column] ADD' );
	endif;
	loop
	    exitif delim = 0;
	    lse$copy_line('    SET LANGUAGE FIXED COMMENTS '  +
		      lse$$quote_string(get_info(delim, 'lse$fixed_delimit')) +
                      ' ' +
 		      str(get_info(delim, 'lse$column')) +
                      ' ADD' );
	    delim := get_info(language_element, 'next', lse$fixed_comments);
	endloop;

	! LINE COMMENTS
	!
	work_string := get_info(language_element, 'first', lse$line_comments);
	if work_string = 0
	then
	    lse$copy_line('    !SET LANGUAGE LINE COMMENTS [text_string] ADD' );
	endif;
	loop
	    exitif work_string = 0;
	    lse$copy_line('    SET LANGUAGE LINE COMMENTS ' + 
                      lse$$quote_string(work_string) +
                      ' ADD' );

	    work_string := get_info(language_element, 'next', lse$line_comments);
	endloop;

	! TRAILING COMMENTS
	!
	work_string := get_info(language_element, 'first', lse$trailing_comments);
	if work_string = 0
	then
	    lse$copy_line('    !SET LANGUAGE TRAILING COMMENTS [text_string] ADD' );
	endif;
	loop
	    exitif work_string = 0;
	    lse$copy_line('    SET LANGUAGE TRAILING COMMENTS ' + 
                      lse$$quote_string(work_string) +
                      ' ADD' );

	    work_string := get_info(language_element, 'next', lse$trailing_comments);
	endloop;


	! IDENTIFIER CHARACTERS
	!
	IF get_info(language_element, 'lse$identifier_char') =
	   "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ%$_0123456789"
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line('SET LANGUAGE IDENTIFIER CHARACTERS ' +
	          lse$$quote_string(get_info(language_element, 'lse$identifier_char')) );

	! PUNCTUATION CHARACTERS
	!
	IF get_info(language_element, 'lse$punctuation_char') = ',;()'
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line('SET LANGUAGE PUNCTUATION CHARACTERS ' +
	         lse$$quote_string(get_info(language_element, 'lse$punctuation_char')) );

	! QUOTES
	!
	work_string := get_info(language_element, 'lse$quoting_char');
	IF work_string = ''
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	copy_text ('SET LANGUAGE QUOTES "');
	i := 1;
	loop
	    exitif i > length(work_string);
	    if substr(work_string, i, 1) = '"'
	    then
		COPY_TEXT('""');
	    else
		COPY_TEXT(substr(work_string, i, 1));
	    endif;
	    i := i + 1;
	endloop;
	lse$copy_line('"');

	! ESCAPES
	!
	if get_info(language_element, 'lse$quoting_escape_char') = ''
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line('SET LANGUAGE ESCAPES "' + 
		      get_info(language_element, 'lse$quoting_escape_char') +
		      '"' );

	! LEFT MARGIN
	!
	IF get_info(language_element, 'lse$left_margin') = 0
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line('SET LANGUAGE LEFT MARGIN ' + 
	           str(get_info(language_element, 'lse$left_margin')) );

	! RIGHT MARGIN
	!
	IF get_info(language_element, 'lse$right_margin') = 80
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line('SET LANGUAGE RIGHT MARGIN ' +
	              str(get_info(language_element, 'lse$right_margin')) );

	! TAB INCREMENT
	!
	IF get_info(language_element, 'lse$tab_increment') = 4
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line('SET LANGUAGE TAB INCREMENT ' + 
	              str(get_info(language_element, 'lse$tab_increment')) );

	! TAG TERMINATORS
	!
	work_string := get_info(language_element, 'first', lse$tag_terminators);
	if work_string = 0
	then
	    lse$copy_line('    !SET LANGUAGE TAG TERMINATORS [character_string] ADD' );
	endif;	    
	loop
	    exitif work_string = 0;
	    lse$copy_line('    SET LANGUAGE TAG TERMINATORS ' + 
		      lse$$quote_string(work_string) + 
                      ' ADD' );
	    work_string := get_info(language_element, 'next', lse$tag_terminators);
	endloop;

	! HELP PREFIX TOPIC
	!
	if get_info(language_element, 'lse$help_prefix') = ''
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line('SET LANGUAGE HELP TOPIC ' + 
	    	  lse$$quote_string(get_info(language_element, 'lse$help_prefix')) );

	! VERSION STRING
	!
	if get_info(language_element, 'lse$version_string') = ''
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line('SET LANGUAGE VERSION ' + 
 	          lse$$quote_string(get_info(language_element, 'lse$version_string')) );

	! WRAP
	!
	if get_info(language_element, 'lse$wrap') 
	then
	    lse$copy_line( '    SET LANGUAGE WRAP ON' );
	else
	    lse$copy_line( '    !SET LANGUAGE WRAP OFF ' );
	endif;

	! BOOK
	!
!-Hyperhelp
!	work_string := get_info(language_element, 'lse$book');
!	if work_string = ''
!	then
!	    copy_text( def_prefix );
!	else
!	    copy_text( exe_prefix );
!	endif;
!	lse$copy_line('SET LANGUAGE BOOK ' + 
!		      lse$$quote_string(work_string) );
!
	! REFERENCE 
	!
!	if get_info(language_element, 'lse$bookreference') = ''
!	then
!	    copy_text( def_prefix );
!	else
!	    copy_text( exe_prefix );
!	endif;
!	lse$copy_line('SET LANGUAGE REFERENCE ' + 
!	    	  lse$$quote_string(get_info(language_element, 'lse$bookreference')) );
!-Hyperhelp

    [ LSE$PARAMETER_TYPE   ]: 
	eve$message(lse$get_message_text(lse$_nyi, 1, 'EXTRACT PARAMETER'));

    [ LSE$PACKAGE_TYPE     ]: 

	pack_name := ' ' + get_info(language_element, 'lse$name');

	lse$copy_line('NEW PACKAGE' + pack_name);

	! HELP LIBRARY
	! 
	temp := get_info(language_element, 'lse$help_library');
	if temp = ""
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line("SET PACKAGE HELP LIBRARY " + 
		      lse$$quote_string(temp) );

	! HELP TOPIC
	! 
	temp := get_info(language_element, 'lse$help_prefix');
	if temp = ""
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line('SET PACKAGE HELP TOPIC ' +
		      lse$$quote_string(temp) );
	
	! LANGUAGE
	! 
	temp := get_info(language_element, 'first', lse$language);
	if temp = 0
	then
	    lse$copy_line('    !SET PACKAGE LANGUAGE [defined_language] ADD' );
	endif;
	loop
	    exitif temp = 0;
	    lse$copy_line('    SET PACKAGE LANGUAGE ' + 
                               lse$$quote_string(temp) + ' ADD' );
	    temp := get_info(language_element, 'next', lse$language);
	endloop;

	! ROUTINE EXPAND
	! 
	temp := get_info(language_element, 'lse$routine_exp_prefix');
	if temp = ""
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line('SET PACKAGE ROUTINE EXPAND ' + 
                       lse$$quote_string(temp) );

	! PARAMETER EXPAND
	! 
	temp := get_info(language_element, 'lse$parameter_exp_prefix');
	if temp = ""
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line('SET PACKAGE PARAMETER EXPAND ' + 
                       lse$$quote_string(temp) );

	! BOOK
	! 
!-Hyperhelp
!	temp := get_info(language_element, 'lse$book');
!	if temp = ""
!	then
!	    copy_text( def_prefix );
!	else
!	    copy_text( exe_prefix );
!	endif;
!	lse$copy_line("SET PACKAGE BOOK " + 
!		      lse$$quote_string(temp) );

	! REFERENCE
	! 
!	temp := get_info(language_element, 'lse$bookreference');
!	if temp = ""
!	then
!	    copy_text( def_prefix );
!	else
!	    copy_text( exe_prefix );
!	endif;
!	lse$copy_line('SET PACKAGE REFERENCE ' +
!		      lse$$quote_string(temp) );
!-Hyperhelp
	
    [ LSE$PLACEHOLDER_TYPE ]: 

	lang_name := ' ' + get_info(get_info(language_element, 
                                      'lse$language_type'), 'lse$name');
	lang_elem_name := ' ' + lse$$quote_string(
				    get_info(language_element, 'lse$name'));

	copy_text('NEW PLACEHOLDER' + lang_elem_name );
	case get_info(language_element, 'lse$type')
            [lse$nonterminal] : copy_text(" NONTERMINAL");
	    [lse$terminal]    : copy_text(" TERMINAL");
	    [lse$alias]	      : copy_text(" ALIAS"); 
	    [lse$menu]	      : copy_text(" MENU");
        endcase;
	lse$copy_line( lang_name );

	if get_info(language_element, 'lse$type') = lse$alias
	then
	    work_string := get_info(language_element, 'lse$placeholder');
	    if work_string <> ""
	    then
		! INHERIT
		!
		lse$copy_line("    SET PLACEHOLDER INHERIT " +
			      lse$$quote_string(work_string) );
            endif;
        else
	    ! AUTO_SUBSTITUTE
	    !
	    if get_info(language_element, 'lse$auto_substitute')
	    then
		copy_text( exe_prefix );
	    else
		copy_text( def_prefix );
	    endif;
	    copy_text("SET PLACEHOLDER AUTO SUBSTITUTE ");
	    if get_info(language_element, 'lse$auto_substitute') 
	    then
		lse$copy_line("ON ");
	    else
		lse$copy_line("OFF ");
	    endif;

	    ! DESCRIPTION
	    !
	    work_string := get_info(language_element, 'lse$description');
	    if work_string = ""
	    then
		copy_text( def_prefix );
		lse$copy_line("SET PLACEHOLDER DESCRIPTION [text_string]" );
	    else
		copy_text( exe_prefix );
		lse$copy_line(	"SET PLACEHOLDER DESCRIPTION " + 
				lse$$quote_string(work_string) );
	    endif;

	    ! DUPLICATION
	    !
	    if get_info(language_element, 'lse$duplication') = lse$context_dependent
	    then
		copy_text( def_prefix );
	    else
		copy_text( exe_prefix );
	    endif;
	    lse$copy_text("SET PLACEHOLDER DUPLICATION");
	    case get_info(language_element, 'lse$duplication')
		[lse$context_dependent] : lse$copy_line(' CONTEXT_DEPENDENT '); 
		[lse$horizontal]	: lse$copy_line(' HORIZONTAL ');
		[lse$vertical]		: lse$copy_line(' VERTICAL ');
	    endcase;

	    ! HELP TOPIC
	    !
	    work_string := get_info(language_element, 'lse$help_topic');
	    if work_string = ""
	    then
		copy_text( def_prefix );
		lse$copy_line('SET PLACEHOLDER HELP TOPIC [text_string]' );
	    else
		copy_text( exe_prefix );
		lse$copy_line('SET PLACEHOLDER HELP TOPIC ' + 
			       lse$$quote_string(work_string) );
	    endif;

	    ! PSEUDOCODE
	    if get_info(language_element, 'lse$pseudocode_allowed')
	    then
		copy_text( def_prefix );
	    else
		copy_text( exe_prefix );
	    endif;
	    copy_text("SET PLACEHOLDER PSEUDOCODE ");
	    if get_info(language_element, 'lse$pseudocode_allowed')
	    then
		lse$copy_line("ON ");
	    else
		lse$copy_line("OFF ");
	    endif;

	    ! LEADING
	    work_string := get_info(language_element, 'lse$leading_text');
	    if work_string = ""
	    then
		copy_text( def_prefix );
		lse$copy_line('SET PLACEHOLDER LEADING [text_string]' );
	    else
		copy_text( exe_prefix );
		lse$copy_line('SET PLACEHOLDER LEADING ' +
				lse$$quote_string(work_string) );
	    endif;

	    ! TRAILING
	    work_string := get_info(language_element, 'lse$trailing_text');
	    if work_string = ""
	    then
		copy_text( def_prefix );
		lse$copy_line("SET PLACEHOLDER TRAILING [text_string]" );
	    else
		copy_text( exe_prefix );
		lse$copy_line("SET PLACEHOLDER TRAILING " + 
				lse$$quote_string(work_string));
	    endif;

	    ! SEPARATOR
	    work_string := get_info(language_element, 'lse$separator_text');
	    if work_string = ""
	    then
		copy_text( def_prefix );
		lse$copy_line("SET PLACEHOLDER SEPARATOR [text_string]" );
	    else
		copy_text( exe_prefix );
		lse$copy_line("SET PLACEHOLDER SEPARATOR " +
				lse$$quote_string(work_string) );
	    endif;

	    ! BOOK
	    !
!-Hyperhelp
!	    work_string := get_info(language_element, 'lse$book');
!	    if work_string = ""
!	    then
!		copy_text( def_prefix );
!		lse$copy_line("SET PLACEHOLDER BOOK [File Name]" );
!	    else
!		copy_text( exe_prefix );
!                lse$copy_line('SET PLACEHOLDER BOOK ' + 
!                              lse$$quote_string(work_string) );
!	    endif;

	    ! REFERENCE
	    !
!	    work_string := get_info(language_element, 'lse$bookreference');
!	    if work_string = ""
!	    then
!		copy_text( def_prefix );
!		lse$copy_line("SET PLACEHOLDER REFERENCE [Reference String]" );
!	    else
!		copy_text( exe_prefix );
!                lse$copy_line('SET PLACEHOLDER REFERENCE ' + 
!		          lse$$quote_string(work_string) );
!	    endif;
!-Hyperhelp

	    ! body lines depend on the type of placeholder
	    !
	    case get_info(language_element, 'lse$type')
		[lse$terminal] : 
		    work_string := get_info(language_element, 'first', lse$terminal_text);
		    loop
			exitif work_string = 0;
			copy_text("    SET PLACEHOLDER TERMINAL LINE " +
				  lse$$quote_string(work_string) +
				  " ADD " );
			split_line;
			work_string := get_info(language_element, 'next', lse$terminal_text);
		    endloop;
			
		[lse$nonterminal] :
		    temp := get_info(language_element, 'first', lse$token_line);
		    loop
			exitif temp = 0;
			work_string := get_info(temp, 'lse$lines_string');
			copy_text("    SET PLACEHOLDER BODY LINE "  +
				  lse$$quote_string(work_string));
		        case get_info(temp, 'lse$lines_indent') 
			    [lse$expand] : copy_text(" EXPAND ");
			    [lse$fixed] :  copy_text(" FIXED ");
			    [lse$current] : copy_text(" CURRENT ");
			    [lse$previous]: copy_text(" PREVIOUS ");
			endcase;
			
			copy_text(str(get_info(temp, 'lse$lines_integer')));
			
			case get_info(temp, 'lse$lines_indent_type')
			    [lse$space] : copy_text(" SPACE");
			    [lse$TAB]:	  copy_text(" TAB");
			endcase;

			if get_info(temp, 'lse$same_line')
			then
			    copy_text(" SAME");
			else
			    copy_text(" NEXT");
			endif;

			lse$copy_line(" ADD" );
			temp := get_info(language_element, 'next', lse$token_line);
		    endloop;

                [lse$menu] :
		    temp := get_info(language_element, 'first', lse$menu_entries);
		    loop
			exitif temp = 0;
			work_string := get_info(temp, 'lse$menu_string');
			copy_text("    SET PLACEHOLDER MENU LINE " + 
				  lse$$quote_string(work_string) + ' ');
		        work_string := get_info(temp, 'lse$description');
			copy_text(lse$$quote_string(work_string));

			case get_info(temp, 'lse$placeholder_or_token')
			    [lse$token]:    copy_text(" TOKEN");
			    [lse$placeholder]: copy_text(" PLACEHOLDER");
			    [otherwise]: copy_text(" TEXT");
			endcase;

			if get_info(temp, 'lse$list_delimit')
			then
			    copy_text(" ON");
			else
			    copy_text(" OFF");
			endif;

			lse$copy_line(" ADD" );
			temp := get_info(language_element, 'next', lse$menu_entries);
		    endloop;

            endcase;
	endif;

    [ LSE$ROUTINE_TYPE     ]:
	pack_elem_name := get_info (language_element, 'lse$name');
	pack_name := get_info (	get_info (language_element, 'lse$package_type'), 'lse$name');

        lse$copy_line(fao ('NEW ROUTINE !AS !AS', 
		       pack_elem_name,
		       pack_name));

	! DESCRIPTION
	!
	work_string := get_info (language_element, 'lse$description');
	if work_string = ""
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line( fao ('SET ROUTINE DESCRIPTION "!AS"', work_string));

	! HELP TOPIC
	!
	work_string := get_info (language_element, 'lse$help_topic');
	if work_string = ""
	then
	    copy_text( def_prefix );
	else
	    copy_text( exe_prefix );
	endif;
	lse$copy_line( fao ('SET ROUTINE HELP TOPIC "!AS"', work_string));

	! BOOK
	!
!-Hyperhelp
!	work_string := get_info (language_element, 'lse$book');
!	if work_string = ""
!	then
!	    copy_text( def_prefix );
!	else
!	    copy_text( exe_prefix );
!	endif;
!	lse$copy_line( fao ('SET ROUTINE BOOK "!AS"', work_string));

	! REFERENCE
	!
!	work_string := get_info (language_element, 'lse$bookreference');
!	if work_string = ""
!	then
!	    copy_text( def_prefix );
!	else
!	    copy_text( exe_prefix );
!	endif;
!	lse$copy_line( fao ('SET ROUTINE REFERENCE "!AS"', work_string));
!-Hyperhelp


	! list any parameters and their attributes 
	!
	the_elem := get_info (language_element, 'first', lse$parameter);
	loop
	    exitif the_elem = 0;

	    the_elem_name := get_info (the_elem, 'lse$param_string');
	    copy_text('    SET ROUTINE PARAMETER ' + the_elem_name);
	    
	    if get_info (the_elem, 'lse$required')
	    then
	       copy_text (' REQUIRED ');
	    else
	       copy_text (' OPTIONAL ');
	    endif;

	    case get_info (the_elem, 'lse$mechanism')
		[lse$value]:		copy_text('VALUE ');
		[lse$descriptor]:	copy_text('DESCRIPTOR ');
		[lse$reference]:	copy_text('REFERENCE ');
		[lse$unknown]:		copy_text('UNKNOWN ');
		[otherwise]:		eve$message(lse$_internerr, 0, 
					'lse$extract_pack_lang_elem routine');
	    endcase;

            lse$copy_line(fao ('ADD'));

	    the_elem := get_info (language_element, 'next', lse$parameter);
	endloop;

    [ LSE$TOKEN_TYPE       ]: 
        lang_name := ' ' + get_info( get_info(language_element, 'lse$language_type'), 
                               'lse$name');
	lang_elem_name := ' ' + lse$$quote_string(
				    get_info( language_element, 'lse$name' ));

	copy_text('NEW TOKEN' + lang_elem_name);
	case get_info(language_element, 'lse$type')
            [lse$terminal]  : copy_text(" TERMINAL");
	    [lse$alias]	    : copy_text(" ALIAS"); 
        endcase;
	lse$copy_line( lang_name );

	if get_info(language_element, 'lse$type') = lse$alias
	then
	    ! INHERIT
	    !
	    work_string := get_info(language_element, 'lse$placeholder');
	    if work_string <> "" 
	    then
		lse$copy_line("    SET TOKEN INHERIT " +
			      lse$$quote_string(work_string) );
	    endif;
	else
	    ! DESCRIPTION
	    work_string := get_info(language_element, 'lse$description');
	    if work_string = ""
	    then
		copy_text( def_prefix );
		lse$copy_line("SET TOKEN DESCRIPTION [description]" );
	    else
		copy_text( exe_prefix );
		lse$copy_line("SET TOKEN DESCRIPTION " +
			    lse$$quote_string(work_string));
	    endif;

	    ! HELP TOPIC
	    work_string := get_info(language_element, 'lse$help_topic');
	    if work_string = ""
	    then
		copy_text( def_prefix );
		lse$copy_line("SET TOKEN HELP TOPIC [help_topic]" );
	    else
		copy_text( exe_prefix );
		lse$copy_line("SET TOKEN HELP TOPIC " +
				lse$$quote_string(work_string));
	    endif;

	    ! BOOK
!-Hyperhelp
!	    work_string := get_info(language_element, 'lse$book');
!	    if work_string = ""
!	    then
!		copy_text( def_prefix );
!		lse$copy_line("SET TOKEN BOOK [File Name]" );
!	    else
!		copy_text( exe_prefix );
!		lse$copy_line("SET TOKEN BOOK " +
!				lse$$quote_string(work_string));
!	    endif;

	    ! REFERENCE
!	    work_string := get_info(language_element, 'lse$bookreference');
!	    if work_string = ""
!	    then
!		copy_text( def_prefix );
!		lse$copy_line("SET TOKEN REFERENCE [Reference String]" );
!	    else
!		copy_text( exe_prefix );
!		lse$copy_line("SET TOKEN REFERENCE " +
!				lse$$quote_string(work_string));
!	    endif;
!-Hyperhelp

	    ! BODY LINE
	    temp := get_info(language_element, 'first', lse$token_line);
	    loop
		exitif temp = 0;
		work_string := get_info(temp, 'lse$lines_string');
		copy_text("    SET TOKEN BODY LINE " +
			   lse$$quote_string(work_string));
		case get_info(temp, 'lse$lines_indent') 
		    [lse$expand] : copy_text(" EXPAND ");
		    [lse$fixed] :  copy_text(" FIXED ");
		    [lse$current] : copy_text(" CURRENT ");
		    [lse$previous]: copy_text(" PREVIOUS ");
		endcase;
		
		copy_text(str(get_info(temp, 'lse$lines_integer')));
		
		case get_info(temp, 'lse$lines_indent_type')
		    [lse$space] : copy_text(" SPACE");
		    [lse$TAB]:	  copy_text(" TAB");
		endcase;

                if get_info(temp, 'lse$same_line') 
		then
		    copy_text(" SAME");
		else
		    copy_text(" NEXT");
                endif;

		lse$copy_line(" ADD");
		temp := get_info(language_element, 'next', lse$token_line);
	    endloop;

        endif;

    [ OTHERWISE            ]: return FALSE; ! We don't handle other types

ENDCASE;

split_line;
return TRUE;

endprocedure; !lse$extract_one_lang_element


procedure lse$delete_lang_pack( lang_pack_name, 
				lang_pack_kwd )
!doc_begin
!
! ONE LINE DEFINITION:
!    This function deletes one or more language or package.
!    «TBS»
!
! DESCRIPTION:
!    This function deletes one or more language or package.  Wildcard names are
!    accepted for the language/package name.
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!++
! Parameters:
!
!   lang_pack_name  - Name of language or package to be deleted.
!                     Can contain wildcard.
!
!   lang_pack_kwd   - Keyword indicating language or package type for the
!  		      parameter lang_pack_name. Keyword supported:
!			  LSE$LANGUAGE
!			  LSE$PACKAGE
!
! Return Value:
!
!   True    - Delete operation is successful.
!   False   - Error status of delete operation.
!--
LOCAL
    delete_candidate,
    find_lang_pack_str,
    langpack_match,
    loop_lang_pack,
    loop_lang_pack_name,
    langpack_notdef_msg;

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

    ! Get the associated messages
    ! 
    lse$get_lang_elem_message(lang_pack_kwd, find_lang_pack_str,,,,
                              langpack_notdef_msg,);

    ! Assume no language/package match to start
    ! 
    langpack_match := FALSE;

    ! Check if the language/package given is an exact match
    ! 
    loop_lang_pack := get_info(lse$system, find_lang_pack_str, lang_pack_name);
    if loop_lang_pack = 0
    then
	! Not an exact match. Check if the language/package name is
	! wildcarded. If not, then a match is impossible - error and return.
	!
	if NOT lse$$wildcard_name(lang_pack_name) then
	    eve$message(langpack_notdef_msg, 0, lang_pack_name);
	    return FALSE;
        endif;
    else
	! We have an exact match. Delete and return.
	! 
	lse$delete_one_lang_element(loop_lang_pack, lang_pack_kwd);
	return TRUE;
    endif;

    ! Start looping through all languages/packages
    !
    loop_lang_pack := get_info(LSE$SYSTEM, "first", lang_pack_kwd);
    loop
        exitif loop_lang_pack = 0;
	delete_candidate := loop_lang_pack;
	loop_lang_pack := get_info(LSE$SYSTEM, "next", lang_pack_kwd);

        loop_lang_pack_name := get_info (delete_candidate, 'lse$name');
    
        ! Make sure we have a matching language/package
        !
        if lse$$strmatch_wild (loop_lang_pack_name, lang_pack_name)
        then
	    lse$delete_one_lang_element(delete_candidate, lang_pack_kwd);
	    langpack_match := TRUE;
        endif;
    endloop;

    if NOT langpack_match
    then
	eve$message( langpack_notdef_msg, 0, lang_pack_name );
	return FALSE;
    else
	return TRUE;
    endif;

endprocedure; !lse$delete_lang_pack


procedure lse$delete_lang_pack_elem( lang_pack_elem_name, 
				     lang_elem_kwd, 
                                     lang_pack_name, 
				     lang_pack_kwd )
!doc_begin
!
! ONE LINE DEFINITION:
!    This function deletes one or more language element of a language/package.
!    «TBS»
!
! DESCRIPTION:
!    This function deletes one or more language element(s) of a language or
!    package.  Wildcard names are accepted for the language element name and
!    the language/package name.
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!++
! Parameters:
!
!   lang_pack_elem_name - Name of language element. Can contain wildcard.
!
!   lang_elem_kwd       - Keyword indicating type of language/package element 
!		          Language:
!		             LSE$ALIAS
!			     LSE$ADJUSTMENT
!			     LSE$PLACEHOLDER
!			     LSE$TOKEN
!			  Package:
!			     LSE$ROUTINE
!
!   lang_pack_name      - Name of language or package. Can contain wildcard.
!
!   lang_pack_kwd       - Keyword indicating language or package type for the
!  			  parameter lang_pack_name. Keyword supported:
!			     LSE$LANGUAGE
!			     LSE$PACKAGE
!
! Return Value:
!
!   True    - Delete operation is successful.
!   False   - Error status of delete operation.
!--
LOCAL
    delete_candidate,
    element_match,
    exact_lang_pack_match,
    find_lang_pack_str,
    find_elem_str,
    loop_lang_pack,
    loop_lang_pack_name,
    loop_lang_elem,
    loop_lang_elem_name,
    lang_pack_match,
    langpack_notdef_msg,
    elem_notdef_msg;

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

    ! Get the associated messages
    ! 
    lse$get_lang_elem_message(lang_pack_kwd, find_lang_pack_str,,,,
			      langpack_notdef_msg,);
    lse$get_lang_elem_message(lang_elem_kwd, find_elem_str,,,,
                              elem_notdef_msg,);    

    ! Assume from the start that we haven't found either an element or a
    ! language match
    ! 
    lang_pack_match := FALSE;
    element_match := FALSE;
    exact_lang_pack_match := FALSE;

    ! Check if the language/package given is an exact match
    ! 
    loop_lang_pack := get_info(lse$system, find_lang_pack_str, lang_pack_name);
    if loop_lang_pack = 0
    then
	! It isn't an exact match - check if the language/package name is
	! wildcarded. If not, then a match is impossible - error and return.
	!
	if NOT lse$$wildcard_name(lang_pack_name) then
	    eve$message(langpack_notdef_msg, 0, lang_pack_name);
	    return FALSE;
        endif;

	! Language/Package name is a wildcard, so get the first language out so
	! we can loop through it.
	!
	loop_lang_pack := get_info(LSE$SYSTEM, "first", lang_pack_kwd);
    else
	! An exact match for the language/package was found, mark it so
	!
	exact_lang_pack_match := TRUE;
    endif;

    ! Start looping through all languages/packages
    !
    loop
        exitif loop_lang_pack = 0;
        loop_lang_pack_name := get_info (loop_lang_pack, 'lse$name');
    
        ! Make sure we have a matching language - either a wildcard match or
	! an exact match.
        !
        if lse$$strmatch_wild (loop_lang_pack_name, lang_pack_name) ! if 3
        then
	    lang_pack_match := TRUE;

	    ! Check whether we have an exact match on the element
	    ! 
	    loop_lang_elem := get_info(loop_lang_pack,
                                       find_elem_str,
                                       lang_pack_elem_name);
            if loop_lang_elem <> 0	    ! if 2
	    then
		! We got an exact match on the element - just delete this one
		!
		lse$delete_one_lang_element(loop_lang_elem, lang_elem_kwd);
		element_match := TRUE;
		if lse$$wildcard_name( lang_pack_elem_name )
		then
		    eve$message(lse$_wldchrdel,
				0, 
				SUBSTR( STR( lang_elem_kwd ), 5, 99999 ),
				lang_pack_elem_name ); 
		    return true;
		endif;
            else
		! We didn't get an exact match on the element. Check to see if
		! element name is a wildcarded name. If yes, we have to loop
		! through every element in the language/package
		!
                if lse$$wildcard_name(lang_pack_elem_name) ! if 1
		then 
		    loop_lang_elem := get_info(loop_lang_pack, "first", lang_elem_kwd);
		    loop 
			exitif loop_lang_elem = 0;
			delete_candidate := loop_lang_elem;
			loop_lang_elem := get_info(loop_lang_pack, "next", lang_elem_kwd);

			loop_lang_elem_name := get_info (delete_candidate, 'lse$name');
			! Make sure we have a matching language element before we delete
			! it.
			!
			if lse$$strmatch_wild(loop_lang_elem_name, lang_pack_elem_name)
			then
			    lse$delete_one_lang_element(delete_candidate,
                                                        lang_elem_kwd);
			    element_match := TRUE;
			endif;
		    endloop;	    !loop through all the elements
		endif;		    ! if 1
            endif;		    ! if 2
        endif;			    ! if 3
	exitif exact_lang_pack_match; 
     	loop_lang_pack := get_info(LSE$SYSTEM, "next", lang_pack_kwd);
    endloop;			    ! loop through all the languages/packages

    if NOT lang_pack_match
    then
	eve$message( langpack_notdef_msg, 0, lang_pack_name );
	return FALSE;
    else
	if NOT element_match
        then
            eve$message( elem_notdef_msg, 0, lang_pack_elem_name );
            return FALSE;
        else
            return TRUE;
        endif;
    endif;

endprocedure; !lse$delete_lang_pack_elem


procedure lse$delete_one_lang_element(language_element,
                                      lang_elem_kwd)
!doc_begin
!
! ONE LINE DEFINITION:
!    This function takes a language element object and generates the 
!    extract display for it.
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!++
! Parameters:
!
!   language_element - A language element object
!
! Return Value:
!
!   none
!--
LOCAL
    delete_success,
    unset_flag;
    
ON_ERROR
    [OTHERWISE]:
	lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE,
	                       "lse$delete_one_lang_element" );
ENDON_ERROR;

lse$delete_one_lang_element := FALSE;

! If the current language element happens to be the one to be deleted, reset 
! current language element of the corresponding type to unspecified
!
unset_flag := lse$compare_lang_pack_elem( 
                   lse$get_curr_lang_element(lang_elem_kwd), language_element );

CASE get_info(language_element, 'type')

    [ LSE$ADJUSTMENT_TYPE  ]: 
	delete_success := lse$delete_adjustment(language_element);

    [ LSE$ALIAS_TYPE	   ]: 
	delete_success := lse$delete_alias(language_element);

    [ LSE$LANGUAGE_TYPE    ]: 
	delete_success := lse$delete_language(language_element);

    [ LSE$PACKAGE_TYPE     ]: 
	delete_success := lse$delete_package(language_element);

    [ LSE$PLACEHOLDER_TYPE ]: 
	delete_success := lse$delete_placeholder(language_element);

    [ LSE$ROUTINE_TYPE     ]: 
	delete_success := lse$delete_routine(language_element);

    [ LSE$TOKEN_TYPE       ]: 
	delete_success := lse$delete_token(language_element);

    [ OTHERWISE            ]: return FALSE; ! We don't handle other types

ENDCASE;

if delete_success
then
    if unset_flag
    then
	lse$unset_curr_lang_element(lang_elem_kwd);
    endif;
    lse$delete_one_lang_element := TRUE;
endif;

endprocedure; !lse$delete_one_lang_element


procedure lse$copy_line(copy_string)
!doc_begin
!
! ONE LINE DEFINITION:
!    This function copies a string given at the location of the current 
!    buffer and goes to the next line. 
!    «TBS»
!
! DESCRIPTION:
!    This function copies a string given at the location of the
!    current buffer and goes to the next line. This function is
!    added mostly to enhance readabiliy of code using the tpu
!    copy_text builtin.
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!++ 
! Parameters:
!
!   copy_string - string to be copied to the buffer.
!
! Return Value:
!
!   none
!--
LOCAL
    copy_str;

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

copy_text(copy_string);
split_line;

endprocedure;


procedure lse$is_continuation_line(;the_line)
!
! An LSE command may be entered on one or several lines.
! If the user terminates a line with either hyphen '-' or backslash '\'
! as the last character, the command is "continued" on the next line.
!
! This routine returns TRUE if 'the_line' is continued, and FALSE
! otherwise. If 'the_line' is omitted, the current line in the current
! buffer is read. 
!
!doc_begin
!
! ONE LINE DEFINITION:
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
    ON_ERROR
	[OTHERWISE]:
	    lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$is_continuation_line");
    ENDON_ERROR;

    if the_line = tpu$k_unspecified
    then
	the_line := current_line;
    endif;

    case substr (the_line, length (the_line), 1)    ! Examine last character
    ['-', '\']:
	return TRUE;

    [OTHERWISE]:
	return FALSE;
    endcase;

endprocedure;


procedure lse$checkpoint_buffer(the_buffer)
!
! Checkpoint a buffer.
!
! If the buffer has been modified (since the last time it was written)
! then attempt to write it. Before writing, the following conditions 
! are tested:
! 1) No output or input file - prompt and set (output_file).
! 2) If buffer is set READ_ONLY, confirm before writing out.
! 3) If buffer's file is in a READ_ONLY directory, confirm before writing out.
!
! If the buffer has not been modified, all is well. If it has been modified
! and any of the above conditions are not satisfied, that is an error.
!
! Return the buffer's filename if all is well, or 0 if error.
!
!doc_begin
!
! ONE LINE DEFINITION:
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!
    local
	i,
	write_the_file,
	bufname,
	filespec;

    on_error
    [LSE$_INVFILNAM,
     TPU$_CLOSEOUT,
     TPU$_OPENOUT]:
	eve$message (error_text);	
	eve$learn_abort;
	return false;

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

    bufname := get_info (the_buffer, "name");

    ! Buffer must have either an input or output file;
    ! output file takes precedence.

    filespec := get_info (the_buffer, "output_file");
    if filespec = 0
    then
	filespec := get_info (the_buffer, "file_name");
    endif;
    if filespec = ''
    then
	! The buffer has no associated file.  V3.1 behavior is to not
	! checkpoint it.  Return ''.
	!
	return filespec;
    endif;

    ! strip off VMS version number, if any
    filespec := file_parse (filespec, '', '', DEVICE, DIRECTORY, NAME, TYPE);

    ! If the buffer has not been modified, it doesn't need to be written out.
    if get_info (the_buffer, "modified") = TRUE
    then
	write_the_file := TRUE;
    else
	return filespec;
    endif;

    ! If buffer is set READ_ONLY, ask for confirmation.
    if get_info (the_buffer, "lse$read_only") = TRUE
    then
	eve$message (lse$_bufname, 0, bufname);
	if not lse$prompt_boolean (tpu$k_unspecified,
			           write_the_file,
				   lse$_readwrite,,
				   lse$_wrfilrddirdef)
	then
	    return 0;	! user aborted the prompt
	endif;
    endif;

    ! If file is in a READ_ONLY directory, ask for confirmation.
    if write_the_file and lse$is_read_only_directory(filespec)
    then
	eve$message (lse$_bufname, 0, bufname);
	if not lse$prompt_boolean (tpu$k_unspecified,
			           write_the_file,
			           lse$_writereaddir,,
			           lse$_wrfilrddirdef)
	then
	    return 0;	! user aborted the prompt
	endif;
    endif;

    if write_the_file
    then
	lse$renumber_buffer(the_buffer);
	lse$write_file(the_buffer, filespec);
	return filespec;
    else
	return 0;  ! should have been written, but wasn't
    endif;

endprocedure;


procedure lse$save_visible_selected (;file_spec)
!
!doc_begin
!
! ONE LINE DEFINITION:
!    Writes the visible contents in the selected range to a 
!    file.    
!
! DESCRIPTION:
!    Visible contents are those source lines that are
!    not compressed by the COLLAPSE command.
!
! RELATED COMMANDS:
!    WRITE FILE
!    WRITE SELECTED 
!    WRITE VISIBLE FILE
!
! CATEGORY:
!    Text
!
!doc_end
!

LOCAL the_file_spec, the_range;

ON_ERROR
    [TPU$_OPENOUT]:
        ! Before changing, see comment in lse_save_file, [TPU$_OPENOUT].
	eve$message (error_text);	
	lse$post_command_proc;
	eve$learn_abort;
	return false;

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

!
! Get the current select range
!
the_range := eve$selection 
		   (true,	! Report messages
		    false,	! Don't use found range
		    false,	! Don't use global select
		    false,	! Don't extend null range to single character
		    false);	! Don't cancel the selection

!
! Errors have already been reported if there is no range
!
if get_info (the_range, 'type') <> range
then     return false;
endif;

!
! Get the file name to be written to.  This is required and cannot default.
!
if not lse$prompt_string ( file_spec, the_file_spec,
		           lse$_setbufofnprompt,
	                   eve$_nofilespec)
then     return false;
endif;

!
! Write the file and take the error handler out if problems.  Note that the
! following builtin returns the output file specification and not a status.
!
lse$write_visible (the_range, the_file_spec);

!
! Cancel the selection and do post command processing
!
return lse_delete_selection_mark;
endprocedure;

procedure lse$begin_line_include_file (;file_spec)

!doc_begin
!
! ONE LINE DEFINITION:
!    Inserts the contents of a file into a buffer.
!
! DESCRIPTION:
!    LSE inserts the file before the line containing the current position
!    in the receiving buffer.  If the buffer does not contain text, the
!    cursor is positioned at the end of the buffer.
!    This command uses the list of directories
!    set by the SET DIRECTORY SOURCE command if you do not specify a
!    directory in the file specification.
!    
! RELATED COMMANDS:
!    INCLUDE
!     
! CATEGORY:
!    File
!
!doc_end
!

LOCAL the_file_spec;

!
! By not putting anything in the error clause, TPU displays the message and
! any additional RMS information available.
!
ON_ERROR
    [TPU$_OPENIN,
     TPU$_CONTROLC,
     LSE$_COMMANDCANCEL,
     LSE$_FILEOPENFAIL]:
	eve$message (error_text);	
	eve$learn_abort;
	lse$post_command_proc;
	return false;

    [TPU$_NOTMODIFIABLE,
     LSE$_UNMODIFIABLE]:
        eve$message(ERROR_TEXT);
	eve$learn_abort;
	lse$post_command_proc;
	return false;

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

!
! Get the file name to be included.  This is required and cannot default.
!
if not lse$prompt_existing_file (file_spec, the_file_spec, 
				 lse$_filenameprompt,
				 eve$_nofilespec,
			         tpu$k_unspecified,	! Default value
				 'READ FILE',		! DECwindows title
				 '*.*',			! Files to display
				 'READ FILE !AS')	! Asynchronous command
then     return false;
endif;

!
! Call the read_file builtin
!
lse$read_file (the_file_spec);
lse$$save_inserted_text;

return true;
endprocedure;

procedure lse$call (;procedure_name, param_string)
!
!
!doc_begin
!
! ONE LINE DEFINITION:
!    Calls the indicated TPU procedure.
!
! RELATED COMMANDS:
!    TPU
!
! CATEGORY:
!    Tailor
!
!doc_end
!
local
    proc_string,
    tpu_procedure;

on_error
     [OTHERWISE]:
        lse$$enable_undo_calls ();
        lse$$reset_all_undo_bufs;
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse_call ");
endon_error;

if NOT lse$prompt_string(  procedure_name,
			   proc_string,
			   lse$_procnamprompt,
			   '',
			   lse$get_message_text( lse$_procnamdef ) )
then
     return FALSE;
endif;

tpu_procedure := proc_string;

if not get_info (PROCEDURES, "defined", proc_string)
then 
     eve$message(message_text(tpu$_undefinedproc), 0, proc_string, '');
     return FALSE;
endif;

if get_info (PROCEDURES,"minimum_parameters", proc_string) > 1
then
     eve$message (lse$_morethanonearg);
     return FALSE;
endif;

if get_info (PROCEDURES,"maximum_parameters", proc_string) = 0
then
    if param_string <> tpu$k_unspecified
    then
	if (get_info (param_string, 'type') <> STRING) OR (param_string <> '') 
        then
             eve$message(message_text(tpu$_toomany), 0, proc_string, '');
	     return FALSE;
	endif;
    endif;
endif;

if (param_string <> '')  AND (param_string <> tpu$k_unspecified)
then
    if index (param_string, '"') <> 0
    then tpu_procedure := proc_string + " ( '" + param_string +"' )"; 
    else tpu_procedure := proc_string + ' ( "' + param_string +'" )'; 
    endif;
endif;

lse$$disable_undo_calls ();
execute(tpu_procedure);
lse$$enable_undo_calls ();
lse$$reset_all_undo_bufs;

!
!   Since a TPU command just got executed, the UNDO buffers may be in an
!   unknown state, so just let the user know that no UNDOes will be possible
!   at this point
!
!removed in 4.4-2    EVE$MESSAGE (lse$_resetallundobufs);

return TRUE;

endprocedure;

procedure lse$$quote_char(the_string)

! this routine returns the correct character to quote a string - 
! double quotes if the string contains no double quotes, single quotes
! otherwise, or if no quotes are needed (ie: the string contains no
! white space and is all upper case) then it returns a null_string.
!doc_begin
!
! ONE LINE DEFINITION:
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!

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

    if NOT index(the_string, '"') 
    then 
	lse$$quote_char := '"';
    else
	lse$$quote_char := "'";
    endif;
 
endprocedure; ! lse$$quote_char

procedure lse$$quote_string(the_string)
! this procedure returns a string which is quoted if necessary (ie: it
! contains white space or quote characters or lower case letters.

    local
	parsed_string,
	unparsed_string,
	quote_pos,
	quote_char,
	new_string;

    new_string := the_string;
    change_case(new_string, UPPER);

    if (NOT (new_string = the_string)) or
       (index(the_string, ' ') <> 0) or
       (index(the_string, '	') <> 0) or
       (index(the_string, '"') <> 0) or
       (index(the_string, "'") <> 0) or
       (index(the_string, "!") <> 0) or
       (substr(the_string, length(the_string), 1) = "-") or
       (the_string = '')
    then
	! Check to see if the string contains any double quote
	!
	new_string := the_string;
	quote_pos := index(the_string, '"');
	if quote_pos <> 0
	then
	    ! If double quotes are found, we search the whole string and put in
	    ! double double quotes for each double quote
	    !
	    unparsed_string := the_string;
	    new_string := '';
	    loop
		exitif quote_pos = 0;
		parsed_string := substr(unparsed_string, 1, quote_pos) + '"';
		unparsed_string := substr(unparsed_string, quote_pos+1, 
					  length(unparsed_string)-quote_pos);
		new_string := new_string + parsed_string; 
		quote_pos := index(unparsed_string, '"');
	    endloop;
	    new_string := new_string + unparsed_string; 
	endif;

       lse$$quote_string := '"' + new_string + '"';
   else
       lse$$quote_string := the_string;
   endif;

endprocedure; ! lse$$quote_string

procedure lse$$wildcard_name (pattern_string)
! This routine returns true if the pattern string contains a wildcard
! character (% or *), false otherwise
!doc_begin
!
! ONE LINE DEFINITION:
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!
ON_ERROR
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "wildcard_name");
ENDON_ERROR;

if (index(pattern_string, '*')) <> 0 OR
   (index(pattern_string, '%')) <> 0 
then
    return TRUE;
else
    return FALSE;
endif;

endprocedure; !lse$$wildcard_name


procedure lse$help_text (file_name, topic, prompt, result_buffer)
!
! This procedure is used on the MIPS/ULTRIX platform instead of the HELP_TEXT
! builtin.  It actually reads and searches a .HLP file for the frames.  The
! parameters to the procedure are the same as the HELP_TEXT builtin.
!
!doc_begin
!
! ONE LINE DEFINITION:
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! EXAMPLE:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!
local
     help_file_ext,
     help_buffer_name,
     help_file_name,
     the_help_buffer,
     token_array,
     max_topic_depth,
     found_file,
     s_range,
     i;

ON_ERROR

[TPU$_PARSEFAIL,	! User filespec has syntax error
 TPU$_OPENIN,	! Help library file not found
 TPU$_READERR]:	! Error reading library file
    eve$$release_scratch_buffer;
    lse$$x_help_message_text := fao (lse$get_message_text(error), help_file_name);
    lse$$pop_position;
    return FALSE;

[OTHERWISE]:
    eve$$release_scratch_buffer;
    lse$$pop_position;
    lse$$unexpected_error(ERROR, ERROR_TEXT, ERROR_LINE, "lse$help_text");

ENDON_ERROR;

lse$$push_position;		! remember original position

if not eve$x_ultrix_active
then
    eve$$reserve_scratch_buffer;

    ! Use file_search to get the real name of the file (no logicals)
    !
    help_file_name := file_name;			! initialize

    found_file     := file_search ('');	                ! init search
    found_file     := file_search (file_name, '', ".hlp");

    ! Use file_parse to examine file's extension
    !
    help_file_ext := edit (file_parse (found_file, '', '', type), UPPER, TRIM);

    ! If the file is not found let the HELP_TEXT builtin try.
    ! Since HELP_TEXT erases its result buffer each time, 
    ! we have it write to the scratch buffer first. This
    ! allows clients to accumulate results from multiple calls 
    ! (see LSE_HELP_INDICATED).
    !
    case help_file_ext
    [".",	    ! no file found
     ".HLB"]:	    ! found a VMS (binary) help library

	! Let the builtin translate the original file name,
	! just like it always has.
	!
	position (eve$$x_scratch_buffer);
	help_text (help_file_name, topic, prompt, current_buffer);

	! The TPU help_text builtin does not return a status
	! or signal to indicate "topic not found".
	!
	! If no topics were matched, current_buffer will contain 
	! the 'sorrynohelp' message. If it is present, erase the 
	! buffer and leave our own error message there.
	!
	position (BUFFER_BEGIN);
        s_range := search_quietly (LINE_BEGIN + span (' ') + lse$get_message_text(lse$_sorrynohelp), FORWARD);
	if s_range = 0
	then
	    lse$help_text := TRUE;
	else
	    ! get rid of the garbage that help_text () barfs out.
	    !
	    erase (current_buffer);
	    lse$$x_help_message_text := lse$get_message_text(lse$_nohelpavail);
	    lse$help_text := FALSE;
	endif;

	position (result_buffer);
	copy_text (eve$$x_scratch_buffer);
	eve$$release_scratch_buffer;
	lse$$pop_position;
	return;

    [OTHERWISE]:
	! Can't use the help_text builtin.
	!
	! Will be using the TPU algorithm below.
	! This name should be pointing at an .HLP file.
	!
	help_file_name := found_file;
    endcase;

    eve$$release_scratch_buffer;

else    ! Find help library on ULTRIX

    ! First look in user's current directory
    !
    help_file_name := file_parse (file_name, '', ".hlp", NAME, TYPE);

    found_file := file_search ('');		  ! init file search
    found_file := file_search (help_file_name);	  ! look for file

    ! If nothing found, attempt to open the file we were given. 
    ! Reason is that on ULTRIX the file may contain environment 
    ! variables that file_search doesn't resolve. 
    !
    if found_file = ''
    then
	help_file_name := file_name;
    else
	help_file_name := found_file;
    endif;

endif;


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!        HELP_TEXT builtin can't be used.
!             Run this TPU algorithm.
!
! help_file_name is pointing to the .HLP help library to use.
! Re-use our buffer if it exists, otherwise create. 
! If getting help on a different library, 
! erase buffer and read in new file.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

help_buffer_name := eve$x_buf_str_help + "_LIBRARY_FILE";
the_help_buffer  := lse$find_buffer(help_buffer_name);

! Create a system buffer to hold help file
!
if the_help_buffer = 0
then
    the_help_buffer := eve$init_buffer(help_buffer_name, eve$x_null);
endif;

! Now the buffer exists.
! Does it contain the desired library?
!
position (the_help_buffer);   
if help_file_name <> get_info (the_help_buffer, 'output_file')
then
    eve$message (lse$_gethelplib);
    set (modifiable, the_help_buffer, on);
    erase (current_buffer);	    
    read_file (help_file_name);          ! read help into buffer
    set (output_file, current_buffer, help_file_name);
    position (BUFFER_BEGIN);
    lse$$build_help_index;
    set (modifiable, the_help_buffer, off);
endif;

! Buffer now contains the desired help library.

! Tokenize the help frame into up to 9 topics.  
! Tokens not present are set to a null string.
!
max_topic_depth       := 9;

eve$$x_command_line   := topic;
eve$$x_command_length := length (eve$$x_command_line);
eve$$x_command_index  := 1;

i := 1;
token_array := create_array (max_topic_depth);
loop
    exitif i > max_topic_depth;
    token_array{i} := edit (eve$$get_token, UPPER);
    exitif token_array{i} = '';
    i := i + 1;
endloop;

! Search through topics in current_buffer and 
! place all matched in the result buffer.
!
! If none matched, place the 'no help available' message there.
!
if lse$$match_topics (token_array, result_buffer) = TRUE
then
    lse$help_text := TRUE;
else
    lse$$x_help_message_text := lse$get_message_text(lse$_nohelpavail);
    lse$help_text := FALSE;
endif;

lse$$pop_position;
return;

endprocedure;	! lse$help_text



! 
! Format an error or informational message and put it in HELP's SHOW buffer. 
! They go in there so lse$help_text will never return an EMPTY buffer.
! This is important because some procedures (notably eve$draw_keypad)
! do some "post-processing" on the buffer.
!
procedure lse$$help_message(the_buffer, the_string)
    on_error
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$help_message");
    endon_error;

    position (the_buffer);
    split_line;
    copy_text (edit (substr (the_string, 1, 1), UPPER) + substr (the_string, 2));
    split_line;
endprocedure;


procedure lse$$build_help_index
!
! This routine finds all topic lines in a .HLP file,
! marks them, and puts the marks into an array.
! For information on the HLP-file format, refer to
! the VMS LIBRARIAN manual.
!

    local
	the_range,		    ! search-result range
	i;			    ! topic counter

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

    lse$$x_topic_level  := create_array (500);   ! Pre-allocate for 500 topics;
    lse$$x_topic_string := create_array (500);	 ! TPU will dynamically allocate
    lse$$x_topic_line   := create_array (500);	 ! if more are needed.
    i := 0;					 ! index of current topic

    ! Build array of all topics
    !
    loop
	the_range := search_quietly (any ("123456789") + " ", FORWARD);
	exitif the_range = 0;
	position (the_range);

	! only pay attention to matches at LINE_BEGIN
	!
	if current_offset = 0	
	then
	    i := i + 1;
	    lse$$x_topic_level{i}  := int (current_character);
	    lse$$x_topic_string{i} := edit (substr (current_line, 3), UPPER, TRIM, OFF);
	    lse$$x_topic_line{i}   := get_info (current_buffer, "record_number");
	endif;
	position (LINE_BEGIN);
	move_vertical (1);
    endloop;

    ! Create an "end-of-buffer" topic. We need to append a blank line
    ! in order to delimit the last topic properly (see lse$$match_topics).
    !
    position (BUFFER_END);
    split_line;
    i := i + 1;
    lse$$x_topic_level{i}  := 0;    ! signal no-more-topics
    lse$$x_topic_string{i} := "";
    lse$$x_topic_line{i}   := get_info (current_buffer, "record_count") + 1;

endprocedure;	! lse$build_help_index


procedure lse$$match_topics (token_array, result_buffer)
!
! This is the real worker routine for LSE_HELP and LSE_HELP_INDICATED.
!
! It searches the array built by lse$$build_help_index. All matching
! topics are formatted and placed in the result_buffer.
!    * Tokens in the token_array are assumed to be uppercase.
!    * Current buffer is assumed to be the desired help-file buffer.
!    * Tokens may include a leading wildcard ('*'), trailing wildcard,
!      or both. 
!
! If a token does not have any wildcards, only the LAST successful match
! will be displayed; if more than one topic is matched, the previous ones
! will be "superceded" (i.e., erased). This is done in order to be compatible
! with the VMS librarian.
!
    local
        pad_string,
	rcount,
	token,
	topic_begin,
	topic_level,
	current_level,
	result_range,
        result_string,
	found_one,
	done,
	i;

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

    position (BUFFER_BEGIN);
    eve$$reserve_scratch_buffer;

    i         := 1;	    ! topic index counter
    found_one := FALSE;	    ! TRUE if at least one match was found
    done      := FALSE;	    ! TRUE when matching is complete

    loop
	! Begin. Search for a top-level topic.
	!
	current_level := 1;
	token         := token_array{1};
	lse$$set_match_mode(token);
	erase (eve$$x_scratch_buffer);

	loop
	    topic_level := lse$$x_topic_level{i};

	    if topic_level = 0
	    then
		done := TRUE;
		exitif;
	    endif;		
	    
	    ! If true, there is no match in this subtree;
	    ! try another one.
	    !
	    exitif topic_level < current_level;

	    ! Levels must be the same to even consider a match.
	    !
	    if topic_level = current_level
	    then
	        ! Does the token match the topic?
		! Test for a match depends on the match_mode.
		!
		if lse$$topic_matches_token(lse$$x_topic_string{i}, token)
		then
		    ! We got a match at this level; go to next level
		    !
		    current_level := current_level + 1;
		    token         := token_array{current_level};
		    lse$$set_match_mode(token);

		    ! Write topic pathfinder to scratch
		    !
		    position (lse$$x_topic_line{i});
		    result_string := substr (current_line, 3);
		    lse$$push_position;
		    position (eve$$x_scratch_buffer);
		    split_line;
		    copy_text (('  ' * (current_level-2)) + result_string);
		    split_line;
		    lse$$pop_position;

		    ! If no more tokens to match, found a topic!
		    !
		    if token = ''
		    then
			! Delimit the desired help text. Do this little
			! "dance" to edit out the topic tag lines.
			!
			move_vertical (1);
			topic_begin := mark (NONE);
			position (lse$$x_topic_line{i+1});
			move_horizontal (-1);
			result_range := create_range (topic_begin, mark (NONE));

			! Output help topic matched. 
			!
			lse$$push_position;
			position (result_buffer);

			! If true, more than one topic has been matched.
			! separate topics with a form-feed.
			!
			if found_one 
			then
			    copy_text (ascii (12));
			    split_line;

			    !don't print this.
			    !copy_text (lse$get_message_text(lse$_separatorline));

			    ! If mode = 0, "supercede" any previous match.
			    !
			    if (lse$$x_match_mode = 0)
			    then
				erase (current_buffer);
			    endif;
			endif;

			copy_text (eve$$x_scratch_buffer);  ! copy pathfinder
			position (eve$$x_scratch_buffer);
			erase (current_buffer);
			copy_text (result_range);	    ! copy help text
		    
			! Indent help text to proper level
			!
			pad_string := '  ' * (current_level - 1);
			rcount     := get_info (current_buffer, "record_count");
			position (BUFFER_BEGIN);
			loop
			    exitif get_info (current_buffer, "record_number") > rcount;
			    copy_text (pad_string);
			    position (LINE_BEGIN);
			    move_vertical (1);
			endloop;

			position (result_buffer);
			copy_text (eve$$x_scratch_buffer);  ! copy indented help text
			lse$$pop_position;

			! Otherwise, just break out of inner loop and
			! search remaining topics, starting from first token.
			!
			found_one := TRUE;
			exitif;
		    endif;
		endif;
	    endif;
	    exitif done = TRUE;
	    i := i + 1;	          ! next topic line
	endloop;
	exitif done = TRUE;
	i := i + 1;	          ! next topic line
    endloop;

    ! Matching is complete; clean up and return.
    !
    eve$$release_scratch_buffer;

    return found_one;

endprocedure;	! lse$$match_topics


procedure lse$$set_match_mode (token)
!
! For each token, determine position of any wildcards;
! this will determine what constitutes a topic "match".
!
!  MODE  TOKEN
!   0     x    Match first topic that begins with 'x'.
!   1    *x    Match all topics that end with 'x'.
!   2     x*   Match all topics that begin with 'x'.
!   3    *x*   Match all topics that contain 'x'.
!   4     *    Match all.
!
    on_error
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$set_match_mode");
    endon_error;

    if token = ''	! Null token doesn't change match-mode
    then
	return;
    endif;

    if token = '*'	! Match all
    then
	lse$$x_match_mode := 4;
	return;
    endif;

    if substr (token, 1, 1) = '*'
    then
	if substr (token, length (token), 1) = '*'
	then
            token := substr (token, 2, length (token)-2);  ! remove leading and trailing '*'
	    lse$$x_match_mode := 3;
	else
	    token := substr (token, 2);			   ! remove leading '*'
	    lse$$x_match_mode := 1;
	endif;
    else
	if substr (token, length (token), 1) = '*'
	then
	    token := substr (token, 1, length (token)-1);  ! remove trailing '*'
	    lse$$x_match_mode := 2;
	else
	    lse$$x_match_mode := 0;			   ! no change
	endif;
    endif;	

endprocedure;


procedure lse$$topic_matches_token(topic, token)
!
! Compare topic-string to token-string. The test for
! a "match" depends on the current match_mode.
!
    on_error
    [OTHERWISE]:
        lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$topic_matches_token");
    endon_error;

    case lse$$x_match_mode
    [4]:
        return TRUE;
    [0,2]:
	if index (topic, token) = 1
	then
	    return TRUE;
	endif;
    [1]:
	if substr (topic, index (topic, token)) = token
	then
	    return TRUE;
	endif;
    [3]:
	if index (topic, token) > 0
	then
	    return TRUE;
	endif;
    endcase;

    return FALSE;

endprocedure;


procedure lse$$first_lang_routine 
!
! DESCRIPTION:
!   lse$$first_lang_routine returns the first routine entry within the current
!   language. Routines within a language are routines defined within all the
!   packages associated with the language. This procedure will then return the
!   first routine within the first package associated with the current language.
!
!doc_begin
!
! ONE LINE DEFINITION:
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!
local
    curr_lang,
    the_routine;

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

curr_lang := lse$get_curr_lang_element(LSE$LANGUAGE);
lse$$x_curr_rout_package := get_info( curr_lang, 'first', LSE$PACKAGE);

loop
    exitif lse$$x_curr_rout_package = 0;
    the_routine := get_info(lse$$x_curr_rout_package, 'first', LSE$ROUTINE);
    if the_routine <> 0
    then
	RETURN the_routine;
    endif;
    lse$$x_curr_rout_package := get_info( curr_lang, 'next', LSE$PACKAGE);
endloop;

! We can't find any more packages in the language, therefore no more routine.
!
RETURN FALSE;

endprocedure;


procedure lse$$next_lang_routine 
!
! DESCRIPTION:
!   lse$$next_lang_routine returns the next routine entry within a language. If
!   no language is input, the language associated with the current buffer is
!   used.
!
!doc_begin
!
! ONE LINE DEFINITION:
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!
local
    curr_lang,
    the_routine;

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

! Return if there's no current package within the language whose current
! routine we are going to find.
! 
if get_info(lse$$x_curr_rout_package, 'type') <> LSE$PACKAGE_TYPE
then
    RETURN FALSE;
endif;    

the_routine := get_info(lse$$x_curr_rout_package, 'next', LSE$ROUTINE);
if the_routine <> 0
then
    RETURN the_routine;
endif;

! We can't find any more routine in the current package associated with the
! current language. Try the next package.
!
curr_lang := lse$get_curr_lang_element(LSE$LANGUAGE);
lse$$x_curr_rout_package := get_info( curr_lang, 'next', LSE$PACKAGE);
loop
    exitif lse$$x_curr_rout_package = 0;
    the_routine := get_info(lse$$x_curr_rout_package, 'first', LSE$ROUTINE);
    if the_routine <> 0
    then
	RETURN the_routine;
    endif;
    lse$$x_curr_rout_package := get_info( curr_lang, 'next', LSE$PACKAGE);
endloop;

! We can't find any more packages in the language, therefore no more routine.
!
RETURN FALSE;

endprocedure;


procedure lse$$find_lang_routine( defined_routine )
!
! DESCRIPTION:
!   lse$$find_lang_routine returns a routine object within the current
!   language given the routine name. 
!
!doc_begin
!
! ONE LINE DEFINITION:
!    «TBS»
!
! DESCRIPTION:
!    «TBS»
!
! RELATED COMMANDS:
!    «TBS»
!
! CATEGORY:
!    «TBS»
!
!doc_end
!
local
    the_routine,
    curr_lang,
    curr_routine,
    curr_routine_name;

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

the_routine := edit(defined_routine, TRIM, UPPER);
curr_lang := lse$get_curr_lang_element(LSE$LANGUAGE);
lse$$x_curr_rout_package := get_info( curr_lang, 'first', LSE$PACKAGE);

loop
    exitif lse$$x_curr_rout_package = 0;
    curr_routine := get_info(lse$$x_curr_rout_package, 'first', LSE$ROUTINE);
    loop
	exitif curr_routine = 0;
	if get_info(curr_routine,'lse$name') = the_routine
	then
	    RETURN curr_routine;
	endif;
	curr_routine := get_info(lse$$x_curr_rout_package, 'next', LSE$ROUTINE);
    endloop;
    lse$$x_curr_rout_package := get_info( curr_lang, 'next', LSE$PACKAGE);
endloop;

! We can't find the routine in any of the packages in the language
!
RETURN FALSE;

endprocedure;

procedure lse$$gs_position

! Position in the current buffer using the PROMARY selection's line and column
!
local
    rec_num,
    col_num;

    !
    ! Get line and column number and move to there if we get them
    !
    rec_num := 1;
    col_num := 1;
	    
    lse$$get_global_select( "LINE_NUMBER" );
    if  get_info( lse$$global_select_return, "type" ) = ARRAY
    then
	rec_num := lse$$global_select_span1 + 1;
	lse$$get_global_select( "COLUMN_NUMBER" );
	if  get_info( lse$$global_select_return, "type" ) = ARRAY
	then
	    col_num := lse$$global_select_span1 + 1;
	endif;
    endif;

    !    
    ! Process the positioning in the file
    !
    eve_line (rec_num, '');
    position( LINE_BEGIN );

    if length(create_range(LINE_BEGIN, LINE_END)) < col_num
    then
        position(LINE_END)
    else 
        move_horizontal(col_num-1)
    endif;

    return( TRUE );
    
endprocedure;


!
! If output_buffer is not specified, the output goes to the message buffer
!
procedure lse$$compile_buffer (compile_buffer, compile_command; output_buffer)

    local
	i,
	buffer_ptr_language,
	compsub_str,
	filesub_str,
	the_lang_type,
	output_range,
	the_buffer,     
	bufname,
	filespec,
	the_command,
	compile_output_buffer,
	use_message_buffer,
	completion_message,
	buffer_ptr;

    on_error
    [LSE$_NOREVIEW]:
	! catch and ignore this signal.

    [OTHERWISE]:
	lse$post_command_proc;
        lse$$unexpected_error(ERROR, ERROR_TEXT, ERROR_LINE, "lse$$compile_buffer");
	return FALSE;
    endon_error;
    
    compsub_str  := "$";	        ! compile-command substitution string
    filesub_str  := "'lse$file'";       ! filename substitution string

    ! Buffer must have a language
    the_lang_type := get_info (compile_buffer, "lse$language_type");
    if the_lang_type = tpu$k_unspecified
    then
	eve$message (lse$_nolang);
	lse$post_command_proc;
	return FALSE;
    endif;

    ! Prompt for compile command, according to PARSER PROMPTING
    if lse$prompt_string(compile_command, 
			 the_command,
			 '',,
			 get_info (the_lang_type, "lse$compile_command"))
    then
	if the_command = ''
	then
	    if lse$prompt_string(compile_command, 
				the_command,
				lse$_langcompileprompt,,
				get_info (the_lang_type, "lse$compile_command"))
	    then
		if the_command = ''
		then
		    eve$message (lse$_nodefcompcmd, 0, get_info (the_lang_type, "lse$name"));
		    lse$post_command_proc;
		    return FALSE;
		endif;
	    else
		lse$post_command_proc;
		return FALSE;
	    endif;
	endif;
    else
	lse$post_command_proc;
	return FALSE;
    endif;

    if get_info (lse$system, "lse$save_related_buffers")
    then

	! Go through all of the user buffers, checkpointing each one that
	! has the same language type as the one being compiled.
	!
	buffer_ptr := get_info (buffer, "first");

	loop
	    exitif buffer_ptr = 0;

	    if not get_info (buffer_ptr, "system") then
		if buffer_ptr <> compile_buffer then

		    buffer_ptr_language := get_info (buffer_ptr, "lse$language_type");

		    if buffer_ptr_language = the_lang_type
		    then

			filespec := lse$checkpoint_buffer(buffer_ptr);
			if filespec = 0
			then
			    lse$post_command_proc;
			    return FALSE;
			endif;

		    endif;
		endif;
    
	    endif;

	    buffer_ptr := get_info (buffer, "next");
	endloop;   

    endif;

    filespec := get_info (compile_buffer, "output_file");
    if filespec = 0
    then
	filespec := get_info (compile_buffer, "file_name");
    endif;
    if filespec = ''
    then
	bufname := get_info (compile_buffer, "name");

	eve$message (lse$_bufname, 0, bufname);
	if lse$prompt_string (tpu$k_unspecified, 
			      filespec, 
			      lse$_setbufofnprompt,
			      '',
			      '')
	then
	    if filespec = ''
	    then
		! They didn't provide a file, done!
		!
		eve$message( lse$_invfilnam, 0, '' );
		return false;
	    else
		set (output_file, compile_buffer, filespec);
	    endif;
	else
	    return false;   ! error - needs output file. didn't give one
	endif;    
    endif;

    !
    ! Checkpoint the current buffer and get its file name
    ! Terminate compile command if any errors
    !
    filespec := lse$checkpoint_buffer(compile_buffer);
    if filespec = 0
    then
	lse$post_command_proc;
	return FALSE;
    endif;

    !
    ! If command begins with the compile-substitute string, 
    ! use the default command from the language definition.
    !
    if index (edit (the_command, TRIM_LEADING), compsub_str) = 1
    then
	the_command := get_info (the_lang_type, "lse$compile_command") + 
	               substr (the_command, 1+length (compsub_str));
    endif;

    !
    ! If the file-substitute string is found anywhere,
    ! substitute the file spec of the current buffer.
    !
    ! Use the directives NOT_IN_PLACE and OFF to remove case-sensitivity
    ! from the filesub-string but not from the rest of the command.
    !
    ! If the file-substitute string is NOT found anywhere, just
    ! append the buffer's file spec. In either case add a separating space.
    !
    i := index (edit (the_command, LOWER, NOT_IN_PLACE, OFF), filesub_str);
    if i = 0
    then
	the_command := the_command + ' ' + filespec;
    else
	the_command := substr (the_command, 1, i-1) + ' ' + filespec +
			   substr (the_command, i+length (filesub_str));
    endif;
    
    !
    ! Add the /DIAGNOSTICS qualifier to the command if required
    !
    is_diag := get_info (the_lang_type, "LSE$DIAGNOSTICS");
    IF (is_diag)
    THEN
	the_command := the_command + ' /DIAGNOSTICS=' +
                          get_info (system, "default_directory");
    ENDIF;

    ! Terminate any REVIEW in progress
    lse$close_review;		    

    ! Print the resulting compile command
    eve$message (lse$_compstart, 0, the_command);  

    !
    ! create subprocess if necessary, and send the 
    ! compile command to it. Note that we can't tell
    ! if the compile was successful or not.
    !
    set (lse$compile_state, compile_buffer, 0);
    set (lse$review_state,  compile_buffer, 0);
    if get_info (lse$$x_compile_process, "type") <> PROCESS
    then
	lse$$x_compile_process := create_process (lse$compile_output_buffer);
    endif;

    ERASE (lse$compile_output_buffer);

    send (the_command, lse$$x_compile_process);

    if get_info (output_buffer, "type") <> BUFFER
    then
	use_message_buffer := true;
    else
	use_message_buffer := false;
    endif;

    !
    ! Tell user that the command completed. Note that
    ! if the compilation croaked, the subprocess terminates;
    ! therefore, we can say "please review errors". 
    ! However, if the subprocess survives it does NOT
    ! necessarily mean that the compile succeeded.
    ! (therefore we just give the vague message "command completed")
    ! 
    if get_info (lse$$x_compile_process, "type") = PROCESS
    then
	completion_message := FAO (lse$get_message_text (lse$_lsecompdone), 
				   get_info (compile_buffer, "name"));
    else
	completion_message := lse$get_message_text (lse$_revcomp);
    endif;

    set (lse$compile_state, compile_buffer, 1);

    if use_message_buffer 
    then
	MESSAGE (lse$compile_output_buffer);
	eve$message (completion_message);
    else
	lse$$push_position;
	POSITION (lse$compile_output_buffer);
	output_range := CREATE_RANGE (BUFFER_BEGIN, BUFFER_END);
	POSITION (output_buffer);
	COPY_TEXT (output_range);
	POSITION (BUFFER_END);
	SPLIT_LINE;
	COPY_TEXT (completion_message);
	lse$$pop_position;
    endif;

endprocedure;



!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Global variable declarations
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

variable 
    lse$$expand_result;

! For LSE$$MATCH_TOPICS
!
variable
    lse$$x_match_mode,	    ! indicate wildcard state of token

    lse$$x_topic_level,	    ! for each topic {i} in the help file, 
    lse$$x_topic_string,    ! there is an entry in each of these
    lse$$x_topic_line;	    ! arrays. (conceptually an array-of-struct,
			    ! but this implementation should be faster)
!
! Following global variables are used for the language grammar routines. As the
! grammar modules for the various language elements are created. These should
! reside in the corresponding modules
!
variable 
    lse$$x_curr_adjustment,
    lse$$x_curr_alias,
    lse$$x_curr_language,
    lse$$x_curr_package,     
    lse$$x_curr_parameter,
    lse$$x_curr_param_string,
    lse$$x_curr_placeholder,
    lse$$x_curr_routine,
    lse$$x_curr_rout_package,
    lse$$x_curr_token;