!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubehelp_collect
  use sic_types
  use cubetools_parameters
  use cubetools_structure
  use cubetools_ascii
  use cube_messaging
  !
  public :: collect
  private
  !
  type :: collect_comm_t
     type(option_t),           pointer :: comm
     type(option_t),           pointer :: format
     type(keywordlist_comm_t), pointer :: format_arg
   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_basename_default='cube'
  type :: collect_user_t
     character(len=file_l) :: filename
     character(len=argu_l) :: format
   contains
     procedure, private :: toprog => cubehelp_collect_user_toprog
  end type collect_user_t
  !
  type :: collect_prog_t
     character(len=file_l) :: filename
     integer(kind=code_k)  :: iformat
     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 :: arguments     => cubehelp_collect_flags_arguments
     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
    type(keywordlist_comm_t) :: keyarg
    character(len=*), parameter :: rname='COLLECT>REGISTER'
    !
    call cube_message(seve%t,rname,'Welcome')
    !
    call cubetools_register_command(&
         'COLLECT','[File]',&
         '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
    !
    ! /FORMAT
    call cubetools_register_option(&
         'FORMAT','Kind',&
         'Collect options, arguments, and flags under the named kind',&
         strg_id,&
         collect%format,error)
    if (error) return
    call keyarg%register( &
         'Kind',  &
         'Format kind', &
         'TEX: TeX format for inclusion in LaTeX files'&
         //strg_cr//&
         'FLAGS: ASCII format showing expected flags for command and &
         &option arguments',&
         code_arg_mandatory, &
         help_formats, &
         .not.flexible, &
         collect%format_arg, &
         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_basename_default
    call cubetools_getarg(line,collect%comm,1,user%filename,.not.mandatory,error)
    if (error) return
    !
    user%format = help_formats(help_format_tex)
    call cubetools_getarg(line,collect%format,1,user%format,.not.mandatory,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
    select case (prog%iformat)
    case (help_format_flags)
      call prog%collect_flags(error)
      if (error) return
    case (help_format_tex)
      call prog%collect_help(error)
      if (error) return
    end select
  end subroutine cubehelp_collect_main
  !
  !----------------------------------------------------------------------
  !
  subroutine cubehelp_collect_user_toprog(user,prog,error)
    use gkernel_interfaces
    use cubetools_disambiguate
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(collect_user_t), intent(in)    :: user
    type(collect_prog_t),  intent(out)   :: prog
    logical,               intent(inout) :: error
    !
    character(len=32) :: solved
    character(len=*), parameter :: rname='COLLECT>USER>TOPROG'
    !
    call cubetools_disambiguate_strict(user%format,help_formats,  &
      prog%iformat,solved,error)
    if (error)  return
    !
    call sic_parse_file(user%filename,' ',help_extensions(prog%iformat),prog%filename)
  end subroutine cubehelp_collect_user_toprog
  !
  !----------------------------------------------------------------------
  !
  subroutine cubehelp_collect_prog_help(prog,error)
    use gkernel_interfaces
    use cubetools_help_tool
    use cubetools_terminal_tool
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(collect_prog_t), intent(in)    :: prog
    logical,               intent(inout) :: error
    !
    type(help_tool_t) :: help
    character(len=*), parameter :: rname='COLLECT>HELP'
    !
    call file%set_width() ! Default file width
    call file%set_format(help_format_tex)
    call help%open_file(prog%filename,error)
    if (error) goto 10
    call cubetools_structure_help_iterate(help_format_tex,error)
    if (error) goto 10
10  continue
    call help%close_file(error)
    if (error) return
    call terminal%set_width()  ! Dynamic terminal width
    call terminal%set_format()  ! Specific terminal format
  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'
    !
    ! Note this help format can not use the generic help collector in
    ! libcubesyntax because it needs properties of cubeid_arg_t
    !
    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_standard_comm
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    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_primitive_opt
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    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) :: chain
    integer(kind=opti_k) :: iopt
    class(primitive_opt_t), pointer :: opt
    character(len=*), parameter :: rname='COLLECT>FLAGS>COMMAND'
    !
    outbuffer = '*** Command '//trim(langname)//backslash//trim(comm%name)//strg_cr
    opt => cubetools_primitive_opt_ptr(comm%opt%list(0)%p,error)
    if (error) return
    !
    call prog%option(opt,'Command ',chain,error)
    if (error)  return
    outbuffer = trim(outbuffer)//chain
    !
    do iopt=1,comm%opt%n
       opt => cubetools_primitive_opt_ptr(comm%opt%list(iopt)%p,error)
       if (error) return
       call prog%option(opt,'Option /',chain,error)
       if (error) return
       outbuffer = trim(outbuffer)//chain
    enddo
    !
    call prog%file%write_next(outbuffer,error)
    if (error) return
  end subroutine cubehelp_collect_flags_command
  !
  subroutine cubehelp_collect_flags_option(prog,opt,optkind,chain,error)
    use cubetools_primitive_opt
    !-------------------------------------------------------------------
    !-------------------------------------------------------------------
    class(collect_prog_t),  intent(in)    :: prog
    class(primitive_opt_t), intent(in)    :: opt
    character(len=*),       intent(in)    :: optkind
    character(len=*),       intent(out)   :: chain
    logical,                intent(inout) :: error
    !
    integer(kind=narg_k) :: ncubes
    character(len=256) :: optargs
    !
    call prog%arguments(opt%arg,ncubes,optargs,error)
    if (error) return
    write(chain,'(4a,i0,a,i0,2a)')  &
      '    ',optkind,trim(opt%name),' has ',opt%arg%n,  &
      ' arguments (',ncubes
    if (ncubes.eq.0) then
      chain = trim(chain)//' cube)'//strg_cr
    elseif (ncubes.eq.1) then
      chain = trim(chain)//' cube):'//strg_cr//trim(optargs)
    else
      chain = trim(chain)//' cubes):'//strg_cr//trim(optargs)
    endif
  end subroutine cubehelp_collect_flags_option
  !
  subroutine cubehelp_collect_flags_arguments(prog,arglist,ncubes,optargs,error)
    use cubelist_types
    use cubeadm_cubeid_types
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(collect_prog_t), intent(in)    :: prog
    type(list_t),          intent(in)    :: arglist
    integer(kind=narg_k),  intent(out)   :: ncubes   ! Number of cubes for this option
    character(len=*),      intent(out)   :: optargs  ! Description
    logical,               intent(inout) :: error
    !
    integer(kind=narg_k) :: iarg
    character(len=128) :: argflags
    class(list_object_t), pointer :: arg
    character(len=*), parameter :: rname='COLLECT>FLAGS>ARGUMENTS'
    !
    ncubes = 0
    optargs = ''
    do iarg=1,arglist%n
       arg => arglist%list(iarg)%p
       select type(arg)
       type is (cubeid_arg_t)
          ncubes = ncubes+1
          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_arguments
  !
  subroutine cubehelp_collect_flags_argument(prog,arg,argflags,error)
    use cubedag_allflags
    use cubeadm_cubeid_types
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(collect_prog_t), intent(in)    :: 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,'(3a)') '       ',trim(arg%name),':'
    do iflag=1,arg%nflag
       if (arg%flag(iflag).eq.flag_any) then
          write(argflags,'(2a)') trim(argflags),' any'
       else
          write(argflags,'(3a)') 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
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
