!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_standard_opt
  use cubesyntax_messaging
  use cubetools_primitive_opt
  use cubetools_structure_main
  !
  public :: option_t
  public :: opti_k
  public :: cubetools_register_option,cubetools_option_ptr
  public :: cubetools_option_check_execute,cubetools_option_print_abstract
  private
  !
  type, extends(primitive_opt_t) :: option_t  ! standard_option_t
     ! No element to add
  contains
     ! procedure :: register => cubetools_register_option
  end type option_t
  !
contains
  !
  subroutine cubetools_register_option(name,syntax,abstract,help,popt,error)
    !----------------------------------------------------------------------
    ! Register an option of exact type option_t in the global 'pack'
    !----------------------------------------------------------------------
    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(option_t) :: template
    class(primitive_opt_t), pointer :: actualopt
    !
    call cubetools_register_primitive_opt(template,name,syntax,abstract,help,actualopt,error)
    if (error)  return
    popt => cubetools_option_ptr(actualopt,error)
    if (error)  return
    popt%check          => cubetools_option_check_execute
    popt%build_syntax   => cubetools_option_build_syntax
    popt%print_abstract => cubetools_option_print_abstract
  end subroutine cubetools_register_option
  !
  function cubetools_option_ptr(pot,error)
    !-------------------------------------------------------------------
    ! Check if the input class is of type(option_t), and return
    ! a pointer to it if relevant.
    !-------------------------------------------------------------------
    type(option_t), pointer :: cubetools_option_ptr  ! Function value on return
    class(primitive_opt_t), pointer       :: pot
    logical,                intent(inout) :: error
    !
    character(len=*), parameter :: rname='OPTION>PTR'
    !
    select type(pot)
    type is (option_t)
      cubetools_option_ptr => pot
    class default
      cubetools_option_ptr => null()
      call cubesyntax_message(seve%e,rname,  &
        'Internal error: object is not a option_t type')
      error = .true.
      return
    end select
  end function cubetools_option_ptr
  !
  subroutine cubetools_option_check_execute(opt,command,line,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    ! When a command is executed, check if the option is present. If yes,
    ! check if the number of arguments are within the expected range
    ! EXCEPT if the first argument is ?, which shows the help.
    !----------------------------------------------------------------------
    class(primitive_opt_t), intent(in)    :: opt
    character(len=*),       intent(in)    :: command  ! Command name (for proper feedback)
    character(len=*),       intent(in)    :: line
    logical,                intent(inout) :: error
    !
    integer(kind=narg_k) :: narg
    character(len=mess_l) :: mess
    character(len=128) :: prefix
    logical :: present
    character(len=*), parameter :: rname='OPTION>CHECK>EXECUTE'
    !
    call cubesyntax_message(syntaxseve%trace,rname,'Welcome')
    !
    ! Check if present and trap ? as first argument to the option:
    call opt%present(line,present,error)
    if (error) return
    if (.not.present)  return
    !
    narg = opt%getnarg()
    !
    if (opt%inum.eq.0) then
      prefix = 'Command '//opt%name
    else
      prefix = 'Key /'//opt%name
    endif
    !
    if (narg.lt.opt%nargmin) then
      write(mess,'(a,3(a,i0))')  trim(prefix),  &
        ' takes at least ',opt%nargmin,' argument(s) (',narg,' given)'
      call cubesyntax_message(seve%e,rname,mess)
      error = .true.
      return
    endif
    !
    if (narg.gt.opt%nargmax) then
      if (opt%nargmax.eq.0) then
        write(mess,'(a,2(a,i0))')  trim(prefix),  &
          ' takes no argument (',narg,' given)'
      else
        write(mess,'(a,3(a,i0))')  trim(prefix),  &
          ' takes at most ',opt%nargmax,' argument(s) (',narg,' given)'
      endif
      call cubesyntax_message(seve%e,rname,mess)
      error = .true.
      return
    endif
  end subroutine cubetools_option_check_execute
  !
  subroutine cubetools_option_build_syntax(opt,syntax,error)
    use cubetools_format
    !-------------------------------------------------------------------
    !  Build the string
    !    /OPTNAME Arg1 ... ArgN
    !  according to opt%name and opt%syntax
    !-------------------------------------------------------------------
    class(primitive_opt_t), intent(in)    :: opt
    character(len=*),       intent(out)   :: syntax
    logical,                intent(inout) :: error
    !
    syntax = trim(cubetools_format_bold('/'//opt%name))// &
             ' '// &
             opt%syntax
  end subroutine cubetools_option_build_syntax
  !
  subroutine cubetools_option_print_abstract(opt,error)
    use cubetools_format
    use cubetools_terminal_tool
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(primitive_opt_t), intent(in)    :: opt
    logical,                intent(inout) :: error
    !
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='OPTION>PRINT>ABSTRACT'
    !
    call cubesyntax_message(syntaxseve%trace,rname,'Welcome')
    !
    mess = '  /'//cubetools_format_stdkey_boldval(opt%name,opt%abstract,terminal%width()-1)
    call cubesyntax_message(syntaxseve%help,rname,mess)
  end subroutine cubetools_option_print_abstract
end module cubetools_standard_opt
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
