!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_obsolete_opt
  use cubetools_parameters
  use cubesyntax_messaging
  use cubetools_primitive_opt
  use cubetools_structure_main
  !
  public :: obsolete_opt_t
  public :: cubetools_register_obsolete_opt
  private
  !
  type, extends(primitive_opt_t) :: obsolete_opt_t
    character(len=11) :: date  ! Obsolescence date e.g. 01-JAN-1970
  contains
    procedure :: register => cubetools_register_obsolete_opt
  end type obsolete_opt_t
  !
contains
  !
  subroutine cubetools_register_obsolete_opt(template,name,help,date,error)
    !----------------------------------------------------------------------
    ! Register an option of exact type obsolete_opt_t in the global 'pack'
    !----------------------------------------------------------------------
    class(obsolete_opt_t), intent(in)    :: template
    character(len=*),      intent(in)    :: name
    character(len=*),      intent(in)    :: help
    character(len=*),      intent(in)    :: date
    logical,               intent(inout) :: error
    !
    class(primitive_opt_t), pointer :: actualopt
    type(obsolete_opt_t), pointer :: oopt
    !
    ! Note: the pointer to the option is not returned to the caller as
    ! there is no need to use it for parsing
    call cubetools_register_primitive_opt(template,name,strg_emp,strg_emp,  &
      help,actualopt,error)
    if (error)  return
    oopt => cubetools_obsolete_opt_ptr(actualopt,error)
    if (error)  return
    !
    oopt%date           =  date
    oopt%check          => cubetools_option_check_execute
    oopt%build_syntax   => cubetools_option_build_syntax
    oopt%print_abstract => cubetools_option_print_abstract
  end subroutine cubetools_register_obsolete_opt
  !
  function cubetools_obsolete_opt_ptr(pot,error)
    !-------------------------------------------------------------------
    ! Check if the input class is of type(obsolete_opt_t), and return
    ! a pointer to it if relevant.
    !-------------------------------------------------------------------
    type(obsolete_opt_t), pointer :: cubetools_obsolete_opt_ptr  ! Function value on return
    class(primitive_opt_t), target, intent(in)    :: pot
    logical,                        intent(inout) :: error
    !
    character(len=*), parameter :: rname='OPTION>PTR'
    !
    select type(pot)
    type is (obsolete_opt_t)
      cubetools_obsolete_opt_ptr => pot
    class default
      cubetools_obsolete_opt_ptr => null()
      call cubesyntax_message(seve%e,rname,  &
        'Internal error: object is not a obsolete_opt_t type')
      error = .true.
      return
    end select
  end function cubetools_obsolete_opt_ptr
  !
  subroutine cubetools_option_check_execute(opt,command,line,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    ! Obsolete option must not be present on the command line. If yes,
    ! raise an error with appropriate message.
    !----------------------------------------------------------------------
    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
    !
    logical :: present
    type(obsolete_opt_t), pointer :: oopt
    character(len=*), parameter :: rname='OPTION>CHECK>EXECUTE'
    !
    call cubesyntax_message(syntaxseve%trace,rname,'Welcome')
    !
    call opt%present(line,present,error)
    if (error) return
    if (.not.present)  return
    !
    oopt => cubetools_obsolete_opt_ptr(opt,error)
    if (error)  return
    !
    call cubesyntax_message(seve%e,rname,  &
      '/'//trim(opt%name)//' is obsolete since '//oopt%date)
    call oopt%help(error)
    if (error)  return
    !
    ! Raise error to stop parsing
    error = .true.
    return
  end subroutine cubetools_option_check_execute
  !
  subroutine cubetools_option_build_syntax(opt,syntax,error)
    !-------------------------------------------------------------------
    !  Return empty (=> invisible) syntax for obsolete option
    !-------------------------------------------------------------------
    class(primitive_opt_t), intent(in)    :: opt
    character(len=*),       intent(out)   :: syntax
    logical,                intent(inout) :: error
    !
    syntax = ' '
  end subroutine cubetools_option_build_syntax
  !
  subroutine cubetools_option_print_abstract(opt,error)
    !----------------------------------------------------------------------
    !  Print nothing for an obsolete option
    !----------------------------------------------------------------------
    class(primitive_opt_t), intent(in)    :: opt
    logical,                intent(inout) :: error
    !
    return
  end subroutine cubetools_option_print_abstract
end module cubetools_obsolete_opt
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
