mat_getlin Subroutine

public subroutine mat_getlin()

Arguments

None

Contents

Source Code


Variables

Type Visibility Attributes Name Initial
integer, public :: i
integer, public :: ios
integer, public :: istat
integer, public :: j
integer, public :: k
integer, public :: l
character(len=GG_LINELEN), public :: mline
integer, public :: n
integer, public, parameter :: retu(GG_MAX_NAME_LENGTH) = [iachar(['q', 'u', 'i', 't', ' ', ' ', ' ']), GG_PAD(8:)]
character(len=GG_LINELEN), public :: shift_mline

Functions

function get_pseudo_line() result(line)

Arguments

None

Return Value character(len=GG_LINELEN)


Source Code

subroutine mat_getlin() ! get a new input line

character(len=GG_LINELEN) :: mline
character(len=GG_LINELEN) :: shift_mline

integer                   :: istat
integer,parameter         :: retu(GG_MAX_NAME_LENGTH) =  [iachar(['q','u','i','t',' ',' ',' ']),GG_PAD(8:)]
integer                   :: i, j, k
integer                   :: l
integer                   :: n
integer                   :: ios
!.......................................................................
   l = G_LINE_POINTER(1)
!.......................................................................
   11 continue

      G_BUF(:GG_LINELEN)= blank      ! blank out buffer before reading into it
      n = GG_LINELEN+1

      ! get line of input and place it in line buffer
      if(size(G_PSEUDO_FILE).eq.1.and.G_RIO.eq.STDIN)then
         mline=get_pseudo_line()
         G_RIO = G_INPUT_LUN
      elseif(size(G_PSEUDO_FILE).ne.0.and.G_RIO.eq.STDIN)then
         mline=get_pseudo_line()
      else
         mline(:)=' '
         read(G_RIO,'(a)',iostat=ios) mline       ! read input line from file
         if( (ios.ne.0) ) then
             if(is_iostat_end(ios))then           ! hit end of file
                call mat_copyid(G_LIN(l),retu) ! store QUIT onto G_LIN(L) to simulate RETURN command
                l = l + 4
                goto 45
             else
                goto 15
             endif
         endif
      endif
      if(G_ECHO)write(*,'(*(g0))')'',trim(mline)
      shift_mline=adjustl(mline)
      if(shift_mline(1:2).eq.'??')then            ! edit command line history
         mline='. '//mline(3:)
      endif

      if(G_RIO.eq.stdin)then
         call journal('t',mline)   ! reading from standard input, so copy to trail file
      else
         call journal('c',mline)   ! reading from an exec() command, so write as a comment
      endif
      call redo(mline,'.')         ! pass line to REDO(3f). This is a no-op except for storing the line into the input history
                                   ! (unless the input line is the "r" command)

      ! look for other lines to immediately process and then ignore
      shift_mline=adjustl(mline)
      if(shift_mline(1:1).eq.'#')then
         mline=''                                                      ! ignore lines with a # as first non-blank character
      elseif(shift_mline(1:1).eq.'!')then
         if(shift_mline.eq.'!')then
            call get_environment_variable('SHELL',shift_mline)         ! get command to execute
            call execute_command_line(shift_mline,cmdstat=istat)       ! call system shell
         else
            call execute_command_line(shift_mline(2:),cmdstat=istat)   ! call system shell
         endif
         mline=''
      endif

      call mat_str2buf(mline,G_BUF,GG_LINELEN)    ! convert input line to "Hollerith" buffer
!.......................................................................
   15 continue
      n = n-1
      if(n.lt.1)then
         n=1
      elseif (G_BUF(n) .eq. blank)then
         goto 15 ! trim off trailing spaces
      endif

      if (mod(G_LINECOUNT(4),2) .eq. 1) then
              call mat_buf2str(mline,G_BUF,n) ! convert ADE buffer to character
              call journal('s',mline) ! just to standard output
      endif
!.......................................................................
      do j = 1, n
         do k = 1, G_CHARSET_SIZE  ! make sure this letter is in set of LALA characters and get its LALA number
           if (G_BUF(j).eq.k ) goto 30
         enddo
         call journal('sc','Unknown character at column ',j) ! this is not a known character
         k = GG_EOL+1
         if (k .gt. GG_EOL) then
            l = G_LINE_POINTER(1)
            goto 11   ! Unknown character , K not changed. get new line
         endif
         if (k .eq. GG_EOL) exit
         if (k .eq. -1) l = l-1
         if (k .le. 0) cycle
!
   30    continue
         if (k.eq.slash .and. G_BUF(j+1).eq.G_BUF(j)) exit     ! if // rest is comment
         if (k.eq.dot .and. G_BUF(j+1).eq.G_BUF(j)) goto 11    ! if .. line continuation
         if (k.eq.bslash .and. n.eq.1) then                    ! if \ in column 1
            n = G_LINE_POINTER(6) - G_LINE_POINTER(1)
            do i = 1, n
               k = G_LIN(l+i-1)
               G_BUF(i) = k
            enddo
            goto 15
         endif
         G_LIN(l) = k
         if (l.lt.1024) l = l+1
         if (l.eq.1024) call journal('sc','input buffer limit exceeded=',l)
      enddo
!.......................................................................
   45 CONTINUE      ! line is ready, reset line pointers
      G_LIN(l) = GG_EOL;G_LIN(l+1:)=blank
      G_LINE_POINTER(6) = l
      G_LINE_POINTER(4) = G_LINE_POINTER(1)
      G_LINE_POINTER(3) = 0
      G_LINE_POINTER(2) = 0
      G_LINECOUNT(1) = 0
      call mat_getch() ! load first character onto G_CHRA

contains

function get_pseudo_line() result(line)
character(len=GG_LINELEN) :: line
! reallocating all the time is inefficient
   line=G_PSEUDO_FILE(1)
   if(size(G_PSEUDO_FILE).gt.1)then
      G_PSEUDO_FILE=G_PSEUDO_FILE(2:)
   else
      G_PSEUDO_FILE=[character(len=GG_LINELEN) :: ]
   endif
end function get_pseudo_line

end subroutine mat_getlin