c
c     Copyright (c) 1999,2000, Compaq Computer Corporation
c
c     See the file "license.terms" for information on usage and redistribution
c     of this file, and for a DISCLAIMER OF ALL WARRANTIES.
c
c     File parsing routines
c
      subroutine get_keyword(buffer,key,ipos)
      implicit none
c
c     Get keyword from string buffer and return in key, starting at character
c     position ipos.
c     On return, ipos is position of next character after keyword.
c     If a keyword is not found, ipos is set to zero.
c
c     Keywords are any series of characters, separated by blanks,
c     commas, or equal signs.
c
c     Quoting:
c        Any set of characters inside single quotes ' is considered
c     to be a single keyword (not yet implemented).
c
c     Bugs: If keyword ends on the last character of buffer, ipos is set to
c           the last character in buffer.
c
      character*(*) buffer, key
      integer ipos
c
      character*1 TAB
      parameter (TAB = CHAR(9))

      integer i, i1, i2, lbuf
      logical in_key
c
      in_key = .FALSE.
      lbuf = LEN(buffer)
      i1 = 0
      i2 = 0
c
      do i=ipos,lbuf
         if( buffer(i:i) .ne. ' ' .and. buffer(i:i) .ne. ',' .and.
     1       buffer(i:i) .ne. TAB .and. buffer(i:i) .ne. '=' ) then
            if( .NOT. in_key ) then
               in_key = .TRUE.
               i1 = i
            endif
         else if( in_key ) then
               i2 = i
               goto 1000
         endif
      end do
c
1000  if( i1 .eq. 0 ) then
         ipos = 0
      else if( in_key .and. i2 .eq. 0 ) then
         key = buffer(i1:lbuf)
         ipos = lbuf
      else
         key = buffer(i1:i2-1)
         ipos = i2
      endif
c
      return
      end
c
      subroutine get_str_start(buffer,ipos)
      implicit none
c
c     Finds the beginning of a "non-delimiter" character from string buffer
c     starting at character position ipos. Delimiters are blanks,
c     commads or equal signs.
c
c     On return, ipos is position of next "non-delimiter" character
c     If "non-delimiter" character is not found, ipos is set to zero.
c
      character*(*) buffer
      integer ipos
c
      integer i, i1
c
      i1 = 0
      do i=ipos,LEN(buffer)
         if( buffer(i:i) .ne. ' ' .and. buffer(i:i) .ne. ',' .and.
     1       buffer(i:i) .ne. '=' ) then
            i1 = i
            goto 1000
         endif
      end do
1000  continue
      ipos = i1
      return
      end
c
      subroutine next_line
      implicit none
c
      include 'sysdep.cmn'
      include 'io.cmn'
      include 'parser.cmn'
c
c     Reads next line of file and parses first keyword
c     Skips over comment lines
c     Returns .TRUE. in feof if end of file reached
c
      character*(PM_MAX_PATHLEN)  internal_buffer
      integer isemi, string_len, find_line_terminator
c
      integer ilen, icur
      data ilen/0/, icur/0/
      save ilen, icur, internal_buffer
c
c     Look to see if we need to read the next line
c
      if( icur .ge. ilen ) then
1000     read(savefil,1001,end=2000) internal_buffer
1001     format(a)
         iline = iline + 1
c        Check for comment line
         if( internal_buffer(1:1) .eq. '!' ) goto 1000
c        Check for blank input line
         ilen = string_len(internal_buffer)
         if( ilen .eq. 0 ) goto 1000
         icur = 1
      endif
c
c     Check for "line" terminator
      isemi = find_line_terminator(internal_buffer(icur:ilen))
      if( isemi .eq. 0 ) then
c        No terminator found on line, copy from current character to end
c        of internal buffer into buffer
         buffer = internal_buffer(icur:ilen)
         icur = ilen + 1
      else
c        Terminator found. Copy from end of last terminator to
c        the new terminator; advance current character pointer to after
c        terminator
         buffer = internal_buffer(icur:icur+isemi-2)
         icur = icur + isemi
      endif
      ipos = 1
c
c     Decode keyword
      call get_keyword(buffer,key,ipos)
      call upcase(key)
      klen = string_len(key)
c
      return
c
2000  continue
      feof = .TRUE.
      return
      end
c
      logical function check_command()
      implicit none
c
c     Compares key with known command keys.
c     Returns .TRUE. if key matches any command; .FALSE. otherwise
c
      include 'sysdep.cmn'
      include 'parser.cmn'
c
      integer i
c
      check_command = .FALSE.
      do 100 i=1, num_parse_commands
         if( key .eq. parse_command(i) ) check_command = .TRUE.
100   continue
c
      return
      end
c
      subroutine perror_write(ierr, iline, ipos, key, item, buffer)
      implicit none
c
      include 'sysdep.cmn'
      include 'io.cmn'
c
      integer ierr, iline, ipos
      character*(*) key, item, buffer
c
      integer ilen, ilen2, string_len
c
      if( ierr .eq. 1 ) then
         ilen = string_len(key) 
         ilen2 = string_len(buffer)
         write(luttyo,1001) iline, key(1:ilen), buffer(1:ilen2)
1001     format(' ','Error on line ',i5,': Illegal key: ',a/' ',a)
      else if( ierr .eq. 2 ) then
         if( ipos .eq. 0 ) then
            ilen = string_len(buffer)
            write(luttyo,2001) iline, buffer(1:ilen)
2001        format(' ','Error on line ',i5,
     1             ': Insufficient number of value(s)'/
     1             ' ',a)
         else
            ilen = string_len(item) 
            ilen2 = string_len(buffer)
            write(luttyo,2002) iline, item(1:ilen), buffer(1:ilen2)
2002        format(' ','Error on line ',i5,': Illegal value: ',a/' ',a)
         endif
      else if( ierr .eq. 3 ) then
c        Bad quotes in string
         ilen = string_len(buffer)
         write(luttyo,2003) iline, buffer(1:ilen)
2003     format(' ','Error on line ',i5,
     1              ': Incorrect use of quotes in string'/' ',a)
      else if( ierr .eq. 4 ) then
c        Too many values on line
         ilen = string_len(buffer)
         write(luttyo,2004) iline, buffer(1:ilen)
2004     format(' ','Error on line ',i5,
     1              ': Too many values specified'/' ',a)
      else if( ierr .eq. 5 ) then
c        String too long
         ilen = string_len(buffer)
         write(luttyo,2005) iline, buffer(1:ilen)
2005     format(' ','Error on line ',i5,
     1              ': String too long'/' ',a)
      endif
c
      return
      end
c
      integer function find_line_terminator(string)
      implicit none
c
      character*(*) string
c
c     Look for the logical end of line terminator in a string
c
c     The current terminator is a semicolon.
c     If the semicolon occurs within single quotes ('),
c     or is escaped by a preceeding backslash (\), then ignore it.
c
      integer i,j,klen
      logical inquote, escape
c     The backslash character
      character*1 BACKSLASH
      parameter( BACKSLASH = CHAR(92))
c
      inquote = .FALSE.
      escape  = .FALSE.
      j = 0
      klen=LEN(string)
      do 100 i=1,klen
         if( string(i:i) .eq. '''' ) then
            if( inquote ) then
               inquote = .FALSE.
            else
               inquote = .TRUE.
            endif
            escape = .FALSE.
         else if( string(i:i) .eq. ';' ) then
c           Check for possible version number (backwards compatibility
c           for VMS only)
            if( i+1 .le. klen ) then
               if( INDEX('0123456789-',string(i+1:i+1)) .gt. 0 ) then
c                 Likely version number found
                  escape = .TRUE.
               endif
            endif
            if (.NOT. inquote .and. .NOT. escape ) then
               j = i
               goto 101
            endif
         else if(string(i:i) .eq. BACKSLASH ) then
            escape = .TRUE.
         else
            escape = .FALSE.
         endif
100   continue
101   find_line_terminator = j
c
      return
      end
c
      subroutine dequote_string(string,ierror)
      implicit none
c
      character*(*) string
      integer ierror
c
c     Removes quotes from a string in-place.
c
c     Two single quotes '' are replaced by a single quote.
c
c     If this string has a quoting error, then ierror=1
c                                         else ierror=0
c
      integer i, j, ilen, string_len
      logical lquote
c
      ierror = 0
      ilen = string_len(string)
c
c     If string does not start with a quote, then return entire string
c     This is for backward compatibility so we can support unquoted
c     strings.
      if( string(1:1) .ne. '''' ) return
c
      j = 0
      lquote = .FALSE.
      do i=2,ilen
        if( string(i:i) .eq. '''' ) then
           if( lquote ) then
              j = j + 1
              string(j:j) = ''''
              lquote = .FALSE.
           else
              lquote = .TRUE.
           endif
        else
           if( lquote ) ierror = 1
           j = j + 1
           string(j:j) = string(i:i)
           lquote = .FALSE.
        endif
      end do
c
      if( .NOT. lquote ) ierror = 1
c
      do i=j+1,ilen
         string(i:i) = ' '
      enddo
c
      return
      end
c
      subroutine get_keyword_2(buffer,delim,key,ipos)
      implicit none
c
c     Get keyword from string buffer and return in key, starting at character
c     position ipos. delim lists string delimiters
c     On return, ipos is position of next character after keyword.
c     If a keyword is not found, ipos is set to zero.
c
c     Keywords are any series of characters, separated by blanks,
c     commas, or equal signs.
c
c     Quoting:
c        Any set of characters inside single quotes ' is considered
c     to be a single keyword (not yet implemented).
c
c     Bugs: If keyword ends on the last character of buffer, ipos is set to
c           the last character in buffer.
c
      character*(*) buffer, key, delim
      integer ipos
c
      integer i, i1, i2, lbuf
      logical in_key
c
      in_key = .FALSE.
      lbuf = LEN(buffer)
      i1 = 0
      i2 = 0
c
      do i=ipos,lbuf
         if( INDEX(delim,buffer(i:i)) .eq. 0 ) then
            if( .NOT. in_key ) then
               in_key = .TRUE.
               i1 = i
            endif
         else if( in_key ) then
               i2 = i
               goto 1000
         endif
      end do
c
1000  if( i1 .eq. 0 ) then
         ipos = 0
      else if( in_key .and. i2 .eq. 0 ) then
         key = buffer(i1:lbuf)
         ipos = lbuf
      else
         key = buffer(i1:i2-1)
         ipos = i2
      endif
c
      return
      end
