!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_structure_main
  use cubetools_parameters
  use cubelist_types
  use cubesyntax_messaging
  use cubetools_package
  use cubetools_terminal_tool
  use cubetools_language
  use cubetools_command
  use cubetools_primitive_opt
  use cubetools_primitive_arg
  use cubetools_primitive_prod
  !
  public :: cubetools_register_package,cubetools_list_package_languages
  public :: cubetools_register_language,cubetools_list_language_commands
  public :: cubetools_register_primitive_comm
  public :: cubetools_register_primitive_opt
  public :: cubetools_register_primitive_arg
  public :: cubetools_register_primitive_prod
  public :: cubetools_register_dict
  public :: cubetools_execute_command,cubetools_show_command
  public :: 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(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 cubesyntax_message(syntaxseve%trace,rname,'Welcome')
    !
    call pack%put(name,help,error)
    if (error) return
  end subroutine cubetools_register_package
  !
  subroutine cubetools_register_language(name,authors,abstract,help,helpfile,run,langid,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*),     intent(in)    :: name
    character(len=*),     intent(in)    :: authors
    character(len=*),     intent(in)    :: abstract
    character(len=*),     intent(in)    :: help
    character(len=*),     intent(in)    :: helpfile
    external                            :: run
    integer(kind=lang_k), intent(out)   :: langid
    logical,              intent(inout) :: error
    !
    type(language_t) :: template
    class(list_object_t), pointer :: lot
    type(language_t), pointer :: lang
    character(len=*), parameter :: rname='REGISTER>LANGUAGE'
    !
    call cubesyntax_message(syntaxseve%trace,rname,'Welcome')
    !
    call pack%lang%allocate(template,lot,error)
    if (error)  return
    lang => cubetools_language_ptr(lot,error)
    if (error) return
    call lang%put(name,authors,abstract,help,helpfile,run,error)
    if (error) return
    langid = pack%lang%n
  end subroutine cubetools_register_language
  !
  subroutine cubetools_register_primitive_comm(template,otemplate,  &
    name,syntax,abstract,help,run,popt,error,allowopt)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(command_t),        intent(in)    :: template   ! Command template
    class(primitive_opt_t), intent(in)    :: otemplate  ! Option template
    character(len=*),       intent(in)    :: name
    character(len=*),       intent(in)    :: syntax
    character(len=*),       intent(in)    :: abstract
    character(len=*),       intent(in)    :: help
    external                              :: run
    class(primitive_opt_t), pointer       :: popt       ! Return pointer to registered 'option'
    logical,                intent(inout) :: error
    logical, optional,      intent(in)    :: allowopt
    !
    type(language_t), pointer :: lang
    class(list_object_t), pointer :: lot
    type(command_t), pointer :: comm
    integer(kind=comm_k) :: ncomm
    character(len=*), parameter :: rname='REGISTER>COMMAND'
    !
    call cubesyntax_message(syntaxseve%trace,rname,'Welcome')
    !
    lang => cubetools_language_ptr(pack%lang%list(pack%lang%n)%p,error)
    if (error) return
    !
    call lang%comm%allocate(template,lot,error)
    if (error)  return
    ncomm = lang%comm%n
    lang%ndict = lang%ndict+1
    comm => cubetools_command_ptr(lot,error)
    if (error) return
    call comm%put(ncomm,name,abstract,help,run,error)
    if (error) return
    if (present(allowopt))  comm%allowopt = allowopt
    ! The numbering of options to this command start at 0 (command==0)
    call comm%opt%lbound(0_list_k,error)
    if (error)  return
    !
    ! Register 0-eth option that contains command's syntax and a copy
    ! of its help and abstract
    call cubetools_register_primitive_opt(otemplate,name,syntax,abstract,help,popt,error)
    if (error) return
  end subroutine cubetools_register_primitive_comm
  !
  subroutine cubetools_register_primitive_opt(template,name,syntax,abstract,help,popt,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(primitive_opt_t), intent(in)    :: template
    character(len=*),       intent(in)    :: name
    character(len=*),       intent(in)    :: syntax
    character(len=*),       intent(in)    :: abstract
    character(len=*),       intent(in)    :: help
    class(primitive_opt_t), pointer       :: popt  ! Return pointer to registered option
    logical,                intent(inout) :: error
    !
    type(language_t), pointer :: lang
    type(command_t), pointer :: comm
    class(list_object_t), pointer :: lot
    integer(kind=opti_k) :: nopt
    character(len=*), parameter :: rname='REGISTER>OPTION'
    !
    call cubesyntax_message(syntaxseve%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
    !
    call comm%opt%allocate(template,lot,error)
    if (error) return
    nopt = comm%opt%n
    if (nopt.gt.0) lang%ndict = lang%ndict+1
    popt => cubetools_primitive_opt_ptr(lot,error)
    if (error) return
    call popt%put(nopt,name,syntax,abstract,help,error)
    if (error) return
  end subroutine cubetools_register_primitive_opt
  !
  subroutine cubetools_register_primitive_arg(template,name,abstract,help,  &
    mandat,parg,error)
    !----------------------------------------------------------------------
    ! 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
    class(primitive_opt_t), pointer :: opt
    class(list_object_t), pointer :: lot
    integer(kind=narg_k) :: iarg
    integer(kind=4), parameter :: narginfinite=huge(1_4)
    character(len=*), parameter :: rname='REGISTER>ARGUMENT'
    !
    call cubesyntax_message(syntaxseve%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_primitive_opt_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 cubesyntax_message(seve%e,rname,'A mandatory argument can not follow an optional one')
        error = .true.
        return
      endif
    endif
    !
    ! 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 opt%arg%allocate(template,lot,error)
    if (error)  return
    parg => cubetools_primitive_arg_ptr(lot,error)
    if (error) return
    iarg = opt%arg%n
    call parg%put(iarg,name,abstract,help,mandat,error)
    if (error) return
  end subroutine cubetools_register_primitive_arg
  !
  subroutine cubetools_register_primitive_prod(template,name,abstract,help,  &
    pprod,error)
    !----------------------------------------------------------------------
    ! Register any product of class primitive_prod_t in the global 'pack'
    !----------------------------------------------------------------------
    class(primitive_prod_t), intent(in)    :: template
    character(len=*),        intent(in)    :: name
    character(len=*),        intent(in)    :: abstract
    character(len=*),        intent(in)    :: help
    class(primitive_prod_t), pointer       :: pprod  ! Return pointer to actual product
    logical,                 intent(inout) :: error
    !
    type(language_t), pointer :: lang
    type(command_t), pointer :: comm
    class(list_object_t), pointer :: lot
    integer(kind=prod_k) :: iprod
    integer(kind=4), parameter :: narginfinite=huge(1_4)
    character(len=*), parameter :: rname='REGISTER>PRODUCT'
    !
    call cubesyntax_message(syntaxseve%trace,rname,'Welcome')
    !
    pprod => 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
    iprod = comm%prod%n
    !
    call comm%prod%allocate(template,lot,error)
    if (error) return
    pprod => cubetools_primitive_prod_ptr(lot,error)
    if (error) return
    iprod = comm%prod%n
    call pprod%put(iprod,name,abstract,help,error)
    if (error) return
  end subroutine cubetools_register_primitive_prod
  !
  !------------------------------------------------------------------------
  !
  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 cubesyntax_message(syntaxseve%trace,rname,'Welcome')
    !
    if (ilang.gt.pack%lang%n .or. ilang.le.0) then
       call cubesyntax_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 cubesyntax_message(syntaxseve%trace,rname,'Welcome')
    !
    call cubetools_get_command_id(ilang,comm,icomm,error)
    if (error) return
    call cubesyntax_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 cubesyntax_message(syntaxseve%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 cubesyntax_message(syntaxseve%help,rname,terminal%dash_strg())
    call cubesyntax_message(syntaxseve%help,rname,blankstr)
    call cubesyntax_message(syntaxseve%help,rname,'For a more complete help please type:')
    call cubesyntax_message(syntaxseve%help,rname,trim(lang)//backslash//trim(solved)//' ?')
    call cubesyntax_message(syntaxseve%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 cubesyntax_message(syntaxseve%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 cubesyntax_message(seve%r,rname,'Clever help')
          present = .false.
          error = .true.
          return
       else
          present = sic_present(iopt,iarg)
       endif
    else
       call cubesyntax_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
    class(primitive_opt_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 cubesyntax_message(syntaxseve%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
    class(primitive_opt_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 cubesyntax_message(syntaxseve%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
    class(primitive_opt_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 cubesyntax_message(syntaxseve%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
    class(primitive_opt_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 cubesyntax_message(syntaxseve%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
    class(primitive_opt_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 cubesyntax_message(syntaxseve%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 cubesyntax_message(syntaxseve%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 cubesyntax_message(syntaxseve%trace,rname,'Welcome')
    !
    if (ilang.gt.pack%lang%n .or. ilang.le.0) then
       call cubesyntax_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 cubesyntax_message(syntaxseve%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(forma,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    integer(kind=code_k), intent(in)    :: forma
    logical,              intent(inout) :: error
    !
    call pack%help_iterate(forma,error)
    if (error) return
  end subroutine cubetools_structure_help_iterate
  !
end module cubetools_structure_main
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
