/*

/*
** Procedure: confirm
** Source File: confirm.osq
** Description:
**
** Prompts the user to confirm that a potentially dangerous 
** action is to proceed. The prompting is done via the built-
** in frame look_up, which displays a popup like the following:
**
** +-------------------------------------------------------+
** |<question>                                             |
** +-------+-----------------------------------------------+
** |no     |<no>                                           |
** |yes    |<yes>                                          |
** +-------+-----------------------------------------------+
**** <question>, <no>, and <yes> are keyword parameters
** that you supply:
** <question> asks users if they really want to do the
** potentially dangerous action; <no> and <yes> provide
** explanations of the consequences of choosing 'no' or 'yes'.
**
** When the popup is displayed, the cursor is positioned on 'no'.
** The user can choose 'no' at this point by selecting
** 'Select', or choose 'yes' by scrolling down to it or
** hitting 'y' (which positions the cursor on the 'yes') and
** selecting 'Select'.
** The user can also select 'Cancel', which is equivalent to
** choosing 'no', no matter where the cursor is positioned.
**

** When you call this procedure, you can specify an
** explanation (<no> and/or <yes>) that occupies
** more than one line. To do this, embed
** a backslash character ('\') in the explanation at each
** point where a line break is to occur. The popup then
** displays blanks in the "choice" column of each continu-
** ation line. (The "choice" column is the left-hand column,
** which contains 'no' or 'yes' for non-continuation lines).
**
** The look_up frame allows the user to scroll into a 
** continuation line (and "choose" it by selecting 'Select').
** If the user does choose a continuation line, this procedure
** acts as if the 'no' or 'yes' above it had been chosen.
**
** If an explanation is longer than 1000 bytes, it is truncated
** on the right. If a piece of an explanation (delimited by 
** '\') is longer than 50 bytes (the size of the "explanation"
** attribute of the "choice_line" record type), it is .
** truncated on the right. If the question is longer than 57
** bytes, it too is truncated on the right.
**
** Returns:
**       'y' if the user chooses 'yes'.
**       'n' otherwise.
*/

procedure confirm (
  question = varchar(57) not null,
  no = varchar(1000) not null,
  yes = varchar(1000) not null,
) =
declare
  choice_array = array of choice_line,
  choice_index = integer not null,
  yes_index = integer not null,
  array_size = integer not null,
  fill_array = procedure returning integer not null,
begin
  yes_index = 1 + fill_array(starting_at = 1, explanation = no);
  array_size = fill_array(starting_at = yes_index,
    explanation = yes);

  choice_array[1].choice = 'no';
  choice_array[yes_index].choice = 'yes';
 
  choice_index = callframe look_up (
    ii_rows = array_size,
    ii_array = choice_array,
    ii_field1 = 'choice',
    ii_field2 = 'explanation',
    ii_title = question
  );

  /* If the user selected 'yes', look_up returns yes_index.
  ** If the user selected a blank choice below 'yes'
  ** (which represents a continuation of the explanation for
  ** 'yes'), look_up returns a value greater than yes_index.
  **
  ** If the user selected 'no', look_up returns 1.
  ** If the user selected a blank choice below 'no'
  ** (which represents a continuation of the explanation for 
  ** 'no'), look_up returns a value greater than 1 but less
  ** than yes_index.
  **
  ** If the user canceled the look_up operation,
  ** look_up returns 0 or a negative number.
  */
  if (choice_index >= yes_index) then
    return 'y';
  endif;
  return 'n';
end

/*
** Local procedure: fill_array
** Description:
**
** Fills rows of the array choice_array starting at the
** specified row. The "choice" attributes of the filled-in
** rows are set to ''. The "explanation" attributes of the
** filled-in rows are set to pieces of the specified
** explanation. (The pieces are separated by '\').
** As many rows are filled in as there are pieces in the
** specified explanation.
**
** Input parameters:
**    starting_at     the index of the first row to be filled in.
**    explanation     the explanation to be placed into the
**                    filled-in rows.
** Returns:
**    the index of the last row filled in.
*/

procedure fill_array (
  starting_at = integer not null,
  explanation = varchar(1000) not null,
) =
declare
  x = varchar(1000) not null,
  i = integer not null,
  b = integer not null,
 begin
  x = explanation;
  i = starting_at;
  b = locate(x, '\'); /* sets b to 1001 if no '\' found */
  while (b <= 1000) do
    choice_array[i].choice = '';
    choice_array[i].explanation = left(x, b - 1);
    x = right(x, length(x) - b);
    i = i + 1;
    b = locate(x, '\'); 
  /* sets b to 1001 if no '\' found */
  endwhile;
  choice_array[i].choice = '';
  choice_array[i].explanation = x;
  return i;
end