c*************
c  Description: X-Midas Datafile List/Modification primitive
c
c  Author:	CLI (Based on X-DataMod by JGS)
c
c 980518:JRH:Modified from XM350 to include fix for memory leak associated
c            with multiple new files.
c 200215:MIB:Modified to respond with an =NEWFILEINFO message when appropriate
c            DR RRCcl00592
c 05-21-2004: JLR DR 503499 - Modified to only reinitialize Gx.top if PAN 
c                             mask bit is not indicated in NEWFILE message.
c 06-14-2004: JLR DR 500123 - Modified XDATA_FORM_COMMAND, when keyword
c                             EDIT==COMMAND and COMMAND uses ^DATA, to properly
c                             form command based the length of the value of ^DATA
c                             not the string "^DATA"
c 06-26-2020: JTM NXM-3531  - Added GFC
c
c #_SUN OPTIMIZATION -O1
c
c    11-03 EHG DR 500002 Change 'type' to 'write' for Intel Compiler.
c
c*************
	program XDATALIST
	include 'xdatalist.inc'

	call M$CHECKIN()

	call XDATA_PREAMBLE()

	call M$SYNC()

	call XDATA_PLOT()

	do while (Gx.status.ge.0 .AND. .NOT.Mc.break)
	  Gx.status = 0
	  call XDATA_EVENT()
	  call XDATA_MESSAGE()
	  call XDATA_POLL()
	  if (Gx.status .eq. 0) call M$PAUSE(Mc.pause)
	enddo

	call XDATA_POSTAMBLE()
	call M$RETURN()
	END	! XDATALIST



c XDATA_PREAMBLE
c
c Initializes data structures, interprets parameters & switches
c
	subroutine XDATA_PREAMBLE ()
	include 'xdatalist.inc'

	record /HEADER/	hcb
	integer*4	text_w, text_h, view, flen, ii, jj, junk
	logical*4	bjunk
	character	str*(DEFSTRLEN), filename*80
	real*8		dummy

	Gx.status	  = 0
	Gx.pbData.p	  = 0
	Gx.pbFinfo.p	  = 0
	Gx.pbPoll.p	  = 0
	Gx.pbScreen.p	  = 0
	Gx.pbHlit.p	  = 0
	Gx.pbPaste.p	  = 0
	Gx.pbScratch.p	  = 0
	Gx.pastebufempty  = .TRUE.
	Gx.top		  = 1d0
	Gx.left		  = 0
	Gx.fleft	  = 1
	Gx.elemt	  = SEL_NONE
	Gx.field	  = SEL_NONE
	Gx.scalar	  = SEL_NONE
	Gx.defcolor	  = L_FGColor
	Gx.nhlit	  = 0
	Gx.ahlit	  = 0
	Mx.ytag = ' '
	Mx.xtag = ' '
	Mx.ztag = ' '

	!
	! Read command line switches
	!

	! Cursor granularity
	if (M$GET_USWITCH('CUR', str(1:10)) .le. 0) then
	  Gx.cursor = CR_DEF
	else if (str(1:3) .eq. 'ROW') then
	  Gx.cursor = CR_ROW
	else if (str(1:5) .eq. 'FIELD') then
	  Gx.cursor = CR_FIELD
	else if (str(1:3) .eq. 'SCA') then
	  Gx.cursor = CR_SCALAR
	else if (str(1:4) .eq. 'FCOL') then
	  Gx.cursor = CR_FCOL
	else if (str(1:4) .eq. 'SCOL') then
	  Gx.cursor = CR_SCOL
	else if (str(1:4) .eq. 'NONE') then
	  Gx.cursor = CR_NONE
	else
	  Gx.cursor = CR_DEF
	endif

	! Cursor Color
	if (M$GET_PSWITCH('CURCOLOR')) then
	  Gx.curcolor = M$GET_SWITCH('CURCOLOR')
	else
	  ! Transparent cursor with background the same color as the
	  ! background of a highlighted item in a menu widget
	  Gx.curcolor = DEFCURCOLOR*1000 + L_XORColor
	endif
	Gx.curcolor_bg	  = NINT(Gx.curcolor/1000.0)
	Gx.curcolor_fg	  = Gx.curcolor - Gx.curcolor_bg * 1000
	Gx.xparent_cursor = (Gx.curcolor_fg .eq. L_XORColor)

	! NOTE: Undocumented switch
	! TODO: (someday) Get this value from X-Midas/window manager
	Gx.doubleclick = REAL(M$GET_DSWITCH('DBLCLK'))
	if (Gx.doubleclick .lt. 0.1)
     +	  Gx.doubleclick = 0.3			! seconds

	! NOTE: Undocumented switch
	! Arbitrary index offset for displaying indices
	Gx.ioffset = MAX(0, M$GET_SWITCH('IOFF'))

	! Bitmask specifying which INFO messages to generate
	if (M$GET_PSWITCH('MASK')) then
	  Gx.msgmask = M$GET_SWITCH('MASK')
	else
	  Gx.msgmask = 0
	endif

	Gx.modify = MAX(0, MIN(M$GET_SWITCH('MOD'),2))

	! Who is to receive INFO messages?
	Gx.msgid = M$GET_SWITCH('MSGID')

	! Rate at which visible portion of datafile will be
	! read from disk and checked for changes
	Gx.pollperiod = MAX(0.0, REAL(M$GET_DSWITCH('POLL')))

	view = M$GET_SWITCH('VIEW')

	Gx.tracksel = M$GET_PSWITCH('TRACKSEL')

	Gx.cntrls = M$GET_SWITCH('XCNT')
	if (Gx.cntrls.lt.0 .OR. Gx.cntrls.gt.2) Gx.cntrls = 1

	if (M$GET_PSWITCH('XMBOFF')) then
	  Gx.xmboff = M$GET_SWITCH('XMBOFF')
	else
	  Gx.xmboff = 0
	endif

	Gx.fnametitle = .NOT. M$GET_PSWITCH('XN')

	text_w = M$GET_SWITCH('XTS')
	if (text_w .eq. -1) then
	  text_w = 9
	else
	  text_w = ABS(text_w)
	endif


	!
	! Read command line arguments
	!
	filename = M$APICK(1)		! Datafile filename
	flen = M$UAPICK(2, str, 0)	! Template filename(s)
	Gx.ndatarows = M$LPICK(3)	! Number of data rows to display
	if (Gx.ndatarows .lt. 0) Gx.ndatarows = 20

	! Open any command line template files
	Gx.ntmpl = 0
	hcb.type_allow = ' '
	hcb.format_allow = ' '
	do while (M$LENGTH(str).gt.0 .AND. Gx.ntmpl.lt.NTMPL)
	  Gx.ntmpl = Gx.ntmpl + 1
	  ii = M$SEARCH(str,'|')
	  if (ii .eq. 0) ii = M$LENGTH(str)+1
	  hcb.file_name = str(1:ii-1)
	  junk = M$APICK_POST (hcb.file_name, ii-1)
	  call M$INOK(hcb)
	  call M$MALLOC(L_header_size, Gx.phTmpl(Gx.ntmpl).p)
	  call M$MOVE(hcb, %val(Gx.phTmpl(Gx.ntmpl).p), L_header_size)
	  str = str(ii+1:)
	enddo

	! If template file(s) were specified on command line, use the 1st
	view = MIN(view,Gx.ntmpl)
	if (view.lt.0) then
	  if (Gx.ntmpl .gt. 0) then
	    view = 1
	  else
	    view = 0
	  endif
	endif

	! Open the data file, generate its default template, 
	! decide which template we're using and initialize it
	call M$MALLOC(L_header_size, Gx.phData.p)
	call M$MALLOC(L_header_size, Gx.phTmpl(0).p)
	call XDATA_NEWFILE(filename, 0, view, 0, .TRUE.,Gx.msgid) !MIB

	! Open X-window display and root window
	Mx.level = 1
	Mx.origin = 4	! quadrant IV: (0,0) at top-left

	! Duplicate algorithm of mx_setfont (grr...)
	if (text_w .lt. 6) then
	  text_w = 5
	  text_h = 10
	elseif (text_w .lt. 7) then
	  text_w = 6
	  text_h = 12
	elseif (text_w .lt. 9) then
	  text_w = 7
	  text_h = 14
	elseif (text_w .lt. 11) then
	  text_w = 9
	  text_h = 16
	elseif (text_w .lt. 15) then
	  text_w = 11
	  text_h = 18
	else
	  text_w = 15
	  text_h = 24
	endif

	call MX$SETUP(-1*text_w*(Gx.dispwidth+Gx.iwidth+4),
     +		      -1*text_h*(Gx.ndatarows+Gx.ntitle))

c+++
c jdh added
        call MX$SETFONT(text_w)
c---

	! Need to call XDATA_MTAGS again here because the Mx structure
	! wasn't initialzed when it was called via XDATA_NEWFILE!
	if (Gx.cntrls.gt.0) call XDATA_MTAGS(0.d0, 0.d0, 0.d0)

	! This also needs to be done after MX$SETUP...
	bjunk = MX$SCROLL(Gx.sbvert, XW_INIT)
	bjunk = MX$SCROLL(Gx.sbhorz, XW_INIT)

	! Trim pathname and extension
	flen = M$LENGTH(filename)
	ii = M$SEARCHB(filename(1:flen), ']')
	if (ii.eq.0) ii = M$SEARCHB(filename(1:flen), '/')
	if (ii.eq.0) ii = M$SEARCHB(filename(1:flen), ':')
	jj = M$SEARCH(filename(ii+1:flen), '.') - 1
	if (jj.lt.0) jj = flen - ii
	call MX$OPEN('X-DataList - '//filename(ii+1:ii+jj))
	Mx.no_arrow_move = .TRUE.

	! Initialize the colormap
	call XDATA_COLORS(0)

	return
	END	! XDATA_PREAMBLE



c XDATA_NEWFILE
c
c Opens a new data file and with the requested template view
c
c If modify .gt. 0  Data file will be opened with write access
c If modify .lt. 0  Data file will be opened with read access
c If modify .eq. 0  The current value of Gx.modify will determine
c		    read/write access.
c
	subroutine XDATA_NEWFILE (filename, modify, reqview, keepmask,
     +						init,sid)        !MIB
	include 'xdatalist.inc'
	include 'qmessages.inc'                                  !MIB
	character*(*)	filename
	integer*4	modify, reqview, keepmask, success, sid
	logical*4	init

	! NEWFILE message arg2 bitmask codes
	integer*4 KEEPSELECT, KEEPPAN, KEEPHLIT
	parameter (KEEPSELECT=1, KEEPPAN=2, KEEPHLIT=4)

	record /HEADER/ hdata, oldhdata
	pointer		(oldhdataptr, oldhdata)
	integer*4	mod, view, len, ii, jj, ljunk
	character	fname*(80)

	integer*4	XDATA_OFFSET2FIELD

	hdata.type_allow = '-4000'
	hdata.format_allow = ' '
	hdata.switch = 'NOABORT'
	if (init) hdata.switch = ' '
	hdata.file_name = filename
	if (modify .ne. 0) then
	  mod = modify
	else
	  mod = Gx.modify
	endif
	if (mod .gt. 0) then
	  call M$INOKW(hdata)
	  call M$HCBFUNC(hdata, HCBF_APPEND, ljunk)
	else
	  call M$INOK(hdata)
	endif
	if (hdata.open) then

	  ! Don't use disk caching
	  hdata.flush = .TRUE.

	  ! Close old file, load new header
	  if (.NOT. init) then
	    oldhdataptr = Gx.phData.p
	    oldhdata.output = .FALSE.
	    call M$CLOSE(oldhdata)
	  endif
	  call M$MOVE(hdata, %val(Gx.phData.p), L_header_size)
	  
	  fname    = hdata.file_name
	  Gx.class = hdata.class
	  Gx.nsize = hdata.size
	  Gx.bpe = hdata.bpe
	  ! The scratch buffer needs to be large enough
	  ! to hold one logical datafile element.
	  call M$REMALLOC(Gx.bpe, Gx.pbScratch.p)
	  if (mod .gt. 0) then
	    call M$REMALLOC(Gx.bpe, Gx.pbPaste.p)
	    ! Fill paste buffer with 0s
	    call M$VSTYPE('B')
	    call M$VFILL(%val(Gx.pbPaste.p), 0, Gx.bpe)
	    Gx.pastebufempty = .TRUE.
	  endif
	  Gx.modify = mod

	  ! Generate the default template
	  if (.NOT. init) then
	    ! Free the memory associated with the previous
	    ! default template's extended header.  This is done
	    ! in M$CLOSE only if there's a file associated with
	    ! the header that's currently open (hcb.open is .TRUE.),
	    ! so we have do do it ourselves.
	    oldhdataptr = Gx.phTmpl(0).p
	    call M$STMFREE(oldhdata.ext_alloc, oldhdata.ext_loc)
	    oldhdata.ext_alloc = 0
	  endif
	  call M$INITIALIZE(%val(Gx.phTmpl(0).p))
	  call XDATA_DEFAULT_TEMPLATE(%val(Gx.phData.p),
     +				      %val(Gx.phTmpl(0).p))

	  ! Validate view, open selected template
	  view = MIN(Gx.ntmpl,ABS(reqview))
	  if (view.gt.0 .AND. view.eq.-1*reqview) then
	    ! Close and re-open the template
	    call M$CLOSE(%val(Gx.phTmpl(view).p))
	    call M$INOK(%val(Gx.phTmpl(view).p))
	  endif
	  call XDATA_NEWTEMPLATE(view)

	  ! Remove current selection?
	  if (.NOT.init .AND. IAND(keepmask,KEEPSELECT).eq.0)
     +	    call XDATA_DESELECT()

	  ! Init plotting range?
	  if (IAND(keepmask,KEEPPAN) .eq. 0) then
	    Gx.top    = 1d0
c Gx.left and Gx.fleft are reinitialized in XDATA_NEWTEMPLATE (DR 2776)
c	    Gx.left   = 0
c	    Gx.fleft  = 1
	  else
	    Gx.fleft  = XDATA_OFFSET2FIELD(Gx.left, .FALSE.)
	  endif

	  ! Initialize the highlight buffer?
	  if (IAND(keepmask,KEEPHLIT) .eq. 0)
     +	    call XDATA_DEL_HIGHLIGHT(0, 0)

	  if (.NOT. init) then
	    ! Put filename in Title Bar?
	    if (Gx.fnametitle) then
	      ! Trim pathname and extension
	      len = M$LENGTH(fname)
	      ii = M$SEARCHB(fname(1:len), ']')
	      if (ii.eq.0) ii = M$SEARCHB(fname(1:len), '/')
	      if (ii.eq.0) ii = M$SEARCHB(fname(1:len), ':')
	      jj = M$SEARCH(fname(ii+1:len), '.') - 1
	      if (jj.lt.0) jj = len - ii
	      call MX$TITLE('X-DataList - '//fname(ii+1:ii+jj), 3)
	    endif
	  endif
          success = 0                                                !MIB
	else
	  call MX$MESSAGE('Unable to open data file '//filename, -1.0)
          success = -1                                               !MIB
	endif

C...Start of Mods for DR RRCcl00592   MIB
        if(.NOT. init .and. success .eq. 0) then
         if(Gx.msgid .ne. sid .and. sid.ge.0 .and.
     *             BTEST(Gx.msgmask,MSK_NEWFILE) ) then
      	   call XDATA_INFOMSG(MSK_NEWFILE, sid, success)
         endif
         if(XDATA_SENDINFOMSG(MSK_NEWFILE))  THEN
     	  call XDATA_INFOMSG(MSK_NEWFILE, Gx.msgid, success)
         endif
        endif
C...End of Mods for DR RRCcl00592   MIB

 	return
	END	! XDATA_NEWFILE

c XDATA_NEWTEMPLATE
c
c Attempts to load an X-DataList template into memory.
c If unsuccessful, reopens the current template
c
	subroutine XDATA_NEWTEMPLATE (reqview)
	include 'xdatalist.inc'
	integer*4	reqview

	logical*4	XDATA_LOAD_TEMPLATE

	record /HEADER/	htmpl
	pointer		(htmplptr, htmpl)
	logical*4	bjunk

	htmplptr = Gx.phTmpl(reqview).p
	if ( XDATA_LOAD_TEMPLATE(htmpl) ) then
	  Gx.view = reqview
c DR 2776 12/6/02 sar
          ! Reset template pointers
c DR 503499 05/21/04 JLR
c         Only reinitialized in XDATA_NEWFILE if PAN bit is not set in keepmask.
c          Gx.top    = 1d0
          Gx.left   = 0
          Gx.fleft  = 1
c end DR 2776
	else
	  ! Abort and reload the current template
	  call M$WARNING('Unable to load template '//htmpl.file_name)
	  htmplptr = Gx.phTmpl(Gx.view).p
	  bjunk = XDATA_LOAD_TEMPLATE(htmpl)
	endif

	return
	END	! XDATA_NEWTEMPLATE



c XDATA_LOAD_TEMPLATE
c
c Loads an X-DataList template's keywords into a series of
c FIELDINFO structures.  Also performs template error-checking
c
	logical*4
     +	function XDATA_LOAD_TEMPLATE (htmpl)
	include 'xdatalist.inc'
	record /HEADER/	htmpl

	record /HEADER/		hdata
	pointer			(hdataptr, hdata)
c	record /FIELDINFO/	finfo(1)
	record /FIELDINFO/	finfo(*)	! _IFC
	pointer			(finfoptr, finfo)
	record /M_PTR/		pKeyword
	character		keywordstr*(LBLLEN), cjunk
	integer*4		field, len, nn, ljunk, ffi
	real*8			dval
	logical*4		success

	logical*4		XDATA_LOAD_FIELD

	XDATA_LOAD_TEMPLATE = .FALSE.
	hdataptr = Gx.phData.p

	! Release any dynamic memory that might have been
	! allocated in loading the previous template
	call XDATA_CLEANUP_TEMPLATE()

	if (M$SCOPE_KEYWORD_QUIET(htmpl, 'SECTION=XDATALIST') .lt. 0) then
	  len = M$LENGTH(htmpl.file_name)
	  call M$WARNING(htmpl.file_name(1:len)//
     +			 ' is not an X-DataList template')
	  return
	endif

	! We need to set the scope to everything between SECTION==
	! XDATALIST and FIELD==1 but as of X-Midas 3.3.1 there's no
	! straightforward way to do this.  The following acrobatics
	! place a FIELD==0 immediately after SECTION==XDATALIST and
	! scope on it, giving us the scope we need.
	if (M$SCOPE_KEYWORD_QUIET(htmpl, 'SECTION=XDATALIST,FIELD=0')
     +	    .lt. 0) then
	  ljunk = M$SCOPE_KEYWORD_QUIET(htmpl, 'SECTION=XDATALIST')
#if JEFF
	  keywordstr = '**INIT**'
	  len = M$FIND_KEYDATA(htmpl, keywordstr,
     +				pKeyword, ljunk, MK_NEXT, cjunk)
	  htmpl.ext_scope_end = htmpl.ext_scope_start + htmpl.ext_next
	  ljunk = M$PUT_KEYDATA(htmpl, 'FIELD', 0, 4, 0, 'L')
	  ljunk = M$SCOPE_KEYWORD(htmpl, 'SECTION=XDATALIST,FIELD=0')
#endif
	endif

	! VERSION is to make backwards-compatibility easier...
	if (M$GET_KEYDATA(htmpl, 'VERSION', Gx.version, 4, 0, 'F') .lt. 0)
     +	  Gx.version = 3.30

	Gx.ntitle = 0
	ljunk = M$GET_KEYDATA(htmpl, 'TITLELINES', Gx.ntitle, 4, 0, 'L')
	ljunk = M$GET_KEYWORD(htmpl, 'LABELS', keywordstr)
	if (keywordstr .eq. 'OFF') then
	  Gx.labelstyle = 0
	else
	  Gx.ntitle = Gx.ntitle + 1	! Labels count as 1 title line
	  if (keywordstr(1:9) .eq. 'UNDERLINE') then
	    Gx.labelstyle = 2
	  else
	    Gx.labelstyle = 1
	  endif
	endif

	! These keywords describe the placement and format
	! of the row indices
	len = M$GET_KEYWORD(htmpl, 'INDEX', keywordstr)
	if (len.le.0 .OR. keywordstr(1:5) .eq. 'RIGHT') then
	  Gx.indexpos = 1
	elseif (keywordstr(1:4) .eq. 'LEFT') then
	  Gx.indexpos = -1
	else
	  Gx.indexpos = 0
	endif

	if (M$GET_KEYDATA(htmpl,'INDEXRADIX',Gx.iradix,4,0,'L') .lt. 0)
     +	  Gx.iradix = 100
	if (M$GET_KEYDATA(htmpl,'INDEXWIDTH',Gx.iwidth,4,0,'L') .lt. 0)
     +	then
	  len = M$GET_KEYWORD(htmpl, 'INDEXLABEL', keywordstr)
	  Gx.iwidth = MAX(len, M$L2A(Gx.iradix, keywordstr)) + 1
	endif
	if (Gx.indexpos .eq. 0)  Gx.iwidth = 0

	! SPACING specifies how many blank characters will follow each field.
	! (can be overriden by individual SPACING keywords in FIELD sections)
	if (M$GET_KEYDATA(htmpl, 'SPACING', Gx.spacing, 4, 0, 'L')
     +	    .lt. 0) then
	  if (Gx.version .lt. 3.40) then
	    Gx.spacing = DEFAULT_SPACING
	  else
	    Gx.spacing = 0
	  endif
	endif

	if (M$GET_KEYDATA(htmpl, 'FIELDS', Gx.nfields, 4, 0, 'L')
     +	    .lt. 0) then
	  len = M$LENGTH(htmpl.file_name)
	  call M$WARNING('Template '//htmpl.file_name(1:len)//
     +			 ' is missing required keyword FIELDS')
	  return
	endif
	Gx.nxdlfields = Gx.nfields
	if (Gx.class .eq. 2)  Gx.nfields = hdata.subsize

	Gx.colormode = USEDEFCOLORS
	Gx.colordep  = .FALSE.
	Gx.color     = 0
	len = M$GET_KEYWORD(htmpl, 'COLOR', keywordstr)
	if (len .gt. 0) then
	  if (M$A2D(keywordstr(1:len), dval) .gt. 0) then
	    ! Field color is constant
	    Gx.colormode = USEDEFCOLORS
	    Gx.defcolor = INT(dval)
	  elseif (len .gt. 5) then
	    if (keywordstr(1:5) .eq. 'FIELD') then
	      if (M$A2D(keywordstr(6:len), dval) .gt. 0) then
		! Field color is based on an enumerated field
		Gx.colormode = COLOR_BY_FIELD
		Gx.colordep  = .TRUE.
		Gx.color     = INT(dval)
	      else
	      endif
	    else
	    endif
	  elseif (len.le.4 .AND. Gx.class.gt.2) then
	    nn = M$SUB_FIND(hdata, keywordstr(1:len))
	    if (nn .gt. 0) then
	      ! Field color is based on a Type 3000 subrecord
	      ! or Type 5000 subcomponent
	      Gx.colormode = COLOR_BY_SUBR
	      Gx.colordep  = .TRUE.
	      Gx.color     = nn
	    else
	      call M$WARNING('Keyword COLOR=='//keywordstr(1:len)//
     +				' does not reference a valid subrecord')
	    endif
	  else
	  endif
	endif

	if (Gx.class .eq. 2) then
	  ! For Type 2000 files, we'll allocate memory for
	  ! one extra field record whose offset, atomoff,
	  ! fieldoff and label fields can be updated by
	  ! calls to XDATA_2000_FIELDINFO.
	  call M$MALLOC((Gx.nxdlfields+1)*FIELDINFOSIZE, Gx.pbFinfo.p)
	else
	  call M$MALLOC(Gx.nxdlfields*FIELDINFOSIZE, Gx.pbFinfo.p)
	endif

	! Load the keywords from each FIELD section
	success      = .TRUE.
	Gx.dispwidth = 0
	Gx.scrambled = .FALSE.	! maybe set true by XDATA_LOAD_FIELD
	finfoptr     = Gx.pbFinfo.p
	do field = 1, Gx.nxdlfields
	  success = success .AND.
     +		    XDATA_LOAD_FIELD(hdata, htmpl, field)
	  Gx.dispwidth = MAX(Gx.dispwidth, finfo(field).offset + 
     +			     finfo(field).width + finfo(field).spacing)
	enddo
	if (Gx.scrambled) then	! calculate spacing
	  do field = 1, Gx.nxdlfields
	    ljunk = Gx.dispwidth
	    do ffi = 1, Gx.nxdlfields
	      if (finfo(ffi).offset .gt. finfo(field).offset .AND.
     +		  finfo(ffi).offset .lt. ljunk) then
		ljunk = finfo(ffi).offset
	      endif
	    enddo
	    finfo(field).spacing = ljunk - 
     +		(finfo(field).offset+finfo(field).width)
	  enddo
	endif
	call XDATA_SCOPE_TO_FIELD(htmpl, 0)	! Refresh scope

	! Set up .colordep fields and check FIELD references
	do field = 1, Gx.nxdlfields
	  if (finfo(field).colormode .eq. COLOR_BY_FIELD) then
	    nn = finfo(field).color
	    if (finfo(nn).colormode .eq. COLOR_BY_FIELD) then
	      len = M$L2A(field, keywordstr)
	      call M$WARNING('FIELD=='//keywordstr(1:len)//': '//
     +			     'COLOR==FIELDn references cannot be chained')
	      finfo(field).colormode = USEDEFCOLORS
	    elseif (finfo(nn).colormode.ne.COLOR_BY_ENUM .AND.
     +		    finfo(nn).format(2:2) .eq. 'A') then
	      call M$WARNING('FIELD=='//keywordstr(1:len)//': '//
     +			     'COLOR==FIELDn references a '//
     +			     'nonenumerated, nonnumeric field')
	      finfo(field).colormode = USEDEFCOLORS
	    else
	      finfo(nn).colordep = .TRUE.
	    endif
	  endif
	enddo

	if (Gx.class .eq. 2) then
	  Gx.dispwidth = Gx.dispwidth + (Gx.nfields-Gx.nxdlfields)
     +		 *(finfo(Gx.nxdlfields).width+finfo(Gx.nxdlfields).spacing)
	  finfo(Gx.nxdlfields+1) = finfo(Gx.nxdlfields)
	endif

	! DISPLAYWIDTH is read for backwards compatibility
	! and overrides the computed display width.
	if (M$GET_KEYDATA(htmpl, 'DISPLAYWIDTH',
     +			    Gx.dispwidth, 4, 0, 'L') .ge. 0) then
	    if (Gx.class .eq. 2) then
	      Gx.dispwidth = Gx.dispwidth*Gx.nfields
	    else
	      ! Adjust the SPACING of the last field
	      nn = Gx.nxdlfields
	      finfo(nn).spacing = MAX(0, Gx.dispwidth -
     +				      (finfo(nn).offset+finfo(nn).width))
	    endif
	endif

	XDATA_LOAD_TEMPLATE = success

	return
	END	! XDATA_LOAD_TEMPLATE



c XDATA_LOAD_FIELD
c
c Helper routine to XDATA_LOAD_TEMPLATE
c Gathers and error-checks template info on a specific field
c
c Side effect: Sets the Keyword Scope to the current field
c
	logical*4
     +	function XDATA_LOAD_FIELD (hdata, htmpl, field)
	include 'xdatalist.inc'
	integer*4 L_bbuf
	parameter (L_bbuf=16)
	include 'buffers.inc'
	record /HEADER/		hdata, htmpl
	integer*4		field

	integer*4		flen, len, nn, scalar, bps, ii
	integer*4		mlen, vlen, clen, slen, mi, lval, ljunk
	integer*4		lowestvalidoffset
	real*8			dval
	character		fstr*(20), str*(LBLLEN), edit, cjunk
	character*(DEFSTRLEN)	mstr, vstr, cstr
	logical*4		success, ascii
c	record /FIELDINFO/	finfo(1), fi
	record /FIELDINFO/	finfo(*), fi	! _IFC
	pointer			(finfoptr, finfo)
	pointer			(fiptr, fi)
	record /BUFFER/		MVALUES
	pointer			(mvaluesptr, MVALUES)
	record /BUFFER/		MCOLORS
	pointer			(mcolorsptr, MCOLORS)

	success = .TRUE.
	flen = M$L2A(field, fstr)
	finfoptr = Gx.pbFinfo.p
	fiptr    = %loc(finfo(field))

	! Initialize the fi structure
	fi.label.p	= 0		! Field label
	fi.dispform.p	= 0		! Output display format string
	fi.menustr.p	= 0		! Pointer to menu keyword string
	fi.mvalues.p	= 0		! Pointer to menu value data
	fi.mcolors.p	= 0		! Pointer to menu color data
	fi.field	= field		! X-DataList field number
	fi.scalar1	= 0		! Atom index of 1st scalar in field
	fi.nscalars	= 0		! # scalars visible in field
	if (field .eq. 1) then
	  lowestvalidoffset = 0
	  fi.offset	= 0		! Offset in chars from column 1
	else
	  lowestvalidoffset = finfo(field-1).offset
     +			      + finfo(field-1).width
	  fi.offset	= lowestvalidoffset + finfo(field-1).spacing
	endif
	fi.width	= 0		! Field display width in characters
	fi.swidth	= 0		! Scalar display width in characters
	fi.spacing	= Gx.spacing	! Additional spacing at end of field
	fi.atomoff	= 0		! Atom byte offset into log. elemt
	fi.fieldoff	= 0		! Field byte offset into log. elemt
	fi.bpf		= 0		! Bytes Per Field
	fi.subelemt	= 0		! Element/Subrecord/Component number
	fi.llabel	= 0		! String length of label
	fi.ldispform	= 0		! String length of display fmt str
	fi.nmenuitems	= 0		! Number of menu items
	fi.color	= 0		! Color code
	fi.colormode	= USEDEFCOLORS	! Color mode
	fi.colordep	= .FALSE.	! Do other fields mimic my color?
	fi.enumerated	= .FALSE.	! Is this an enumerated field?
	fi.usenullval	= .FALSE.	! Is the NULLVAL keyword specified?
	fi.nullval	= 0.d0		! value of NULLVAL keyword
	fi.subname	= '    '	! Subrecord/Component Name
	fi.format	= '  '		! Atom digraph
	fi.edit		= 'P'		! Edit action to perform

	if (M$SCOPE_KEYWORD(htmpl,
     +	    'SECTION=XDATALIST,FIELD='//fstr(1:flen)) .lt. 0) then
	  call M$WARNING('FIELD=='//fstr(1:flen)//
     +			 ' keyword section not found in template')
	  success = .FALSE.
	  goto 99
	endif
      
	! Determine subelement #, format, and atom byte offset
	! within logical element
	if (Gx.class .eq. 1) then	! Type 1000
	  fi.subelemt = 1
	  fi.format = hdata.format
	  fi.atomoff = 0
	elseif (Gx.class .eq. 2) then	! Type 2000
	  if (M$GET_KEYDATA(htmpl, 'ELEMENT', fi.subelemt, 4, 0, 'L')
     +	      .lt. 0) fi.subelemt = field
	  fi.format = hdata.format
	  fi.atomoff = (fi.subelemt-1) * hdata.bpa
	else				! Type 3000, 5000, 6000
	  if (M$GET_KEYWORD(htmpl, 'SUBR', fi.subname) .gt. 0) then
	    nn = M$SUB_FIND(hdata, fi.subname)
	    if (nn .eq. 0) then
	      call M$WARNING('FIELD=='//fstr(1:flen)//': '//
     +			     'Subrecord referenced in SUBR=='//
     +			     fi.subname//' does not exist')
	      success = .FALSE.
	      goto 99
	    endif
	    fi.subelemt = nn
	    fi.format = M$SUB_FORMAT(hdata,nn)
	    fi.atomoff = M$SUB_OFFSET(hdata, nn)
	  else
	    call M$WARNING('FIELD=='//fstr(1:flen)//': '//
     +			   'Missing required keyword SUBR')
	    success = .FALSE.
	    goto 99
	  endif
	endif

	! Determine number of scalars, first scalar, bytes per field
	! and field byte offset within logical element
	ascii	= fi.format(2:2) .eq. 'A'
	bps	= M$BPS(fi.format)
	nn	= M$SPA(fi.format)
	fi.nscalars = nn
	fi.scalar1 = 1
	fi.bpf = M$BPA(fi.format)
	if (nn .gt. 1) then
	  if (M$GET_KEYDATA(htmpl, 'SCALAR', scalar, 4, 0, 'L') .gt. 1)
     +	  then
	    fi.nscalars = 1
	    fi.scalar1 = scalar
	    fi.bpf = bps
	    if (scalar.lt.1 .OR. scalar.gt.nn) then
	      call M$WARNING('FIELD=='//fstr(1:flen)//': '//
     +				'SCALAR keyword is out of bounds')
	      fi.scalar1 = MIN(MAX(1,scalar), nn)
	    endif
	  elseif (ascii) then
	    fi.nscalars = 1
	  endif
	endif
	fi.fieldoff = fi.atomoff + (fi.scalar1-1)*M$BPS(fi.format)

	len = M$GET_KEYWORD(htmpl, 'LABEL', str)
	if (len .gt. 0) then
	  call M$MALLOC(len, fi.label.p)
	  call M$MOVE(%ref(str), %val(fi.label.p), len)
	endif
	fi.llabel = len

	slen = M$GET_KEYWORD(htmpl, 'EDIT', str)
	if (slen .lt. 0) then
	  edit = 'P'
	elseif (slen .eq. 0) then
	  edit = 'N'
	else
	  edit = str(1:1)
	endif
	if (edit .eq. 'P') then
	  fi.edit = 'PROMPT'
	elseif (edit .eq. 'M') then
	  fi.edit = 'MENU'
	elseif (edit .eq. 'V') then
	  fi.edit = 'VALUATOR'
	elseif (edit .eq. 'F') then
	  fi.edit = 'FILES'
	elseif (edit .eq. 'B') then
	  fi.edit = 'BEEP'
	elseif (edit .eq. 'N') then
	  fi.edit = 'NONE'
	elseif (edit .eq. 'C') then
	  fi.edit = 'COMMAND'
	else
	  call M$WARNING('FIELD=='//fstr(1:flen)//': '//
     +			 'Invalid keyword value: EDIT=='//str(1:slen))
	endif

	! Determine how field is to be displayed
	len = M$GET_KEYWORD(htmpl, 'DISPFORM', str)
	if (len .gt. 0) then
	  if (len.eq.4 .AND. str(1:4).eq.'ENUM') then
	    fi.enumerated = .TRUE.
	    if (M$SEARCH('MBN', edit) .eq. 0) then
	      call M$WARNING('FIELD=='//fstr(1:flen)//': '//
     +			     'Enumerated fields must have '//
     +			     'EDIT==[MENU|BEEP|NONE]')
	      success = .FALSE.
	    endif
	  endif
	else
	  ! TODO: Default DISPFORM
	  ! (pull values out of DEFAULT_TEMPLATE into subroutine)
	endif
	call M$MALLOC(len, fi.dispform.p)
	call M$MOVE(%ref(str), %val(fi.dispform.p), len)
	fi.ldispform = len

	! Is a NULL value specified?
	if (M$GET_KEYDATA(htmpl, 'NULLVAL', dval, 8, 0, 'D') .eq. 8)
     +	then
	  if (ascii) then
	    call M$WARNING('FIELD=='//fstr(1:flen)//': '//
     +			   'NULLVAL is only valid for numeric fields')
	  else
	    fi.usenullval = .TRUE.
	    fi.nullval = dval
	  endif
	endif

	! Determine field width, scalar width and spacing
	ljunk = M$GET_KEYDATA(htmpl, 'WIDTH', fi.width, 4, 0, 'L')
	fi.width = MAX(0,fi.width)
	fi.swidth = fi.width / fi.nscalars
	if (fi.width .eq. 0) fi.spacing = 0
	if (M$GET_KEYDATA(htmpl, 'SPACING', nn, 4, 0, 'L') .eq. 4) then
	  if (nn .ge. 0) fi.spacing = nn
	endif

	! Obey the OFFSET keyword for backwards compatibility
	if (M$GET_KEYDATA(htmpl, 'OFFSET', lval, 4, 0, 'L') .eq. 4)
     +	then
	  if (lval .lt. lowestvalidoffset) 
     +	    Gx.scrambled = .TRUE.
	  if (lval .ne. fi.offset) then
	    fi.offset = lval
	    if (field.gt.1 .AND. .NOT.Gx.scrambled) then
	      ! Fix the previous field's spacing
	      finfo(field-1).spacing = fi.offset - finfo(field-1).offset
     +					- finfo(field-1).width
	    endif
	  endif
	endif

	! Determine field color
	len = M$GET_KEYWORD(htmpl, 'COLOR', str)
	if (len .gt. 0) then
	  if (M$A2D(str(1:len), dval) .gt. 0) then
	    ! Field color is constant
	    fi.colormode = COLOR_BY_NUM
	    fi.color = INT(dval)
	  elseif (len .gt. 5) then
	    if (str(1:5) .eq. 'FIELD') then
	      if (M$A2D(str(6:len), dval) .gt. 0) then
		nn = INT(dval)
		if (nn.gt.0 .AND. nn.le.Gx.nxdlfields) then
		  ! Field color is based on an enumerated field
		  fi.colormode = COLOR_BY_FIELD
		  fi.color     = nn
		else
		  call M$WARNING('FIELD=='//fstr(1:flen)//': '//
     +				 'Keyword COLOR=='//str(1:len)//
     +				 ' references a nonexistant field')
		endif
	      endif
	    endif
	  elseif (len.le.4 .AND. Gx.class.gt.2) then
	    nn = M$SUB_FIND(hdata, str(1:len))
	    if (nn .gt. 0) then
	      ! Field color is based on a Type 3000 subrecord
	      ! or Type 5000 subcomponent
	      fi.colormode = COLOR_BY_SUBR
	      fi.color	   = nn
	      Gx.colordep  = .TRUE.
	    else
	      call M$WARNING('FIELD=='//fstr(1:flen)//': '//
     +				'Keyword COLOR=='//str(1:len)//
     +				' references a nonexistant subrecord')
	    endif
	  else
	    call M$WARNING('FIELD=='//fstr(1:flen)//': '//
     +			   'Keyword COLOR=='//str(1:len)//
     +			   ' could not be interpreted')
	  endif
	endif

	if (edit.eq.'M' .OR. fi.enumerated) then
	  ! Verify that a MENU keyword exists
	  mlen = M$GET_KEYWORD(htmpl, 'MENU', mstr)
	  if (mlen .le. 0) then
	    if (edit .eq. 'M') then
	      call M$WARNING('FIELD=='//fstr(1:flen)//': '//
     +			     'EDIT==MENU but no MENU keyword found')
	    else
	      call M$WARNING('FIELD=='//fstr(1:flen)//': '//
     +			     'Enumerated field has no MENU keyword')
	    endif
	    success = .FALSE.
	    goto 99
	  endif
	  ! Store menu string in field info structure
	  call M$MALLOC(mlen, fi.menustr.p)
	  call M$MOVE(%ref(mstr), %val(fi.menustr.p), mlen)
	  fi.lmenustr = mlen

	  ! Strip menu label, if any
	  ii = M$SEARCH(mstr, ';')
	  mstr = mstr(ii+1:mlen)
	  mlen = mlen - ii

	  ! Find out how many menu items there are...
	  ii = 1
	  do while (M$PARSE(mstr(1:mlen), ii, cjunk) .gt. 0)
	    fi.nmenuitems = fi.nmenuitems + 1
	    ii = ii + 1
	  enddo
	  ! ...and allocate space for that many values
	  if (.NOT. ascii) then
	    fi.lmvalues = bps * fi.nmenuitems
	    call M$MALLOC(fi.lmvalues, fi.mvalues.p)
	    mvaluesptr = fi.mvalues.p
	  endif
	  ! ...and that many colors
	  call M$MALLOC(2*fi.nmenuitems, fi.mcolors.p)

	  ! Store MENU values into dynamic memory for speed
	  vlen = M$GET_KEYWORD(htmpl, 'MVALUES', vstr)
	  if (vlen .gt. 0) then
	    mi = M$SEARCH(vstr(1:vlen), 'MINDEX')
	  else
	    mi = 0
	  endif
	  if (mi .gt. 0) then
	    !********************************************
	    ! MVALUES string contains MINDEX
	    !********************************************
	    if (ascii) then
	      fi.lmvalues = DEFSTRLEN
	      call M$MALLOC(fi.lmvalues, fi.mvalues.p)
	      mvaluesptr = fi.mvalues.p
	    endif
	    nn = 1
	    do ii = 1, fi.nmenuitems
	      str = vstr(1:vlen)
	      len = vlen
	      slen = M$L2A(ii, str(mi:mi+5))
	      if (len .ge. mi+6)
     +		str(mi+slen:len-(6-slen)) = str(mi+6:len)
	      len = len - (6-slen)
	      if (M$A2D(str(1:len), dval) .ne. len) then
		call M$WARNING('FIELD=='//fstr(1:flen)//': '//
     +				'Unable to interpret MVALUES expression')
		success = .FALSE.
		dval = 0.d0
	      endif
	      if (ascii) then
		slen = M$D2A(dval, MVALUES.sbuf(nn:fi.lmvalues))
		MVALUES.sbuf(nn+slen:nn+slen) = ','
		nn = nn + slen + 1
	      else
		call M$REFORMAT(dval, 'D',
     +				MVALUES.bbuf(nn), fi.format(2:2), 1)
		nn = nn + bps
	      endif
	    enddo
	  else
	    !********************************************
	    ! Parse MVALUES keyword string for values, or
	    ! use MENU string if MVALUES wasn't specified.
	    !********************************************
	    if (vlen .lt. 0) then
	      vstr = mstr(1:mlen)
	      vlen = mlen
	    endif
	    if (ascii) then
	      fi.lmvalues = vlen
	      call M$MALLOC(fi.lmvalues, fi.mvalues.p)
	      mvaluesptr = fi.mvalues.p
	      MVALUES.sbuf(1:vlen) = vstr(1:vlen)
	    else
	      nn = 1
	      do ii = 1, fi.nmenuitems
		slen = IABS(M$PARSE(vstr(1:vlen), ii, str))
		if (slen .eq. 0) then
		  ! Missing value in MVALUES
		  mlen = M$L2A(ii, mstr)
		  call M$WARNING('FIELD=='//fstr(1:flen)//': '//
     +			'Menu item '//mstr(1:mlen)//' has no '//
     +			'associated value in MVALUES keyword')
		  success = .FALSE.
		  dval = 0.d0
		elseif (M$A2D(str(1:slen), dval) .le. 0) then
		  call M$WARNING('FIELD=='//fstr(1:flen)//': '//
     +				 'Error converting MVALUES '//
     +				 'keyword to numeric.')
		  success = .FALSE.
		  dval = 0.d0
		endif
		call M$REFORMAT(dval, 'D',
     +				MVALUES.bbuf(nn), fi.format(2:2), 1)
		nn = nn + bps
	      enddo
	    endif ! ascii
	  endif ! MINDEX-equation or series of values


	  ! Fill mcolors array with colors corresponding to each value
	  clen = M$GET_KEYWORD(htmpl, 'MCOLORS', cstr)
	  if (clen .gt. 0) then
	    mcolorsptr = fi.mcolors.p
	    do ii = 1, fi.nmenuitems
	      slen = IABS(M$PARSE(cstr(1:clen), ii, str))
	      if (slen .gt. 0) then
		if (M$A2D(str(1:slen), dval) .eq. slen) then
		  call M$REFORMAT(dval, 'D',
     +				  MCOLORS.ibuf(ii), 'I', 1)
		else
		  call M$WARNING('FIELD=='//fstr(1:flen)//': '//
     +				 'Error converting MCOLORS '//
     +				 'template keyword to numeric.')
		  MCOLORS.ibuf(ii) = USEDEFCOLORS
		endif
	      else
		MCOLORS.ibuf(ii) = USEDEFCOLORS
	      endif
	    enddo
	    if (fi.colormode .eq. USEDEFCOLORS) then
	      fi.colormode = COLOR_BY_ENUM
	      fi.color = fi.field
	    endif
	  endif		! MCOLORS

	endif	! EDIT==MENU or field is enumerated

  99	XDATA_LOAD_FIELD = success
	return
	END	! XDATA_LOAD_FIELD



c XDATA_CLEANUP_TEMPLATE
c
c Frees the dynamic memory allocated in loading the previous template
c
	subroutine XDATA_CLEANUP_TEMPLATE ()
	include 'xdatalist.inc'

c	record /FIELDINFO/	finfo(1)
	record /FIELDINFO/	finfo(*)	! _IFC
	pointer			(finfoptr, finfo)
	integer			ii

	if (Gx.pbFinfo.p .eq. 0) return

	! Release dynamic memory used by individual fields
	finfoptr = Gx.pbFinfo.p
	do ii = 1, Gx.nxdlfields
	  call M$FREE(finfo(ii).label.p)
	  call M$FREE(finfo(ii).dispform.p)
	  call M$FREE(finfo(ii).menustr.p)
	  call M$FREE(finfo(ii).mvalues.p)
	  call M$FREE(finfo(ii).mcolors.p)
	enddo
	call M$FREE(Gx.pbFinfo.p)
	Gx.nxdlfields = 0

	return
	END	! XDATA_CLEANUP_TEMPLATE



c XDATA_2000_FIELDINFO
c
c For Type 2000 files, the same FIELDINFO structure may well be
c used for multiple display fields (i.e. multiple subelements in
c a logical element).  However, some attributes must be unique,
c such as where to find the field's data in the file, where the
c field is to be drawn, etc..  This routine computes these unique
c field attributes and updates the extra /FIELDINFO/ record.
c
	subroutine XDATA_2000_FIELDINFO (field)
	include 'xdatalist.inc'
	integer*4		field		! IN/OUT

	record /HEADER/		hdata
	pointer			(hdataptr, hdata)
c	record /FIELDINFO/	finfo(1)
	record /FIELDINFO/	finfo(*)	! _IFC
	pointer			(finfoptr, finfo)
	integer*4		ff

	if (field .le. Gx.nxdlfields) return

	hdataptr = Gx.phData.p
	finfoptr = Gx.pbFinfo.p
	ff = Gx.nxdlfields + 1

	finfo(ff).field	   = field
	finfo(ff).offset   = finfo(ff-1).offset + (field-ff+1)
     +			     * (finfo(ff).width+finfo(ff).spacing)
	finfo(ff).subelemt = finfo(ff-1).subelemt + (field-ff+1)
	finfo(ff).atomoff  = (finfo(ff).subelemt-1) * hdata.bpa
	finfo(ff).fieldoff = finfo(ff-1).fieldoff
     +			     + (field-ff+1)*hdata.bpa

	field = ff

	return
	END	! XDATA_2000_FIELDINFO



c XDATA_FORMAT_FIELDLABEL
c
c Retrieves and formats the field label for the requested field
c
	subroutine XDATA_FORMAT_FIELDLABEL (fi, label)
	include 'xdatalist.inc'
	record /FIELDINFO/	fi
	character		label*(*)

	character	keyword
	pointer		(keywordptr, keyword)
	integer*4	flen, klen, pos, ll, kk
	character	fstr*20

	flen = M$L2A(fi.field, fstr)
	klen = fi.llabel
	if (klen .gt. 0) then
	  ! Format label by subsituting un-escaped '#'s
	  ! in the LABEL keyword with the field number
	  keywordptr = fi.label.p
	  ll = 1
	  kk = 1
	  label = ' '
	  pos = M$SEARCH(keyword(1:klen), '#') - 1
	  do while (pos.ge.0 .AND. kk.le.klen)
	    if (pos .gt. 0) then
	      label(ll:ll+pos-1) = keyword(kk:kk+pos-1)
	      ll = ll + pos
	      kk = kk + pos
#if _OSF|_SOL|_IRIX|_PGF77|_IFC|_GFC
	      if (keyword(kk-1:kk-1) .eq. '\\') then
#else
	      if (keyword(kk-1:kk-1) .eq. '\') then
#endif
		! We really want the character '#'
		label(ll-1:ll-1) = '#'
	      else
		goto 50
	      endif
	    else
	      goto 50
	    endif
	    goto 55

   50	    do while (kk.lt.klen .AND. keyword(kk+1:kk+1).eq.'#')
	      kk = kk + 1
	    enddo
	    label(ll:ll+flen-1) = fstr(1:flen)
	    ll = ll + flen

   55	    continue
	    kk = kk + 1
	    if (kk .le. klen)
     +	      pos = M$SEARCH(keyword(kk:klen), '#') - 1
	  enddo
	  if (kk .le. klen)
     +	    label(ll:) = keyword(kk:klen)
	elseif (klen .lt. 0) then
	  if (fi.subname(1:1) .eq. ' ') then
	    label = 'F'//fstr(1:flen)
	  else
	    label = fi.subname
	  endif
	else	! klen .eq. 0
	  label = ' '
	endif

	return
	END	! XDATA_FORMAT_FIELDLABEL


c XDATA_READ
c
c Fills the internal file data buffer, resets poll timer
c
	subroutine XDATA_READ ()
	include 'xdatalist.inc'

	integer*4 ngot

	call M$GRAB(%val(Gx.phData.p), %val(Gx.pbData.p),
     +		    Gx.top, Gx.nvisrows, ngot)
	if (ngot .ne. Gx.nvisrows) then
	  call M$WARNING('M$GRAB ERROR in XDATA_READ:')
	  write(*,*) '  Only able to read', ngot, ' of', Gx.nvisrows,
     +			' requested elements!'
	endif
	if (Gx.pollperiod .gt. 0.0) call XDATA_POLLINIT()
	    
	return
	END	! XDATA_READ



c XDATA_POLLINIT
c
c Initializes poll buffer with current data and starts the poll timer
c
	subroutine XDATA_POLLINIT ()
	include 'xdatalist.inc'

	call M$MOVE(%val(Gx.pbData.p), %val(Gx.pbPoll.p),
     +		    Gx.bpe*Gx.ndatarows)
	Gx.polltime = SECNDS(0.0)

	return
	END	! XDATA_POLLINIT



c XDATA_POLL
c
c Checks the in-view data buffer for external changes
c
	subroutine XDATA_POLL ()
	include 'xdatalist.inc'

	integer*4 ngot

	if (Gx.pollperiod .gt. 0.0) then

	  if (SECNDS(Gx.polltime) .gt. Gx.pollperiod) then

	    ! Read from file into poll buffer
	    call M$GRAB(%val(Gx.phData.p), %val(Gx.pbPoll.p),
     +			Gx.top, Gx.nvisrows, ngot)
	    if (ngot .ne. Gx.nvisrows) then
	      call M$WARNING('M$GRAB ERROR in XDATA_POLL:')
	      write(*,*) '  Only able to read', ngot, ' of', Gx.nvisrows,
     +			 ' requested elements!'
	      return
	    endif

	    ! Compare poll and data buffers
	    if (M$CHK(%val(Gx.pbData.p), %val(Gx.pbPoll.p),
     +		      Gx.bpe*Gx.ndatarows) .ne. 1) then
C TODO: This could be optimized: if we knew the first (and last?)
C	byte that differed we could reduce the number of rows to draw
D	      write(*,*)  'External change detected'

	      ! Visible portion of file has changed - load new data 
	      call M$MOVE(%val(Gx.pbPoll.p), %val(Gx.pbData.p),
     +			  Gx.bpe*Gx.ndatarows)
	      Gx.polltime = SECNDS(0.0)
	      call XDATA_DRAW_REGION(1, 1, 1,
     +				     Gx.nvisrows, Gx.nfields, SEL_ALL,
     +				     USEDEFCOLORS, .TRUE.)
	    else
	      Gx.polltime = SECNDS(0.0)
	    endif	! changes?
	  endif
	endif	! Are we polling?

	return
	END	! XDATA_POLL



c XDATA_PLOT
c
c Determines fontsize, window borders, and need for scrollbars.
c Also allocates data (and poll) buffer(s).
c
	subroutine XDATA_PLOT ()
	include 'xdatalist.inc'

	integer*4	k

	integer*4	XDATA_OFFSET2FIELD
	integer*4	XDATA_RIGHTMOST_VISIBLE_FIELD

	call MX$SETFONT(MAX(7,
     +			    MIN(11,NINT((Mx.width-4)/FLOAT(Gx.dispwidth+6)))))
	k = Mx.level
	Mx.stk(k).xscl = 1.d0 / Mx.text_w
	Mx.stk(k).yscl = 1.d0 / Mx.text_h

	! Compute X borders
	Mx.stk(k).x1 = 2
	Mx.stk(k).x2 = Mx.width - 2
	if (Gx.indexpos .lt. 0) then	! Indices on the left
	  Mx.stk(k).x1 = Mx.stk(k).x1 + Mx.text_w*(Gx.iwidth+3)
	else				! Indices on the right
	  Mx.stk(k).x2 = Mx.stk(k).x2 - Mx.text_w*(Gx.iwidth)
	endif
	Gx.ndatacols = (Mx.stk(k).x2 - Mx.stk(k).x1)/Mx.text_w
	Gx.panx = Gx.ndatacols .lt. Gx.dispwidth

	! Compute Y borders
	Mx.stk(k).y1 = 2 + Mx.text_h*Gx.ntitle
	Mx.stk(k).y2 = Mx.height - 2
	if (Gx.panx) Mx.stk(k).y2 = Mx.stk(k).y2 - Mx.text_w*1.5
	Gx.ndatarows = (Mx.stk(k).y2 - Mx.stk(k).y1)/Mx.text_h
	Gx.pany = Gx.ndatarows .lt. Gx.nsize

	if (Gx.pany) then
	  ! Recalculate X borders
	  Mx.stk(k).x2 = Mx.stk(k).x2 - Mx.text_w*1.5
	  Gx.ndatacols = (Mx.stk(k).x2 - Mx.stk(k).x1)/Mx.text_w
	  if (Gx.ndatacols.lt.Gx.dispwidth .AND. .NOT.Gx.panx) then
	    Gx.panx = .TRUE.
	    ! Recalculate Y borders
	    Mx.stk(k).y2 = Mx.stk(k).y2 - Mx.text_w*1.5
	    Gx.ndatarows = (Mx.stk(k).y2 - Mx.stk(k).y1)/Mx.text_h
	  endif
	endif

	! Now we know where to place the scrollbars
	call MX$SCROLL_LOC(Gx.sbvert, Mx.stk(k).x2, Mx.stk(k).y1,
     +			   Mx.text_w, Gx.ndatarows*Mx.text_h, 4)
	call MX$SCROLL_LOC(Gx.sbhorz,
     +			   Mx.stk(k).x1, Mx.stk(k).y2 + Mx.text_w/2,
     +			   Mx.stk(k).x2-Mx.stk(k).x1, Mx.text_w, 1)

	! Reallocate Data Buffer
	call M$REMALLOC(Gx.bpe*Gx.ndatarows, Gx.pbData.p)
	if (Gx.pollperiod .gt. 0.0)
     +	  call M$REMALLOC(Gx.bpe*Gx.ndatarows, Gx.pbPoll.p)

	! Make sure the selected element is still visible(?)
	if (Gx.tracksel)
     +	  Gx.top = MAX(1d0,Gx.elemt-((Gx.ndatarows+1)/2)+1)

	! Reset Gx.top if we've resized past the end of the data file
	if (Gx.top+Gx.ndatarows .gt. Gx.nsize+1)
     +	  Gx.top = MAX(1d0, Gx.nsize-Gx.ndatarows+1)
	! Reset Gx.left if we've resized past the end of the display
	if (Gx.left+Gx.ndatacols .gt. Gx.dispwidth) then
	  Gx.left = MAX(0, Gx.dispwidth-Gx.ndatacols)
	  Gx.fright = Gx.nfields
	endif

	! Determine how many lines and columns we're displaying
	Gx.nvisrows = MAX(0, MIN(Gx.ndatarows, INT(Gx.nsize-Gx.top+1)))
	Gx.nviscols = MIN(Gx.ndatacols, Gx.dispwidth)
	! What are the left and right-most visible field?
	Gx.fleft    = XDATA_OFFSET2FIELD(Gx.left, .FALSE.)
	Gx.fright   = XDATA_RIGHTMOST_VISIBLE_FIELD()

	! Screen character buffer
	call M$REMALLOC(Gx.nvisrows*Gx.nviscols, Gx.pbScreen.p)

	! Mx.stk(k)xmin/xmax units are characters
	Mx.stk(k).xmin = Gx.left
	Mx.stk(k).xmax = Mx.stk(k).xmin + Gx.ndatacols

	! Mx.stk(k)ymin/ymax units are lines of text
	Mx.stk(k).ymin = Gx.top
	Mx.stk(k).ymax = Mx.stk(k).ymin + Gx.ndatarows - 1

	call XDATA_READ()
	call XDATA_REFRESH()

	return
	END	! XDATA_PLOT



c XDATA_REFRESH
c
c Clears and redraws the screen
c
	subroutine XDATA_REFRESH ()
	include 'xdatalist.inc'
	integer*4	ljunk
	logical*4	bjunk

	logical*4	XDATA_SCROLLBARS

	call MX$CLEAR_WINDOW()
	call XDATA_DRAW()

	! Draw scrollbars
	bjunk = XDATA_SCROLLBARS(0, 3, ljunk, bjunk)

	return
	END	! XDATA_REFRESH



c XDATA_DRAW
c
c Draws the entire display (minus scrollbars)
c
	subroutine XDATA_DRAW ()
	include 'xdatalist.inc'

	integer*4	row, field, scalar, px1, py1, k
	integer*4	nrows, len, ii, joff, ljunk
	logical*4	bjunk
	character	str*(DEFSTRLEN), titlekey*(20)
	record /HEADER/	htmpl
	pointer		(htmplptr, htmpl)

	k = Mx.level

	! Display title lines
	htmplptr = Gx.phTmpl(Gx.view).p
	call XDATA_SCOPE_TO_FIELD(htmpl, 0)
	if (Gx.labelstyle.gt.0) then
	  nrows = Gx.ntitle - 1
	else
	  nrows = Gx.ntitle
	endif
	do row = 1, nrows
	  ii = 1
	  px1 = Mx.stk(k).x1
	  titlekey = 'TITLE'
	  ljunk = M$L2A(row, titlekey(6:))
	  len = M$GET_KEYWORD(htmpl, titlekey, str)
	  if (len .gt. 3) then
	    if (str(1:1).eq.'[' .AND. str(3:3).eq.']') then
	      ii = 4
	      len = len-3
	      if (str(2:2) .eq. 'S') then	! scrollable title
		ii = ii + Gx.left
		str(1:) = str(ii:len+3)
		ii = 1
		len = MIN(Gx.nviscols, DEFSTRLEN)
	      elseif (str(2:2).eq.'C' .OR. str(2:2).eq.'R') then
		! centered or right-justified title
		joff = Gx.nviscols - len
		if (str(2:2) .eq. 'C') joff = joff / 2
		if (joff .gt. 0) then
		  px1 = px1 + joff*Mx.text_w
		else
		  ii = ii-joff
		endif
	      endif
	    endif
	  endif
	  if (len .gt. 0) then
	    len = MIN(len, Gx.ndatacols)
	    py1 = row*Mx.text_h
	    call MX$COLORTEXT(Gx.defcolor,px1,py1,str(ii:ii+len-1))
	  endif
	enddo

	call XDATA_DRAW_REGION(SEL_ALL, SEL_ALL, SEL_ALL,
     +				Gx.nvisrows, Gx.nfields, SEL_ALL,
     +				USEDEFCOLORS, .TRUE.)
	    
	return
	END	! XDATA_DRAW



c XDATA_DRAW_REGION
c
c Displays the rectangular region of data defined by
c	(row1,field1,scalar1)  =  Upper Left corner
c	(row2,field2,scalar2)  =  Lower Right corner
c
c	SEL_ALL means all rows,   0 is the label row
c	SEL_ALL means all fields, 0 is the index field
c
	subroutine XDATA_DRAW_REGION (row1, field1, scalar1,
     +				      row2, field2, scalar2,
     +				      reqcolor, update_data)
	include 'xdatalist.inc'
	integer*4	row1, field1, scalar1
	integer*4	row2, field2, scalar2, reqcolor
	logical*4	update_data

	integer*4	   row, firstrow, lastrow
	integer*4	   field, firstfield, lastfield, ff, firstff
	integer*4	   scalar, firstscalar, lastscalar, ns, s1, s2
	integer*4	   firstcol, lastcol, coff1, coff2
	integer*4	   k, px1, py1, len, ii, jj, width, lval, bg, fg
	integer*4	   color, new_color, prev_color, hlitopt, coloropt
	logical*4	   cursor_in_row
	logical*4	   cursor_in_field, cursor_in_last_field
	real*8		   elemt, dval
	character	   str*(DEFSTRLEN)
	record /M_PTR/	   pbElemt, pbField	! Pointers into data buffer
	character	   linebuf		! Pointer into screen buffer
	pointer		   (linebufptr, linebuf)
c	record /FIELDINFO/ finfo(1)		! Pointer to finfo array
	record /FIELDINFO/ finfo(*)		! Pointer to finfo array _IFC
	pointer		   (finfoptr, finfo)

	integer*4	XDATA_GET_SCALAR_COLOR, XDATA_FIND_HIGHLIGHT
	logical*4	XDATA_SCALAR_IN_CURSOR


D	write(*,*)  'REQUESTED:',row1,field1,scalar1,'   ',row2,field2,scalar2
	k = Mx.level
	firstrow	= MAX(1,row1)
	lastrow		= MIN(row2,Gx.nvisrows)
	firstfield	= MAX(Gx.fleft,field1)
	lastfield	= MIN(field2,Gx.fright)
	firstscalar	= MAX(1,scalar1)

	! Draw the row indices?
	if (Gx.indexpos.ne.0 .AND.
     +	    (field1.eq.SEL_ALL .OR. field1.eq.0)) then
	  ! Index column label
	  if (Gx.labelstyle.gt.0) then
	    if (Gx.top+Gx.ioffset .lt. Gx.iradix) then
	      len = M$GET_KEYWORD(%val(Gx.phTmpl(Gx.view).p),
     +				  'INDEXLABEL', str)
	    else
	      dval = Gx.top + Gx.ioffset
	      lval = NINT(dval-MOD(dval,DBLE(Gx.iradix)))
	      len = M$L2A(lval, str) + 1
	      str(len:len) = '+'
	    endif
	    if (Gx.indexpos .lt. 0) then
	      px1 = 2
	    else
	      px1 = Mx.width - (Gx.iwidth+1)*Mx.text_w
	    endif
	    py1 = Gx.ntitle*Mx.text_h
	    if (XDATA_FIND_HIGHLIGHT(0d0, 0, SEL_ALL, color, hlitopt)
     +		.eq. 0)  color = Gx.defcolor
	    call MX$COLORTEXT(color, px1, py1, str(1:Gx.iwidth))
	    hlitopt = 0
	  endif
	  ! Indices
	  if (Gx.indexpos .gt. 0) then
	    px1 = Mx.width - Gx.iwidth*Mx.text_w
	  else
	    px1 = 2
	  endif
	  py1 = Mx.stk(k).y1 + firstrow*Mx.text_h
	  do row = firstrow, lastrow
	    elemt = XDATA_ROW2ELEMT(row)
	    lval = NINT(MOD(Gx.top+Gx.ioffset+row-1,DBLE(Gx.iradix)))
	    len = M$L2A(lval, str)
	    if (Gx.indexpos .lt. 0) then
	      if (len .gt. Gx.iwidth) then
		str(1:Gx.iwidth) = '***************************'
	      elseif (len .lt. Gx.iwidth) then
		! Right-align index (no %ref in 1st arg to avoid SUN bug)
		call M$MOVE(%val(%loc(str(1:len))),
     +			    %ref(str(Gx.iwidth-len+1:Gx.iwidth)), len)
		str(1:Gx.iwidth-len) = ' '
	      endif
	    endif
	    cursor_in_field = XDATA_SCALAR_IN_CURSOR(row, 0, SEL_ALL)
	    if (cursor_in_field .AND. .NOT.Gx.xparent_cursor) then
	      color = Gx.curcolor
	    else
	      ! Either we're not in the cursor or it's transparent
	      if (reqcolor .eq. USEDEFCOLORS) then
		if (XDATA_FIND_HIGHLIGHT(elemt, 0, SEL_ALL, color, hlitopt)
     +		    .eq. 0) color = Gx.defcolor
	      else
		color = reqcolor
	      endif
	      if (cursor_in_field) then
		! Transparent cursor
		! If the field's foreground and cursor's background
		! colors are the same, make the field's foreground
		! color X-DataList's background color
		bg = (color-L_NoColor)/1000
		fg = color - bg * 1000
		if (fg .eq. Gx.curcolor_bg)
     +		  fg = L_BGColor
		color = Gx.curcolor_bg*1000 + fg
	      endif
	    endif
	    call MX$COLORTEXT(color, px1, py1, str(1:Gx.iwidth))
	    py1 = py1 + Mx.text_h
	  enddo
	endif	! draw row indices


	! Is any part of the region visible?
	if (firstfield .gt. lastfield)
     +	  return	! Nope

	finfoptr = Gx.pbFinfo.p

	! Compute the leftmost scalar and leftmost column to be drawn
	ff = firstfield
	if (Gx.scrambled) then
	  do field = firstfield, lastfield
	    if (finfo(field).offset.lt.finfo(ff).offset) ff = field
	  enddo
	endif
	if (Gx.class .eq. 2)
     +	  call XDATA_2000_FIELDINFO(ff)
	firstff = ff
	coff1 = finfo(ff).offset - Gx.left
	if (coff1.gt.0 .AND. firstfield.eq.1 .AND. firstscalar.eq.1)
     +	then
	  ! Handle the case where FIELD 1's OFFSET > 0
	  firstcol = 1
	  firstscalar = 1
	elseif (finfo(ff).nscalars .eq. 1) then
	  firstscalar = 1
	  firstcol = MAX(1, coff1+1)
	else
	  firstcol = coff1 + (firstscalar-1)*finfo(ff).swidth + 1
	  if (firstcol .lt. 1) then
	    firstscalar = MIN(finfo(ff).nscalars, firstscalar +
     +				(-1*firstcol+1)/finfo(ff).swidth)
	    firstcol = 1
	  endif
	endif

	! Compute the rightmost scalar and rightmost column to be drawn
	ff = lastfield
	if (Gx.scrambled) then
	  do field = firstfield, lastfield
	    if (finfo(field).offset.gt.finfo(ff).offset) ff = field
	  enddo
	endif
	if (Gx.class .eq. 2)
     +	  call XDATA_2000_FIELDINFO(ff)
	if (finfo(ff).nscalars .eq. 1) then
	  lastscalar = 1
	  lastcol    = MIN(finfo(ff).offset-Gx.left
     +			   +finfo(ff).width+finfo(ff).spacing,
     +			   Gx.nviscols)
	else
	  if (scalar2 .eq. SEL_ALL) then
	    lastscalar = finfo(ff).nscalars
	  else
	    lastscalar = MIN(scalar2, finfo(ff).nscalars)
	  endif
	  coff1 = finfo(ff).offset - Gx.left
	  lastcol = coff1 + lastscalar*finfo(ff).swidth
	  if (lastcol .gt. Gx.nviscols) then
	    lastscalar = (Gx.nviscols-coff1)/finfo(ff).swidth + 1
	    lastcol    = Gx.nviscols
	  elseif (lastscalar .eq. finfo(ff).nscalars) then
	    lastcol    = MIN(lastcol+finfo(ff).spacing, Gx.nviscols)
	  endif
	endif

D	write(*,*)  'ACTUAL:', firstrow, firstfield, firstscalar, '   ',
D    +			   lastrow,  lastfield,  lastscalar
D	write(*,*)  'firstcol =',firstcol, '  lastcol =', lastcol

	if (firstfield.eq.lastfield .AND. firstscalar.gt.lastscalar)
     +	  return


	! Draw field labels?
	if (Gx.labelstyle.gt.0 .AND. (row1.eq.SEL_ALL .OR. row1.eq.0))
     +	then
	  hlitopt = 0
	  coloropt = 0
	  if (firstfield.eq.1 .AND. .NOT.Gx.scrambled) then
C TODO: Leftmost field label
	    ! Clear screen to left of 1st field label
	    coff1 = finfo(1).offset - Gx.left
	    if (coff1 .gt. 0) then
	      str(1:coff1) = ' '
	      call MX$COLORTEXT(Gx.defcolor, Mx.stk(k).x1,
     +				Gx.ntitle*Mx.text_h, str(1:coff1))
	    endif
	  endif
	  do field = firstfield, lastfield
	    ff = field
	    if (Gx.class .eq. 2)
     +	      call XDATA_2000_FIELDINFO(ff)
	    if (Gx.scrambled) then	! skip this field ?
	      if (finfo(ff).offset+finfo(ff).width+
     +		finfo(ff).spacing .lt. Gx.left   .or. 
     +		finfo(ff).offset .gt. Gx.left+Gx.nviscols) goto 12
	    endif
	    call XDATA_FORMAT_FIELDLABEL(finfo(ff), str)
	    coff1 = finfo(ff).offset - Gx.left
	    ii = 1
	    if (coff1 .lt. 0)
     +	      ii = -1*coff1 + 1
	    jj = finfo(ff).width + finfo(ff).spacing
	    if (coff1+jj .gt. Gx.nviscols)
     +	      jj = Gx.nviscols - coff1
	    px1 = Mx.stk(k).x1 + MAX(0,coff1)*Mx.text_w
	    color = XDATA_GET_SCALAR_COLOR(0d0, 0, ff, SEL_ALL,
     +			%val(Gx.pbFinfo.p), reqcolor, hlitopt, coloropt)
	    call MX$COLORTEXT(color, px1, Gx.ntitle*Mx.text_h, str(ii:jj))
  12	  enddo
	endif

	! Format(?) and Display data
	py1 = Mx.stk(k).y1 + firstrow*Mx.text_h
	do row = firstrow, lastrow
	  linebufptr = Gx.pbScreen.p + (row-1)*Gx.nviscols 
	  pbElemt.p  = Gx.pbData.p   + (row-1)*Gx.bpe
	  elemt      = XDATA_ROW2ELEMT(row)
	  ! Determine the color of the first scalar in this row
	  hlitopt = 0
	  coloropt = 0
	  ! Compute color here in case through optimization we don't below
	  ! (and also so prev_color .eq. color the first time around)
	  color = XDATA_GET_SCALAR_COLOR(elemt, row, firstff,
     +				firstscalar, %val(Gx.pbFinfo.p),
     +				reqcolor, hlitopt, coloropt)
	  prev_color = color
	  cursor_in_last_field = .FALSE.
	  px1 = Mx.stk(k).x1 + (firstcol-1)*Mx.text_w
	  ii  = firstcol

	  cursor_in_row = XDATA_SCALAR_IN_CURSOR(row, SEL_ALL, SEL_ALL)
	  if (update_data .OR. cursor_in_row
     +	      .OR. reqcolor.eq.USEDEFCOLORS .OR. Gx.scrambled) then
	    do field = firstfield, lastfield
	      ff = field
	      if (Gx.class .eq. 2)
     +		call XDATA_2000_FIELDINFO(ff)
	      coff1 = finfo(ff).offset - Gx.left
	      coff2 = coff1 + finfo(ff).width + finfo(ff).spacing
D	      write(*,*)  'ff =',ff, ' coff1 =',coff1, ' coff2 =',coff2
	      cursor_in_field = XDATA_SCALAR_IN_CURSOR(row, field, SEL_ALL)

	      ! Do we need to reformat data from the data buffer?
	      if ( update_data ) then
		pbField.p = pbElemt.p + finfo(ff).fieldoff 
		if (coff1.lt.0 .OR. coff2.gt.Gx.nviscols) then
		  if (coff2.lt.0 .OR. coff1.gt.Gx.nviscols) goto 112
		  ! Field is clipped
		  call XDATA_FORMAT_FIELD(pbField, finfo(ff), str)
		  if (coff1 .lt. 0) then
		    ! Clipped on left (and maybe right too)
		    linebuf(1:MIN(coff2,Gx.nviscols)) =
     +			    str(-1*coff1+1:coff2-coff1)
		  else
		    ! Clipped on right
		    if (field.eq.1 .AND. coff1.gt.0)
     +		      linebuf(1:coff1) = ' '
		    linebuf(coff1+1:Gx.nviscols) = str
		  endif
		else
		  ! Entire field is visible
		  if (field.eq.1 .AND. coff1.gt.0)
     +		    linebuf(1:coff1) = ' '
		  call XDATA_FORMAT_FIELD(pbField, finfo(ff),
     +					  linebuf(coff1+1:coff2))
		endif

	      elseif (coloropt.eq.2 .AND. .NOT.cursor_in_row) then
		! We know the color for the rest of this row and no
		! data formatting is being done...
		goto 222	! go on to next row
	      endif	! update_data

	      ! Check to see if we already know the colors for this field 
	      if ((reqcolor.ne.USEDEFCOLORS .OR. coloropt.eq.2) .AND.
     +		  .NOT.cursor_in_field .AND. .NOT.cursor_in_last_field)
     +		goto 111	! go on to next field

	      ! Check the color of each scalar.  Each time we encounter
	      ! a new color, we have to write the preceeding contents to
	      ! the display using the previous color.
	      if (ABS(hlitopt) .eq. 1) hlitopt = 0
	      ns = finfo(ff).nscalars
	      s1 = 1
	      s2 = ns
	      if (ns .eq. 1) then
		width = finfo(ff).width + finfo(ff).spacing
		jj = coff1
	      else
		if (field .eq. firstfield) s1 = firstscalar
		if (field .eq. lastfield)  s2 = lastscalar
		width = finfo(ff).swidth
		jj = coff1 + (s1-1)*width
	      endif
	      if (Gx.scrambled) then
		ii = MAX(0,coff1)+1
		px1 = Mx.stk(k).x1 + (ii-1)*Mx.text_w
	      endif
	      do scalar = s1, s2
		color = XDATA_GET_SCALAR_COLOR(elemt, row, ff, scalar,
     +					       %val(Gx.pbFinfo.p),
     +					       reqcolor, hlitopt, coloropt)
		if (color .ne. prev_color) then
D		  write(*,*)  'Color change: Field',field, '  scalar',scalar
D		  write(*,*)  linebuf(ii:jj)
		  if (jj-ii+1.gt.0) then
		    call MX$COLORTEXT(prev_color, px1, py1, linebuf(ii:jj))
		  endif
		  px1 = px1 + (jj-ii+1)*Mx.text_w
		  ii = jj + 1
		  prev_color = color
		endif
		if (coloropt .ne. 0) then
		  coloropt = 0
		  goto 111
		endif
		jj = jj + width
	      enddo	! scalar loop
  111	      continue			! Optimization target #1
	      if (Gx.scrambled .AND. coff2-coff1+1.gt.0) then
		ii = MAX(0,coff1)+1
		jj = MIN(coff2,lastcol)
	        px1 = Mx.stk(k).x1 + (ii-1)*Mx.text_w
		if (jj-ii+1 .gt. 0) then
		  call MX$COLORTEXT(color, px1, py1, linebuf(ii:jj))
		endif
	      endif
  112	      continue			! Optimization target #1
	      cursor_in_last_field = cursor_in_field
	    enddo	! field loop
  222	    continue			! Optimization target #2
	    hlitopt = 0
	  endif
	  ! Draw whatever is left of this row
	  if (ii .le. lastcol .AND. .NOT.Gx.scrambled)
     +	    call MX$COLORTEXT(color, px1, py1, linebuf(ii:lastcol))
	  py1 = py1 + Mx.text_h
	enddo	! row loop

	return
	END	! XDATA_DRAW_REGION



c XDATA_FORMAT_FIELD
c
c A wrapper to XDATA_FIELDFMT that handles alignment problems
c
	subroutine XDATA_FORMAT_FIELD (F, fi, str)
	include 'xdatalist.inc'
	record /M_PTR/	    F		! Pointer to field data
	record /FIELDINFO/  fi		! field information
	character*(*)	    str		! OUT: Output string

#if !_VMS
	if (Gx.class .gt. 2) then
	  ! Move field into the scratch buffer to ensure proper
	  ! byte alignment (Alphas/VAXs seem to handle this ok)
	  call M$MOVE(%val(F.p), %val(Gx.pbScratch.p), fi.bpf)
	  call XDATA_FIELDFMT(%val(Gx.pbScratch.p), fi, str)
	  return
	endif
#endif
	call XDATA_FIELDFMT(%val(F.p), fi, str)

	return
	END	! XDATA_FORMAT_FIELD



c XDATA_FIELDFMT
c
c Formats a single X-DataList field into the given string
c
	subroutine XDATA_FIELDFMT (F, fi, str)
	include 'xdatalist.inc'
	integer*4 L_bbuf
	parameter (L_bbuf=16)
	include 'buffers.inc'
	record /BUFFER/		F		! IN:  Field data
	record /FIELDINFO/	fi		! IN:  Field information
	character*(*)		str		! OUT: Output string

	integer*4	 width, ldispform, mlen, ns, bps
	integer*4	 scalar, enum, ii, jj, mm, ljunk
	real*8		 dval
	logical*4	 f2d
	character	 datatype
	character	 menustr
	pointer		(menustrptr, menustr)
	character	 dispform
	pointer		(dispformptr, dispform)

	integer*4  XDATA_MATCH_ENUM_VALUE

	dispformptr = fi.dispform.p
	ldispform   = fi.ldispform
	datatype    = fi.format(2:2)
	ns	    = fi.nscalars

	! Single-field FORTRAN format string
	if (dispform(1:1) .eq. '(') then
	  width = fi.width
	  if (width .eq. 0) goto 99
	  if (datatype .eq. 'A') then
	    write(unit=str(1:width), fmt=dispform(1:ldispform), err=100)
     +	       F.sbuf(1:MIN(width,M$NPT(fi.format(1:1))*8))
100         continue
	  elseif (datatype .eq. 'D') then
	    write(unit=str(1:width), fmt=dispform(1:ldispform), err=200)
     +	      (F.dbuf(scalar), scalar=1, ns)
200         continue
	    if (fi.usenullval) then
	      do scalar = 1, ns
		if (F.dbuf(scalar) .eq. fi.nullval)
     +		  str((scalar-1)*width/ns+1:scalar*width/ns) = ' '
	      enddo
	    endif
	  elseif (datatype .eq. 'F') then
	    write(unit=str(1:width), fmt=dispform(1:ldispform), err=300)
     +	      (F.fbuf(scalar), scalar=1, ns)
300         continue
	    if (fi.usenullval) then
	      do scalar = 1, ns
		call M$F2D(F.fbuf(scalar), dval)
		if (dval .eq. fi.nullval)
     +		  str((scalar-1)*width/ns+1:scalar*width/ns) = ' '
	      enddo
	    endif
	  elseif (datatype .eq. 'L') then
            write(unit=str(1:width), fmt=dispform(1:ldispform), err=400)
     +	      (F.lbuf(scalar), scalar=1, ns)
400         continue
	    if (fi.usenullval) then
	      do scalar = 1, ns
		if (F.lbuf(scalar) .eq. fi.nullval)
     +		  str((scalar-1)*width/ns+1:scalar*width/ns) = ' '
	      enddo
	    endif
	  elseif (datatype .eq. 'I') then
	    write(unit=str(1:width), fmt=dispform(1:ldispform),err=500)
     +	      (F.ibuf(scalar), scalar=1, ns)
500         continue
	    if (fi.usenullval) then
	      do scalar = 1, ns
		if (F.ibuf(scalar) .eq. fi.nullval)
     +		  str((scalar-1)*width/ns+1:scalar*width/ns) = ' '
	      enddo
	    endif
	  elseif (datatype .eq. 'B') then
	    write(unit=str(1:width), fmt=dispform(1:ldispform),err=600)
     +	      (F.bbuf(scalar), scalar=1, ns)
600         continue
	    if (fi.usenullval) then
	      do scalar = 1, ns
#if _SUN
		if (DBLE(F.bbuf(scalar)) .eq. fi.nullval)
#else
		if (F.bbuf(scalar) .eq. fi.nullval)
#endif
     +		  str((scalar-1)*width/ns+1:scalar*width/ns) = ' '
	      enddo
	    endif
	  endif

	else
	  width = fi.swidth
	  if (width .eq. 0) goto 99
	  bps = M$NPT(datatype)

	  if (fi.enumerated) then
	    ! Enumerated field: parse the MENU keyword string
	    menustrptr = fi.menustr.p
	    mm = M$SEARCH(menustr(1:fi.lmenustr), ';') + 1
	    ii = 1
	    do scalar = 1, ns
	      enum = XDATA_MATCH_ENUM_VALUE(F.bbuf((scalar-1)*bps+1), fi)
	      if (enum .eq. -1) then
		str(ii:ii+width-1) = ' '
	      elseif (enum.eq.0 .OR.
     +		      M$PARSE(menustr(mm:fi.lmenustr), enum,
     +			      str(ii:ii+width-1)) .eq. 0) then
		do jj = ii, ii+width-1
		  str(jj:jj) = '*'
		enddo
	      endif
	      ii = ii + width
	    enddo
	  else
	    jj = 1
	    if (ldispform .ge. 4) then
	      ljunk = 4	! Hide '4' from VAX compiler in following substring
	      if (dispform(1:ljunk) .eq. 'D2A:')
     +		jj = 5
	    endif
	    ii = 1
	    f2d = (datatype .eq. 'F')
	    do scalar = 1, ns
	      if (f2d) then
		call M$F2D(F.fbuf(scalar), dval)
	      else
		call M$REFORMAT(F.bbuf((scalar-1)*bps+1),
     +				datatype, dval, 'D', 1)
	      endif
	      if (fi.usenullval .AND. dval.eq.fi.nullval) then
		str(ii:ii+width-1) = ' '
	      else
		ljunk = M$D2A_FORM(dval, str(ii:ii+width-1),
     +				   dispform(jj:ldispform))
	      endif
	      ii = ii + width
	    enddo
	  endif
	endif

	! Add spacing
  99	str(fi.width+1:fi.width+fi.spacing) = ' '

	return
	END	! XDATA_FIELDFMT



c XDATA_GET_SCALAR_COLOR
c
c Decides what color a specified X-DataList scalar should be, based on
c the current location and type of the cursor, highlight regions or COLOR
c keywords in the template.
c
c Returns the color as the function value, and one of the following color
c optimization codes in <coloropt>:
c	 0: No oppurtunity for color optimization possible/detected
c	 1: All scalars in the specified field are the same color
c	 2: All scalars in the specified row are the same color
c
	integer*4
     +	function XDATA_GET_SCALAR_COLOR (elemt, row, xdlfield, scalar,
     +					 finfo, reqcolor, hlitopt, coloropt)
	include 'xdatalist.inc'
	real*8		   elemt		 ! IN:  Scalar coordinates
	integer*4	   row, xdlfield, scalar ! IN:  Scalar coordinates
	record /FIELDINFO/ finfo(*)		 ! IN:  Field info structure
	integer*4	   reqcolor		 ! IN:  Requested color
	integer*4	   hlitopt		 ! IN/OUT: Hlit opt. code
	integer*4	   coloropt		 ! OUT: Color optimization code
	integer*4	   ff, color, colormode, colorcode, enum, bg, fg
	logical*4	   in_cursor
	character	   datatype
	character*2	   format
	record /M_PTR/	   pbColordata
	record /HEADER/	   hdata
	pointer		   (hdataptr, hdata)

	logical*4	XDATA_SCALAR_IN_CURSOR
	integer*4	XDATA_FIND_HIGHLIGHT
	integer*4	XDATA_MATCH_ENUM_VALUE

	ff = xdlfield	! <xdlfield> is an IN parameter

	in_cursor = XDATA_SCALAR_IN_CURSOR(row, finfo(ff).field, scalar)
	if (in_cursor .AND. .NOT.Gx.xparent_cursor) then
	  ! We are within the cursor -- use the cursor color
	  ! TODO: set coloropt?
	  XDATA_GET_SCALAR_COLOR = Gx.curcolor
	  return
	elseif (reqcolor .ne. USEDEFCOLORS) then
	  ! We've been asked to draw in a specific color
	  color = reqcolor
	  goto 50	! Check for transparent cursor
	endif

	! Is scalar contained in a highlight region?
	if (Gx.nhlit.gt.0 .AND. hlitopt.eq.0) then
	  if (XDATA_FIND_HIGHLIGHT(elemt, finfo(ff).field, scalar,
     +				   color, hlitopt) .gt. 0) then
	    coloropt = hlitopt
	    goto 50	! Check for transparent cursor
	  endif
	endif

	! Retrieve the color mode and code for the containing field
	! (Found in the COLOR keyword of the field or 'global' section)
	colormode = finfo(ff).colormode
	colorcode = finfo(ff).color
	if (colormode .eq. USEDEFCOLORS) then
	  colormode = Gx.colormode
	  colorcode = Gx.color
	endif

	if (colormode .eq. USEDEFCOLORS) then
	  color = Gx.defcolor
	elseif (colormode .eq. COLOR_BY_NUM) then
	  ! Field color is constant
	  color = colorcode
	elseif (row .gt. 0) then	! not the field label row
	  if (colormode .eq. COLOR_BY_SUBR) then
	    ! Field color is based on the value of
	    ! a Type 3000/5000 subrecord/subcomponent
	    hdataptr = Gx.phData.p
	    pbColordata.p = Gx.pbData.p + (row-1)*Gx.bpe
     +			    + M$SUB_OFFSET(hdata, colorcode)
            format = M$SUB_FORMAT(hdata, colorcode)
	    datatype = format(2:2)
	    call M$REFORMAT(%val(pbColordata.p), datatype,
     +			    color, 'L', 1)
	  elseif (colormode.eq.COLOR_BY_FIELD .OR.
     +		  colormode.eq.COLOR_BY_ENUM) then
	    ! Field color is based on another X-DataList FIELD
	    ! or on MCOLORS keyword
	    ff = colorcode
	    pbColordata.p = Gx.pbData.p + (row-1)*Gx.bpe
     +			    + finfo(ff).fieldoff
	    datatype = finfo(ff).format(2:2)

	    if (finfo(ff).enumerated) then
	      color = Gx.defcolor
	      if (finfo(ff).mcolors.p .ne. 0) then
		! Enumerated field colors
		enum = XDATA_MATCH_ENUM_VALUE(%val(pbColordata.p),
     +					      finfo(ff))
		if (enum .gt. 0) then
		  ! Return color associated with enumeration
		  call M$REFORMAT(%val(finfo(ff).mcolors.p+(enum-1)*2),
     +				  'I', color, 'L', 1)
		endif
	      endif
	    else
	      ! Use field value as a color table index
	      call M$REFORMAT(%val(pbColordata.p), datatype,
     +				color, 'L', 1)
	    endif
	  endif	! colormode
	else
	  ! field label row
	  color = Gx.defcolor
	endif

  50	continue		! Optimization target

	! Transparent cursor?
	if (in_cursor) then
	  ! If the field's foreground and cursor's background
	  ! colors are the same, make the field's foreground
	  ! color X-DataList's background color
	  coloropt = 0
	  bg = (color-L_NoColor)/1000
	  fg = color - bg * 1000
	  if (fg .eq. Gx.curcolor_bg)
     +	    fg = L_BGColor
	  color = Gx.curcolor_bg*1000 + fg
	endif

	XDATA_GET_SCALAR_COLOR = color
	return
	END	! XDATA_GET_SCALAR_COLOR



c XDATA_MATCH_ENUM_VALUE
c
c Compares a scalar value to one of a series of enumerated values
c and returns the index of the first match, or:
c   0 if no match, -1 if scalar value = fi.nullval
c
	integer*4
     +	function XDATA_MATCH_ENUM_VALUE (Sval, fi)
	include 'xdatalist.inc'
	integer*4 L_bbuf
	parameter (L_bbuf=16)
	include 'buffers.inc'
	record /BUFFER/		Sval		! Scalar value
	record /FIELDINFO/	fi		! Field info. structure

	record /BUFFER/	ENUM_VALS		! Values to compare against
	pointer		(enum_valsptr, ENUM_VALS)
	real*8		dval
	integer*4	index, ii, len
	character	str*(DEFSTRLEN), datatype

	enum_valsptr = fi.mvalues.p
	datatype     = fi.format(2:2)
	index = 0

	if (datatype .eq. 'D') then
	  if (fi.usenullval .AND. Sval.dbuf(1).eq.fi.nullval) then
	    index = -1
	  else
	    do ii = 1, fi.nmenuitems
	      if (Sval.dbuf(1) .eq. ENUM_VALS.dbuf(ii)) then
		index = ii
		goto 100
	      endif
	    enddo
	  endif
	elseif (datatype .eq. 'F') then
	  call M$F2D(Sval.fbuf(1), dval)
	  if (fi.usenullval .AND. dval.eq.fi.nullval) then
	    index = -1
	  else
	    do ii = 1, fi.nmenuitems
	      if (Sval.fbuf(1) .eq. ENUM_VALS.fbuf(ii)) then
		index = ii
		goto 100
	      endif
	    enddo
	  endif
	elseif (datatype .eq. 'L') then
	  if (fi.usenullval .AND. Sval.lbuf(1).eq.fi.nullval) then
	    index = -1
	  else

	    do ii = 1, fi.nmenuitems
	      if (Sval.lbuf(1) .eq. ENUM_VALS.lbuf(ii)) then
		index = ii
		goto 100
	      endif
	    enddo
	  endif
	elseif (datatype .eq. 'I') then
	  if (fi.usenullval .AND. Sval.ibuf(1).eq.fi.nullval) then
	    index = -1
	  else
	    do ii = 1, fi.nmenuitems
	      if (Sval.ibuf(1) .eq. ENUM_VALS.ibuf(ii)) then
		index = ii
		goto 100
	      endif
	    enddo
	  endif
	elseif (datatype .eq. 'B') then
#if _SUN
	  if (fi.usenullval .AND. DBLE(Sval.bbuf(1)).eq.fi.nullval) then
#else
	  if (fi.usenullval .AND. Sval.bbuf(1).eq.fi.nullval) then
#endif
	    index = -1
	  else
	    do ii = 1, fi.nmenuitems
	      if (Sval.bbuf(1) .eq. ENUM_VALS.bbuf(ii)) then
		index = ii
		goto 100
	      endif
	    enddo
	  endif
	elseif (datatype .eq. 'A') then
	  do ii = 1, fi.nmenuitems
	    len = M$PARSE(ENUM_VALS.sbuf(1:fi.lmvalues), ii, str)
	    if (str(1:fi.bpf) .eq. Sval.sbuf(1:fi.bpf)) then
	      index = ii
	      goto 100
	    endif
	  enddo
	else
	  call M$ERROR('XDATA_MATCH_ENUM_VALUE given bad type: '
     +			//datatype)
	endif

 100	XDATA_MATCH_ENUM_VALUE = index
	return
	END	! XDATA_MATCH_ENUM_VALUE



c XDATA_COLORS
c
c Initializes the colormap or brings up a COLORTAB widget
c
	subroutine XDATA_COLORS (mode)
	include 'xdatalist.inc'
	include 'qmessdef.inc'
	integer*4	mode, lval, nn

	SAVE	! static variables
	integer*4		ncolors
	record /MQD_COLORINFO/	color(NUMCOLORS)

	if (mode .eq. 0) then
	  ! Get a nice grey for the cursor
	  call MX$COLORLAB(DEFCURCOLOR, '%40.40.40')
	  if (Mx.pixel(DEFCURCOLOR) .eq. Mx.white)
     +	    Mx.pixel(DEFCURCOLOR) = Mx.XWBG
	  ncolors = NUMCOLORS
	  do nn = 1, ncolors
	    color(nn).position = L_NoColor
	  enddo
	  call MX$XC(Mc.colormap(4), color, ncolors)
	  call MX$COLORMAP(Mc.colormap(4), ncolors)
	  do nn = 1, ncolors
	    lval = color(nn).position
	    if (lval.ge.0 .AND. lval.le.100) then
	      call MX$COLORTAB(nn, Mc.colormap(4), lval)
	    elseif (lval .lt. 0) then
	      call MX$COLORTAB(nn, color(nn), -2)
	    endif
	  enddo
	elseif (mode .eq. -1) then
	  call MX$COLORTAB(0, color, -3)
	  call MX$COLORTAB(1, Mc.colormap(4), -1)
	endif

	return
	END	! XDATA_COLORS



c XDATA_CURSOR
c
c Updates Gx.elemt, Gx.field and Gx.scalar and draws/erases the cursor
c
c If mode is -1, just 'erase' the cursor's current position
c If mode is  0, 'move' the cursor (erase then draw at given position)
c If mode is  1, just draw the cursor at the given position
c
	subroutine XDATA_CURSOR (elemt, field, scalar, mode)
	include 'xdatalist.inc'
	real*8		elemt
	integer*4	field, scalar, mode
	integer*4	r1, r2, f1, f2, s1, s2, curmode, cursor

	curmode = mode
	if (mode .eq. 0) curmode = -1

  98	if (curmode .eq. -1) then
	  r1 = XDATA_ELEMT2ROW(Gx.elemt)
	  f1 = Gx.field
	  s1 = Gx.scalar
	  ! Update currently selected elemt/field/scalar
	  Gx.elemt  = SEL_NONE
	  Gx.field  = SEL_NONE
	  Gx.scalar = SEL_NONE
	else
	  r1 = XDATA_ELEMT2ROW(elemt)
	  f1 = field
	  s1 = scalar
	  ! Update currently selected elemt/field/scalar
	  Gx.elemt  = elemt
	  Gx.field  = field
	  Gx.scalar = scalar
	endif
	r2 = r1
	f2 = f1
	s2 = s1

	if (Gx.cursor .eq. CR_NONE)  goto 99

	cursor = Gx.cursor
	if (cursor .eq. CR_DEF) then
	  if (f1 .eq. SEL_ALL) then
	    cursor = CR_ROW
	  elseif (r1 .eq. SEL_ALL) then
	    cursor = CR_FCOL
	  else
	    cursor = CR_SCALAR
	  endif
	endif

	if (cursor.eq.CR_ROW .AND. (r1.gt.0 .OR. f1.gt.0)) then
	  f1 = SEL_ALL
	  f2 = Gx.fright
	  s1 = SEL_ALL
	  s2 = SEL_ALL
	else
	  if (f1 .le. 0) goto 99
	  if (cursor.eq.CR_FCOL .OR. cursor.eq.CR_SCOL) then
	    r1 = SEL_ALL
	    r2 = Gx.nvisrows
	  elseif (Gx.cursor .eq. CR_FIELD) then
	    s1 = SEL_ALL
	    s2 = SEL_ALL
	  endif
	endif

	call XDATA_DRAW_REGION(r1, f1, s1, r2, f2, s2,
     +				USEDEFCOLORS, .FALSE.)

  99	if (mode.eq.0 .AND. curmode.eq.-1) then
	  curmode = 1
	  goto 98
	endif

	return
	END	! XDATA_CURSOR



c XDATA_SCALAR_IN_CURSOR
c
c Returns .TRUE. if the given row, field and scalar is within the cursor.
c
	logical*4
     +	function XDATA_SCALAR_IN_CURSOR (row, field, scalar)
	include 'xdatalist.inc'
	integer*4  row, field, scalar

	XDATA_SCALAR_IN_CURSOR = .FALSE.

	if ((Gx.elemt.eq.SEL_NONE .AND. Gx.field.eq.SEL_NONE)
     +	    .OR. Gx.cursor.eq.CR_NONE)
     +	  return	! No selection or no cursor

	if (Gx.elemt.eq.SEL_ALL .OR. row.eq.SEL_ALL .OR.
     +	    Gx.cursor.eq.CR_FCOL .OR.
     +	    Gx.cursor.eq.CR_SCOL .OR.
     +	    Gx.elemt.eq.XDATA_ROW2ELEMT(row)) then
	  if (Gx.field.eq.SEL_ALL .OR. field.eq.SEL_ALL .OR.
     +	      Gx.cursor.eq.CR_ROW .OR.
     +	      Gx.field.eq.field) then
	    if (Gx.scalar.eq.SEL_ALL .OR. scalar.eq.SEL_ALL .OR.
     +		Gx.cursor.eq.CR_ROW .OR.
     +		Gx.cursor.eq.CR_FIELD .OR.
     +		Gx.scalar.eq.scalar) then
	      XDATA_SCALAR_IN_CURSOR = .TRUE.
	    endif
	  endif
	endif

	return
	END	! XDATA_SCALAR_IN_CURSOR



c XDATA_FIND_HIGHLIGHT
c
c Given a scalar, this routine determines the color of the highest layer
c highlight region that contains it.
c
c Returns: The number of the frontmost highlight region containing the
c	   scalar, or 0 if no region contains it.
C
c   >0	The region # containing the scalar
c    0	This scalar is not contained in any region
c   -1	This field  is not contained in any region
c   -2	This elemt  is not contained in any region
C TODO:
C    We could be even smarter about this; given the rightmost field/scalar
C    of the region to be drawn, we can tell if the rest of this field or
C    row is ultimately affected by the same highlight region.  Then we'll
C    have the additional return values
c    1	Every scalar in <field> is affected by the same region
c    2	Every scalar in <elemt> is affected by the same region
c
	integer*4
     +	function XDATA_FIND_HIGHLIGHT (elemt, field, scalar,
     +				       color, hlitopt)
	include 'xdatalist.inc'
	real*8	   elemt	  ! IN  - The element of interest
	integer*4  field, scalar  ! IN  - The field & scalar of interest
	integer*4  color	  ! OUT - The color of the containing
				  !	  region (USEDEFCOLORS if none)
	integer*4  hlitopt	  ! OUT - optimization code (see above)
c	record /HLITREGION/	hlitbuf(1)
	record /HLITREGION/	hlitbuf(*)	! _IFC
	pointer			(hlitbufptr, hlitbuf)
	integer*4		returnval, ii

	hlitbufptr = Gx.pbHlit.p
	color = USEDEFCOLORS
	returnval = 0
	hlitopt = -2

	do ii = Gx.nhlit, 1, -1
	  if (hlitbuf(ii).from.elemt  .eq. elemt .OR.
     +	      (hlitbuf(ii).from.elemt .lt. elemt .AND.
     +	       (hlitbuf(ii).to.elemt  .ge. elemt .OR.
     +		hlitbuf(ii).to.elemt  .eq. SEL_ALL))) then
	    if (hlitbuf(ii).from.field  .eq. field .OR.
     +		(hlitbuf(ii).from.field .lt. field .AND.
     +		 (hlitbuf(ii).to.field  .ge. field .OR.
     +		  hlitbuf(ii).to.field  .eq. SEL_ALL))) then
	      if (scalar .eq. SEL_ALL .OR.
     +		  hlitbuf(ii).from.scalar  .eq. scalar .OR.
     +		  (hlitbuf(ii).from.scalar .lt. scalar .AND.
     +		   (hlitbuf(ii).to.scalar  .ge. scalar .OR.
     +		    hlitbuf(ii).to.scalar  .eq. SEL_ALL))) then
		color = hlitbuf(ii).from.color
		returnval = ii
		hlitopt   = 0
		goto 10
	      else
		hlitopt   = 0
	      endif	! Does region contain this scalar?
	    else
	      hlitopt = MAX(-1, hlitopt)
	    endif	! Does region contain this field?
	  endif		! Does region contain this element?
	enddo
  10	XDATA_FIND_HIGHLIGHT = returnval
D	if (returnval .gt. 0) then
D	  write(*,101) 'scalar', elemt, field, scalar,
D    +			'contained in region', ii
D	elseif (hlitopt .eq. 0) then
D	  write(*,102) 'scalar', elemt, field, scalar,
D    +			'not contained in any region'
D	elseif (hlitopt .eq. -1) then
D	  write(*,103) 'field', elemt, field, 'not contained in any region'
D	else
D	  write(*,104) 'element', elemt, 'not contained in any region'
D	endif
D 101	format (a, ' (', f5.0, ',', i4, ',', i2, ') ', a, ' ', i3)
D 102	format (a, ' (', f5.0, ',', i4, ',', i2, ') ', a)
D 103	format (a, ' (', f5.0, ',', i4, ') ', a)
D 104	format (a, ' ',  f5.0, ' ', a)
	return
	END	! XDATA_FIND_HIGHLIGHT



c XDATA_DRAW_HIGHLIGHTS
c
c Draws all visible highlight regions starting with <first>
c
	subroutine XDATA_DRAW_HIGHLIGHTS (first)
	include 'xdatalist.inc'
	integer*4		first

c	record /HLITREGION/	hlitbuf(1)
	record /HLITREGION/	hlitbuf(*)	! _IFC
	pointer			(hlitbufptr, hlitbuf)
	integer*4		row1, row2, field1, field2
	integer*4		scalar1, scalar2, ii

	! Draw all (visible) highlight regions
	hlitbufptr = Gx.pbHlit.p
	do ii = MAX(first,1), Gx.nhlit
	  row1 = XDATA_ELEMT2ROW(hlitbuf(ii).from.elemt)
	  row2 = XDATA_ELEMT2ROW(hlitbuf(ii).to.elemt)
	  ! Are any of the highlight region's rows in viewing range?
	  if (row1.ne.SEL_INVALID .AND. row1.ne.SEL_BEYOND_VIEW .AND.
     +	      row2.ne.SEL_INVALID .AND. row2.ne.SEL_BEFORE_VIEW .AND.
     +	      .NOT.(row1.eq.SEL_BEFORE_VIEW .AND. row2.eq.0)) then
	    ! Determine the row range
	    if (row1 .eq. SEL_BEFORE_VIEW) row1 = 1
	    if (row2.eq.SEL_ALL .OR. row2.eq.SEL_BEYOND_VIEW)
     +	      row2 = Gx.nvisrows
	    ! Determine the field range
	    field1 = hlitbuf(ii).from.field
	    field2 = hlitbuf(ii).to.field
	    if (field2.eq.SEL_ALL)
     +	      field2 = Gx.nfields
	    ! Determine the scalar range
	    scalar1 = hlitbuf(ii).from.scalar
	    scalar2 = hlitbuf(ii).to.scalar
D	    write(*,*)  'HL:',row1,field1,scalar1,row2,field2,scalar2,
D    +			  '	!',hlitbuf(ii).from.id
	    call XDATA_DRAW_REGION(row1, field1, scalar1,
     +				   row2, field2, scalar2,
     +				   hlitbuf(ii).from.color, .FALSE.)
	  endif	! visible
	enddo

	return
	END	! XDATA_DRAW_HIGHLIGHTS



c XDATA_ADD_HIGHLIGHT
c
c Adds a highlight region to the global highlight buffer
c
	subroutine XDATA_ADD_HIGHLIGHT (highlight)
	include 'xdatalist.inc'
	record /HLITREGION/	highlight

	logical*4	validregion
	record /M_PTR/	newptr

	logical*4 XDATA_VALID_HLITREGION

	if (XDATA_VALID_HLITREGION(highlight, 'ADD_HIGHLIGHT')) then
	  ! Allocate more memory if needed.  Note that we need to
	  ! allocate a new buffer, copy, and free the old buffer:
	  ! M$REMALLOC doesn't guarantee preservation of data.
	  if (Gx.nhlit .eq. Gx.ahlit) then
	    Gx.ahlit = Gx.ahlit + 32
	    call M$MALLOC(Gx.ahlit*HLITREGIONSIZE, newptr.p)
	    call M$MOVE(%val(Gx.pbHlit.p), %val(newptr.p),
     +			Gx.nhlit*HLITREGIONSIZE)
	    call M$FREE(Gx.pbHlit.p)
	    Gx.pbHlit.p = newptr.p
	  endif
	  call M$MOVE(highlight,%val(Gx.pbHlit.p+Gx.nhlit*HLITREGIONSIZE),
     +			HLITREGIONSIZE)
	  Gx.nhlit = Gx.nhlit + 1
	else
	  call M$WARNING('Ignoring HLITADD request')
	endif

	return
	END	! XDATA_ADD_HIGHLIGHT



c XDATA_MOD_HIGHLIGHT
c
c Modifies a highlight region in the global highlight buffer.  If an
c ID was specifed, modify all those regions whose id match ID.  If ID
c was specified and is unique, add the region to the highlight buffer.
c
	subroutine XDATA_MOD_HIGHLIGHT (region, highlight)
	include 'xdatalist.inc'
	integer*4	region
	record /HLITREGION/	highlight

	record /HLITREGION/	temphlit
c	record /HLITREGION/	hlitbuf(1)
	record /HLITREGION/	hlitbuf(*)	! _IFC
	pointer			(hlitbufptr, hlitbuf)
	integer*4		first, last, ii
	logical*4		validregion, found

	logical*4 XDATA_VALID_HLITREGION

	hlitbufptr = Gx.pbHlit.p

	validregion = .TRUE.

	! If ID wasn't specified, use region as an index
	! into the highlight buffer...
	if (highlight.from.id .eq. 0) then
	  ! Error checking
	  if (region .lt. 0) then
	    ! Modify the 'region'th region from the end
	    region = Gx.nhlit+1+region
	    if (region .lt. 1)
     +	      validregion = XDATA_WARNING('region', 'MOD_HIGHLIGHT')
	  elseif (region.eq.0 .OR. region.gt.Gx.nhlit) then
	    validregion = XDATA_WARNING('region', 'MOD_HIGHLIGHT')
	  endif
	  if (validregion) then
	    ! Modify the 'region'th region
	    first = region
	    last  = first
	  endif

	! ...Otherwise modify all regions whose id match ID
	else
	  first = 1
	  last  = Gx.nhlit
	  ! User shouldn't have specified both region and id
	  if (region .ne. 0) then
	    call M$WARNING('Both "region" and "ID" were specified to '//
     +			   'XDATA_MOD_HIGHLIGHT: "region" will be ignored')
	    region = 0
	  endif
	endif

	if (validregion) then
	  found = .FALSE.
	  do ii = first, last
	    if (region.gt.0
     +		.OR. hlitbuf(ii).from.id.eq.highlight.from.id) then
	      found = .TRUE.
	      temphlit = hlitbuf(ii)
	      if (highlight.from.elemt .ne. HLITDEFAULTVAL)
     +		temphlit.from.elemt  = highlight.from.elemt
	      if (highlight.from.field .ne. HLITDEFAULTVAL)
     +		temphlit.from.field  = highlight.from.field
	      if (highlight.from.scalar .ne. HLITDEFAULTVAL)
     +		temphlit.from.scalar = highlight.from.scalar
	      if (highlight.to.elemt .ne. HLITDEFAULTVAL)
     +		temphlit.to.elemt  = highlight.to.elemt
	      if (highlight.to.field .ne. HLITDEFAULTVAL)
     +		temphlit.to.field  = highlight.to.field
	      if (highlight.to.scalar .ne. HLITDEFAULTVAL)
     +		temphlit.to.scalar = highlight.to.scalar
	      if (highlight.from.color .ne. HLITDEFAULTVAL) then
		temphlit.from.color = highlight.from.color
		temphlit.to.color   = highlight.from.color
	      endif
	      if (XDATA_VALID_HLITREGION(temphlit, 'MOD_HIGHLIGHT')) then
		hlitbuf(ii) = temphlit
	      else
		call M$WARNING('Ignoring MODHLIT request')
	      endif
	    endif
	  enddo
	  if (.NOT. found)
     +	    call XDATA_ADD_HIGHLIGHT(highlight)
	else
	  call M$WARNING('Ignoring MODHLIT request')
	endif

	return
	END	! XDATA_MOD_HIGHLIGHT



c XDATA_VALID_HLITREGION
c
c Performs validation and 'pre-processing' on a highlight region
c for XDATA_ADD_HIGHLIGHT and XDATA_MOD_HIGHLIGHT
c
	logical*4
     +	function XDATA_VALID_HLITREGION (highlight, rname)
	include 'xdatalist.inc'
	record /HLITREGION/	highlight
	character*(*)		rname

	logical*4	validregion, hlitadd

	validregion = .TRUE.
	hlitadd = (rname .eq. 'ADD_HIGHLIGHT')

	! Validate the highlight region values
	if (highlight.from.elemt .lt. SEL_ALL)
     +	  validregion = XDATA_WARNING('elemtfrom', rname)
	if (highlight.from.field .lt. SEL_ALL)
     +	  validregion = XDATA_WARNING('fieldfrom', rname)
	if (highlight.from.scalar .lt. SEL_ALL)
     +	  validregion = XDATA_WARNING('scalarfrom', rname)
	if (highlight.to.elemt .lt. SEL_ALL)
     +	  validregion = XDATA_WARNING('elemtto', rname)
	if (highlight.to.field .lt. SEL_ALL)
     +	  validregion = XDATA_WARNING('fieldto', rname)
	if (highlight.to.scalar .lt. SEL_ALL)
     +	  validregion = XDATA_WARNING('scalarto', rname)

	! Interpret highlight region defaults
	if (highlight.to.elemt .eq. 0d0) then
	  highlight.to.elemt = highlight.from.elemt
	elseif (highlight.to.elemt .lt. highlight.from.elemt) then
	  highlight.to.elemt = SEL_ALL
	endif
	if (highlight.to.field .eq. 0) then
	  highlight.to.field = highlight.from.field
	elseif (highlight.to.field .lt. highlight.from.field) then
	  highlight.to.field = SEL_ALL
	endif
	if (highlight.from.scalar .le. 0)
     +	  highlight.from.scalar = SEL_ALL
	if (highlight.to.scalar .eq. 0) then
	  highlight.to.scalar = highlight.from.scalar
	elseif (highlight.to.scalar .lt. highlight.from.scalar) then
	  highlight.to.scalar = SEL_ALL
	endif

	XDATA_VALID_HLITREGION = validregion
	return
	END	! XDATA_VALID_HLITREGION



c XDATA_DEL_HIGHLIGHT
c
c Deletes a highlight region from the global highlight buffer
c
	subroutine XDATA_DEL_HIGHLIGHT (reqregion, id)
	include 'xdatalist.inc'
	integer*4		reqregion, id

c	record /HLITREGION/	hlitbuf(1)
	record /HLITREGION/	hlitbuf(*)	! _IFC
	pointer			(hlitbufptr, hlitbuf)
	integer*4		region, total_regions, cur_offset, ii
	integer*4		empty_offset, valid_offset
	logical*4		validregion, found

	hlitbufptr = Gx.pbHlit.p
	region = reqregion
	total_regions = Gx.nhlit

	! If no id was given, 'region' will tell us which
	! highlight region to delete...
	if (id .eq. 0) then
	  ! Error checking
	  validregion = .TRUE.
	  if (region .lt. 0) then
	    ! Caller meant the 'region'th most recent region
	    region = total_regions+1+region
	    if (region .lt. 1) validregion = .FALSE.
	  elseif (region .gt. total_regions) then

	    validregion = .FALSE.
	  endif

	  if (validregion) then
	    if (region .eq. 0) then
	      ! Clear the entire highlight region buffer
	      Gx.nhlit = 0
	    else
	      ! Delete the 'region'th region
	      call M$MOVE(%val(Gx.pbHlit.p+region*HLITREGIONSIZE),
     +			  %val(Gx.pbHlit.p+(region-1)*HLITREGIONSIZE),
     +			  (total_regions-region)*HLITREGIONSIZE)
	      Gx.nhlit = Gx.nhlit - 1
	    endif
	  else
	    validregion = XDATA_WARNING('region',
     +				'DEL_HIGHLIGHT: ignoring request')
	  endif

	! ...Otherwise, delete all highlight regions whose id == id
	else
	  ! User shouldn't have specified both region and id
	  if (region .ne. 0)
     +	    call M$WARNING('Both "region" and "ID" were specified to '//
     +			   'XDATA_DEL_HIGHLIGHT: "region" will be ignored')
	  empty_offset = -1
	  valid_offset = -1
	  found = .FALSE.
	  ! Stride through the highlight buffer one region at a time
	  do ii = 1, total_regions
	    cur_offset = (ii-1)*HLITREGIONSIZE

	    ! If this region is to be deleted (i.e. its ID matches 'id') ...
	    if (hlitbuf(ii).from.id .eq. id) then
	      found = .TRUE.
	      Gx.nhlit = Gx.nhlit - 1

	      ! If this is the first to-be-deleted region
	      ! we've encountered...
	      if (empty_offset .lt. 0) then
		! Mark the beginning of an empty block
		empty_offset = cur_offset

	      ! ... Otherwise, if we've passed the end of a
	      !	    valid block following a to-be-deleted block
	      !	    (i.e. both empty and valid offsets have been set)...
	      elseif (valid_offset .gt. 0) then
		! Move the valid block back to fill the empty space
		call M$MOVE(%val(Gx.pbHlit.p+valid_offset),
     +			    %val(Gx.pbHlit.p+empty_offset),
     +			    cur_offset-valid_offset)
		! Mark the start of the new empty block
		empty_offset = cur_offset - (valid_offset-empty_offset)
		! Clear the valid block offset
		valid_offset = -1
	      endif

	    ! ...Otherwise, if this is the first valid region we've
	    ! encountered after a series of to-be-deleted regions...
	    elseif (valid_offset.lt.0 .AND. empty_offset.ge.0) then
	      ! Mark the start of a valid block
	      valid_offset = cur_offset
	    endif
	  enddo

	  ! Warn if no regions existed that matched the ID
	  if (.NOT. found) then
	    call M$WARNING('Specified region ID not found - '//
     +			   'hlitdel ignored')
	    return
	  endif

	  ! If there still remains a pocket of empty space...
	  if (valid_offset .gt. 0) then
	    ! Move the remaining valid block back to fill the hole
	    call M$MOVE(%val(Gx.pbHlit.p+valid_offset),
     +			%val(Gx.pbHlit.p+empty_offset),
     +			total_regions*HLITREGIONSIZE-valid_offset)
	  endif

	endif

	return
	END	! XDATA_DEL_HIGHLIGHT



c XDATA_EVENT
c
c Handles User Interface actions
c
	subroutine XDATA_EVENT ()
	include 'xdatalist.inc'

	integer*4	  choice, row, field, scalar, which
	integer*4	  change, ii, ljunk
	logical*4	  action, selected, bjunk
	real*4		  fval
	real*8		  dval, djunk
	character	  str*(DEFSTRLEN), mstr*(80)
	record /HEADER/	  hdata, htmpl
	pointer		  (hdataptr, hdata)
	pointer		  (htmplptr, htmpl)
	record /EFSCOORD/ check

	logical*4	XDATA_SCROLLBARS, XDATA_SETTINGS
	logical*4	XDATA_CUT, XDATA_COPY, XDATA_PASTE
	logical*4	XDATA_REPLACE

	SAVE	! static variables
	real*4		  doubleclick
	record /EFSCOORD/ dblclk
	character	  spawncmd*(L_max_ascii)

	! If file is modifiable...
	if (Gx.modify .eq. 2) then
	  ! Double-click check: if we've seen one click and not the
	  ! second, the user meant to select rather than modify
	  if (dblclk.id.eq.1 .AND. SECNDS(doubleclick).gt.Gx.doubleclick)
     +	  then
	    call XDATA_SELECT(dblclk.elemt,dblclk.field,dblclk.scalar)
	    dblclk.id = 2
	  endif
	endif

	hdataptr = Gx.phData.p
	htmplptr = Gx.phTmpl(Gx.view).p

	do while (MX$IFEVENT() .AND. Gx.status.ge.0)
	  Gx.status = Gx.status + 1

	  if (XDATA_SCROLLBARS(1, 3, change, action)) then	! Panning
	    if (change.ne.0) call XDATA_DRAW()
	    which = change
	    do while (action)
	      bjunk = XDATA_SCROLLBARS(1, which, change, action)
	      if (change .ne. 0) call XDATA_DRAW()
	    enddo

	  elseif (Mx.motion_notify) then	! Mouse move
	    if (Gx.cntrls .eq. 2) then
	      call XDATA_GET_ROWFIELD(row, field, scalar)
	      dval = XDATA_ROW2ELEMT(row)
	      call XDATA_MTAGS(dval, DBLE(field), DBLE(scalar))
	    endif

	  elseif ((Mx.button_press.eq.2 .OR. Mx.key_upchar.eq.'M')
     +		  .AND. .NOT.BTEST(Gx.xmboff,1)) then
	    choice = MX$MENU(0,'X-DATALIST;Refresh,File...,Edit...,'//
     +			'Template...,Settings...,Color...,'//
     +			'Spawn...,Keypress Info...,Exit')

	    if (choice .eq. 1) then		! Refresh
	      call XDATA_REFRESH()

	    elseif (choice .eq. 2) then		! File...
	      choice = MX$MENU(0,'FILE;Reread,New File...')

	      if (choice .eq. 1) then			! Reread
		call XDATA_READ()
		call XDATA_DRAW()

	      elseif (choice .eq. 2) then		! New File
		choice = MX$MENU(0,'FILE MODE;Read Only,Modify')
		if (choice .gt. 0) then
		  str = hdata.file_name
		  if (MX$FILES(str(1:80)) .gt. 0) then
		    ii = M$CLEAN(str, str)
		    str(ii:ii) = ' '
		    call XDATA_NEWFILE(str(1:ii), choice*2-3,
     +					0, 0, .FALSE.,Gx.msgid)         !MIB
		    htmplptr = Gx.phTmpl(Gx.view).p
		    call XDATA_PLOT()
		  endif
		endif

	      endif

	    elseif (choice .eq. 3) then		! Edit...
	      GOTO 10

	    elseif (choice .eq. 4) then		! Template...
	      mstr = 'TEMPLATE;Dump Default...,0,1,2,3,4,5,6,7'
	      choice = MX$MENU(Gx.view+2, mstr(1:(26+2*Gx.ntmpl))) - 2
	      if (choice .eq. -1) then
		str = ' '
		if (MX$FILES(str(1:80)) .gt. 0) then
		  ii = M$CLEAN(str,str)
		  str(ii:ii) = ' '
		  call XDATA_DUMP_TEMPLATE(htmpl, str(1:ii))
		  call MX$MESSAGE('File saved', 1.0)
		endif
	      elseif (choice.ne.Gx.view .AND. choice.le.Gx.ntmpl) then
		call XDATA_NEWTEMPLATE(choice)
		htmplptr = Gx.phTmpl(Gx.view).p
		call XDATA_PLOT()
	      endif

	    elseif (choice .eq. 5) then		! Settings...

	      choice = MX$MENU(0,'SETTINGS;Cursor Color...,'//
     +			'Cursor Granularity...,Font Size...,Poll Period...')
	      if (choice .eq. 1) then			! Cursor Color...
		choice = Gx.curcolor
		call MX$LPROMPT('Cursor Color: ',choice)
		bjunk = XDATA_SETTINGS('CURCOLOR', choice, djunk)

	      elseif (choice .eq. 2) then		! Cursor Granularity...
		choice = Gx.cursor+2
		choice = MX$MENU(choice,'CURSOR GRANULARITY;None,Default,'//
     +			'Row,Field,Scalar,Field Column,Scalar Column') - 2
		bjunk = XDATA_SETTINGS('CURSIZE', choice, djunk)

	      elseif (choice .eq. 3) then		! Font Size...
		choice = Mx.text_w
		call MX$LPROMPT('Font Width: ',choice)
		bjunk = XDATA_SETTINGS('FONTSIZE', choice, djunk)

	      elseif (choice .eq. 4) then		! Poll Period...
		fval = Gx.pollperiod
		call MX$FPROMPT('Poll Period: ',fval)
		bjunk = XDATA_SETTINGS('POLLPER', ljunk, DBLE(fval))

	      endif

	    elseif (choice .eq. 6) then		! Color...
	      call XDATA_COLORS(-1)

	    elseif (choice .eq. 7) then		! Spawn...
	      call MX$PROMPT('Spawn Command: ', spawncmd)
	      ii = M$LENGTH(spawncmd)
	      if (ii .gt. 0) then
		call M$DISPATCH(spawncmd(1:ii), LD_smart, -1)
	      endif

	    elseif (choice .eq. 8) then		! Keypress Info...
	      call MX$MHELP('X-DATALIST','Keypress Info...')

	    elseif (choice .eq. 9) then		! Exit
	      if (Mx.noexit .gt. 1) then
		call MX$MESSAGE('Exit disabled', 1.0)
	      else
		Gx.status = -1
	      endif
	    endif

	  elseif (Mx.button_press.eq.1
     +		  .AND. .NOT.BTEST(Gx.xmboff,0)) then
	    call XDATA_GET_ROWFIELD(row, field, scalar)
	    dval = XDATA_ROW2ELEMT(row)

	    if (Gx.modify .gt. 0) then
	      if (Gx.modify .eq. 2) then
		check.elemt  = dblclk.elemt
		check.field  = dblclk.field
		check.scalar = dblclk.scalar
	      else
		check.elemt  = Gx.elemt
		check.field  = Gx.field
		check.scalar = Gx.scalar
	      endif 
	      ! Allow modification?
	      selected = .TRUE.
	      if (row.gt.0 .AND. dval.eq.check.elemt
     +		  .AND. SECNDS(doubleclick).lt.Gx.doubleclick) then
		if (field.gt.0 .AND. field.eq.check.field
     +		    .AND. scalar.eq.check.scalar) then
		  selected = .FALSE.
		  call XDATA_MODIFY(hdata, htmpl, row, field, scalar)
		endif
	      endif
	      if (selected) then
		if (Gx.modify .eq. 1) then
		  call XDATA_SELECT(dval, field, scalar)
		else
		  dblclk.elemt  = dval
		  dblclk.field  = field
		  dblclk.scalar = scalar
		  dblclk.id = 1
		endif
		doubleclick = SECNDS(0.0)
	      else
		dblclk.id = 2
	      endif
	    else
	      call XDATA_SELECT(dval, field, scalar)
	    endif

	  elseif (Mx.button_press.eq.3
     +		  .AND. .NOT.BTEST(Gx.xmboff,2)) then
	    call XDATA_DESELECT()

	  elseif (Mx.key_press.eq.9 .AND. Gx.modify.gt.0
     +		  .AND. .NOT.BTEST(Gx.xmboff,0)) then
	    ! TAB key pressed - same as double-click
	    if (Gx.modify .eq. 2) then
	      call XDATA_GET_ROWFIELD(row, field, scalar)
	    else
	      row    = XDATA_ELEMT2ROW(Gx.elemt)
	      field  = Gx.field
	      scalar = Gx.scalar
	    endif
	    if (row.gt.0 .AND. field.gt.0)
     +	      call XDATA_MODIFY(hdata, htmpl, row, field, scalar)

	  elseif (Mx.key_upchar.eq.'E'			! Edit menu shortcut
     +		  .AND. .NOT.BTEST(Gx.xmboff, 1)) then
	    GOTO 10

	  elseif (IAND(Mx.state_mask,L_Mod1KeyMask+L_Mod4KeyMask).ne.0
     +		  .AND. M$SEARCH('XCV', Mx.key_upchar).gt.0) then
	    if (Gx.modify .gt. 0) then
	      if (Mx.key_upchar .eq. 'X') then		! Cut
		bjunk = XDATA_CUT(hdata)
	      elseif (Mx.key_upchar .eq. 'C') then	! Copy
		bjunk = XDATA_COPY(hdata)
	      elseif (Mx.key_upchar .eq. 'V') then	! Paste
		bjunk = XDATA_PASTE(hdata)
	      endif
	    else
	      call MX$MESSAGE('File is not open for modification', 2.0)
	    endif

	  elseif (Mx.key_upchar.eq.'H') then 		! Hardcopy
	    str = 'xdatalist'
	    if (MX$HARDCOPY_OPEN(str, -1)) then
	      call XDATA_REFRESH()
	      call MX$HARDCOPY_CLOSE()
	    endif

	  elseif (Mx.key_upchar .eq. '?') then		! Help
	    ! Is the mouse cursor on a field label?
	    call XDATA_GET_ROWFIELD(row, field, scalar)
	    if (row.eq.SEL_ALL .AND. field.gt.0) then
	      ! Yes -- check for the corresponding HELP keyword
	      call XDATA_SCOPE_TO_FIELD(htmpl, field)
	      ii = M$GET_KEYWORD(htmpl, 'HELP', str)
	      if (ii .gt. 0) then
		! Help keyword found -- Provide field-sensitive help
		call MX$MESSAGE(str(1:ii), -1.0)
	      else
		! No HELP keyword: Provide general X-DataList help
		call MX$MHELP('X-DATALIST', 'Primitive')
	      endif
	      call XDATA_SCOPE_TO_FIELD(htmpl, 0)  ! Refresh the scope
	    else
	      ! Provide general X-DataList help
	      call MX$MHELP('X-DATALIST', 'Primitive')
	    endif
 
	  elseif (Mx.key_press.eq.13 .AND. Mx.noexit.le.0) then
	    ! Return key pressed - exit
	    Gx.status = -1


	  endif	! event checklist
	  goto 15

  10	  if (Gx.modify .gt. 0) then
	    choice = MX$MENU(0, 'EDIT;X - Cut Row,C - Copy Row,'//
     +		  'V - Paste Row,Duplicate Row,Replace Row')
	    if (choice .eq. 1) then			! Cut
	      bjunk = XDATA_CUT(hdata)
	    elseif (choice .eq. 2) then		! Copy
	      bjunk = XDATA_COPY(hdata)
	    elseif (choice .eq. 3) then		! Paste
	      bjunk = XDATA_PASTE(hdata)
	    elseif (choice .eq. 4) then		! Duplicate
	      if (Gx.nsize .eq. 0d0) then
		bjunk = XDATA_PASTE(hdata)
	      elseif (XDATA_COPY(hdata)) then
		bjunk = XDATA_PASTE(hdata)
	      endif
	    elseif (choice .eq. 5) then		! Replace
	      bjunk = XDATA_REPLACE(hdata, .TRUE.)
	    endif
	  else
	    call MX$MESSAGE('File is not open for modification', 2.0)
	  endif

  15	  continue

	  if (Mx.breakflag) then
	    Gx.status = -1
	  else
	    if (Mx.exposure) call XDATA_REFRESH()
	    if (Mx.resize) call XDATA_PLOT()
	  endif

	enddo
	return
	END	! XDATA_EVENT



c XDATA_GET_ROWFIELD
c
c Determines the (row, field, scalar) coordinates corresponding
c to the pixel coordinates in Mx.xpos and Mx.ypos.
c
	subroutine XDATA_GET_ROWFIELD (row, field, scalar)
	include 'xdatalist.inc'
	integer*4		row, field, scalar

	integer*4		k, ff, offset
	logical*4		found
	record /FIELDINFO/	finfo(1)
	pointer			(finfoptr, finfo)
	record /HEADER/		hdata, htmpl
	pointer			(hdataptr, hdata)
	pointer			(htmplptr, htmpl)

	integer*4	XDATA_OFFSET2FIELD

	k = Mx.level
	finfoptr = Gx.pbFinfo.p
	hdataptr = Gx.phData.p
	htmplptr = Gx.phTmpl(Gx.view).p

	! Determine which row was selected
	if (Mx.ypos.lt.Mx.stk(k).y1) then
	  if (Gx.labelstyle.gt.0 .AND. Mx.ypos.ge.Mx.stk(k).y1-Mx.text_h)
     +	  then
	    row = SEL_ALL
	  else
	    row = SEL_INVALID
	  endif
	else
	  row = (Mx.ypos-Mx.stk(k).y1)/Mx.text_h + 1
	  if (row.gt.Gx.nvisrows) row = SEL_INVALID
	endif	! Mx.ypos is "in bounds"

	! Determine which field was selected
	field  = SEL_INVALID
	scalar = SEL_INVALID
	if (Mx.xpos .lt. Mx.stk(k).x1) then
	  if (Gx.indexpos .lt. 0) then
	    field  = SEL_ALL
	    scalar = SEL_ALL
	  endif
	elseif (Mx.xpos .gt. Mx.stk(k).x2) then
	  if (Gx.indexpos .gt. 0) then
	    field  = SEL_ALL
	    scalar = SEL_ALL
	  endif
	else
	  offset = Gx.left + INT((Mx.xpos-Mx.stk(k).x1)*Mx.stk(k).xscl)
	  field = XDATA_OFFSET2FIELD(offset, .TRUE.)
	  if (field .ne. SEL_INVALID) then
	    ! Determine which scalar was selected (1-based)
	    ff = field
	    if (Gx.class .eq. 2)
     +	      call XDATA_2000_FIELDINFO(ff)
	    scalar = finfo(ff).nscalars
	    if (scalar .gt. 1)
     +	      scalar = (offset-finfo(ff).offset)/finfo(ff).swidth + 1
	  endif
	endif	! Mx.xpos is "in bounds"

	return
	END	! XDATA_GET_ROWFIELD



c XDATA_SELECT
c
c Determines if a new row/field/scalar is to be selected.  If so, it
c updates the display & MTAGs and possibly sends a SELECTINFO message.
c
	subroutine XDATA_SELECT (elemt, field, scalar)
	include 'xdatalist.inc'
	include 'msgmask.inc'
	real*8		elemt
	integer*4	field, scalar

	record /M_PTR/		pbField
	integer*4		row, lval
	record /FIELDINFO/	finfo(1)
	pointer			(finfoptr, finfo)

	row = XDATA_ELEMT2ROW(elemt)

	! Ignore if selection makes no sense for cursor type
	if (Gx.cursor .le. CR_DEF) then		! CR_NONE or CR_DEF
	  ! Abort if invalid row, invalid field, or both == ALL
	  if (row.eq.SEL_INVALID .OR. field.eq.SEL_INVALID .OR.
     +	      (row.eq.SEL_ALL .AND. field.eq.SEL_ALL)) return
	elseif (Gx.cursor .eq. CR_ROW) then
	  ! Abort if invalid row or all rows
	  if (row.eq.SEL_INVALID .OR. row.eq.SEL_ALL) return
	elseif (Gx.cursor.eq.CR_FIELD .OR. Gx.cursor.eq.CR_SCALAR) then
	  ! Abort if invalid row, all rows, or invalid field
	  if (row.eq.SEL_INVALID .OR. row.eq.SEL_ALL .OR. field.lt.1) return
	else					! CR_FCOL or CR_SCOL
	  ! Abort if invalid row or invalid field
	  if (row.eq.SEL_INVALID .OR. field.lt.1) return
	endif

	! 'Move' cursor to new location
	call XDATA_CURSOR(elemt, field, scalar, 0)

	if (Gx.cntrls .eq. 1)
     +	  call XDATA_MTAGS(Gx.elemt, DBLE(Gx.field), DBLE(Gx.scalar))

	! Send SELECTINFO message
C TODO: Data is available only if selection is in view!!!
	if (XDATA_SENDINFOMSG(MSK_SELECT)) then
	  finfoptr = Gx.pbFinfo.p
	  pbField.p = Gx.pbData.p + (row-1)*Gx.bpe
     +				  + finfo(Gx.field).fieldoff
	  call XDATA_FIELDINFOMSG(MSK_SELECT, Gx.msgid, Gx.elemt,
     +			Gx.field, Gx.scalar, finfo(Gx.field), pbField)
	endif

	return
	END	! XDATA_SELECT



c XDATA_DESELECT
c
c Removes the current selection, updates the display & MTAGs,
c and sends a SELECTINFO message if appropriate.
c
	subroutine XDATA_DESELECT ()
	include 'xdatalist.inc'
	include 'msgmask.inc'

	record /FIELDINFO/	finfojunk
	record /M_PTR/		pjunk

	! Overwrite the MTAGs regardless of current state
	if (Gx.cntrls .eq. 1)
     +	  call XDATA_MTAGS(0d0, 0d0, 0d0)

	! Bail if there's already no selection (we don't need to
	! refresh the display or send additional =SELECT messages)
	if (Gx.elemt.le.0d0 .AND. Gx.field.le.0) return

	! Update display and currently selected elemt/field/scalar
	call XDATA_CURSOR(Gx.elemt, Gx.field, Gx.scalar, -1)

	! Send SELECTINFO message?
	if (XDATA_SENDINFOMSG(MSK_SELECT)) then
	  finfojunk.field = 0
	  pjunk.p = 0
	  call XDATA_FIELDINFOMSG(MSK_SELECT, Gx.msgid, 0d0, 0, 0,
     +				  finfojunk, pjunk)
	endif

	return
	END	! XDATA_DESELECT



c XDATA_MTAGS
c
c Updates the MTAG widgets
c
	subroutine XDATA_MTAGS (elemt, field, scalar)
	include 'xdatalist.inc'
	real*8	elemt, field, scalar

	call M$DRSLT(Mx.ytag, elemt)
	call M$DRSLT(Mx.xtag, field)
	call M$DRSLT(Mx.ztag, scalar)

D	write(*,*)  'File coords:', Gx.elemt, Gx.field,   Gx.scalar
D	write(*,*)  'View coords:', elemt,	  INT(field), INT(scalar)
	return
	END	! XDATA_MTAGS




c XDATA_SCROLLBARS
c
c Vertical/Horizontal scrollbar interface
c
	logical*4
     +	function XDATA_SCROLLBARS (mode, which, change, action) 
	include 'xdatalist.inc'
	integer*4	mode	! IN:  0=Draw  1=CheckEvent  2=PerformAction
	integer*4	which	! IN:  1=vert  2=horz  3=both
	integer*4	change	! OUT: 1=vert  2=horz  3=both
	logical*4	action, returnval, bjunk
	integer*4	k

	integer*4	XDATA_OFFSET2FIELD
	integer*4	XDATA_RIGHTMOST_VISIBLE_FIELD

	returnval = .FALSE.
	action    = .FALSE.
	change    = 0
	k	  = Mx.level

	! *** Vertical Scrollbar ***
	if (which.ne.2 .AND. Gx.pany) then
	  if (mode .eq. 0) then
	    ! Just draw the scrollbar
	    call MX$SCROLL_VALS(Gx.sbvert, Gx.top, DBLE(Gx.nvisrows),
     +				1.d0, Gx.nsize,
     +				1.d0, DBLE(Gx.nvisrows/2), 1.d0)
	    bjunk = MX$SCROLL(Gx.sbvert, XW_DRAW)

	  elseif ( MX$SCROLL(Gx.sbvert, XW_EVENT) ) then
	    Gx.sbvert.smin = DNINT(Gx.sbvert.smin)
	    if (Gx.sbvert.smin .ne. Gx.top) then
	      change = 1
	      Gx.top = Gx.sbvert.smin
	      Mx.stk(k).ymin = Gx.top
	      Mx.stk(k).ymax = Gx.top + Gx.sbvert.srange - 1
	      call XDATA_READ()
	      bjunk = MX$SCROLL(Gx.sbvert, XW_UPDATE)
	    endif
	    returnval = .TRUE.
	    action = (Gx.sbvert.action .ne. 0)
	  endif
	endif	! Gx.pany

	! *** Horizontal Scrollbar ***
	if (which.ne.1 .AND. Gx.panx) then
	  if (mode .eq. 0) then
	    ! Just draw the scrollbar
	    call MX$SCROLL_VALS(Gx.sbhorz,
     +				DBLE(Gx.left), DBLE(Gx.nviscols),
     +				0.d0, DBLE(Gx.dispwidth),
     +				1.d0, DBLE(Gx.nviscols/2), 1.d0)
	    bjunk = MX$SCROLL(Gx.sbhorz, XW_DRAW)
	  elseif ( MX$SCROLL(Gx.sbhorz, XW_EVENT) ) then
	    Gx.sbhorz.smin = DNINT(Gx.sbhorz.smin)
	    if (INT(Gx.sbhorz.smin) .ne. Gx.left) then
	      change = 2
	      Gx.left = INT(Gx.sbhorz.smin)
	      Mx.stk(k).xmin = Gx.left
	      Mx.stk(k).xmax = Gx.left + Gx.sbhorz.srange
	      Gx.fleft  = XDATA_OFFSET2FIELD(Gx.left, .FALSE.)
	      Gx.fright = XDATA_RIGHTMOST_VISIBLE_FIELD()
	      bjunk = MX$SCROLL(Gx.sbhorz, XW_UPDATE)
	    endif
	    returnval = .TRUE.
	    action    = action .OR. (Gx.sbhorz.action .ne. 0)
	  endif
	endif	! Gx.panx

	XDATA_SCROLLBARS = returnval
	return
	END	! XDATA_SCROLLBARS


c XDATA_SETTINGS
c
c Modifies X-DataList Settings/toggles
c
	logical*4
     +	function XDATA_SETTINGS (param, lval, dval)
	include 'xdatalist.inc'
	character*(*)	param
	integer*4	lval
	real*8		dval

	integer*4	field, scalar, ii
	real*8		elemt
	real*4		fval
	logical*4	success

	success = .FALSE.
	if (param .eq. 'CURCOLOR') then
	  Gx.curcolor = lval
	  Gx.curcolor_bg = NINT(Gx.curcolor/1000.0)
	  Gx.curcolor_fg = Gx.curcolor - Gx.curcolor_bg * 1000
	  Gx.xparent_cursor = (Gx.curcolor_fg .eq. L_XORColor)
	  call XDATA_CURSOR(Gx.elemt, Gx.field, Gx.scalar, 1)
	  success = .TRUE.

	elseif (param .eq. 'CURSIZE') then
	  if (Gx.cursor.ne.lval .AND. lval.ge.CR_NONE
     +				.AND. lval.le.CR_SCOL) then
	    elemt  = Gx.elemt
	    field  = Gx.field
	    scalar = Gx.scalar
	    call XDATA_CURSOR(Gx.elemt, Gx.field, Gx.scalar, -1)
	    Gx.cursor = lval
	    call XDATA_CURSOR(elemt, field, scalar, 1)
	    success = .TRUE.
	  endif

	elseif (param .eq. 'DEFCOLOR') then
	  Gx.defcolor = lval
	  call XDATA_DRAW()
	  success = .TRUE.

	elseif (param .eq. 'FONTSIZE') then
	  ii = Mx.text_w
	  if (IABS(lval).le.1) then
	    ! Make font width variable
	    if (lval.lt.0) then
	      Mx.text_size_lock = -1
	    else
	      Mx.text_size_lock = 1
	    endif
	    ii = 0	! Force redraw
	  elseif (Mx.text_size_lock.ge.0) then
	    ! Lock Bold font
	    Mx.text_size_lock = 1
	    call MX$SETFONT(lval)
	    Mx.text_size_lock = Mx.text_w
	  else
	    ! Lock Normal font
	    Mx.text_size_lock = -1
	    call MX$SETFONT(lval)
	    Mx.text_size_lock = -Mx.text_w
	  endif
	  if (Mx.text_w .ne. ii) then
	    call XDATA_PLOT()
	    success = .TRUE.
	  endif

	elseif (param .eq. 'POLLPER') then
	  fval = REAL(dval)
	  if (fval .lt. 0.0) fval = 0.0
	  if (fval .ne. Gx.pollperiod) then
	    if (fval .eq. 0.0) then
	      call M$FREE(Gx.pbPoll.p)
	    else if (Gx.pollperiod .eq. 0.0) then
	      call M$MALLOC(Gx.bpe*Gx.ndatarows, Gx.pbPoll.p)
	      call XDATA_POLLINIT()
	    endif
	    Gx.pollperiod = fval
	    success = .TRUE.
	  endif

	elseif (param .eq. 'XMBOFF') then
	  Gx.xmboff = lval

	endif

	XDATA_SETTINGS = success
	return
	END	! XDATA_SETTINGS



c XDATA_MESSAGE
c
c Checks for and responds to incoming messages
c
	subroutine XDATA_MESSAGE ()
	include 'xdatalist.inc'
	include 'qmessages.inc'

	integer*4		info, sid, msgid, field, ff, slen
	record /HLITREGION/	highlight
	real*8			elemt, dval
	logical*4		redraw, bjunk
	character		str*(20)
	record /FIELDINFO/	finfo(1)
	pointer			(finfoptr, finfo)

	record /HEADER/		hdata
	pointer			(hdataptr, hdata)
	integer*4		      i

	logical*4	XDATA_CUTFEDIT
	logical*4	XDATA_COPY, XDATA_PASTE
	logical*4	XDATA_SETTINGS

	redraw  = .FALSE.
	do while (M$GET_MSG(MQH, MQD, L_mqd, 0.0, 0) .eq. 1)
	  Gx.status = Gx.status + 1
	  info  = MQH.info
	  sid   = MQH.sender
	  msgid = Gx.msgid

	  if (MX$GRAPHICS_MSG(Mx, MQH, MQD, msgid, Gx.msgmask).ne.0) then
	    if (Mx.breakflag) then
	      Gx.status = -1
	      return
	    endif

	  elseif (MQH.name .eq. MQH_QUERY.name) then
	    if (MQD.QUERY.object .eq. MQH_SELECTINFO.name) then
C	      call XDATA_FIELDINFOMSG(MSK_SELECT, sid,
C    +			Gx.elemt, Gx.field, Gx.scalar, finfo, pbField)
	    elseif (MQD.QUERY.object .eq. MQH_COLORINFO.name) then
	      call XDATA_INFOMSG(MSK_COLOR, sid, info)
	    endif

	  else

	    ! Do not echo actions caused by an id to that id
	    ! unless MSK_ECHO is set
	    if (.NOT. BTEST(Gx.msgmask,MSK_ECHO)) then
	      if (msgid.gt.0 .AND. msgid.eq.sid) Gx.msgid = -1
	    endif

	    if (MQH.name .eq. MQH_COLOR.name) then
	      if (info.ge.1 .AND. info.le.NUMCOLORS) then
		if (MQD.COLOR.position .ge. 0) then
		  call MX$COLORTAB(info,Mc.colormap(4),INT(MQD.COLOR.position))
		else
		  call MX$COLORTAB(info,MQD.COLOR,-2)
		endif
		if (XDATA_SENDINFOMSG(MSK_COLOR))
     +		  call XDATA_INFOMSG(MSK_COLOR, Gx.msgid, info)
	      endif

	    elseif (MQH.name .eq. 'DEBUG') then
	      call XDATA_DEBUG(MQH.info, 0)

	    elseif (MQH.name .eq. 'FEDIT  ') then
	      if (Gx.modify .gt. 0) then
		elemt = MQD.FEDIT.elemt
		if (elemt.ge.1.d0 .AND. elemt.le.Gx.nsize) then
		  if (MQH.info .eq. -1) then		!Cut
		    Gx.elemt = elemt
		    hdataptr = Gx.phData.p
		    bjunk = XDATA_CUTFEDIT(hdata, MQD.FEDIT.numelemts)
		    Gx.elemt = 0  
		  elseif (MQH.info .eq. 1) then		!PASTE
		    Gx.elemt = elemt
		    hdataptr = Gx.phData.p
		    bjunk = XDATA_PASTE(hdata)
		    Gx.elemt = 0  
		  elseif (MQH.info .eq. 2) then		!COPY
		    Gx.elemt = elemt
		    hdataptr = Gx.phData.p
		    bjunk = XDATA_COPY(hdata)
		    Gx.elemt = 0  
		  else !Unhandled
		    call M$WARNING('In FEDIT message, unhandled'//
     +		            ' value in info field')
		  endif
		else
		  call M$WARNING('In FEDIT message, start'//
     +		            ' element out of range')
		endif
	      else
		call M$WARNING('Received FEDIT message, but'//
     +		        ' file is NOT open for modifying')
	      endif

	    elseif (MQH.name .eq. MQH_HARDCOPY.name) then
	      if (MX$HARDCOPY_OPEN(MQD.HARDCOPY.file, INT(MQH.info))) then
		call XDATA_REFRESH()
		call MX$HARDCOPY_CLOSE()
	      endif

	    elseif (MQH.name .eq. MQH_HLITADD.name) then
	      highlight.from.elemt  = MQD.HLITADD.elemtfrom
	      highlight.from.field  = MQD.HLITADD.fieldfrom
	      highlight.from.scalar = MQD.HLITADD.scalarfrom
	      highlight.from.color  = MQD.HLITADD.color
	      highlight.from.id     = MQD.HLITADD.id
	      highlight.to.elemt    = MQD.HLITADD.elemtto
	      highlight.to.field    = MQD.HLITADD.fieldto
	      highlight.to.scalar   = MQD.HLITADD.scalarto
	      highlight.to.color    = highlight.from.color
	      highlight.to.id	    = highlight.from.id
	      call XDATA_ADD_HIGHLIGHT(highlight)
	      call XDATA_DRAW_HIGHLIGHTS(Gx.nhlit)

	    elseif (MQH.name .eq. MQH_HLITDEL.name) then
	      call XDATA_DEL_HIGHLIGHT(info, MQD.HLITDEL.id)
	      redraw = .TRUE.

	    elseif (MQH.name .eq. MQH_HLITMOD.name) then
	      highlight.from.elemt  = MQD.HLITMOD.elemtfrom
	      highlight.from.field  = MQD.HLITMOD.fieldfrom
	      highlight.from.scalar = MQD.HLITMOD.scalarfrom
	      highlight.from.color  = MQD.HLITMOD.color
	      highlight.from.id	    = MQD.HLITMOD.id
	      highlight.to.elemt    = MQD.HLITMOD.elemtto
	      highlight.to.field    = MQD.HLITMOD.fieldto
	      highlight.to.scalar   = MQD.HLITMOD.scalarto
	      highlight.to.color    = highlight.from.color
	      highlight.to.id	    = highlight.from.id
	      call XDATA_MOD_HIGHLIGHT(info, highlight)
	      redraw = .TRUE.

C TODO:	    elseif (MQH.name .eq. MQH_LOADTEMPLATE.name) then
C	      call XDATA_PLOT()

	    elseif (MQH.name .eq. MQH_MODIFY.name) then
	      elemt = MQD.MODIFY.elemt
	      if (elemt.ge.1d0 .AND. elemt.le.Gx.nsize) then
C TODO:
	      endif

	    elseif (MQH.name .eq. MQH_NEWFILE.name) then
	      call XDATA_NEWFILE(MQD.NEWFILE.filename, INT(info),
     +	           MQD.NEWFILE.arg1, MQD.NEWFILE.arg2, .FALSE.,sid) !MIB
	      call XDATA_PLOT()

C TODO:	    elseif (MQH.name .eq. MQH_PAN.name) then

	    elseif (MQH.name .eq. MQH_REFRESH.name) then
	      call XDATA_REFRESH()

	    elseif (MQH.name .eq. MQH_REREAD.name) then
	      if (info.gt.0 .AND. info.le.Gx.ntmpl) then
		! Close and re-open the template
		call M$CLOSE(%val(Gx.phTmpl(info).p))
		call M$INOK(%val(Gx.phTmpl(info).p))
	      else
		call XDATA_READ()
	      endif
	      call XDATA_DRAW()
	
	    elseif (MQH.name .eq. MQH_SELECT.name) then
	      elemt = MQD.SELECT.elemt
	      if (elemt.gt.0d0 .AND. elemt.le.Gx.nsize) then
		! The info field (aliased to PAN) can be used to pan the
		! field of view (in y):
		! If not specified (0):
		!   The rows displayed will not change even if the newly
		!   selected row is out of view
		! If .gt. 0:
		!   The viewing window will be panned so that the newly
		!   selected row is the nth row displayed (top row is 1)
		! If .lt. 0 .OR. .gt. Gx.ndatarows
		!   The current viewing window will be adjusted so that the
		!   newly selected row is visible (centered if possible).
		if (info.lt.0 .OR. info.gt.Gx.ndatarows)
     +		  info = (Gx.ndatarows+1)/2
		if (info .gt. 0) then
		  dval = Gx.top
		  ! Pan so that selected row is visible
		  Gx.top = MAX(1d0,elemt-info+1)
		  ! Adjust Gx.top if we've panned past the last row
		  if (Gx.top+Gx.ndatarows .gt. Gx.nsize+1)
     +		    Gx.top = MAX(1d0, Gx.nsize-Gx.ndatarows+1)
		  if (Gx.top .ne. dval) then
		    call XDATA_PLOT()
		  endif
		endif
	      elseif (elemt .le. 0d0) then
		elemt = SEL_ALL
	      endif
	      field = 0
	      if (Gx.class.gt.2 .AND. MQD.SELECT.name .ne. ' ') then
		finfoptr = Gx.pbFinfo.p
		do ff = Gx.nfields, 1, -1
		  if (finfo(ff).subname .eq. MQD.SELECT.name)
     +		    field = ff
		enddo
		if (field .eq. 0) then
		  call M$WARNING('In SELECT message, NAME = '//
     +				 MQD.SELECT.name//' does not match '//
     +				 'any field in the current template')
		  goto 99
		endif
	      elseif (MQD.SELECT.subelemt .gt. 0) then
		finfoptr = Gx.pbFinfo.p
		do ff = Gx.nfields, 1, -1
		  if (finfo(ff).subelemt .eq. MQD.SELECT.subelemt)
     +		    field = ff
		enddo
		if (field .eq. 0) then
		  slen = M$L2A(MQD.SELECT.subelemt, str)
		  call M$WARNING('In SELECT message, SUBELEMT = '//
     +				 str(1:slen)//' does not match '//
     +				 'any field in the current template')
		  goto 99
		endif
	      else
		field = MQD.SELECT.field
		if (field .le. 0) field = SEL_ALL
	      endif
	      if (MQD.SELECT.scalar .le. 0) MQD.SELECT.scalar = SEL_ALL
	      if (elemt+field+MQD.SELECT.scalar .eq. -3d0) then
		elemt = 0d0
		field = 0
		MQD.SELECT.scalar = 0
	      endif
	      call XDATA_SELECT(elemt, field, MQD.SELECT.scalar)

	    elseif (MQH.name .eq. MQH_SET.name) then
	      bjunk = XDATA_SETTINGS(MQD.SET.object, info, DBLE(info))

	    elseif (MQH.name .eq. MQH_SETD.name) then
	      bjunk = XDATA_SETTINGS(MQD.SETD.object,
     +				     NINT(MQD.SETD.value),MQD.SETD.value)

	    else
	      call M$WARNING('Unrecognized message: '//MQH.name)
	    endif

	    Gx.msgid = msgid
	  endif
  99	  continue	! Message error bailout target
	enddo
	if (redraw)
     +	  call XDATA_DRAW()
	return
	END	! XDATA_MESSAGE


	
c XDATA_INFOMSG
c
c Handles INFO messages not requiring the sending of atom data
c
	subroutine XDATA_INFOMSG (bit, rid, lval)
	include 'xdatalist.inc'
	include 'qmessages.inc'
	integer*4	bit, rid, lval

	if (bit .eq. MSK_COLOR) then
	  call MX$COLORTAB(lval, MQD.COLORINFO, -3)
	  MQH_COLORINFO.colorid = lval
	  call M$SEND_MSG(MQH_COLORINFO, MQD.COLORINFO, rid, 0)

	elseif (bit .eq. MSK_EXIT) then
	  call M$SEND_MSG(MQH_EXITINFO, MQD, rid, 0)

C...Start of Mods for DR RRCcl00592   MIB
	elseif (bit .eq. MSK_NEWFILE) then
          MQH_NEWFILEINFO.success = lval
	  call M$SEND_MSG(MQH_NEWFILEINFO, MQD, rid, 0)
C...End   of Mods for DR RRCcl00592   MIB

	elseif (bit .eq. MSK_MODIFY) then
	  ! Cuts Replaces and Pastes generate "=FEDIT" messages
	  ! IFF MSK_MODIFY is in X-DataList's message mask.
	  MQH_FEDITINFO.op	  = lval  ! -1=Cut, 0=Replace, 1=Paste
	  MQD.FEDITINFO.elemt	  = Gx.elemt
	  MQD.FEDITINFO.numelemts = MIN(Gx.pastesize,
     +					INT(Gx.nsize-Gx.elemt+1))
	  call M$SEND_MSG(MQH_FEDITINFO, MQD, rid, 0)

C TODO?	elseif (bit .eq. MSK_HLIT) then
	endif

	return
	END	! XDATA_INFOMSG



c XDATA_FIELDINFOMSG
c
c Handles INFO messages requiring the sending of atom data
c
	subroutine XDATA_FIELDINFOMSG (bit, rid, elemt, field, scalar,
     +					fi, pbField)
	include 'xdatalist.inc'
	include 'qmessages.inc'
	integer*4		bit, rid, field, scalar
	real*8			elemt
	record /FIELDINFO/	fi
	record /M_PTR/		pbField

	record /MQD_MODIFYINFO/ MODMQD
	record /MQH_MODIFYINFO/ CLEAN_MODMQH, MODMQH 
	record /M_PTR/		pBuf
	integer*4		mqdsize, mqhsize, row, ii, jj
	logical			senddata
	character		str*(DEFSTRLEN)

	! Load up the MODMQD structure
	MODMQD.elemt	= elemt
	MODMQD.field	= field
	MODMQD.scalar	= scalar
	MODMQD.subelemt	= fi.subelemt
	MODMQD.name	= fi.subname
	if (field.le.0) MODMQD.name = ' '

	! Get a clean MODMQH structure
	! (No automatic variables in FORTRAN!!!)
	mqhsize = SLOTS_PER_HET_MQH * BYTES_PER_SLOT
	call M$MOVE(CLEAN_MODMQH, MODMQH, mqhsize)

	! Fill in the Message Queue Header name field
	! (It'll be '=MODIFY' by default)
	if (bit .eq. MSK_SELECT) then
	  MODMQH.name = '=SELECT'
	elseif (bit .eq. MSK_LOOKUP) then
	  MODMQH.name = '=LOOKUP'
	endif
D	write(*,*)  'name:   ', MODMQH.name
D	write(*,*)  'nslots: ', MODMQH.nslots
D	write(*,*)  'types:  ', MODMQH.types
D	write(*,*)  'ndata:  ', MODMQH.ndata
D	write(*,*)  'ntype:  ', MODMQH.ntype

	! Include atom data?  User may have selected an entire row/field,
	! in which case there's no data to be sent
	row = XDATA_ELEMT2ROW(Gx.elemt)
	senddata = (row.gt.0 .AND. field.gt.0 .AND. pbField.p.ne.0)
	if (senddata) then

	  ! Allocate enough space for the MQD structure and atom data
	  mqdsize = (CLEAN_MODMQH.nslots-SLOTS_PER_HET_MQH)*BYTES_PER_SLOT
	  call M$MALLOC(mqdsize+fi.bpf, pBuf.p)
	  call M$MOVE(MODMQD, %val(pBuf.p), mqdsize)
	  call M$MOVE(%val(pbField.p), %val(pBuf.p+mqdsize), fi.bpf)

	  ! Increase the nslots, ndata, ntype and types fields of
	  ! the message header to accomodate the atom data
	  MODMQH.nslots = MODMQH.nslots + (fi.bpf-1)/BYTES_PER_SLOT + 1
	  ii = M$LENGTH(MODMQH.types)
	  if (fi.format(2:2) .eq. 'A') then
	    MODMQH.ndata = MODMQH.ndata + 1
	    jj = M$L2A(fi.bpf, str)
	    MODMQH.types(ii+1:) = 'S['//str(1:jj)//']'
	    MODMQH.ntype = MODMQH.ntype + jj + 3
	  else
	    MODMQH.ndata = MODMQH.ndata + fi.nscalars
	    jj = M$L2A(fi.nscalars, str)
	    MODMQH.types(ii+1:) = str(1:jj)//fi.format(2:2)
	    MODMQH.ntype = MODMQH.ntype + jj + 1
	  endif
D	  write(*,*)  'nslots: ', MODMQH.nslots
D	  write(*,*)  'types:  ', MODMQH.types
D	  write(*,*)  'ndata:  ', MODMQH.ndata
D	  write(*,*)  'ntype:  ', MODMQH.ntype

	  call M$SEND_MSG(MODMQH, %val(pBuf.p), rid, 0)
	  call M$FREE(pBuf.p)

	else
	  call M$SEND_MSG(MODMQH, MODMQD, rid, 0)

	endif	! senddata

	return
	END	! XDATA_FIELDINFOMSG



c XDATA_SENDINFOMSG
c
c Boolean routine that tells us whether we're supposed to be
c sending the given message.
c	logical*4
	function XDATA_SENDINFOMSG (bit)
	include 'xdatalist.inc'
	integer*4		bit

	XDATA_SENDINFOMSG = (Gx.msgid.ge.0 .AND. BTEST(Gx.msgmask,bit))

	return
	END	! XDATA_SENDINFOMSG



c XDATA_MODIFY
c
c Calls XDATA_EDIT, checks for changes, sends MODIFYINFO message
c
	subroutine XDATA_MODIFY (hdata, htmpl, row, field, scalar)
	include 'xdatalist.inc'
	include 'msgmask.inc'
	include 'xfacilities.inc'
	record /HEADER/ hdata, htmpl
	integer*4	row, field, scalar

	integer*4		ff, nn, scoff
	real*8			hdoff, elemt
	record /M_PTR/		pbField
	record /FIELDINFO/	finfo(1)
	pointer			(finfoptr, finfo)

	! Find the field's offset into the data buffer
	ff = field
	if (Gx.class .eq. 2)
     +	  call XDATA_2000_FIELDINFO(ff)
	finfoptr = Gx.pbFinfo.p
	pbField.p  = Gx.pbData.p + (row-1)*Gx.bpe + finfo(ff).fieldoff

	! Determine the scalar's size and offset into the field
	if (finfo(ff).format(2:2) .eq. 'A') then
	  nn = finfo(ff).bpf
	else
	  nn = M$BPS(finfo(ff).format)
	endif
	scoff = nn*(scalar-1)

	! Allow user to edit the scalar.  By using the scratch buffer,
	! we avoid any byte-alignment problems
	call M$MOVE(%val(pbField.p+scoff), %val(Gx.pbScratch.p), nn)
	call XDATA_EDIT(hdata, htmpl, row, field, scalar, 
     +		finfo(ff), %val(Gx.pbScratch.p))

	! Has the scalar changed?
	if (M$CHK(%val(pbField.p+scoff),%val(Gx.pbScratch.p),nn) .ne. 1)
     +	then
D	  write(*,*)  'scalar has changed'

	  ! Update the data buffer
	  call M$MOVE(%val(Gx.pbScratch.p), %val(pbField.p+scoff), nn)

	  ! Update the data file
	  elemt = XDATA_ROW2ELEMT(row)
	  hdoff = hdata.first_byte + Gx.bpe*(elemt-1)
     +		  + finfo(ff).fieldoff + scoff
	  call XDATA_WRITE(hdata, hdoff,
     +			   Gx.pbScratch, nn, finfo(ff).format)

	  ! Update the display
	  if (Gx.colordep .OR. finfo(ff).colordep) then
	    call XDATA_DRAW_REGION(row, SEL_ALL, SEL_ALL,
     +				   row, Gx.nfields, SEL_ALL,
     +				   USEDEFCOLORS, .TRUE.)
	  else
	    call XDATA_DRAW_REGION(row, field, scalar,
     +				   row, field, scalar,
     +				   USEDEFCOLORS, .TRUE.)
	  endif

	  ! Send a MODIFYINFO message?
	  if (XDATA_SENDINFOMSG(MSK_MODIFY))
     +	    call XDATA_FIELDINFOMSG(MSK_MODIFY, Gx.msgid, elemt, field,
     +					scalar, finfo(ff), pbField)
	endif

	return
	END	! XDATA_MODIFY



c XDATA_EDIT
c
c Presents the user with a means to modify a scalar based on the
c containing field's template information.
c
	subroutine XDATA_EDIT (hdata, htmpl, row, field, scalar, fi, S)
	include 'xdatalist.inc'
	integer*4 L_bbuf
	parameter (L_bbuf=16)
	include 'buffers.inc'
	record /HEADER/		hdata, htmpl
	record /FIELDINFO/	fi
	record /BUFFER/		S	! scalar data
	integer*4		row, field, scalar	! scalar # (1-based)

	character	str*(DEFSTRLEN)
	character	label*(LBLLEN), datatype, edit
	character	vidstr*(FMTLEN), type
	integer*4	len, llen, mlen, vid
	integer*4	choice, cur_val, mdef, lval, ljunk
	real*8		vmin, vmax, vinc, dval
	logical*1	ascii
	character	string
	pointer		(stringptr, string)

	integer*4  XDATA_MATCH_ENUM_VALUE

	datatype = fi.format(2:2)
	ascii = (datatype .eq. 'A')

	call XDATA_FORMAT_FIELDLABEL(fi, label)
	llen = M$LENGTH(label)
	if (fi.nscalars.eq.1) then
	  label(llen+1:llen+2) = ': '
	  llen = llen+2
	else	
	  len = M$L2A(scalar, str)
	  label(llen+1:llen+len+4) = '('//str(1:len)//'): '
	  llen = llen+len+4
	endif

	edit = fi.edit(1:1)

	if (edit .eq. 'M') then				! MENU widget
	  call XDATA_SCOPE_TO_FIELD(htmpl, fi.field)
	  mlen = M$GET_KEYWORD(htmpl, 'MENU', str)
	  cur_val = XDATA_MATCH_ENUM_VALUE(S, fi)
	  if (M$GET_KEYDATA(htmpl, 'MDEFAULT', mdef, 4, 0, 'L') .lt. 0)
     +	  then
	    mdef = cur_val
	  endif

	  ! Present the user with a MENU widget
	  ! If no menu title was specified, use the field's label
	  lval = M$SEARCH(str(1:mlen), ';') + 1
	  if (lval .eq. 1) then
	    choice = MX$MENU(mdef, label(1:llen-2)//';'//str(1:mlen))
	  else
	    choice = MX$MENU(mdef, str(1:mlen))
	  endif

	  ! If a new menu item was selected, determine the
	  ! corresponding value and write it to the file
	  if (choice .ne. cur_val) then
	    if (ascii) then
	      stringptr = fi.mvalues.p
	      len = M$PARSE(string(1:fi.lmvalues), choice,
     +			    S.sbuf(1:fi.bpf))
	      S.sbuf(len+1:fi.bpf) = ' '
	    else
	      lval = fi.bpf / fi.nscalars
	      call M$MOVE(%val(fi.mvalues.p+(choice-1)*lval),
     +			  S.bbuf(1), lval)
	    endif
	  endif	! choice .ne. cur_val

	  call XDATA_SCOPE_TO_FIELD(htmpl, 0)  ! Refresh the scope
	  return
	endif	! edit .eq. 'M'

	if (edit.eq.'V' .AND. .NOT. ascii) then		! [DFL]VAL widget
	  call XDATA_SCOPE_TO_FIELD(htmpl, fi.field)
	  len = M$GET_KEYWORD(htmpl, 'VPROMPT', str) + 1
	  if (len .gt. 0) then
	    label = str(1:len)
	    llen  = len
	  endif
	  if (M$GET_KEYDATA(htmpl, 'VMIN', vmin, 8, 0, 'D') .le. 0)
     +	    vmin =  1.d0
	  if (M$GET_KEYDATA(htmpl, 'VMAX', vmax, 8, 0, 'D') .le. 0)
     +	    vmax = -1.d0
	  if (M$GET_KEYDATA(htmpl, 'VINC', vinc, 8, 0, 'D') .le. 0)
     +	    vinc =  1.d0
	  vid = M$GET_KEYWORD(htmpl, 'VID', vidstr)
	  if (vid .gt. 0) then
	    if (M$A2D(vidstr(1:vid), dval) .ge. 0) then
	      vid = INT(dval)
	    else
	      vid = 0
	    endif
	  endif
	  if (datatype .eq. 'D') then
	    call MX$DVAL(label(1:llen), S.bbuf(1),
     +	    		 vmin, vmax, vinc, vid)
	  elseif (datatype .eq. 'F') then
	    call MX$FVAL(label(1:llen), S.bbuf(1),
     +			 REAL(vmin), REAL(vmax), REAL(vinc), vid)
	  else
	    call M$REFORMAT(S.bbuf(1), datatype, lval, 'L', 1)
	    call MX$LVAL(label(1:llen), lval,
     +			 INT(vmin), INT(vmax), INT(vinc), vid)
	    call M$REFORMAT(lval, 'L', S.bbuf(1), datatype, 1)
	  endif
	  call XDATA_SCOPE_TO_FIELD(htmpl, 0)  ! Refresh the scope

	elseif (edit.eq.'F' .AND. ascii) then		! FILES widget
	  lval = MX$FILES(S.sbuf(1:fi.bpf))

	elseif (edit .eq. 'B') then			! Just BEEP
	  call M$BEEP(1, 0.0)

	elseif (edit .eq. 'C') then			!  via COMMAND
	  call XDATA_SCOPE_TO_FIELD(htmpl, fi.field)
	  mlen = M$GET_KEYWORD(htmpl, 'COMMAND', str)
	  call XDATA_FORM_COMMAND (hdata, htmpl, 
     +		row, field, scalar, fi, S, str, mlen, DEFSTRLEN)
	  if (M$GET_KEYDATA (htmpl, 'MODE', mdef, 4, 0, 'L') .lt. 0) 
     +		mdef = LD_smart + LD_wait
	  call M$DISPATCH (str(1:mlen), mdef, -1)
	  call XDATA_SCOPE_TO_FIELD(htmpl, 0)  ! Refresh the scope

	elseif (edit .ne. 'N') then			! PROMPT (default)
	  call XDATA_SCOPE_TO_FIELD(htmpl, fi.field)
	  len = M$GET_KEYWORD(htmpl, 'PPROMPT', str) + 1
	  if (len .gt. 0) then
	    label = str(1:len)
	    llen  = len
	  endif
	  if (ascii) then
	    call MX$PROMPT(label(1:llen), S.sbuf(1:fi.bpf))
	  elseif (datatype .eq. 'D') then
	    call MX$DPROMPT(label(1:llen), S.bbuf(1))
	  elseif (datatype .eq. 'F') then
	    call MX$FPROMPT(label(1:llen), S.bbuf(1))
	  else
	    call M$REFORMAT(S.bbuf(1), datatype, lval, 'L', 1)
	    call MX$LPROMPT(label(1:llen), lval)
	    call M$REFORMAT(lval, 'L', S.bbuf(1), datatype, 1)
	  endif
	  call XDATA_SCOPE_TO_FIELD(htmpl, 0)  ! Refresh the scope

	endif

	return
	END	! XDATA_EDIT



c XDATA_WRITE
c
c Writes a scalar to the data file, Handling representation conversion.
c
	subroutine XDATA_WRITE (hdata, hdoff, pBuf, nbytes, format)
	include 'xdatalist.inc'
	record /HEADER/ hdata
	real*8		hdoff
	record /M_PTR/	pBuf
	integer*4	nbytes
	character*2	format

	real*8		dval
	integer*4	nput

	dval = 0.d0
	if (hdata.data_rep .ne. Mc.machine .AND. format(2:2).ne.'A') then
	  call M$MOVE(%val(pBuf.p), dval, nbytes)
	  call M$CONVERT_TO(hdata.data_rep, dval, format(2:2), 1)
	  call M$FWRITE(hdata, dval, hdoff, nbytes, nput)
	else
	  call M$FWRITE(hdata, %val(pBuf.p), hdoff, nbytes, nput)
	endif
	if (nput .ne. nbytes) call M$ERROR('Unsuccessful file write')

	return
	END	! XDATA_WRITE



c XDATA_CUT
c
c Deletes the selected element (row) from the datafile, saving its
c contents in the Paste buffer, and replots the data file.
c
	logical*4
     +	function XDATA_CUT (hdata)
	include 'xdatalist.inc'
	include 'msgmask.inc'
	record /HEADER/ hdata

	real*8		startrow, hdoff
	integer*4	nrows, ntoget, ngot, nput, ljunk
	logical*4	XDATA_COPY, bjunk

	XDATA_CUT = .FALSE.

	! Abort if no element is currently selected
	if (Gx.elemt .lt. 1d0) then
	  call MX$MESSAGE('No row selected', -1.0)
	  return
	endif

	! Save the current selection into the Paste buffer
	bjunk = XDATA_COPY(hdata)

	! Move every data file element below the Cut
	! up to fill the hole.
	startrow = Gx.elemt + 1
	do while (startrow .le. Gx.nsize)
	  nrows = MIN(INT(Gx.nsize-startrow+1), Gx.ndatarows)

	  ! FREAD next data file buffer
	  ntoget = nrows * Gx.bpe
	  hdoff = hdata.first_byte + (startrow-1)*Gx.bpe
	  call M$FREAD(hdata, %val(Gx.pbData.p), hdoff, ntoget, ngot)
	  if (ngot .ne. ntoget) call M$ERROR('Unsuccessful file read')

	  ! Move FREAD buffer up one row
	  hdoff = hdoff - Gx.bpe
	  call M$FWRITE(hdata, %val(Gx.pbData.p), hdoff, ngot, nput)
	  if (nput .ne. ngot) call M$ERROR('Unsuccessful file write')

	  startrow = startrow + nrows
	enddo

	! Update the data file header to reflect its smaller size
	Gx.nsize = Gx.nsize - 1
	hdata.size = Gx.nsize
	call M$HCBFUNC(hdata, IOR(HCBF_LASTBYTE,HCBF_FLUSH), ljunk)

	! Send an FEDITINFO msg
	if (XDATA_SENDINFOMSG(MSK_MODIFY))
     +	  call XDATA_INFOMSG(MSK_MODIFY, Gx.msgid, -1)

	! The previously selected element no longer exists
	call XDATA_DESELECT()

	! Replot the data file
	call XDATA_PLOT()

	XDATA_CUT = .TRUE.
	return
	END	! XDATA_CUT



c XDATA_COPY
c
c Copies the selected element into the Paste buffer.
c
	logical*4
     +	function XDATA_COPY (hdata)
	include 'xdatalist.inc'
	record /HEADER/ hdata

	real*8		hdoff
	integer*4	ngot

	XDATA_COPY = .FALSE.
	if (Gx.elemt .lt. 1d0) then
	  call MX$MESSAGE('No element selected', -1.0)
	else
	  call M$GRAB(hdata, %val(Gx.pbPaste.p), Gx.elemt, 1, ngot)
	  if (ngot .ne. 1) then
	    call MX$MESSAGE('Copy aborted: M$GRAB error', -1.0)
	    return
	  endif
	  Gx.pastebufempty = .FALSE.
	  Gx.pastesize	   = 1
	  XDATA_COPY = .TRUE.
	endif

	return
	END	! XDATA_COPY



c XDATA_PASTE
c
c Inserts the contents of the Paste buffer (currently a single element)
c above the selected element (row) in the datafile
c
	logical*4
     +	function XDATA_PASTE (hdata)
	include 'xdatalist.inc'
	include 'msgmask.inc'
	record /HEADER/ hdata

	real*8		startrow, hdoff
	integer*4	ntoget, ngot, nput, ljunk
	logical*4	XDATA_REPLACE

	XDATA_PASTE = .FALSE.

	! Abort if there is data in the file
	! but the Paste Buffer is empty
	if (Gx.nsize.gt.0d0 .AND. Gx.pastebufempty) then
	  call MX$MESSAGE('Paste Buffer is empty - Use Copy', -1.0)
	  return
	endif

	! Append to data file if its empty or if no element
	! is currently selected
	if (Gx.nsize.eq.0d0 .OR. Gx.elemt.lt.1d0) then
	  call MX$MESSAGE('No row selected - appending to file', 1.0)
	  ! Set hdata.offset to end of file so M$FILAD appends
	  call M$HCBFUNC(hdata, HCBF_APPEND, ljunk)
	  ! M$SHOVE and M$FILAD do in-place conversion if the file data
	  ! is in a foreign representation, so copy the paste buffer
	  ! into the scratch buffer before calling M$FILAD.
	  call M$MOVE(%val(Gx.pbPaste.p), %val(Gx.pbScratch.p), Gx.bpe)
	  call M$FILAD(hdata, %val(Gx.pbScratch.p), 1)
	  ! Update the data file header to reflect its new size
	  Gx.nsize = Gx.nsize + 1
	  hdata.size = Gx.nsize
	  call M$HCBFUNC(hdata, HCBF_FLUSH, ljunk)
	  call XDATA_PLOT()
	  Gx.elemt = Gx.nsize
	  ! Send an FEDITINFO msg
	  if (XDATA_SENDINFOMSG(MSK_MODIFY))
     +	    call XDATA_INFOMSG(MSK_MODIFY, Gx.msgid, 1)
	  ! Select the new element
	  call XDATA_SELECT(Gx.nsize, SEL_ALL, SEL_ALL)
	  XDATA_PASTE = .TRUE.
	  return
	endif

	!****************************************************
	! Move every data file element below the currently
	! selected element down to make room for the Paste.
	!****************************************************
	! Start from the end of the data file: GRAB a buffer...
	startrow = MAX(Gx.elemt,Gx.nsize-Gx.ndatarows+1)
	ntoget = MIN(INT(Gx.nsize-startrow+1), Gx.ndatarows)
	call M$GRAB(hdata, %val(Gx.pbData.p), startrow, ntoget, ngot)
	if (ngot .ne. ntoget) then
	  call MX$MESSAGE('Paste aborted: M$GRAB error', -1.0)
	  return
	endif

	! ...SHOVE the GRABbed buffer down 1 element, increasing
	! the file size by 1 logical element...
C NOTE: M$FILAD called first to satisfy OpenVMS
C TODO: Why doesn't OpenVMS allow just the M$SHOVE?
	call M$FILAD(hdata, %val(Gx.pbData.p+(ngot-1)*Gx.bpe), 1)
	call M$SHOVE(hdata, %val(Gx.pbData.p), startrow+1, ngot-1, nput)
	! Update the data file header to reflect its new size
	Gx.nsize = Gx.nsize + 1
	hdata.size = Gx.nsize
	call M$HCBFUNC(hdata, HCBF_FLUSH, ljunk)

	! ...Moving backwards, Move any remaining element down 1
	! until we're back at the selected element
	do while (startrow .gt. Gx.elemt)
	  ntoget = MIN(INT(startrow-Gx.elemt), Gx.ndatarows)
	  startrow = startrow - ntoget

	  ntoget = ntoget * Gx.bpe	! Convert from rows to bytes
	  hdoff = hdata.first_byte + (startrow-1)*Gx.bpe
	  call M$FREAD(hdata, %val(Gx.pbData.p), hdoff, ntoget, ngot)
	  if (ngot .ne. ntoget) call M$ERROR('Unsuccessful file read')

	  hdoff = hdoff + Gx.bpe
	  call M$FWRITE(hdata, %val(Gx.pbData.p), hdoff, ngot, nput)
	  if (nput .ne. ngot) call M$ERROR('Unsuccessful file write')
	enddo

	! Send an FEDITINFO msg
	if (XDATA_SENDINFOMSG(MSK_MODIFY))
     +	  call XDATA_INFOMSG(MSK_MODIFY, Gx.msgid, 1)

	! Write Paste buffer contents into the new space
	! and redraw the screen
	XDATA_PASTE = XDATA_REPLACE(hdata, .FALSE.)

	return
	END	! XDATA_PASTE



c XDATA_REPLACE
c
c Replaces the current selection with the contents of the
c the Paste buffer (currently a single element).
c
	logical*4
     +	function XDATA_REPLACE (hdata, sendmsg)
	include 'xdatalist.inc'
	include 'msgmask.inc'
	record /HEADER/ hdata
	logical*4	sendmsg
	integer*4	nput

	XDATA_REPLACE = .FALSE.

	! Abort if no element is currently selected
	if (Gx.elemt .lt. 1d0) then
	  call MX$MESSAGE('No row selected', -1.0)
	  return
	endif

	! Abort if Paste buffer is empty
	if (Gx.pastebufempty) then
	  call MX$MESSAGE('Paste Buffer is empty - Use Copy first', -1.0)
	  return
	endif

	! M$SHOVE and M$FILAD do in-place conversion if the file data
	! is in a foreign representation, so copy the paste buffer
	! into the scratch buffer before calling M$SHOVE.
	call M$MOVE(%val(Gx.pbPaste.p), %val(Gx.pbScratch.p), Gx.bpe)
	call M$SHOVE(hdata, %val(Gx.pbScratch.p), Gx.elemt, 1, nput)

	! Send an FEDITINFO msg
	if (sendmsg .AND. XDATA_SENDINFOMSG(MSK_MODIFY))
     +	  call XDATA_INFOMSG(MSK_MODIFY, Gx.msgid, 0)

	call XDATA_PLOT()

	XDATA_REPLACE = .TRUE.
	return
	END	! XDATA_REPLACE



c XDATA_DEFAULT_TEMPLATE
c
c Generates a default X-DataList template file for the given data file.
c
	subroutine XDATA_DEFAULT_TEMPLATE (hdata, htmpl)
	include 'xdatalist.inc'
	record /HEADER/ hdata, htmpl
	record /T6SUBR_STRUCT/ t6subr

	integer*4	width, offset, len, nform, nn, spa, ljunk, lwidth
	character	format*2, dispform*(FMTLEN), kstr*(LBLLEN)

	! Create basic fields at top of ext header (some to fill in later)
c	call M$INITIALIZE(htmpl)
	ljunk = M$SCOPE_KEYWORD(htmpl, ' ')	! Clear keyword scope
	ljunk = M$PUT_KEYWORD(htmpl, 'SECTION', 'XDATALIST')
	ljunk = M$PUT_KEYDATA(htmpl, 'FIELD', 0, 4, 0, 'L')
	ljunk = M$PUT_KEYDATA(htmpl, 'VERSION', 3.4, 4, 0, 'F')
	ljunk = M$PUT_KEYDATA(htmpl, 'TITLELINES', 0, 4, 0, 'L')
	ljunk = M$PUT_KEYWORD(htmpl, 'LABELS', 'ON')
	ljunk = M$PUT_KEYWORD(htmpl, 'INDEX', 'RIGHT')
	ljunk = M$PUT_KEYWORD(htmpl, 'INDEXLABEL', 'Index')
	ljunk = M$PUT_KEYDATA(htmpl, 'INDEXRADIX', 100, 4, 0, 'L')
	ljunk = M$PUT_KEYDATA(htmpl, 'SPACING', DEFAULT_SPACING, 4, 0, 'L')
	ljunk = M$PUT_KEYDATA(htmpl, 'FIELDS', 0, 4, 0, 'L')

	! Branch on file type
	offset = 0
	if (Gx.class .eq. 1) hdata.subsize = 1
	nform = hdata.subsize
	if (Gx.class .eq. 2) nform = 1

	do nn = 1, nform
	  ljunk = M$PUT_KEYDATA(htmpl, 'FIELD', nn, 4, 0, 'L')
	  if ((Gx.class .eq. 3) .or.
     +        (Gx.class .eq. 5) .or. (Gx.class .eq. 6)) then
	    kstr = M$SUB_NAME(hdata,nn)
	    lwidth = M$LENGTH(kstr)
	    ljunk = M$PUT_KEYWORD(htmpl, 'SUBR',  kstr(1:lwidth))
	    ljunk = M$PUT_KEYWORD(htmpl, 'LABEL', kstr(1:lwidth))
	    format = M$SUB_FORMAT(hdata,nn)
	  else
	    lwidth = 0
	    format = hdata.format
	  endif
	  
	  spa = M$SPA(format)
	  len = M$L2A(spa, kstr)
	  if (format(2:2) .eq. 'A') then
	      dispform = '(A)'
	      width = 8
	  elseif (format(2:2) .eq. 'D') then
	      dispform = '(1p'//kstr(1:len)//'g24.9)'
	      width = 24
	  elseif (format(2:2) .eq. 'F') then
	      dispform = '(1p'//kstr(1:len)//'g15.6)'
	      width = 15
	  elseif (format(2:2) .eq. 'L') then
	      dispform = '('//kstr(1:len)//'I12)'
	      width = 12
	  elseif (format(2:2) .eq. 'I') then
	      dispform = '('//kstr(1:len)//'I7)'
	      width = 7
	  elseif (format(2:2) .eq. 'B') then
	      dispform = '('//kstr(1:len)//'I5)'
	      width = 5
	  else
	      call M$WARNING('Illegal format type: '//format)
	  endif	    
	  width = width * spa
c	  write(*,*) 'lwidth,width: ',lwidth,width
	  width = MAX(width,lwidth)
	  ljunk = M$PUT_KEYDATA(htmpl, 'WIDTH', width, 4, 0, 'L')
	  len = M$LENGTH(dispform)
	  ljunk = M$PUT_KEYWORD(htmpl, 'DISPFORM', dispform(1:len))
	  ljunk = M$PUT_KEYWORD(htmpl, 'EDIT', 'PROMPT')
	  offset = offset + width + Gx.spacing
	enddo
	ljunk = M$PUT_KEYDATA(htmpl, 'FIELDS', nform, 4, MK_replace, 'L')
	ljunk = M$PUT_KEYWORD(htmpl, 'SECTION', 'END')

	return
	END	! XDATA_DEFAULT_TEMPLATE



c XDATA_DUMP_TEMPLATE
c
c Writes an X-DataList template to disk as an X-Midas header file.
c
	subroutine XDATA_DUMP_TEMPLATE (htmpl, filename)
	implicit none
	include 'headers.inc'
	include 'types.inc'
	record /HEADER/	htmpl
	character*(*)	filename
	integer*4	ljunk

	record /HEADER/	htmplsav

	htmplsav.file_name = filename
	call M$PROPAGATE(htmpl, htmplsav)
	htmplsav.size = 0
	call M$ALLOCATE(htmplsav)
	! Delete the FIELD==0 kluge keyword
	if (M$SCOPE_KEYWORD_QUIET(htmplsav, 'SECTION=XDATALIST,FIELD=0')
     +      .gt. 0) then
	  ljunk = M$DEL_KEYWORD(htmplsav, 'FIELD')
	endif
	ljunk = M$SCOPE_KEYWORD(htmplsav, 'MAIN')	! Main header
	ljunk = M$PUT_KEYWORD(htmplsav,'COMMENT', 'X-DataList template file')
	call M$CLOSE(htmplsav)

	return
	END	! XDATA_DUMP_TEMPLATE



c XDATA_ROW2ELEMT
c
c Converts a 1-based display row index to a 1-based
c X-Midas file logical element index
c	real*8
	function XDATA_ROW2ELEMT (row)
	include 'xdatalist.inc'
	integer*4	row

	if (row .lt. 1) then
	  XDATA_ROW2ELEMT = row
	else
	  XDATA_ROW2ELEMT = row+Gx.top-1
	endif

	return
	END	! XDATA_ROW2ELEMT



c XDATA_ELEMT2ROW
c
c Converts a 1-based X-Midas file logical element index
c to a 1-based display row index
c
c Return values:
c   SEL_INVALID if elemt is invalid (not in [-1,Gx.nsize])
c   0 if elemt ==  0d0
c  -1 if elemt == -1d0
c   SEL_BEFORE_VIEW if elemt is valid but before current view
c   SEL_BEYOND_VIEW if elemt is valid but past current view
c   Row number [1,Gx.nvisrows] if elemt is within view
c	integer*4
	function XDATA_ELEMT2ROW (elemt)
	include 'xdatalist.inc'
	real*8	elemt

	if (elemt.lt.SEL_ALL .OR. elemt.gt.Gx.nsize) then
	  XDATA_ELEMT2ROW = SEL_INVALID
	elseif (elemt .le. 0d0) then
	  XDATA_ELEMT2ROW = INT(elemt)
	elseif (elemt .lt. Gx.top) then
	  XDATA_ELEMT2ROW = SEL_BEFORE_VIEW
	elseif (elemt .ge. Gx.top+Gx.nvisrows) then
	  XDATA_ELEMT2ROW = SEL_BEYOND_VIEW
	else
	  XDATA_ELEMT2ROW = INT(elemt-Gx.top+1)
	endif

	return
	END	! XDATA_ELEMT2ROW



c XDATA_OFFSET2FIELD
c
c Converts a 0-based character offset to a 1-based field
c
	integer*4
     +	function XDATA_OFFSET2FIELD (offset, picky)
	include 'xdatalist.inc'
	integer*4		offset
	logical*4		picky

	integer*4		field, ff, fws, firstfield, coff1, coff2
	record /FIELDINFO/	finfo(1)
	pointer			(finfoptr, finfo)

	finfoptr = Gx.pbFinfo.p
c       write (*,*) 'Gx.fleft=',Gx.fleft

	! Yet another special case for Type 2000 files...
	if (Gx.class .eq. 2) then
	  ff = Gx.nxdlfields
	  fws = finfo(ff).width + finfo(ff).spacing
	  if (offset.ge.finfo(ff).offset .AND. fws.gt.0) then
	    field = (offset-finfo(ff).offset)/fws + ff
	    if (picky .AND. MOD(offset-finfo(ff).offset, fws)
     +			    .ge.finfo(ff).width) then
	      ! offset falls outside the field's WIDTH
	      field = SEL_INVALID
	    endif
	    goto 50
	  endif
	endif

	! We expect that offset will usually fall within the
	! currently displayed fields, but start from the top
	! if we need to...
	if (offset.lt.finfo(Gx.fleft).offset .OR. Gx.scrambled) then
	  firstfield = 1
	else
	  firstfield = Gx.fleft
	endif
	if (picky) then
	  field = SEL_INVALID
	else
	  field = firstfield
	endif
	do ff = firstfield, Gx.nxdlfields
	  coff1 = finfo(ff).offset
	  if (picky) then
	    coff2 = coff1 + finfo(ff).width
	  else
	    coff2 = coff1 + finfo(ff).width + finfo(ff).spacing
	  endif
	  if (offset .lt. coff2) then
	    if (offset .ge. coff1) field = ff
	    if (.NOT.Gx.scrambled .OR. .NOT.picky)  goto 50
	  endif
	enddo
!??	if (field .eq. SEL_INVALID) field = Gx.nfields

   50	continue
	XDATA_OFFSET2FIELD = field
	return
	END	! XDATA_OFFSET2FIELD



c XDATA_RIGHTMOST_VISIBLE_FIELD
c
c Returns the rightmost visible field
c
	integer*4
     +	function XDATA_RIGHTMOST_VISIBLE_FIELD ()
	include 'xdatalist.inc'

	integer*4		cright, ff, fws
	record /FIELDINFO/	finfo(1)
	pointer			(finfoptr, finfo)

	finfoptr = Gx.pbFinfo.p
	cright = Gx.left + Gx.nviscols

	! Yet another special case for Type 2000 files...
	if (Gx.class.eq.2 .AND. cright.ge.finfo(Gx.nxdlfields).offset)
     +	then
	  fws = finfo(Gx.nxdlfields).width+finfo(Gx.nxdlfields).spacing
	  if (fws .gt. 0) then
	    XDATA_RIGHTMOST_VISIBLE_FIELD = Gx.nxdlfields +
     +		(cright - finfo(Gx.nxdlfields).offset) / fws
	  else
	    XDATA_RIGHTMOST_VISIBLE_FIELD = Gx.nxdlfields
	  endif
	  return
	endif

	if (Gx.scrambled) then
	  do ff = Gx.nxdlfields, Gx.fleft, -1
	    if (finfo(ff).offset.lt.cright .AND.
     +		finfo(ff).offset+finfo(ff).width.gt.Gx.left) then
	      XDATA_RIGHTMOST_VISIBLE_FIELD = ff
	      return
	    endif
	  enddo
	endif

	do ff = Gx.fleft, Gx.nxdlfields
	  if (finfo(ff).offset .gt. cright) then
	    XDATA_RIGHTMOST_VISIBLE_FIELD = ff-1
	    return
	  endif
	enddo
	XDATA_RIGHTMOST_VISIBLE_FIELD = Gx.nxdlfields

	return
	END	! XDATA_RIGHTMOST_VISIBLE_FIELD



c XDATA_SCOPE_TO_FIELD
c
c Sets the template keyword scope to the appropriate FIELD section.
c
c
	subroutine XDATA_SCOPE_TO_FIELD (htmpl, field)
	include 'xdatalist.inc'
	record /HEADER/	htmpl
	integer*4	field

	integer*4	ff, flen, ljunk
	character	fstr*(FMTLEN)

	ff = field
	if (Gx.class .eq. 2) ff = MIN(Gx.nxdlfields, field)
	flen = M$L2A(ff, fstr)
	ljunk = M$SCOPE_KEYWORD(htmpl,
     +			'SECTION=XDATALIST,FIELD='//fstr(1:flen))
	return
	END	! XDATA_SCOPE_TO_FIELD



c XDATA_WARNING
c
c Issues an X-Midas warning message.
c
c Return value: .FALSE. (Aids in 1-line IFs that set error flags)
	logical*4
     +	function XDATA_WARNING (culprit, routinename)
	character*(*)	culprit, routinename

	character	warning_txt*(64)

	warning_txt = 'Invalid '//culprit//' passed to XDATA_'//
     +			routinename
	call M$WARNING(warning_txt)
	XDATA_WARNING = .FALSE.
	return
	END	! XDATA_WARNING




c XDATA_DEBUG
c
c Prints diagnostic data.
c
c
	subroutine XDATA_DEBUG (level, arg)
	include 'xdatalist.inc'
	integer*4	level, arg

	real*8			dval
	integer*4		len, ff, ii
	character		str*(DEFSTRLEN), cjunk

c	record /FIELDINFO/	finfo(1)
	record /FIELDINFO/	finfo(*)	!_IFC
	pointer			(finfoptr, finfo)

	character		string
	pointer			(stringptr, string)

c	record /HLITREGION/	hlitbuf(1)
	record /HLITREGION/	hlitbuf(*)	!_IFC
	pointer			(hlitbufptr, hlitbuf)

	write(*,*) '****************************'
	write(*,*) 'Gx.modify	 =', Gx.modify
	write(*,*) 'Gx.msgid	 =', Gx.msgid
	write(*,*) 'Gx.msgmask	 =', Gx.msgmask
	write(*,*) 'Gx.nfields	 =', Gx.nfields
	write(*,*) 'Gx.ntitle	 =', Gx.ntitle
	write(*,*) 'Gx.ndatarows	 =', Gx.ndatarows
	write(*,*) 'Gx.nvisrows	 =', Gx.nvisrows
	write(*,*) 'Gx.nsize	 =', Gx.nsize
	write(*,*) 'Gx.bpe		 =', Gx.bpe
	write(*,*) 'Gx.top		 =', Gx.top
	write(*,*) 'Mx.stk(1).ymin	 =', Mx.stk(1).ymin
	write(*,*) 'Mx.stk(1).ymax	 =', Mx.stk(1).ymax
	write(*,*) 'Gx.ndatacols	 =', Gx.ndatacols
	write(*,*) 'Gx.nviscols	 =', Gx.nviscols
	write(*,*) 'Gx.dispwidth	 =', Gx.dispwidth
	write(*,*) 'Gx.left		 =', Gx.left
	write(*,*) 'Gx.fleft	 =', Gx.fleft
	write(*,*) 'Gx.fright	 =', Gx.fright
	write(*,*) 'Gx.scrambled	 =', Gx.scrambled
	write(*,*) 'Mx.stk(1).xmin	 =', Mx.stk(1).xmin
	write(*,*) 'Mx.stk(1).xmax	 =', Mx.stk(1).xmax
	write(*,*) 'Gx.elemt	 =', Gx.elemt
	write(*,*) 'Gx.field	 =', Gx.field
	write(*,*) 'Gx.scalar	 =', Gx.scalar
	dval = 0d0
	cjunk = M$RFIND(Mx.ytag, str, dval)
	write(*,*) Mx.ytag, ' =', dval
	cjunk = M$RFIND(Mx.xtag, str, dval)
	write(*,*) Mx.xtag, ' =', dval
	cjunk = M$RFIND(Mx.ztag, str, dval)
	write(*,*) Mx.ztag, ' =', dval
	if (level .ge. 2) then
	  write(*,*) 'Gx.spacing	 =', Gx.spacing
	  write(*,*) 'Gx.indexpos	 =', Gx.indexpos
	  write(*,*) 'Gx.iwidth	 =', Gx.iwidth
	  write(*,*) 'Gx.iradix	 =', Gx.iradix
	  write(*,*) 'Gx.spacing	 =', Gx.spacing
	  write(*,*) 'Gx.xmboff	 =', Gx.xmboff
	  write(*,*) 'Gx.pastebufempty =', Gx.pastebufempty
	  write(*,*) 'Gx.cursor	 =', Gx.cursor
	  write(*,*) 'Gx.defcolor	 =', Gx.defcolor	
	  write(*,*) 'Gx.curcolor	 =', Gx.curcolor
	  write(*,*) 'Gx.curcolor_fg	 =', Gx.curcolor_fg
	  write(*,*) 'Gx.curcolor_bg	 =', Gx.curcolor_bg
	  write(*,*) 'Gx.xparent_cursor	 =', Gx.xparent_cursor
	  write(*,*) 'Gx.colordep	 =', Gx.colordep
	  write(*,*) 'Gx.nhlit	 =', Gx.nhlit
	  write(*,*) 'Gx.ahlit	 =', Gx.ahlit
	endif
	if (level .ge. 3) then
	  finfoptr = Gx.pbFinfo.p
	  do ff = 1, Gx.nxdlfields
	    write(*,*) ' '
	    write(*,*) 'FIELD', finfo(ff).field
	    len = finfo(ff).llabel
	    write(*,*) '  label	 length	', len
	    if (len .gt. 0) then
	      stringptr = finfo(ff).label.p
	      write(*,*) '  label		', string(1:len)
	    else
	      write(*,*) '  label'
	    endif
	    write(*,*) '  1st scalar    ', finfo(ff).scalar1
	    write(*,*) '  # scalars     ', finfo(ff).nscalars
	    write(*,*) '  offset        ', finfo(ff).offset
	    write(*,*) '  width         ', finfo(ff).width
	    write(*,*) '  swidth        ', finfo(ff).swidth
	    write(*,*) '  spacing       ', finfo(ff).spacing
	    write(*,*) '  atom offset   ', finfo(ff).atomoff
	    write(*,*) '  field offset  ', finfo(ff).fieldoff
	    write(*,*) '  bytes/field   ', finfo(ff).bpf
	    write(*,*) '  subelement    ', finfo(ff).subelemt
	    write(*,*) '  color         ', finfo(ff).color
	    write(*,*) '   color mode   ', finfo(ff).colormode
	    write(*,*) '   dependencies?', finfo(ff).colordep
	    write(*,*) '  enumerated?   ', finfo(ff).enumerated
	    if (finfo(ff).usenullval)
     +	      write(*,*) '  null value    ', finfo(ff).nullval
	    write(*,*) '  subrecord name  ', finfo(ff).subname
	    len = finfo(ff).ldispform
	    write(*,*) '  format length	', len
	    if (len .gt. 0) then
	      stringptr = finfo(ff).dispform.p
	      write(*,*) '  display format  ', string(1:len)
	    else
	      write(*,*) '  display format'
	    endif
	    write(*,*) '  data format	  ', finfo(ff).format
	    write(*,*) '  edit mode	  ', finfo(ff).edit
	    write(*,*) '  # menu items	  ', finfo(ff).nmenuitems
	  enddo	! for each field
	  write(*,*) ' '
	endif

	if (level .ge. 4) then
	  ! Display highlight regions
	  write(*,*) 'Current highlight regions:'
	  hlitbufptr = Gx.pbHlit.p
	  do ii = 1, Gx.nhlit
	    write(*,*) 'Region', ii, '   ID:', hlitbuf(ii).from.id,
     +		     '   Color:', hlitbuf(ii).from.color
	    write(*,*) '  From:', hlitbuf(ii).from.elemt,
     +			hlitbuf(ii).from.field, hlitbuf(ii).from.scalar
	    write(*,*) '  To:  ', hlitbuf(ii).to.elemt,
     +			hlitbuf(ii).to.field, hlitbuf(ii).to.scalar
	  enddo	! for each highlight region
	  write(*,*) ' '
	endif

	return
	END	! XDATA_DEBUG



c XDATA_POSTAMBLE
c
c Closes datafile, template files, cleans up
c
	subroutine XDATA_POSTAMBLE ()
	include 'xdatalist.inc'
	include 'msgmask.inc'

	record /HEADER/ hcb
	pointer		(hcbptr, hcb)

	integer*4	ii

	call MX$CLOSE()
	hcbptr = Gx.phTmpl(0).p
	call M$STMFREE(hcb.ext_alloc, hcb.ext_loc)
	do ii = 1,Gx.ntmpl
	  hcbptr = Gx.phTmpl(ii).p
	  call M$CLOSE(hcb)
	enddo
	hcbptr = Gx.phData.p
	hcb.output = .FALSE.
	call M$CLOSE(hcb)

	if ( XDATA_SENDINFOMSG(MSK_EXIT) )
     +	  call XDATA_INFOMSG(MSK_EXIT, Gx.msgid, 0)

	return
	END	! XDATA_POSTAMBLE



c XDATA_FORM_COMMAND 
c
c Handles substiturion of arguments in COMMAND edit string
c
	subroutine XDATA_FORM_COMMAND (hdata, htmpl, 
     +	  row, field, scalar, finfo, S, str, ls, maxls)
	include 'xdatalist.inc'
	record /HEADER/ hdata, htmpl
	record /FIELDINFO/  finfo
	record /M_PTR/ Sptr
	integer*4 row, field, scalar
	integer*4 ls, maxls, i, lt 
	character str*(*), tmp*32
	byte S(*)

	i = M$SEARCH( str(1:ls), '^FILENAME')
	if (i.gt.0) then
	  lt = M$LENGTH(hdata.file_name)
	  str = str(1:i-1)//hdata.file_name(1:lt)//str(i+9:ls)
	  ls = ls - 9 + lt
	endif

	i = M$SEARCH( str(1:ls), '^TEMPLATE')
	if (i.gt.0) then
	  lt = M$LENGTH(htmpl.file_name)
	  str = str(1:i-1)//htmpl.file_name(1:lt)//str(i+9:ls)
	  ls = ls - 9 + lt
	endif

	i = M$SEARCH( str(1:ls), '^ROW')
	if (i.gt.0) then
	  lt = M$L2A (row, tmp)
	  str = str(1:i-1)//tmp(1:lt)//str(i+4:ls)
	  ls = ls - 4 + lt
	endif

	i = M$SEARCH( str(1:ls), '^FIELD')
	if (i.gt.0) then
	  lt = M$L2A (field, tmp)
	  str = str(1:i-1)//tmp(1:lt)//str(i+6:ls)
	  ls = ls - 6 + lt
	endif

	i = M$SEARCH( str(1:ls), '^SCALAR')
	if (i.gt.0) then
	  lt = M$L2A (scalar, tmp)
	  str = str(1:i-1)//tmp(1:lt)//str(i+7:ls)
	  ls = ls - 7 + lt
	endif

	i = M$SEARCH( str(1:ls), '^DATA')
	if (i.gt.0) then
	  Sptr.p = %loc(S)
	  call XDATA_FORMAT_FIELD(Sptr, finfo, tmp)
	  lt = M$LENGTH( str(1:finfo.width) )
	  do while (lt.gt.0 .and. str(1:1).eq.' ')
	    str(1:lt-1) = str(2:lt)
	    lt = lt-1
	  enddo
	  str = str(1:i-1)//tmp(1:M$LENGTH(tmp))//str(i+5:ls)
	  ls = ls - 5 + M$LENGTH(tmp)
	endif
c
	return
	end

c XDATA_CUTFEDIT
c
c Deletes the selected element(s) (row) from the datafile and replots
c the data file.
c
	logical*4
     +	function XDATA_CUTFEDIT (hdata, ncut)
	include 'xdatalist.inc'
	include 'msgmask.inc'
	record /HEADER/ hdata
	integer*4	ncut           ! no. to cut

	real*8		startrow, hdoff
	integer*4	nrows, ntoget, ngot, nput, ljunk

	XDATA_CUTFEDIT = .FALSE.

	! Abort if no element is currently selected
	if (Gx.elemt .lt. 1d0) then
	  call MX$MESSAGE('No row selected', -1.0)
	  return
	endif

	! Move every data file element below the Cut
	! up to fill the hole.
	startrow = Gx.elemt + ncut
	do while (startrow .le. Gx.nsize)
	  nrows = MIN(INT(Gx.nsize-startrow+1), Gx.ndatarows)

	  ! FREAD next data file buffer
	  ntoget = nrows * Gx.bpe
	  hdoff = hdata.first_byte + (startrow-1)*Gx.bpe
	  call M$FREAD(hdata, %val(Gx.pbData.p), hdoff, ntoget, ngot)
	  if (ngot .ne. ntoget) call M$ERROR('Unsuccessful file read')

	  ! Move FREAD buffer up one row
	  hdoff = hdoff - Gx.bpe
	  call M$FWRITE(hdata, %val(Gx.pbData.p), hdoff, ngot, nput)
	  if (nput .ne. ngot) call M$ERROR('Unsuccessful file write')

	  startrow = startrow + nrows
	enddo

	! Update the data file header to reflect its smaller size
	Gx.nsize = MAX (0.d0, Gx.nsize - ncut)
	hdata.size = Gx.nsize
	call M$HCBFUNC(hdata, IOR(HCBF_LASTBYTE,HCBF_FLUSH), ljunk)

	! The previously selected element no longer exists
	call XDATA_DESELECT()

	! Replot the data file
	call XDATA_PLOT()

	XDATA_CUTFEDIT = .TRUE.
	return
	END	! XDATA_CUTFEDIT
