module sic_runs
  use gildas_def
  use sic_dictionaries
  !---------------------------------------------------------------------
  ! Support for nested calls of programs and languages
  !---------------------------------------------------------------------
  integer, parameter :: sic_maxlang=64
  integer(kind=address_length), save :: run_address(2,sic_maxlang)=0
  logical, save :: debug_mode
  integer, save :: sic_icall=0
  character(len=command_length), save :: sic_stack(sic_maxlang)
end module sic_runs
!
subroutine sic_begin(lang,help,scom,ccom,version,inter,prob)
  use sic_runs
  use sic_dictionaries
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_begin
  !---------------------------------------------------------------------
  ! @ public
  ! Main initialisation routine for Languages
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: lang     !
  character(len=*), intent(in) :: help     !
  integer,          intent(in) :: scom     !
  character(len=*), intent(in) :: ccom(1)  !
  character(len=*), intent(in) :: version  !
  external :: inter                        ! Subroutine for executable code
  logical, external :: prob                ! Logical error function
  ! Local
  logical, save :: first=.true.
  logical :: error
  !
  call sic_load(lang,help,scom,ccom,version)
  run_address(1,nlang) = locwrd(inter)
  run_address(2,nlang) = locwrd(prob)
  !
  if (run_address(1,1).eq.0) then
    run_address(1,1) = locwrd(run_sic)
    run_address(2,1) = locwrd(sic_error)
  endif
  !
  if (first) then
    error = .false.
    call sic_def_logi('DEBUG_RECURSIVE',debug_mode,.false.,error)
    first = .false.
  endif
  !
end subroutine sic_begin
!
recursive subroutine exec_program(buffer)
  use gildas_def
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>exec_program
  use sic_runs
  use sic_dictionaries
  use sic_interactions
  !---------------------------------------------------------------------
  ! @ public
  ! Main routine to execute a command or enter a program
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: buffer  !
  ! Global
  include 'gbl_memory.inc'
  ! Local
  integer(kind=address_length) :: ip,ie
  character(len=command_length) :: command
  character(len=language_length) :: lang
  character(len=2048) :: line
  integer :: icode,ocode
  logical :: error
  !
  line = buffer
  icode = code_exec
  goto 10
  !
entry play_program(buffer)  ! @ public
  line = buffer
  icode = code_play
  goto 10
  !
entry enter_program  ! @ public
  icode = code_enter
  goto 10
  !
10 continue
  !
  ! Return Ocode -1 : End of subroutine mode
  !        Ocode  1 : End of interactive mode
  !
  error = .false.
  do while (.true.)
    call sic_run(line,lang,command,error,icode,ocode)
    if (ocode.ne.code_next) then
#if defined(GAG_USE_PYTHON)
      if (ocode.eq.code_exit)  &  ! SIC\EXIT has been called from SIC
        call gpy_onsicexit
#endif
      return
    endif
    icode = code_run
    !
    ! Activate the language dependent code
    if (run_address(1,ccomm%ilang).eq.0) then
      call sic_message(seve%f,'SIC',  &
        trim(lang)//'\ language has not been initialized by SIC_BEGIN')
      call sysexi(fatale)
    endif
    ip = bytpnt(run_address(1,ccomm%ilang),membyt)
    ie = bytpnt(run_address(2,ccomm%ilang),membyt)
    call sub_program (membyt(ip),line,command,error,membyt(ie))
  enddo
  !
end subroutine exec_program
!
subroutine exec_adjust(buffer,error)
  use gildas_def
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>exec_adjust
  use sic_runs
  use sic_dictionaries
  use sic_interactions
  !---------------------------------------------------------------------
  ! @ public-mandatory (because symbol is used elsewhere)
  ! Execute any command, possibly a procedure. Non recursive version
  ! used by ADJUST only
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: buffer  !
  logical,          intent(out) :: error   !
  ! Global
  include 'gbl_memory.inc'
  ! Local
  integer(kind=address_length) :: ip,ie
  !
  character(len=command_length) :: command
  character(len=language_length) :: lang
  character(len=2048) :: line
  integer :: icode,ocode
  !
  error = .false.
  line = buffer
  icode = code_exec
  !
  ! Return Ocode -1 : End of subroutine mode
  !        Ocode  1 : End of interactive mode
  !
  do while (.true.)
    call sic_run(line,lang,command,error,icode,ocode)
    if (ocode.ne.code_next) return
    icode = code_run
    !
    if (run_address(1,ccomm%ilang).eq.0) then
      call sic_message(seve%f,'SIC',  &
        trim(lang)//'\ language has not been initialized by SIC_BEGIN')
      error = .true.
      return
    endif
    ip = bytpnt(run_address(1,ccomm%ilang),membyt)
    ie = bytpnt(run_address(2,ccomm%ilang),membyt)
    call sub_program (membyt(ip),line,command,error,membyt(ie))
    if (error) return
    error = sic_ctrlc()
    if (error) return
  enddo
  !
end subroutine exec_adjust
!
recursive subroutine sub_program(sub,line,command,error,problem)
  use sic_interfaces
  use sic_runs
  use gbl_message
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! This subroutine executes the call to the command dispatching
  ! routine for a specific language. It also calls the problem
  ! specific routine.
  !---------------------------------------------------------------------
  external                        :: sub      ! Subroutine to call intent(in)
  character(len=*), intent(in)    :: line     ! Command line
  character(len=*), intent(in)    :: command  ! Command name
  logical,          intent(inout) :: error    ! Error flag
  logical, external               :: problem  ! Test error function intent(in)
  ! Local
  integer :: i
  character(len=message_length) :: mess
  !
  ! Increment nesting level and optionally printout call stack
  if (debug_mode .and. sic_icall.gt.0) then
    write (mess,*) 'Nesting ',sic_icall,command,(sic_stack(i),i=sic_icall,1,-1)
    call sic_message(seve%d,'SUB',mess)
  endif
  sic_icall = sic_icall+1
  if (sic_icall.lt.sic_maxlang) sic_stack(sic_icall) = command
  !
  call sub(line,command,error)
  error = error .or. problem()
  ! Decrement nesting level
  sic_icall = sic_icall-1
  !
end subroutine sub_program
!
subroutine exec_string (line,error)
  use sic_interfaces, only : exec_command
  use sic_runs
  use sic_dictionaries
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  ! Executes a single command. Input line is protected 
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   ! Line to execute
  logical,          intent(inout) :: error  ! Error flag
  !
  character(len=commandline_length) :: local_line
  !
  local_line = line
  call exec_command(local_line,error)
end subroutine exec_string
!
subroutine exec_command(line,error)
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>exec_command
  use sic_runs
  use sic_dictionaries
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public-mandatory (because symbol is used elsewhere)
  ! Executes a single command. Input line is also resolved on output.
  !---------------------------------------------------------------------
  character(len=*), intent(inout) :: line   ! Line to execute
  logical,          intent(inout) :: error  ! Error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='SIC'
  integer(kind=address_length) :: ip,ie
  integer :: nl
  character(len=command_length) :: command
  !
  ! Analyse line
10 continue
  nl = len_trim(line)
  call sic_blanc(line,nl)
  call sic_analyse(command,line,nl,error)
  if (error) then
    call sic_message(seve%e,rname,'Error interpreting line:')
    call sic_message(seve%e,rname,line(1:nl))
    return
  endif
  !
  ! Support for user languages
  if (languages(ccomm%ilang)%user) then
    ! Command is a user language
    call replace_usercom(languages(ccomm%ilang),command,line,nl,error)
    if (error)  return
    goto 10
  endif
  !
  if (run_address(1,ccomm%ilang).eq.0) then
    call sic_message(seve%f,rname,  &
      trim(ccomm%lang)//'\ language has not been initialized by SIC_BEGIN')
    error = .true.
    return
  endif
  !
  ! Execute line
  ip = bytpnt(run_address(1,ccomm%ilang),membyt)
  ie = bytpnt(run_address(2,ccomm%ilang),membyt)
  call sub_program(membyt(ip),line,command,error,membyt(ie))
  !
end subroutine exec_command
!
subroutine run_sic(line,command,error)
  use sic_interfaces, except_this=>run_sic
  use gbl_message
  use sic_interactions
  use sic_macros_interfaces
  !---------------------------------------------------------------------
  ! @ public-mandatory (public but should probably not) (mandatory
  ! because symbol is used elsewhere)
  ! Execute an elemental SIC command
  !---------------------------------------------------------------------
  character(len=*), intent(inout) :: line     ! Command line, can be updated on return
  character(len=*), intent(in)    :: command  !
  logical,          intent(out)   :: error    !
  ! Local
  integer :: nline,lire
  !
  error = .false.
  !
  call sic_message(seve%c,'SIC',line)
  !
  ! SIC commands
  select case (command)
  !
  case('ACCEPT')
    call sic_accept(line,error)
  !
  case('COMPUTE')
    nline = len_trim(line)
    call sic_compute(line,nline,error)
  !
  case('DATETIME')
    call sic_datetime(line,error)
  !
  case('DEFINE')
    nline = len_trim(line)
    call sic_define(line,nline,error)
  !
  case('DELETE')
    call sic_delete(line,error)
  !
  case('DIFF')
    call sic_diff(line,error)
  !
  case('EXAMINE')
    call examine_variable(line,error)
  !
  case('EXECUTE')
    call sic_execute(line,error)
  !
  case('HELP')
    call sic_help(line,error)
  !
  case('LET')
    nline = len_trim(line)
    if (lxwindow) then
      call xgag_variable(line,nline,error)
    else
      call let_variable(line,nline,error)
    endif
  !
  case('MESSAGE')
    call sic_message_command(line,error)
  !
  case('MFIT')
    call fit_expression(command,line,error)
  !
  case('MODIFY')
    call sic_modify(line,error)
  !
  case('ON')
    call sic_on(line,error)
  !
  case('IMPORT')
#if defined(GAG_USE_STATICLINK)
    call sic_message(seve%e,'IMPORT','Command is only available when '//  &
    'using shared libraries')
    error = .true.
#else
    call import_package(line,error)
#endif
  !
  case('PYTHON')
    call sic_run_python(line,.false.,error)
    !
  case('PARSE')
    call sic_macros_parse(line,error)
  !
  case('SAY')
    nline = len_trim(line)
    call sicsay(line,nline,error)
  !
  case('SIC')
    lire = 0  ! ???
    call sicset(line,lire,error)
  !
  case('SORT')
    call sicsort(line,error)
  !
  case('SYMBOL')
    nline = len_trim(line)
    call define_symbol(line,nline,error)
  !
  case('SYSTEM')
    call sic_dcl(line,error)
  !
  case ('TIMER')
    call sic_timer(line,error)
  !
  ! Invalid
  case default
    call sic_message(seve%e,'SIC','Command '//trim(command)//' is invalid '// &
    'in this context')
    error = .true.
  end select
  !
end subroutine run_sic
!
function sic_error()
  !---------------------------------------------------------------------
  ! @ private
  ! Default error function
  !---------------------------------------------------------------------
  logical :: sic_error              ! Value on return
  sic_error = .false.
end function sic_error
!
subroutine run_gui(line,command,error)
  use sic_interfaces, except_this=>run_gui
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interactions
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  ! Execute an elemental GUI command
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line     !
  character(len=*), intent(in)    :: command  !
  logical,          intent(inout) :: error    !
  ! Local
  character(len=*), parameter :: rname='GUI'
  !
  call sic_message(seve%c,rname,line)
  !
  if (sic_window) then
    !
    select case (command)
    case('PANEL')
      call xgag_input(line,error)
      !
    case('BUTTON')
      call xgag_comm(line,error)
      !
    case('URI')
      call xgag_uri(line,error)
      !
    case('MENU')
      call xgag_menus(line,error)
      !
    case('SUBMENU')
      call xgag_submenu(line,error)
      !
    case('GO')
      call xgag_go(line,error)
      !
    case('END')
      call xgag_end(0,error)
      call sic_nolog ! Avoid writing it in Stack
      !
    case('ERASE')
      call end_dialog
      !
    case('WAIT')
      call xgag_wait
      call xgag_end(1,error)
      !
    case default
      call sic_message(seve%e,rname,'No code to execute for '//command)
      error = .true.
    end select
    !
  else
    call sic_message(seve%e,rname,  &
      "Command '"//trim(command)//"' invalid in this context")
    error = .true.
  endif
  !
end subroutine run_gui
!
function err_gui()
  !-----------------------------------------------------------------------
  ! @ private
  ! Default error function
  !-----------------------------------------------------------------------
  logical :: err_gui  ! Value en return
  !
  err_gui = .false.
end function err_gui
