!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_structure
  use cubetools_parameters
  use cubetools_messaging
  use cubetools_package
  use cubetools_help
  use cubetools_list
  use cubetools_language
  use cubetools_command
  use cubetools_option
  use cubetools_primitive_arg
  !
  public :: lang_k,comm_k,opti_k,narg_max,narg_k
  public :: standard_arg_t,option_t,command_t,language_t
  !
  public :: cubetools_register_package,cubetools_list_package_languages
  public :: cubetools_register_language,cubetools_list_language_commands
  public :: cubetools_register_command,cubetools_get_command_id
  public :: cubetools_register_option
  public :: cubetools_register_primitive_arg
  public :: cubetools_register_dict
  public :: cubetools_execute_command,cubetools_show_command
  public :: cubetools_present,cubetools_getarg
  public :: cubetools_nopt
  public :: cubetools_pack_has_language,cubetools_structure_help_iterate
  public :: pack
  !
  private
  !
  interface cubetools_getarg
     module procedure cubetools_getarg_r4
     module procedure cubetools_getarg_r8
     module procedure cubetools_getarg_i4
     module procedure cubetools_getarg_i8
     module procedure cubetools_getarg_st
  end interface cubetools_getarg
  !
  type, extends(primitive_arg_t) :: standard_arg_t
     ! No element to add
  contains
     procedure :: register => cubetools_register_standard_arg
  end type standard_arg_t
  !
  type(package_t), target :: pack
  !
contains
  !
  subroutine cubetools_register_package(name,help,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*),     intent(in)    :: name
    character(len=*),     intent(in)    :: help
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='REGISTER>PACKAGE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call pack%put(name,help,error)
    if (error) return
  end subroutine cubetools_register_package
  !
  subroutine cubetools_register_language(name,authors,help,helpfile,run,langid,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*),     intent(in)    :: name
    character(len=*),     intent(in)    :: authors
    character(len=*),     intent(in)    :: help
    character(len=*),     intent(in)    :: helpfile
    external                            :: run
    integer(kind=lang_k), intent(out)   :: langid
    logical,              intent(inout) :: error
    !
    integer(kind=lang_k) :: nlang
    type(language_t) :: template
    type(language_t), pointer :: lang
    character(len=*), parameter :: rname='REGISTER>LANGUAGE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    nlang = pack%lang%n
    !
    ! Allocate/increase language list
    nlang = nlang+1
    call cubetools_list_reallocate(pack%lang,int(nlang,kind=list_k),error)
    if (error)  return
    !
    call cubetools_object_allocate(pack%lang%list(nlang),template,error)
    if (error)  return
    pack%lang%n = nlang
    langid = nlang
    !
    lang => cubetools_language_ptr(pack%lang%list(nlang)%p,error)
    if (error)  return
    call lang%put(name,authors,help,helpfile,run,error)
    if (error) return
  end subroutine cubetools_register_language
  !
  subroutine cubetools_register_command(name,syntax,abstract,help,run,popt,error,allowopt)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*),  intent(in)    :: name
    character(len=*),  intent(in)    :: syntax
    character(len=*),  intent(in)    :: abstract
    character(len=*),  intent(in)    :: help
    external                         :: run
    type(option_t),    pointer       :: popt  ! Return pointer to registered option
    logical,           intent(inout) :: error
    logical, optional, intent(in)    :: allowopt
    !
    type(language_t), pointer :: lang
    type(command_t), pointer :: comm
    type(command_t) :: template
    integer(kind=comm_k) :: ncomm
    character(len=*), parameter :: rname='REGISTER>COMMAND'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    lang => cubetools_language_ptr(pack%lang%list(pack%lang%n)%p,error)
    if (error)  return
    ncomm = lang%comm%n
    !
    ! Allocate/increase command list
    ncomm = ncomm+1
    call cubetools_list_reallocate(lang%comm,int(ncomm,kind=list_k),error)
    if (error)  return
    !
    lang%ndict = lang%ndict+1
    !
    call cubetools_object_allocate(lang%comm%list(ncomm),template,error)
    if (error)  return
    lang%comm%n = ncomm
    !
    comm => cubetools_command_ptr(lang%comm%list(ncomm)%p,error)
    if (error)  return
    call comm%put(ncomm,name,abstract,help,run,error)
    if (error) return
    if (present(allowopt))  comm%allowopt = allowopt
    comm%opt%n = -1  ! Because first 'option' is command at index #0
    !
    ! Register 0-eth option that contains command's syntax and a copy
    ! of its help and abstract
    call cubetools_register_option(name,syntax,abstract,help,popt,error)
    if (error) return
  end subroutine cubetools_register_command
  !
  subroutine cubetools_register_option(name,syntax,abstract,help,popt,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: name
    character(len=*), intent(in)    :: syntax
    character(len=*), intent(in)    :: abstract
    character(len=*), intent(in)    :: help
    type(option_t),   pointer       :: popt  ! Return pointer to registered option
    logical,          intent(inout) :: error
    !
    type(language_t), pointer :: lang
    type(command_t), pointer :: comm
    integer(kind=opti_k) :: nopt
    type(option_t) :: template
    character(len=*), parameter :: rname='REGISTER>OPTION'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    lang => cubetools_language_ptr(pack%lang%list(pack%lang%n)%p,error)
    if (error)  return
    comm => cubetools_command_ptr(lang%comm%list(lang%comm%n)%p,error)
    if (error)  return
    !
    nopt = comm%opt%n
    !
    ! Allocate/increase option list
    nopt = nopt+1
    call cubetools_list_reallocate(comm%opt,int(0,kind=list_k),  &
                                   int(nopt,kind=list_k),error)
    if (error)  return
    !
    if (nopt.gt.0) lang%ndict = lang%ndict+1
    !
    call cubetools_object_allocate(comm%opt%list(nopt),template,error)
    if (error)  return
    comm%opt%n = nopt
    !
    popt => cubetools_option_ptr(comm%opt%list(nopt)%p,error)
    if (error)  return
    call popt%put(nopt,name,syntax,abstract,help,error)
    if (error) return
  end subroutine cubetools_register_option
  !
  subroutine cubetools_register_standard_arg(template,name,abstract,help,mandat,error)
    !----------------------------------------------------------------------
    ! Register an argument of exact type standard_arg_t in the global 'pack'
    !----------------------------------------------------------------------
    class(standard_arg_t), intent(in)    :: template
    character(len=*),      intent(in)    :: name
    character(len=*),      intent(in)    :: abstract
    character(len=*),      intent(in)    :: help
    integer(kind=code_k),  intent(in)    :: mandat
    logical,               intent(inout) :: error
    !
    class(primitive_arg_t), pointer :: parg
    !
    call cubetools_register_primitive_arg(template,name,abstract,help,mandat,parg,error)
    if (error)  return
  end subroutine cubetools_register_standard_arg
  !
  subroutine cubetools_register_primitive_arg(template,name,abstract,help,  &
    mandat,parg,error)
    use gkernel_interfaces
    use cubetools_list
    !----------------------------------------------------------------------
    ! Register any argument of class primitive_arg_t in the global 'pack'
    !----------------------------------------------------------------------
    class(primitive_arg_t), intent(in)    :: template
    character(len=*),       intent(in)    :: name
    character(len=*),       intent(in)    :: abstract
    character(len=*),       intent(in)    :: help
    integer(kind=code_k),   intent(in)    :: mandat
    class(primitive_arg_t), pointer       :: parg  ! Return pointer to actual arg
    logical,                intent(inout) :: error
    !
    type(language_t), pointer :: lang
    type(command_t), pointer :: comm
    type(option_t), pointer :: opt
    integer(kind=narg_k) :: iarg
    integer(kind=4), parameter :: narginfinite=huge(1_4)
    character(len=*), parameter :: rname='REGISTER>ARGUMENT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    parg => null()
    !
    lang => cubetools_language_ptr(pack%lang%list(pack%lang%n)%p,error)
    if (error)  return
    comm => cubetools_command_ptr(lang%comm%list(lang%comm%n)%p,error)
    if (error)  return
    opt  => cubetools_option_ptr(comm%opt%list(comm%opt%n)%p,error)
    if (error)  return
    iarg = opt%arg%n
    !
    ! Sanity: compare with previous registered argument
    if (iarg.gt.0) then
      parg => cubetools_primitive_arg_ptr(opt%arg%list(iarg)%p,error)
      if (error)  return
      if (parg%mandatory.ne.code_arg_mandatory .and. mandat.eq.code_arg_mandatory) then
        call cubetools_message(seve%e,rname,'A mandatory argument can not follow an optional one')
        error = .true.
        return
      endif
    endif
    !
    ! Allocate/increase argument list
    iarg = iarg+1
    call cubetools_list_reallocate(opt%arg,int(iarg,kind=list_k),error)
    if (error)  return
    !
    ! Now insert new argument in option structure
    select case (mandat)
    case (code_arg_mandatory)
      opt%nargmin = opt%nargmin+1
      opt%nargmax = opt%nargmax+1
    case (code_arg_optional)
      if (opt%nargmax.ne.narginfinite)  opt%nargmax = opt%nargmax+1
    case (code_arg_unlimited)
      opt%nargmax = narginfinite
    end select
    !
    call cubetools_object_allocate(opt%arg%list(iarg),template,error)
    if (error)  return
    opt%arg%n = iarg
    parg => cubetools_primitive_arg_ptr(opt%arg%list(iarg)%p,error)
    if (error)  return
    !
    ! Fill new argument
    call parg%put(iarg,name,abstract,help,mandat,error)
    if (error) return
  end subroutine cubetools_register_primitive_arg
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_get_command_id(ilang,commname,commid,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    integer(kind=lang_k), intent(in)    :: ilang
    character(len=*),     intent(in)    :: commname
    integer(kind=comm_k), intent(out)   :: commid
    logical,              intent(inout) :: error
    !
    type(language_t), pointer :: lang
    character(len=*), parameter :: rname='GET>COMMAND>ID'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (ilang.gt.pack%lang%n .or. ilang.le.0) then
       call cubetools_message(seve%e,rname,'Unknown language ID')
       error = .true.
       return
    endif
    !
    lang => cubetools_language_ptr(pack%lang%list(ilang)%p,error)
    if (error)  return
    call lang%get_command_id(commname,commid,error)
    if (error) return
  end subroutine cubetools_get_command_id
  !
  subroutine cubetools_execute_command(line,ilang,comm,error)
    use cubetools_cmessaging
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*),     intent(in)    :: line
    integer(kind=lang_k), intent(in)    :: ilang
    character(len=*),     intent(in)    :: comm
    logical,              intent(inout) :: error
    !
    integer(kind=comm_k) :: icomm
    type(language_t), pointer :: plang
    type(command_t), pointer :: pcomm
    character(len=*), parameter :: rname='EXECUTE>COMMAND'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_get_command_id(ilang,comm,icomm,error)
    if (error) return
    call cubetools_message(seve%c,rname,line)
    plang => cubetools_language_ptr(pack%lang%list(ilang)%p,error)
    if (error)  return
    pcomm => cubetools_command_ptr(plang%comm%list(icomm)%p,error)
    if (error)  return
    call cubetools_cmessaging_command(pcomm%name,error)
    if (error)  return
    call pcomm%check(plang%name,line,error)
    if (error)  return
    call pcomm%run(line,error)
    if (error) return
    call cubetools_cmessaging_nocommand(error)
    if (error)  return
  end subroutine cubetools_execute_command
  !
  subroutine cubetools_show_command(lang,comm,error)
    use gkernel_interfaces
    use sic_def
    use cubetools_disambiguate
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: lang
    character(len=*), intent(in)    :: comm
    logical,          intent(inout) :: error
    !
    integer(kind=comm_k) :: ilang
    integer(kind=comm_k) :: icomm
    type(language_t), pointer :: plang
    type(command_t), pointer :: pcomm
    character(len=12) :: solved
    character(len=12), allocatable :: cnames(:)
    integer(kind=4) :: ier
    character(len=*), parameter :: rname='SHOW>COMMAND'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call pack%get_language_id(lang,ilang,error)
    if (error) return
    plang => cubetools_language_ptr(pack%lang%list(ilang)%p,error)
    if (error)  return
    allocate(cnames(plang%comm%n),stat=ier)
    if (failed_allocate(rname,'cnames',ier,error)) return
    do icomm=1,plang%comm%n
      pcomm => cubetools_command_ptr(plang%comm%list(icomm)%p,error)
      if (error)  return
      cnames(icomm) = pcomm%name
    enddo
    call cubetools_disambiguate_strict(comm,cnames,icomm,solved,error)
    if (error) return
    pcomm => cubetools_command_ptr(plang%comm%list(icomm)%p,error)
    if (error)  return
    !
    call pcomm%show_minimum(lang,error)
    if (error) return
    call cubetools_message(toolseve%help,rname,strg_dash())
    call cubetools_message(toolseve%help,rname,blankstr)
    call cubetools_message(toolseve%help,rname,'For a more complete help please type:')
    call cubetools_message(toolseve%help,rname,trim(lang)//backslash//trim(solved)//' ?')
    call cubetools_message(toolseve%help,rname,blankstr)
  end subroutine cubetools_show_command
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_present(line,iopt,iarg,present,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*),     intent(in)    :: line
    integer(kind=opti_k), intent(in)    :: iopt
    integer(kind=argu_k), intent(in)    :: iarg
    logical,              intent(out)   :: present
    logical,              intent(inout) :: error
    !
    integer(kind=4) :: narg
    character(len=argu_l) :: arg
    character(len=*), parameter :: rname='CUBETOOLS>PRESENT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (iarg.eq.0) then 
       present = sic_present(iopt,iarg)
    else if (iarg.gt.0) then
       call sic_ch(line,iopt,iarg,arg,narg,mandatory,error)
       if (error) return
       if (arg.eq.strg_quest) then
          call cubetools_message(seve%r,rname,'Clever help')
          present = .false.
          error = .true.
          return
       else
          present = sic_present(iopt,iarg)
       endif
    else
       call cubetools_message(seve%r,rname,'Argument number must >= 0')
        present = .false.
        error = .true.
        return
    endif
  end subroutine cubetools_present
  !
  subroutine cubetools_getarg_i4(line,opt,iarg,value,mandatory,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*),     intent(in)    :: line
    type(option_t),       intent(in)    :: opt
    integer(kind=argu_k), intent(in)    :: iarg
    integer(kind=4),      intent(inout) :: value
    logical,              intent(in)    :: mandatory
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='GET>ARG>I4'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call sic_i4(line,opt%inum,iarg,value,mandatory,error)
    if (error) then
       error = .false.
       call opt%show_syntax(error)
       error = .true.
       return
    endif
  end subroutine cubetools_getarg_i4
  !
  subroutine cubetools_getarg_i8(line,opt,iarg,value,mandatory,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*),     intent(in)    :: line
    type(option_t),       intent(in)    :: opt
    integer(kind=argu_k), intent(in)    :: iarg
    integer(kind=8),      intent(inout) :: value
    logical,              intent(in)    :: mandatory
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='GET>ARG>I8'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call sic_i8(line,opt%inum,iarg,value,mandatory,error)
    if (error) then
       error = .false.
       call opt%show_syntax(error)
       error = .true.
       return
    endif
  end subroutine cubetools_getarg_i8
  !
  subroutine cubetools_getarg_r4(line,opt,iarg,value,mandatory,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*),     intent(in)    :: line
    type(option_t),       intent(in)    :: opt
    integer(kind=argu_k), intent(in)    :: iarg
    real(kind=4),         intent(inout) :: value
    logical,              intent(in)    :: mandatory
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='GET>ARG>R4'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call sic_r4(line,opt%inum,iarg,value,mandatory,error)
    if (error) then
       error = .false.
       call opt%show_syntax(error)
       error = .true.
       return
    endif
  end subroutine cubetools_getarg_r4
  !
  subroutine cubetools_getarg_r8(line,opt,iarg,value,mandatory,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*),     intent(in)    :: line
    type(option_t),       intent(in)    :: opt
    integer(kind=argu_k), intent(in)    :: iarg
    real(kind=8),         intent(inout) :: value
    logical,              intent(in)    :: mandatory
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='GET>ARG>R8'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call sic_r8(line,opt%inum,iarg,value,mandatory,error)
    if (error) then
       error = .false.
       call opt%show_syntax(error)
       error = .true.
       return
    endif
  end subroutine cubetools_getarg_r8
  !  
  subroutine cubetools_getarg_st(line,opt,iarg,string,mandatory,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*),     intent(in)    :: line
    type(option_t),       intent(in)    :: opt
    integer(kind=argu_k), intent(in)    :: iarg
    character(len=*),     intent(inout) :: string
    logical,              intent(in)    :: mandatory
    logical,              intent(inout) :: error
    !
    integer(kind=4) :: narg
    character(len=*), parameter :: rname='GET>ARG>R8'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call sic_ch(line,opt%inum,iarg,string,narg,mandatory,error)
    if (error) then
       error = .false.
       call opt%show_syntax(error)
       error = .true.
       return
    endif
  end subroutine cubetools_getarg_st
  !
  function cubetools_nopt()
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    integer(kind=opti_k) :: cubetools_nopt
    !
    cubetools_nopt = sic_nopt()
  end function cubetools_nopt
  !  
  !------------------------------------------------------------------------
  !
  subroutine cubetools_list_package_languages(error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    logical, intent(inout) :: error
    !
    character(len=*), parameter :: rname='LIST>PACKAGE>LANGUAGES'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call pack%list(error)
    if (error) return
  end subroutine cubetools_list_package_languages
  !
  subroutine cubetools_list_language_commands(ilang,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    integer(kind=lang_k), intent(in)    :: ilang
    logical,              intent(inout) :: error
    !
    type(language_t), pointer :: lang
    character(len=*), parameter :: rname='LIST>LANGUAGE>COMMANDS'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (ilang.gt.pack%lang%n .or. ilang.le.0) then
       call cubetools_message(seve%e,rname,'Unknown language ID')
       error = .true.
       return
    endif
    !
    lang => cubetools_language_ptr(pack%lang%list(ilang)%p,error)
    if (error)  return
    call lang%list(error)
    if (error) return
  end subroutine cubetools_list_language_commands
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_register_dict(error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    logical, intent(inout) :: error
    !
    type(language_t), pointer :: lang
    character(len=*), parameter :: rname='REGISTER>DICT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    lang => cubetools_language_ptr(pack%lang%list(pack%lang%n)%p,error)
    if (error)  return
    call lang%build_dict(error)
    if (error) return
  end subroutine cubetools_register_dict
  !
  function cubetools_pack_has_language(lang)
    !-------------------------------------------------------------------
    ! Return .true. if package provides the named language
    !-------------------------------------------------------------------
    logical :: cubetools_pack_has_language
    character(len=*), intent(in) :: lang
    !
    type(language_t), pointer :: plang
    integer(kind=4) :: ilang
    logical :: error
    !
    cubetools_pack_has_language = .false.
    error = .false.
    do ilang=1,pack%lang%n
      plang => cubetools_language_ptr(pack%lang%list(ilang)%p,error)
      if (error)  return
      if (plang%name.eq.lang) then
        cubetools_pack_has_language = .true.
        return
      endif
    enddo
    !
  end function cubetools_pack_has_language
  !
  subroutine cubetools_structure_help_iterate(error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    logical, intent(inout) :: error
    !
    call pack%help_iterate(error)
    if (error)  return
  end subroutine cubetools_structure_help_iterate
  !
end module cubetools_structure
!  
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
