!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubehelp_collect
  use sic_types
  use cubetools_parameters
  use cubetools_structure
  use cubetools_ascii
  use cube_messaging
  !
  public :: collect,cubehelp_collect_command
  private
  !
  type :: collect_comm_t
     type(option_t), pointer :: comm
     type(option_t), pointer :: flags
   contains
     procedure, public  :: register  => cubehelp_collect_register
     procedure, private :: parse     => cubehelp_collect_parse
     procedure, private :: main      => cubehelp_collect_main
  end type collect_comm_t
  type(collect_comm_t) :: collect
  !
  character(len=*), parameter :: collect_file_default='cube.hlp'
  type :: collect_user_t
     character(len=file_l) :: filename
     logical               :: doflags
   contains
     procedure, private :: toprog => cubehelp_collect_user_toprog
  end type collect_user_t
  !
  type :: collect_prog_t
     character(len=file_l) :: filename
     logical               :: doflags
     type(ascii_file_t)    :: file
   contains
     procedure, private :: collect_help  => cubehelp_collect_prog_help
     procedure, private :: collect_flags => cubehelp_collect_prog_flags
     procedure, private :: language      => cubehelp_collect_flags_language
     procedure, private :: command       => cubehelp_collect_flags_command 
     procedure, private :: option        => cubehelp_collect_flags_option  
     procedure, private :: argument      => cubehelp_collect_flags_argument
  end type collect_prog_t
  type(collect_prog_t) :: prog
  !
contains
  !
  subroutine cubehelp_collect_command(line,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(collect_user_t) :: user
    !
    call collect%parse(line,user,error)
    if (error)  return
    call collect%main(user,error)
    if (error)  return
  end subroutine cubehelp_collect_command
  !
  !----------------------------------------------------------------------
  !
  subroutine cubehelp_collect_register(collect,error)
    !---------------------------------------------------------------------
    ! 
    !---------------------------------------------------------------------
    class(collect_comm_t), intent(inout) :: collect
    logical,               intent(inout) :: error
    !
    type(standard_arg_t) :: stdarg
    character(len=*), parameter :: rname='COLLECT>REGISTER'
    !
    call cube_message(seve%t,rname,'Welcome')
    !
    call cubetools_register_command(&
         'COLLECT','',&
         'Collect all the helps in a single file',&
         strg_id,&
         cubehelp_collect_command,&
         collect%comm,error)
    if (error) return
    call stdarg%register( &
         'FILE',  &
         'Output file name', &
         'Output file name (default is "cube.hlp" in the current working directory).',&
         code_arg_optional, &
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'FLAGS','',&
         'collect flags asked by commands instead of the help',&
         strg_id,&
         collect%flags,error)
    if (error) return
    !
  end subroutine cubehelp_collect_register
  !
  subroutine cubehelp_collect_parse(collect,line,user,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(collect_comm_t), intent(in)    :: collect
    character(len=*),      intent(in)    :: line
    type(collect_user_t),  intent(out)   :: user
    logical,               intent(inout) :: error
    !
    user%filename = collect_file_default
    call cubetools_getarg(line,collect%comm,1,user%filename,.not.mandatory,error)
    if (error) return
    !
    call collect%flags%present(line,user%doflags,error)
    if (error) return
  end subroutine cubehelp_collect_parse
  !
  subroutine cubehelp_collect_main(collect,user,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(collect_comm_t), intent(in)    :: collect
    type(collect_user_t),  intent(in)    :: user
    logical,               intent(inout) :: error
    !
    type(collect_prog_t) :: prog
    !
    call user%toprog(prog,error)
    if (error) return
    if (prog%doflags) then
       call prog%collect_flags(error)
       if (error) return
    else
       call prog%collect_help(error)
       if (error)  return
    endif
    !
  end subroutine cubehelp_collect_main
  !
  !----------------------------------------------------------------------
  !
  subroutine cubehelp_collect_user_toprog(user,prog,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(collect_user_t), intent(in)    :: user
    type(collect_prog_t),  intent(out)   :: prog
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname = 'COLLECT>USER>TOPROG'
    !
    prog%doflags = user%doflags
    prog%filename = user%filename
  end subroutine cubehelp_collect_user_toprog
  !
  !----------------------------------------------------------------------
  !
  subroutine cubehelp_collect_prog_help(prog,error)
    use gkernel_interfaces
    use cubetools_messaging
    use cubetools_help
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(collect_prog_t), intent(in)    :: prog
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='COLLECT>HELP'
    !
    call cubetools_help_file_width()
    call cubetools_message_open_help_file(prog%filename,error)
    if (error)  goto 10
    call cubetools_structure_help_iterate(error)
    if (error)  goto 10
10  continue
    call cubetools_message_close_help_file(error)
    if (error)  return
  end subroutine cubehelp_collect_prog_help
  !
  !----------------------------------------------------------------------
  !
  subroutine cubehelp_collect_prog_flags(prog,error)
    use cubetools_language
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(collect_prog_t), intent(inout) :: prog
    logical,               intent(inout) :: error
    !
    integer(kind=lang_k) :: ilang
    type(language_t), pointer :: lang
    character(len=*), parameter :: rname='COLLECT>FLAGS'
    !
    call prog%file%open(prog%filename,'write',error)
    if(error) return
    !
    call prog%file%write_next('List of Flags demanded by commands',error)
    if (error) return 
    call prog%file%write_next('* Package: '//pack%name,error)
    if (error) return 
    !
    do ilang=1,pack%lang%n
       lang => cubetools_language_ptr(pack%lang%list(ilang)%p,error)
       if (error)  return
       call prog%language(lang,error)
       if (error)  return
    enddo
    !
    call prog%file%close(error)
    if (error) return
  end subroutine cubehelp_collect_prog_flags
  !
  subroutine cubehelp_collect_flags_language(prog,lang,error)
    use cubetools_command
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(collect_prog_t), intent(inout) :: prog
    type(language_t),      intent(in)    :: lang
    logical,               intent(inout) :: error
    !
    integer(kind=comm_k) :: icomm
    type(command_t), pointer :: comm
    character(len=*), parameter :: rname='COLLECT>FLAGS>LANGUAGE'
    !
    call prog%file%write_next('** Language: '//lang%name,error)
    if (error) return 
    do icomm=1,lang%comm%n
      comm => cubetools_command_ptr(lang%comm%list(icomm)%p,error)
      if (error)  return
      call prog%command(comm,lang%name,error)
      if (error)  return
    enddo
  end subroutine cubehelp_collect_flags_language
  !
  subroutine cubehelp_collect_flags_command(prog,comm,langname,error)
    use sic_def
    use cubetools_option
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(collect_prog_t), intent(inout) :: prog
    type(command_t),       intent(in)    :: comm
    character(len=*),      intent(in)    :: langname
    logical,               intent(inout) :: error
    !
    character(len=2048) :: outbuffer
    character(len=512) :: optargs
    integer(kind=opti_k) :: iopt
    logical :: opthasflags,commhasflags
    type(option_t), pointer :: opt
    character(len=*), parameter :: rname='COLLECT>FLAGS>COMMAND'
    !
    commhasflags = .false.
    outbuffer = '*** Command '//trim(langname)//backslash//comm%name//strg_cr
    opt => cubetools_option_ptr(comm%opt%list(0)%p,error)
    if (error)  return
    call prog%option(opt,opthasflags,optargs,error)
    if (error)  return
    if (opthasflags) then
       outbuffer = trim(outbuffer)//&
            'Command '//trim(langname)//backslash//trim(comm%name)//' arguments: '//strg_cr//optargs
       commhasflags = .true.
    endif
    do iopt=1,comm%opt%n
       opt => cubetools_option_ptr(comm%opt%list(iopt)%p,error)
       if (error)  return
       call prog%option(opt,opthasflags,optargs,error)
       if (error)  return
       if (opthasflags) then
          outbuffer = trim(outbuffer)//strg_cr//'Option '//trim(comm%name)//&
               ' /'//trim(langname)//backslash//trim(opt%name)//&
               ' arguments: '//strg_cr//optargs
          commhasflags = .true.
       endif
    enddo
    if (commhasflags) then
       call prog%file%write_next(outbuffer,error)
       if (error) return
    endif
  end subroutine cubehelp_collect_flags_command
  !
  subroutine cubehelp_collect_flags_option(prog,opt,hasflags,optargs,error)
    use cubetools_list
    use cubetools_primitive_arg
    use cubeadm_cubeid_types
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(collect_prog_t), intent(inout) :: prog
    type(option_t),        intent(in)    :: opt
    logical,               intent(out)   :: hasflags
    character(len=*),      intent(out)   :: optargs
    logical,               intent(inout) :: error
    !
    integer(kind=narg_k) :: iarg
    character(len=128) :: argflags
    class(tools_object_t), pointer :: arg
    character(len=*), parameter :: rname='COLLECT>FLAGS>OPTION'
    !
    hasflags = .false.
    optargs = ''
    do iarg=1,opt%arg%n
       arg => opt%arg%list(iarg)%p
       select type(arg)
       type is (cubeid_arg_t)
          hasflags = .true.
          call prog%argument(arg,argflags,error)
          if (error)  return
          optargs = trim(optargs)//trim(argflags)//strg_cr
       class default
          ! do nothing
       end select
    enddo
  end subroutine cubehelp_collect_flags_option
  !
  subroutine cubehelp_collect_flags_argument(prog,arg,argflags,error)
    use cubedag_allflags
    use cubeadm_cubeid_types
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(collect_prog_t), intent(inout) :: prog
    type(cubeid_arg_t),    intent(in)    :: arg
    character(len=*),      intent(out)   :: argflags
    logical,               intent(inout) :: error
    !
    integer(kind=4) :: iflag
    character(len=*), parameter :: rname='COLLECT>FLAGS>ARGUMENT'
    !
    write(argflags,'(2a)') trim(arg%name),': '
    do iflag=1,arg%nflag
       if (arg%flag(iflag).eq.flag_any) then
          write(argflags,'(a,a)') trim(argflags),'any'
       else
          write(argflags,'(a,a)') trim(argflags),arg%flag(iflag)%get_name()
       endif
       if (iflag.lt.arg%nflag) write(argflags,'(2a)') trim(argflags),','
    enddo
  end subroutine cubehelp_collect_flags_argument
end module cubehelp_collect
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
