!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_command
  use cubetools_parameters
  use cubetools_messaging
  use cubetools_help
  use cubetools_list
  use cubetools_option
  !
  public :: opti_k
  public :: command_t
  public :: cubetools_command_ptr
  private
  !
  integer(kind=4), parameter :: comm_k = 4
  integer(kind=4), parameter :: opti_k = 4
  integer(kind=4), parameter :: comm_l = 16
  integer(kind=4), parameter :: opti_l = 16
  integer(kind=4), parameter :: abst_l = 80
  integer(kind=4), parameter :: synt_l = 80 ! *** JP Probably not enough?
  !
  type, extends(tools_object_t) :: command_t
     integer(kind=comm_k)          :: inum = code_abs      ! Command number in language
     character(len=comm_l)         :: name = strg_unk      ! Command name
     logical                       :: allowopt = .true.    ! Does command allow options?
     character(len=abst_l)         :: abstract = strg_unk  ! One-line help
     character(len=:), allocatable :: help                 ! Multi-line help
     type(tools_list_t)            :: opt                  ! List of options (0=command)
     procedure(), pointer, nopass  :: run                  ! Executable subroutine address
   contains
     ! General
     procedure :: init           => cubetools_command_init           
     procedure :: final          => cubetools_command_final          
     procedure :: free           => cubetools_command_free           
     !                               
     ! Registering                   
     procedure :: put            => cubetools_command_put
     !
     ! Parsing
     procedure :: nopt           => cubetools_command_nopt
     !                               
     ! Print and Help                
     procedure :: print_abstract => cubetools_command_print_abstract 
     procedure, private :: abstract_bis   => cubetools_command_abstract_bis   
     procedure, private :: print_syntax   => cubetools_command_print_syntax   
     procedure, private :: print_help     => cubetools_command_print_help     
     procedure, private :: list           => cubetools_command_list           
     procedure :: show_minimum   => cubetools_command_show_minimum   
     procedure :: help_iterate   => cubetools_command_help_iterate
     !
     ! Exectution
     procedure :: check          => cubetools_command_check_execute
  end type command_t
  !
contains
  !
  !---General------------------------------------------------------------
  !
  subroutine cubetools_command_init(comm,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(command_t), intent(out)   :: comm
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='COMMAND>INIT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
  end subroutine cubetools_command_init
  !
  subroutine cubetools_command_final(comm,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(command_t), intent(inout) :: comm
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='COMMAND>FINAL'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call comm%free(error)
    if (error) return
  end subroutine cubetools_command_final
  !
  function cubetools_command_ptr(tot,error)
    !-------------------------------------------------------------------
    ! Check if the input class is of type(command_t), and return
    ! a pointer to it if relevant.
    !-------------------------------------------------------------------
    type(command_t), pointer :: cubetools_command_ptr  ! Function value on return
    class(tools_object_t), pointer       :: tot
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='COMMAND>PTR'
    !
    select type(tot)
    type is (command_t)
      cubetools_command_ptr => tot
    class default
      cubetools_command_ptr => null()
      call cubetools_message(seve%e,rname,  &
        'Internal error: object is not a command_t type')
      error = .true.
      return
    end select
  end function cubetools_command_ptr
  !
  subroutine cubetools_command_free(comm,error)
    !----------------------------------------------------------------------
    ! Free the contents of a 'command_t'
    !----------------------------------------------------------------------
    class(command_t), intent(inout) :: comm
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='COMMAND>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_list_final(comm%opt,error)
    if (error)  return
  end subroutine cubetools_command_free
  !
  !---Parsing------------------------------------------------------------
  !
  function cubetools_command_nopt(comm)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(command_t), intent(in)    :: comm
    integer(kind=opti_k)            :: cubetools_command_nopt
    !
    cubetools_command_nopt = sic_nopt()
  end function cubetools_command_nopt
  !
  !---Registering----------------------------------------------------------
  !
  subroutine cubetools_command_put(comm,inum,name,abstract,help,run,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(command_t),     intent(inout) :: comm
    integer(kind=comm_k), intent(in)    :: inum
    character(len=*),     intent(in)    :: name
    character(len=*),     intent(in)    :: abstract
    character(len=*),     intent(in)    :: help
    external                            :: run
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='COMMAND>PUT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call comm%final(error)
    if (error) return
    call comm%init(error)
    if (error) return
    comm%inum = inum
    comm%name = name
    comm%abstract = abstract
    comm%help(:) = help(:)
    comm%run => run
  end subroutine cubetools_command_put
  !
  !---Print-and-Help-----------------------------------------------------
  !
  subroutine cubetools_command_print_abstract(comm,error)
    use cubetools_format
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(command_t), intent(in)    :: comm    
    logical,          intent(inout) :: error
    !
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='COMMAND>ABSTRACT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    mess = '  '//cubetools_format_stdkey_boldval(comm%name,comm%abstract,help_width())
    call cubetools_message(toolseve%help,rname,mess)
  end subroutine cubetools_command_print_abstract
  !
  subroutine cubetools_command_abstract_bis(comm,error)
    use cubetools_format
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(command_t), intent(in)    :: comm
    logical,          intent(inout) :: error
    !
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='COMMAND>ABSTRACT>BIS'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_message(toolseve%help,rname,strg_dash())
    mess = '  '//cubetools_format_stdkey_boldval('Abstract',comm%abstract,help_width())
    call cubetools_message(toolseve%help,rname,mess)
  end subroutine cubetools_command_abstract_bis
  !
  subroutine cubetools_command_print_syntax(comm,langname,error)
    use cubetools_format
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(command_t), intent(in)    :: comm
    character(len=*), intent(in)    :: langname
    logical,          intent(inout) :: error
    !
    integer(kind=4) :: width,nmess,noptsyntax
    integer(kind=opti_k) :: iopt
    character(len=mess_l) :: mess,key
    character(len=synt_l) :: optsyntax
    character(len=2*opti_l) :: optname
    type(option_t), pointer :: opt
    character(len=*), parameter :: rname='COMMAND>SYNTAX'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    mess = ''
    nmess = 0
    width = help_width()
    key = 'Syntax'
    do iopt=0,comm%opt%n
       opt => cubetools_option_ptr(comm%opt%list(iopt)%p,error)
       if (error)  return
       if (iopt.eq.0) then
          optname = '['//trim(langname)//'\]'//opt%name
       else
          optname = '/'//trim(opt%name)
       endif
       if (len_trim(opt%syntax).eq.0) then
          optsyntax = cubetools_format_bold(optname)
       else
          optsyntax = trim(cubetools_format_bold(optname))//' '//trim(opt%syntax)
       endif
       if (iopt.ne.0) then
          optsyntax = ' ['//trim(optsyntax)//']'
       endif
       noptsyntax = len_trim(optsyntax)
       if (nmess+noptsyntax.le.width-7) then
          mess = trim(mess)//trim(optsyntax)
          nmess = nmess+noptsyntax
          width = width+bold_l
       else
          mess = '  '//cubetools_format_stdkey_stdval(key,mess,width)
          call cubetools_message(toolseve%help,rname,mess)
          mess = optsyntax
          nmess = noptsyntax
          width = help_width()+bold_l
          key = ''
       endif
    enddo ! iopt
    mess = '  '//cubetools_format_stdkey_stdval('',mess,width)
    call cubetools_message(toolseve%help,rname,mess)
  end subroutine cubetools_command_print_syntax
  !
  subroutine cubetools_command_print_help(comm,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(command_t), intent(in)    :: comm
    logical,         intent(inout) :: error
    !
    type(option_t), pointer :: opt
    character(len=*), parameter :: rname='COMMAND>PRINT>HELP'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    opt => cubetools_option_ptr(comm%opt%list(0)%p,error)
    if (error)  return
    call opt%help(error)
    if (error) return
  end subroutine cubetools_command_print_help
  !
  subroutine cubetools_command_list(comm,langname,error)
    use gbl_ansicodes
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(command_t),  intent(in)    :: comm
    character(len=*),  intent(in)    :: langname
    logical,           intent(inout) :: error
    !
    integer(kind=opti_k) :: iopt
    type(option_t), pointer :: opt
    character(len=*), parameter :: rname='COMMAND>LIST'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call comm%print_syntax(langname,error)
    if (error) return
    call comm%abstract_bis(error)
    if (error) return
    call comm%print_help(error)
    if (error) return
    opt => cubetools_option_ptr(comm%opt%list(0)%p,error)
    if (error)  return
    call opt%list(error)
    if (error) return
    if (comm%opt%n.gt.0) call cubetools_message(toolseve%help,rname,strg_dash())
    do iopt = 1,comm%opt%n
      opt => cubetools_option_ptr(comm%opt%list(iopt)%p,error)
      if (error)  return
      call opt%print_abstract(error)
      if (error) return
    enddo ! iopt
    call cubetools_message(toolseve%help,rname,blankstr)
  end subroutine cubetools_command_list
  !
  subroutine cubetools_command_show_minimum(comm,langname,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(command_t),  intent(in)    :: comm
    character(len=*),  intent(in)    :: langname
    logical,           intent(inout) :: error
    !
    character(len=*), parameter :: rname='COMMAND>SHOW_MINIMUM'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call comm%print_syntax(langname,error)
    if (error) return
    call comm%abstract_bis(error)
    if (error) return
    call comm%print_help(error)
    if (error) return
  end subroutine cubetools_command_show_minimum
  !
  subroutine cubetools_command_help_iterate(comm,langname,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(command_t), intent(in)    :: comm
    character(len=*), intent(in)    :: langname
    logical,          intent(inout) :: error
    !
    integer(kind=opti_k) :: iopt
    type(option_t), pointer :: opt
    character(len=*), parameter :: rname='COMMAND>HELP>ITERATE'
    !
    call cubetools_message(toolseve%help,rname,'\subsection{'//trim(comm%name)//'}')
    call cubetools_message(toolseve%help,rname,'\label{sec:'//trim(langname)//':'//trim(comm%name)//':help}')
    call cubetools_message(toolseve%help,rname,'\index{'//trim(langname)//' '//trim(comm%name)//' command}')
    !
    call cubetools_message(toolseve%help,rname,'\begin{PlusVerbatim}')
    call comm%list(langname,error)
    if (error)  return
    call cubetools_message(toolseve%help,rname,'\end{PlusVerbatim}')
    !
    ! Options help
    do iopt=1,comm%opt%n
      opt => cubetools_option_ptr(comm%opt%list(iopt)%p,error)
      if (error)  return
      call opt%help_iterate(langname,comm%name,error)
      if (error)  return
    enddo
  end subroutine cubetools_command_help_iterate
  !
  !---Execution----------------------------------------------------------
  !
  subroutine cubetools_command_check_execute(comm,langname,line,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(command_t), intent(in)    :: comm
    character(len=*), intent(in)    :: langname
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    character(len=argu_l) :: arg
    integer(kind=opti_k) :: iopt
    type(option_t), pointer :: opt
    character(len=*), parameter :: rname='COMMAND>CHECK>EXECUTE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Re-evaluate the current terminal size
    call cubetools_help_terminal_width()
    !
    ! Trap ? as first argument to the command (trapped here because
    ! we need to call comm%list() and not opt(0)%resume() )
    call cubetools_get_optional_first_argument(line,arg,error)
    if (error) return
    if (arg.eq.strg_quest) then
      call comm%list(langname,error)
      error = .true.
      return
    endif
    !
    ! Check number of arguments to all present options and trap ?
    ! Command (opt #0) is tested last because always present but
    ! might miss an argument on the syntax "COMMAND /OPT ?"
    do iopt=comm%opt%n,0,-1
      opt => cubetools_option_ptr(comm%opt%list(iopt)%p,error)
      if (error)  return
      call opt%check(comm%name,line,error)
      if (error)  return  ! or continue to show all the syntax errors at once?
    enddo
    !
  end subroutine cubetools_command_check_execute
  !
  subroutine cubetools_get_optional_first_argument(line,name,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    character(len=*), intent(out)   :: name
    logical,          intent(inout) :: error
    !
    integer(kind=4), parameter :: iarg=1
    integer(kind=4) :: nc
    character(len=base_l) :: arg
    character(len=*), parameter :: rname='GET>OPTIONAL>FIRST>ARGUMENT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    arg = ''
    call sic_ch(line,icomm,iarg,arg,nc,.not.mandatory,error)
    if (error) return
    name = arg
  end subroutine cubetools_get_optional_first_argument
  !
end module cubetools_command
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
