!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_language
  use cubetools_parameters
  use cubetools_messaging
  use cubetools_command
  use cubetools_help
  use cubetools_list
  use cubetools_option
  !
  public :: comm_k
  public :: language_t
  public :: cubetools_language_ptr
  private
  !
  integer(kind=4), parameter :: comm_k = 4 ! [integer] Languages
  integer(kind=4), parameter :: lang_k = 4 ! [integer] Languages
  integer(kind=4), parameter :: lang_l = 16
  integer(kind=4), parameter :: help_l = 80
  integer(kind=4), parameter :: auth_l = 40
  !
  type, extends(tools_object_t) :: language_t
     character(len=lang_l) :: name     = strg_unk
     character(len=auth_l) :: authors  = strg_unk
     character(len=help_l) :: help     = strg_emp
     character(len=file_l) :: helpfile = strg_emp
     integer(kind=comm_k)  :: ndict = 0  ! Total number of commands + options
     procedure(), pointer, nopass   :: run
     character(len=16), allocatable :: vdict(:)
     type(tools_list_t)             :: comm
   contains
     ! General
     procedure :: init           => cubetools_language_init
     procedure :: final          => cubetools_language_final
     procedure :: free           => cubetools_language_free
     !
     ! Registering
     procedure :: put            => cubetools_language_put
     procedure :: build_dict     => cubetools_language_dict
     !
     ! Execution
     procedure :: get_command_id => cubetools_language_get_command_id
     !
     ! Print and Help
     procedure :: abstract       => cubetools_language_abstract
     procedure :: list           => cubetools_language_list
     procedure :: help_iterate   => cubetools_language_help_iterate
  end type language_t
  !
contains
  !
  !---General------------------------------------------------------------
  !
  subroutine cubetools_language_init(lang,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(language_t), intent(out)   :: lang
    logical,           intent(inout) :: error
    !
    character(len=*), parameter :: rname='LANGUAGE>INIT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
  end subroutine cubetools_language_init
  !
  subroutine cubetools_language_final(lang,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(language_t), intent(inout) :: lang
    logical,           intent(inout) :: error
    !
    character(len=*), parameter :: rname='LANGUAGE>FINAL'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call lang%free(error)
    if (error) return
  end subroutine cubetools_language_final
  !
  function cubetools_language_ptr(tot,error)
    !-------------------------------------------------------------------
    ! Check if the input class is of type(language_t), and return
    ! a pointer to it if relevant.
    !-------------------------------------------------------------------
    type(language_t), pointer :: cubetools_language_ptr  ! Function value on return
    class(tools_object_t), pointer       :: tot
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='LANGUAGE>PTR'
    !
    select type(tot)
    type is (language_t)
      cubetools_language_ptr => tot
    class default
      cubetools_language_ptr => null()
      call cubetools_message(seve%e,rname,  &
        'Internal error: object is not a language_t type')
      error = .true.
      return
    end select
  end function cubetools_language_ptr
  !
  subroutine cubetools_language_free(lang,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(language_t), intent(inout) :: lang
    logical,           intent(inout) :: error
    !
    character(len=*), parameter :: rname='LANGUAGE>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call lang%comm%free(error)
    if (error) return
  end subroutine cubetools_language_free
  !
  !---Registering----------------------------------------------------------
  !
  subroutine cubetools_language_put(lang,name,authors,help,helpfile,run,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(language_t), intent(inout) :: lang
    character(len=*),  intent(in)    :: name
    character(len=*),  intent(in)    :: authors
    character(len=*),  intent(in)    :: help
    character(len=*),  intent(in)    :: helpfile
    external                         :: run
    logical,           intent(inout) :: error
    !
    character(len=*), parameter :: rname='LANGUAGE>PUT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call lang%final(error)
    if (error) return
    call lang%init(error)
    if (error) return
    lang%name = name
    lang%help = help
    lang%helpfile = helpfile
    lang%authors = authors
    lang%run => run
    lang%comm%n = 0
  end subroutine cubetools_language_put
  !
  subroutine cubetools_language_dict(lang,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(language_t), intent(inout) :: lang
    logical,           intent(inout) :: error
    !
    integer(kind=comm_k) :: idict,icomm,iopt
    integer(kind=4) :: ier
    type(command_t), pointer :: comm
    type(option_t), pointer :: opt
    character(len=*), parameter :: rname='LANGUAGE>DICT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Add the initial dummy commands
    lang%ndict = lang%ndict+1
    allocate(lang%vdict(lang%ndict),stat=ier)
    if (failed_allocate(rname,lang%name//' dictionary',ier,error)) return
    !
    idict = 1
    lang%vdict(idict) = ' '//trim(lang%name)//'?'
    do icomm = 1,lang%comm%n
       comm => cubetools_command_ptr(lang%comm%list(icomm)%p,error)
       if (error) return
       idict = idict+1
       if (comm%allowopt) then
         lang%vdict(idict) = ' '//trim(comm%name)
       else
         lang%vdict(idict) = '-'//trim(comm%name)
       endif
       do iopt =1,comm%opt%n
          opt => cubetools_option_ptr(comm%opt%list(iopt)%p,error)
          if (error) return
          idict = idict+1
          lang%vdict(idict) = '/'//trim(opt%name)
       enddo
    enddo ! icomm
    !
    call sic_begin(lang%name,'GAG_HELP_'//lang%name,lang%ndict,lang%vdict,lang%authors,lang%run,gr_error)
    ier = sic_setlog('GAG_HELP_'//lang%name,lang%helpfile)
    if (ier.eq.0) then
       error = .true.
       return
    endif
    !
  end subroutine cubetools_language_dict
  !
  !---Execution----------------------------------------------------------
  !
  subroutine cubetools_language_get_command_id(lang,commname,commid,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(language_t),    intent(in)    :: lang
    character(len=*),     intent(in)    :: commname
    integer(kind=comm_k), intent(out)   :: commid
    logical,              intent(inout) :: error
    !
    integer(kind=comm_k) :: icomm
    type(command_t), pointer :: comm
    character(len=*), parameter :: rname='LANGUAGE>GET>COMMAND>ID'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    do icomm = 1,lang%comm%n
       comm => cubetools_command_ptr(lang%comm%list(icomm)%p,error)
       if (error) return
       if (comm%name.eq.commname) then
          commid = icomm
          return
       endif
    enddo ! icomm
    commid = 0
    call cubetools_message(seve%e,rname,'Unknown command '//trim(commname)//' in language '//trim(lang%name))
    error = .true.
    return
  end subroutine cubetools_language_get_command_id
  !
  !---Print-and-Help-------------------------------------------------------
  !
  subroutine cubetools_language_help_iterate(lang,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(language_t), intent(in)    :: lang
    logical,           intent(inout) :: error
    !
    integer(kind=comm_k) :: icomm
    type(command_t), pointer :: comm
    character(len=*), parameter :: rname='LANGUAGE>HELP>ITERATE'
    !
    call cubetools_message(toolseve%help,rname,'\section{'//trim(lang%name)//' Language On-Line Help}')
    call cubetools_message(toolseve%help,rname,'\label{sec:'//trim(lang%name)//':help}')
    call cubetools_message(toolseve%help,rname,'\index{'//trim(lang%name)//' command list}')
    !
    call cubetools_message(toolseve%help,rname,'\begin{PlusVerbatim}')
    call lang%list(error)
    if (error) return
    call cubetools_message(toolseve%help,rname,'\end{PlusVerbatim}')
    !
    do icomm=1,lang%comm%n
      comm => cubetools_command_ptr(lang%comm%list(icomm)%p,error)
      if (error) return
      call comm%help_iterate(lang%name,error)
      if (error) return
    enddo
  end subroutine cubetools_language_help_iterate
  !
  subroutine cubetools_language_abstract(lang,error)
    use sic_def ! Definition of backslash
    use cubetools_format
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(language_t), intent(in)    :: lang
    logical,           intent(inout) :: error
    !
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='LANGUAGE>ABSTRACT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    mess = '  '//cubetools_format_stdkey_boldval(trim(lang%name)//backslash,  &
      lang%help,help_width())
    call cubetools_message(toolseve%help,rname,mess)
  end subroutine cubetools_language_abstract
  !
  subroutine cubetools_language_list(lang,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(language_t), intent(in)    :: lang
    logical,           intent(inout) :: error
    !
    integer(kind=comm_k) :: icomm
    type(command_t), pointer :: comm
    character(len=*), parameter :: rname='LANGUAGE>LIST'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call lang%abstract(error)
    if (error) return
    if (lang%comm%n.gt.0) call cubetools_message(toolseve%help,rname,strg_dash())
    do icomm = 1,lang%comm%n
       comm => cubetools_command_ptr(lang%comm%list(icomm)%p,error)
       if (error) return
       call comm%print_abstract(error)
       if (error) return
    enddo ! icomm
    call cubetools_message(toolseve%help,rname,blankstr)
  end subroutine cubetools_language_list
end module cubetools_language
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
