!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_keyword_arg
  !----------------------------------------------------------------------
  ! Implement the parsing and resolution of keyword argument from a
  ! predefined list
  !    COMMAND Key
  !----------------------------------------------------------------------
  use cubetools_parameters
  use cubetools_messaging
  use cubetools_primitive_arg
  use cubetools_structure
  !
  public :: keyword_arg_t,flexible,cubetools_keyword_user2prog
  private
  !
  logical, parameter :: flexible=.true.
  !
  type, extends(primitive_arg_t) :: keyword_arg_t
     integer(kind=4)               :: nkey
     character(len=:), allocatable :: keys(:)
     logical                       :: flexible
  contains
     procedure :: register      => cubetools_keyword_register_arg
     procedure :: show_abstract => cubetools_keyword_abstract_arg
  end type keyword_arg_t
  !
contains
  !
  subroutine cubetools_keyword_arg_allocate_and_init(lkey,nkey,arg,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    integer(kind=4),     intent(in)    :: lkey
    integer(kind=4),     intent(in)    :: nkey
    type(keyword_arg_t), intent(inout) :: arg
    logical,             intent(inout) :: error
    !
    integer(kind=4) :: ier
    character(len=*), parameter :: rname='KEYWORD>ARG>ALLOCATE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (allocated(arg%keys)) then
      call cubetools_message(toolseve%alloc,rname,'List array already allocated, deallocating')
      deallocate(arg%keys)
    endif
    !
    allocate(character(len=lkey)::arg%keys(nkey),stat=ier)
    if (failed_allocate(rname,'list array',ier,error)) return
    arg%nkey = nkey
    arg%keys(:) = strg_unk
    arg%flexible = .not.flexible
  end subroutine cubetools_keyword_arg_allocate_and_init
  !
  subroutine cubetools_keyword_arg_put(list,flexibl,arg,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*),    intent(in)    :: list(:)
    logical,             intent(in)    :: flexibl
    type(keyword_arg_t), intent(inout) :: arg
    logical,             intent(inout) :: error
    !
    integer(kind=4) :: lkey,nkey
    character(len=*), parameter :: rname='KEYWORD>ARG>PUT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    lkey = len(list)
    nkey = size(list)
    call cubetools_keyword_arg_allocate_and_init(lkey,nkey,arg,error)
    if (error) return
    !
    arg%keys(:) = list(:)
    arg%flexible = flexibl
  end subroutine cubetools_keyword_arg_put
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_keyword_register_arg(templatearg,name,abstract,  &
    help,mandat,list,flexibl,keyarg,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(keyword_arg_t), intent(in)    :: templatearg  ! Template
    character(len=*),     intent(in)    :: name
    character(len=*),     intent(in)    :: abstract
    character(len=*),     intent(in)    :: help
    integer(kind=code_k), intent(in)    :: mandat
    character(len=*),     intent(in)    :: list(:)
    logical,              intent(in)    :: flexibl
    type(keyword_arg_t),  pointer       :: keyarg
    logical,              intent(inout) :: error
    !
    class(primitive_arg_t), pointer :: actualarg
    character(len=*), parameter :: rname='KEYWORD>REGISTER>ARG'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Register the primitive parts, and get pointer to the actual object
    ! saved in the parsing structure
    call cubetools_register_primitive_arg(templatearg,name,abstract,help,mandat,actualarg,error)
    if (error)  return
    !
    ! Register the extended parts
    select type (actualarg)
    type is (keyword_arg_t)
      keyarg => actualarg
      call cubetools_keyword_arg_put(list,flexibl,keyarg,error)
      if (error) return
    class default
      call cubetools_message(seve%e,rname,'Internal error: argument has wrong type')
      error = .true.
      return
    end select
    !
  end subroutine cubetools_keyword_register_arg
  !
  subroutine cubetools_keyword_abstract_arg(arg,iarg,error)
    use cubetools_help
    !-------------------------------------------------------------------
    ! Dedicated subroutine for custom display of keyword_arg_t argument
    ! abstract in help (as displayed with question mark)
    !-------------------------------------------------------------------
    class(keyword_arg_t), intent(in)    :: arg
    integer(kind=narg_k), intent(in)    :: iarg
    logical,              intent(inout) :: error
    !
    character(len=mess_l) :: mess
    integer(kind=4) :: ikey
    character(len=*), parameter :: tab = '     '
    character(len=*), parameter :: comma = ','
    logical :: linehead
    character(len=*), parameter :: rname='KEYWORD>ABSTRACT>ARG'
    !
    ! One line for the generic help:
    call arg%primitive_arg_t%show_abstract(iarg,error)
    if (error)  return
    !
    ! One more line for the specific help:
    if (arg%flexible) then
       mess = tab//'Possible values: '//trim(arg%name)//comma
    else
       mess = tab//'Possible values: '
    endif
    do ikey=1,arg%nkey
       if (len_trim(mess)+len_trim(arg%keys(ikey)).gt.help_width()) then
          call cubetools_message(toolseve%help,rname,mess)
          linehead = .true.
       else
          linehead = .false.
       endif
       if (linehead) then
          write(mess,'(2a)') tab,arg%keys(ikey)
       else
          write(mess,'(A,1X,A)')  trim(mess),arg%keys(ikey)
       endif
       if (ikey.le.arg%nkey-2) write(mess,'(2a)') trim(mess),comma
       if (ikey.eq.arg%nkey-1) write(mess,'(2a)') trim(mess),' or'
    enddo
    call cubetools_message(toolseve%help,rname,mess)
    !
  end subroutine cubetools_keyword_abstract_arg
  !
  subroutine cubetools_keyword_user2prog(arg,ichain,okey,ochain,error)
    use cubetools_disambiguate
    !-------------------------------------------------------------------
    ! Disambiguate a user input from the list of authorized keywords
    !-------------------------------------------------------------------
    type(keyword_arg_t),  intent(in)    :: arg
    character(len=*),     intent(in)    :: ichain
    integer(kind=code_k), intent(out)   :: okey
    character(len=*),     intent(out)   :: ochain
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='KEYWORD>USER2PROG'
    !
    if (arg%flexible) then
      call cubetools_disambiguate_flexible(ichain,arg%keys,okey,ochain,error)
      if (error)  return
    else
      call cubetools_disambiguate_strict(ichain,arg%keys,okey,ochain,error)
      if (error)  return
    endif
    !
  end subroutine cubetools_keyword_user2prog
end module cubetools_keyword_arg
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
