!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_primitive_prod
  use cubetools_parameters
  use cubelist_types
  use cubesyntax_messaging
  use cubetools_terminal_tool
  !
  public :: primitive_prod_t,prod_k
  public :: cubetools_primitive_prod_ptr
  private
  !
  integer(kind=4), parameter :: prod_k = 4
  integer(kind=4), parameter :: abst_l = 80
  !
  type, extends(list_object_t) :: primitive_prod_t
     integer(kind=prod_k)          :: inum = code_abs       ! Product number in command
     character(len=argu_l)         :: name = strg_unk
     character(len=abst_l)         :: abstract = strg_emp   ! One-line abstract help
     character(len=:), allocatable :: help_strg             ! Long/multiline help
   contains
     ! General
     procedure :: init  => cubetools_primitive_prod_init
     procedure :: final => cubetools_primitive_prod_final
     !
     ! Registering
     procedure :: put   => cubetools_primitive_prod_put
     !
     ! Printing and Help
     procedure :: print_abstract => cubetools_primitive_prod_abstract
     procedure :: summary        => cubetools_primitive_prod_summary
     procedure :: help           => cubetools_primitive_prod_help
  end type primitive_prod_t
  !
contains
  !
  !---General------------------------------------------------------------
  !
  subroutine cubetools_primitive_prod_init(prod,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(primitive_prod_t), intent(out)   :: prod
    logical,                 intent(inout) :: error
    !
    character(len=*), parameter :: rname='PRODUCT>INIT'
    !
    call cubesyntax_message(syntaxseve%trace,rname,'Welcome')
  end subroutine cubetools_primitive_prod_init
  !
  subroutine cubetools_primitive_prod_final(obj,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(primitive_prod_t), intent(inout) :: obj
    logical,                 intent(inout) :: error
    !
    character(len=*), parameter :: rname='PRODUCT>FINAL'
    !
    call cubesyntax_message(syntaxseve%trace,rname,'Welcome')
  end subroutine cubetools_primitive_prod_final
  !
  function cubetools_primitive_prod_ptr(tot,error)
    !-------------------------------------------------------------------
    ! Check if the input class is of class(primitive_prod_t), and return
    ! a pointer to it if relevant.
    !-------------------------------------------------------------------
    class(primitive_prod_t), pointer :: cubetools_primitive_prod_ptr  ! Function value on return
    class(list_object_t), pointer       :: tot
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='PRODUCT>PTR'
    !
    select type(tot)
    class is (primitive_prod_t)
      cubetools_primitive_prod_ptr => tot
    class default
      cubetools_primitive_prod_ptr => null()
      call cubesyntax_message(seve%e,rname,  &
        'Internal error: object is not a primitive_prod_t class')
      error = .true.
      return
    end select
  end function cubetools_primitive_prod_ptr
  !
  !---Registering----------------------------------------------------------
  !
  subroutine cubetools_primitive_prod_put(prod,inum,name,abstract,help,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(primitive_prod_t), intent(inout) :: prod
    integer(kind=prod_k),    intent(in)    :: inum
    character(len=*),        intent(in)    :: name
    character(len=*),        intent(in)    :: abstract
    character(len=*),        intent(in)    :: help
    logical,                 intent(inout) :: error
    !
    character(len=*), parameter :: rname='PRODUCT>PUT'
    !
    call cubesyntax_message(syntaxseve%trace,rname,'Welcome')
    !
    call cubetools_primitive_prod_final(prod,error)
    if (error) return
    call cubetools_primitive_prod_init(prod,error)
    if (error) return
    prod%inum      = inum
    prod%name      = name
    prod%abstract  = abstract
    prod%help_strg = help
  end subroutine cubetools_primitive_prod_put
  !
  !---Printing-and-Help--------------------------------------------------
  !
  subroutine cubetools_primitive_prod_abstract(prod,iprod,error)
    use gkernel_interfaces
    use cubetools_format
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(primitive_prod_t), intent(in)    :: prod
    integer(kind=prod_k),    intent(in)    :: iprod
    logical,                 intent(inout) :: error
    !
    character(len=mess_l) :: name,mess
    character(len=*), parameter :: rname='PRODUCT>ABSTRACT'
    !
    call cubesyntax_message(syntaxseve%trace,rname,'Welcome')
    !
    if ((iprod.lt.1).or.(9.lt.iprod)) then
       ! ZZZ Does this makes sense for products?
       call cubesyntax_message(seve%e,rname,'Product number out of authorized range: [1-9]')
       error = .true.
       return
    endif
    name = prod%name
    call sic_upper(name)
    write(mess,'(a1,i1,1x,a)') '#',iprod,trim(name)
    mess = '  '//cubetools_format_stdkey_boldval(mess,prod%abstract,terminal%width())
    call cubesyntax_message(syntaxseve%help,rname,mess)
  end subroutine cubetools_primitive_prod_abstract
  !
  subroutine cubetools_primitive_prod_help(prod,error)
    use cubetools_terminal_tool
    !-------------------------------------------------------------------
    ! Print option help from prod%help_strg
    !-------------------------------------------------------------------
    class(primitive_prod_t), intent(in)    :: prod
    logical,                 intent(inout) :: error
    !
    character(len=*), parameter :: rname='PRODUCT>HELP'
    !
    call cubesyntax_message(syntaxseve%trace,rname,'Welcome')
    if (.not.allocated(prod%help_strg)) return
    if (len_trim(prod%help_strg).le.0) return
    if (prod%help_strg.eq.strg_emp) return
    !
    call cubesyntax_message(syntaxseve%help,rname,blankstr)
    call terminal%print_strg(syntaxseve%help,prod%help_strg)
  end subroutine cubetools_primitive_prod_help
  !
  subroutine cubetools_primitive_prod_summary(prod,error)
    !-------------------------------------------------------------------
    ! Short option summary
    !-------------------------------------------------------------------
    class(primitive_prod_t), intent(in)    :: prod
    logical,                 intent(inout) :: error
    !
    character(len=*), parameter :: rname='PRODUCT>SUMMARY'
    !
    call cubesyntax_message(syntaxseve%trace,rname,'Welcome')
    !
    call cubesyntax_message(syntaxseve%help,rname,terminal%dash_strg())
    call prod%print_abstract(prod%inum,error)
    if (error) return
    call prod%help(error)
    if (error) return
    call cubesyntax_message(syntaxseve%help,rname,blankstr)
  end subroutine cubetools_primitive_prod_summary
end module cubetools_primitive_prod
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
