c**********************************************************************c
c Description: Run a Java Primitive inside X-Midas
c
c Author:      whk 05/14/2004
c
c $Id: nm.for,v 1.13 2009/01/02 16:56:58 ntn Exp $
c
c**********************************************************************c
      program NM

      implicit none
      include 'primitive.inc'
      include 'flags.inc'
      include 'jni.inc'
      include 'xtypes.inc'

c.. Inputs
      character*(1024) commandname, command

c.. Common
      logical*4 dbg
      common /JSM_COMMON/ dbg

c.. Locals
      integer*4 ltmpstr, lcommandname
      character*2200 tmpstr
      character*64 macroname

      integer*4 ignore, jsm_status
      logical*4 ignore_logical
      logical*4 jvmstatus, jvmoff, jvmon, jvmclean, jvmkill

      integer*4    id_switch  ! The /ID= switch
      integer*4    xs_switch  ! The window id set with /XS (ignore if <= 0)
      integer*4    window_id  ! The window ID (should be null)

      call M$CHECKIN

      !******* Check to debug the primitive
      dbg       = M$GET_PSWITCH('DEBUG')
      jvmstatus = M$GET_PSWITCH('STATUS')
      jvmoff    = M$GET_PSWITCH('OFF')
      jvmkill   = M$GET_PSWITCH('KILL')
      jvmon     = M$GET_PSWITCH('ON')
      jvmclean  = M$GET_PSWITCH('CLEAN')
      xs_switch = M$GET_SWITCH('XS')
      id_switch = M$GET_SWITCH('ID')
      window_id = 0

c      ignore_logical = jni$setclasspath(dbg)
c      ignore_logical = jni$getswitches(dbg)

      call debug('getting command')

      !******* Check to see if there is a JSM already started *********c
      jsm_status = jni$checkforjsm()

      if(dbg)write(*,*) 'NM.FOR: jsm_status = ',jsm_status

      !******* Get the Java Command Name to run ***********************c
      ignore = M$UAPICK(1,command,UAP_TRANSLATE)
      if (jvmon) then
        ! **** NM/ON ****
        if (jsm_status .gt. 0) then
          call m$info('NeXtMidas session already running,'
     &           //' not restarting.')
          call M$SYNC
        else if (.not. Mu.spawn) then
          call m$error('NM/ON requires /BG switch in order to run.')
          call M$SYNC
        else
          if (id_switch .le. 0) then
            call m$warning('NM: Mapping of X-Midas and NeXtMidas'
     &             //' messages disabled. Set /ID= when using'
     &             //' NM/ON to enable message mapping.')
          endif

          ! Create the JVM
          ignore_logical = jni$setclasspath(dbg)
          ignore_logical = jni$getswitches(dbg)

          call debug('Turning on the Java VM')
          ignore = jni$startjvm()

          call debug('Creating callbacks for the Java VM')
          ignore = jni$startjsm()

          call debug('Starting NeXtMidas Classes')
          ignore = jni$startnm()
          ignore = jni$processcommands()
          ignore = jni$cleanupjsm()
          ignore = jni$stopjvm()
        endif

      else if (jvmoff .or. jvmkill) then
        ! **** NM/OFF or NM/KILL ****
        if (jsm_status .lt. 0) then
          call m$info('No NeXtMidas session currently running')
        else
          call debug('Turning off VM')
          ! Remove the callbacks
          ignore = jni$stopjsm()
        endif
        call M$SYNC

      else if (jvmstatus) then
        ! **** NM/STATUS ****
        call debug('Statusing VM')
        if (jsm_status .lt. 0) then
          call m$info('No NeXtMidas session currently running')
        else
          call m$info('NeXtMidas session is already running')
        endif
        call M$SYNC

      else if (jvmclean) then
        ! **** NM/CLEAN ****
        call debug('Cleaning up VM')
        ignore = jni$cleanupjsm()
        call M$SYNC

      else
        ! **** NM <cmd> ****
        if (jsm_status .lt. 0) then
          call m$warning('NM: NeXtMidas is not running, '
     &           //'use NM/ON first')
          call M$SYNC
        elseif (id_switch .gt. 0) then
          call m$warning('NM: Can not start NeXtMidas command. The'
     &           //' /ID= switch can only be specified after the'
     &           //' NeXtMidas command name, not after the NM.')
          call M$SYNC
        else
          lcommandName = M$QPICK(commandname)

          ! If /XS is specified, setup the basic X11 windows...
          ! although Java will use its own windows this will
          ! initialize the initial values that will be used
          ! from inside Java.
          if (xs_switch .gt. 0) then
            call MX$GRAPHICSINIT()
            call MX$SETUP(100,100)
            window_id = MX$WINDOW_ID(xs_switch, 1) ! 1 = SET ID
            call M$GET_MACRO_NAME(0,macroname)
            ! In order to provide Java with the name of the
            ! macro, stick it in Mc.command_string but use
            ! a lower case name so X-Midas will ignore it.
c           Bug 1341 - changes to run under X-Midas 4.5.x+
#if XM_SYS_VERSION_AT_LEAST(4,5,0)
            call M$SET_COMMAND_SWITCH('macroname',
     &                                macroname(1:M$LENGTH(macroname)))
#else

            macroname = '/macroname="'//
     &           macroname(1:M$LENGTH(macroname))//'"'

            tmpstr = Mc.command_string
            Mc.command_string = tmpstr(1:Mc.switch_length-1)//
     &           macroname(1:M$LENGTH(macroname))//
     &           tmpstr(Mc.switch_length:Mc.command_length)
            Mc.command_length = Mc.command_length+M$LENGTH(macroname)
            Mc.switch_length  = Mc.switch_length +M$LENGTH(macroname)
#endif
          endif

          if (M$GET_SWITCH('SYNC') .eq. 1) then
            call debug('found /SYNC switch, calling M$SYNC')
            call M$SYNC()
          endif

          call debug('running command = "'//
     &             commandname(1:M$LENGTH(commandname))//'"')
          ignore = jni$jsmrun(commandname(1:lcommandName))

          ! Cleanup from the /XS switch
          if (xs_switch .gt. 1) then
            window_id = MX$WINDOW_ID(xs_switch, -1) ! -1 = REMOVE ID
          endif
        endif
      endif

      call debug('Returning')
      call M$RETURN
      end

!**********************************************************************!
      subroutine debug (str)

      implicit none
      include 'primitive.inc'

      character*(*) str
      logical*4 dbg
      common /JSM_COMMON/ dbg

      if(dbg) write(*,*) 'NM.FOR: '//str(1:M$LENGTH(str))
      end
