with  system;		      use   system;
with  condition_handling;     use   condition_handling;
with  lbr;		      use   lbr;
with  str;		      use   str;
with  fhelp;		      use   fhelp;

package body forms_help is

    thelp   : fHelp_Type;		  -- temporary forms record
    lcnt    : INTEGER;			  -- temporary line counter
    mcnt    : INTEGER;			  -- max # non blank lines

    spaces  : constant STRING(1..132) := (1..132 => ' ');

    int_com : STRING(1..80) := (1..80 => ' ');
    int_idx : INTEGER := 0;

    status  : lbr.COND_VALUE_TYPE;
    ai_fnd  : BOOLEAN;
    txt_st  : BOOLEAN;
    skp_cnt : INTEGER;			  -- skip number of header lines

    id : INTEGER;			  -- help text indentation
					  -- starting with 5 blanks, increased
					  -- by 2 for each help level

    flags   : constant HLP_TYPE :=	  -- flags for calling LIB$OUTPUT_HELP
	      (PROMPT	=> FALSE,
	      PROCESS	=> TRUE,
	      GROUP	=> TRUE,
	      SYSTEM	=> TRUE,
	      LIBLIST	=> FALSE,
	      HELP	=> TRUE,
	      SPARE1	=> FALSE,
	      SPARE2	=> FALSE,
	      PAGE	=> FALSE,
	      OUTPUT	=> FALSE,
	      LIBRARY	=> FALSE,
	      AL	=> FALSE,
	      PAGEDEF	=> FALSE,
	      PMPTDEF	=> FALSE,
	      NOTTERM	=> FALSE,
	      FILLER_1	=> 0);

pragma TITLE (SubTitle => "String Handling Routines");
pragma PAGE;

    procedure collapse (in_str   : in  STRING;
			out_str  : out STRING;
			out_len  : out INTEGER)   is
      blk_fnd : BOOLEAN;
      i       : INTEGER;
    begin
      out_len := 0;
      blk_fnd := TRUE;			-- so we skip starting blanks
      i       := 0;				-- output pointer
      for k in in_str'range loop
	if in_str(k) = ' ' then
	  if not blk_fnd then
	    i := i + 1;
	    out_str(i) := in_str(k);
	    blk_fnd := TRUE;
	  end if;
	else
	  i := i + 1;
	  out_str(i)  := in_str(k);
	  blk_fnd := FALSE;
	  out_len := i;
	end if;
      end loop;
    end collapse;

    procedure first_blank (in_str   : in  STRING;
			   out_len  : out INTEGER)   is
    begin
      out_len := 0;
      for k in in_str'range loop
	if in_str(k) = ' ' then
	  out_len := k;
	  exit;
        end if;
      end loop;
    end first_blank;

    procedure clear_last (in_str   : in out STRING;
			  out_len  : out INTEGER)   is
      chr_fnd : BOOLEAN;
      i       : INTEGER;
    begin
      out_len := in_str'length;
      chr_fnd := FALSE;
      for k in reverse in_str'range loop
	if in_str(k) = ' ' then
	  if chr_fnd then
	    out_len := k;
	    exit;
	  end if;
	else
	  chr_fnd := TRUE;
	  in_str(k) := ' ';
	end if;
      end loop;
    end clear_last;

    function equal_string (in_str1 : in STRING;
                           in_str2 : in STRING) return BOOLEAN is

      kk  : INTEGER;
      rt  : BOOLEAN;

    begin

      rt := false;

      for ii in in_str1'range loop
	if in_str1(ii) /= ' ' then
	  kk := ii - 1;
	  exit;
	end if;
      end loop;

      if in_str1'length-kk >= in_str2'length then
	if in_str1(kk+1..in_str2'length+kk) = in_str2 then
	  rt := true;
	end if;
      end if;

      return rt;

    end;

pragma TITLE (SubTitle => "Output-Routine needed for LIB$OUTPUT_HELP");
pragma PAGE;

-- This routine not really does any output. The help text line received
-- from LIB$OUTPUT_HELP ist stored in a text array for DECforms. Header
-- lines are ignored.
-- The lines are also searched for the string "Additional information"
-- indicating that subtopics will arrive. These subtopics are then stored
-- in another array for DECforms where they will be treated as icons (=
-- fields with NO DATA INPUT).

    procedure save_help (sav_status : out lbr.COND_VALUE_TYPE;
                         out_line   : in STRING) is

      ml : INTEGER;			  -- for getting minimum string length
      ai : constant STRING := "Additional information";
      cl : INTEGER;			  -- length of collapsed lib string
      cs : STRING(1..out_line'length);	  -- collapsed OUT_LINE
      mc : INTEGER;			  -- count elements in OUT_LINE

      status : str.COND_VALUE_TYPE;


    begin
						-- skip starting blank lines
						-- and key repetition in front
						-- of text or key lines
      if not txt_st then
	if out_line'length > 0 then
	  if skp_cnt > 0 then
	    skp_cnt := skp_cnt - 1;
	  else
	    txt_st := TRUE;
	  end if;
	end if;
      end if;

      if (not ai_fnd) and txt_st then
						-- process normal text lines
						-- remember: LIB$OUTPUT_HELP
						-- lines start with 5 blanks
	if thelp.help_line_cnt < tHelp.help_text'length then
	  lcnt := lcnt + 1;
	  if out_line'length > 0 then
	    if equal_string (out_line, ai) then
	      ai_fnd := TRUE;
	      txt_st := FALSE;
	    end if;
	    if not ai_fnd then
	      if out_line /= spaces(out_line'range) then
		ml := thelp.help_text(1).help_line'length;
		if ml > out_line'length-id then
		  ml := out_line'length-id;
		end if;
		thelp.help_text(lcnt).help_line(1..ml) := out_line(1+id..ml+id);
		mcnt := lcnt;
	      end if;
	    end if;
	  end if;
	end if;

      end if;

      if ai_fnd and txt_st then
						-- process subtopic keywords
	collapse (out_line,cs,cl);
	if cl > 0 then
	  mc := 0;
	  status := str.normal;
	  while status /= UNSIGNED_LONGWORD(str.noelem) loop
	    thelp.help_key_cnt := thelp.help_key_cnt + 1;
	    str.element (STATUS		    => status,
			 DESTINATION_STRING =>
				   thelp.help_keys(thelp.help_key_cnt).help_key,
			 ELEMENT_NUMBER	    => mc,
			 DELIMITER_STRING   => " ",
			 SOURCE_STRING      => cs(1..cl));
	    mc := mc + 1;
	  end loop;
	  thelp.help_key_cnt := thelp.help_key_cnt - 1;
	end if;

      end if;

      sav_status := lbr.normal;			-- tell library routine: it's Ok

    end save_help;

    pragma EXPORT_VALUED_PROCEDURE (INTERNAL => save_help);


pragma TITLE (SUBTITLE => "Main Routine to get Help Text from Library");
pragma PAGE;

-- The function of this routine is to accept the help command string,
-- access the help library pointed to by the logical APPLICATION_HELPLIB,
-- and store the requested help information in the forms record.

  procedure get_help_text (stat  : out INTEGER;
                           fhelp : in out fHelp_Type) is
    in_len : INTEGER;

  begin

    stat    := 0;				-- status for DECforms OK
    ai_fnd  := FALSE;				-- start without additionals
    txt_st  := FALSE;				-- start with no text found

						-- if this is the first call
    if fHelp.Help_Command(1..3) = "%%%" then

      int_com := spaces(int_com'range);		-- clear internal command line
      int_idx := 0;				-- and index
      fHelp.Help_Command(1..fHelp.Help_Command'length-3) :=
                              fHelp.Help_Command(4..fHelp.Help_Command'length);
    end if;

    thelp   := fhelp;				-- copy to internal
    thelp.help_key_cnt  := 0;			-- start with no keys
    thelp.help_line_cnt := 0;			-- and no text lines

						-- start with blank lines and
						-- keys
    for i in thelp.help_text'range loop
      tHelp.help_text(i).help_line :=
				  spaces(tHelp.help_text(1).help_line'range);
    end loop;
    for i in thelp.help_keys'range loop
      tHelp.help_keys(i).help_key :=
				  spaces(tHelp.help_keys(1).help_key'range);
    end loop;

    lcnt := 0;					-- initialize counters
    mcnt := 0;

    str.upcase (STATUS		    => status,
		DESTINATION_STRING  => thelp.help_command,
		SOURCE_STRING	    => thelp.help_command);

					  -- if blank command line delete last
					  -- (sub)topic, else add to existing
					  -- internal command line
    first_blank (tHelp.Help_Command,in_len);
    if in_len <= 1 then
      clear_last (int_com,int_idx);
    else
      int_idx := int_idx + 1;
      int_com(int_idx..int_idx+in_len-1) := tHelp.Help_Command(1..in_len);
      int_idx := int_idx + in_len - 1;
    end if;
    id := 5 + fHelp.Help_Level*2;	  -- set indentation
    skp_cnt := fHelp.Help_Level + 1;	  -- # of header lines to skip

					  -- call library routine to extract
					  -- help text. SAVE_HELP will store
					  -- lines and keywords in arrays of
					  -- forms record
    output_help  (STATUS         => status,
		  OUTPUT_ROUTINE => save_help'address,
		  OUTPUT_WIDTH   => thelp.help_text(1).help_line'length,
		  LINE_DESC      => int_com,
		  LIBRARY_NAME   => "APPLICATION_HELPLIB",
		  FLAGS          => flags);

    if not success(status) then
      stat := 1;
    else
      tHelp.help_line_cnt := mcnt;
      tHelp.help_command := int_com(tHelp.help_command'range);
      fHelp := tHelp;
    end if;

    exception
      when others =>
      	stat := 2;

  end Get_Help_Text;

end forms_help;