Article 8570 of alt.sources:
Xref: mv alt.sources:8570
Path: mv!news.sprintlink.net!news-fw-22.sprintlink.net!news.sprintlink.net!news-ana-7.sprintlink.net!news.sprintlink.net!news-ana-24.sprintlink.net!news.sprintlink.net!new-news.sprintlink.net!news.infi.net!imci5!imci4!newsfeed.internetmci.com!cpk-news-hub1.bbnplanet.com!news.ums.edu!news.umbc.edu!cs.umd.edu!ra.nrl.navy.mil!mitch.nrl.navy.mil!grunes
From: grunes@news.nrl.navy.mil (Mitchell R Grunes)
Newsgroups: alt.sources
Subject: filtert: Simple Text File Filter
Date: 29 Aug 1996 13:27:16 GMT
Organization: AlliedSignal Technical Services Corp.
Lines: 222
Message-ID: <grunes.430.0@news.nrl.navy.mil>
NNTP-Posting-Host: mitch.nrl.navy.mil

Archive-name: filtert
Submitted-by: grunes@ssdd.nrl.navy.mil (Mitchell R Grunes)

********filtert: Simple Text File Filter********

The most recent changes: improved handling of carriage returns.

If you like or dislike it, send e-mail.  DON'T POST to alt.sources.
Bug reports must include sample files on which it failed.

CONTENTS:
   filtert.for     Fortran language source code.
---filtert.for--------------CUT HERE-----------------------------
        program FilterT
c Program by Mitchell R Grunes for his own use.

c Filters text that comes from terminal output or WWW to be readable.
c This is especially helpful when using a text editor to search the output
c  from the Unix "man" command, or the Unix script command.
c Optionally, it can remove the <> clauses from HTML files.

c I try to kill redundant carriage returns, and to deal with overstrikes,
c  tabs, positioning commands, escape sequences, and long lines.

c I assume the ASCII character set.

c This program was written in FORTRAN, for historic reasons.

        character FilNam*80,c*1,Out*255,Out2*255,SaveEnd*16,SaveEnd2*16
        logical OSFlag                  !Overstrike flag
        logical ULFlag                  !Underline  flag (we show as ~)

        print*,'---FilterT by Mitchell R Grunes---'

        print*,'Input file:'
        read(*,'(a80)')FilNam

c Following Open statement not completely portable--I assume direct access
c  unformatted opens employ raw binary I/O.
c For example, Lahey Fortran version requires access='transparent',
c and SGI Fortran version must be compiled with -bytereclen.
c But this should work with Microsoft PC Fortran and Sun Fortran.
        open(1,file=FilNam,access='direct',recl=1,
     &   form='unformatted',status='old')

        print*,'Output file (blank=screen):'
        read(*,'(a80)')FilNam
        if(FilNam.ne.' ')
     &   open(2,file=FilNam,access='sequential',
     &   form='formatted',status='unknown')

        print*,'Maximum column before splitting line (255=max):'
        read*,iColMax
        if(iColMax.le.0)iColMax=255

        print*,'Filter <stuff> clauses (use for HTML files) (0=no):'
        read*,iHTML

        call Init(icol,Out,Out2,OSFlag,ULFlag)

        irec=1
        InHTML=0                                ! Not inside HTML <> clause
        dowhile(.true.)
          call ReadChar(irec,c,i,last,*99)
          if(i.eq.10.or.i.eq.13)then    ! New line
            if((i.eq.10.and.last.ne.13).or.i.eq.13)then
              call WriteLine(Out,Out2,FilNam,icol,OSFlag,ULFlag)
            endif
          elseif(c.eq.'<'.and.iHTML.ne.0)then
            InHTML=1
          elseif(c.eq.'>'.and.InHTML.ne.0)then
            InHTML=0
          elseif(InHTML.ne.0)then
          elseif(i.ge.32.and.i.lt.127)then
            if(icol.gt.iColMax)then             ! Split line
              if(Out (iColMax:iColMax).eq.' '.and.
     &           Out2(iColMax:iColMax).eq.' ')then    !try to split at space

                iSplit=255+1                    !  (no characters from prev line)
              else
                iSplit=iColMax
                dowhile(iSplit.gt.iColMax-15.and.
     &           (Out (iSplit:iSplit).ne.' '.or.
     &            Out2(iSplit:iSplit).ne.' '))
                  iSplit=iSplit-1
                enddo
                if(iSplit.eq.iColMax-15)iSplit=255+1
              endif
              if(iSplit.lt.255+1)then
                SaveEnd= Out (iSplit+1:255)
                SaveEnd2=Out2(iSplit+1:255)
                Out (iSplit+1:255)=' '
                Out2(iSplit+1:255)=' '
              endif
              call WriteLine(Out,Out2,FilNam,icol,OSFlag,ULFlag)
              icol=1
              if(iSplit.lt.255+1)then
                Out =SaveEnd
                Out2=SaveEnd2
                icol=icol + iColMax - (iSplit+1) + 1
              endif
            endif
            if(OSFlag)then
              if(Out(icol:icol).eq.'_')then     ! (overtruck _ = ~)
                Out2(icol:icol)='~'
                Out(icol:icol)=c
              else
                Out2(icol:icol)=c
              endif
              OSFlag=.false.
            else
              Out(icol:icol)=c
              if(ULFlag)Out2(icol:icol)='~'
            endif
            icol=icol+1
          elseif(i.eq.0)then            ! Null--ignore
          elseif(i.eq.7)then            ! Bell--ignore
          elseif(i.eq.8)then            ! Backspace
            icol=max(icol-1,1)
            OSFlag=.true.
          elseif(i.eq.9)then            ! Tab
            icol=(icol-1)/8*8+8+1
          elseif(i.eq.27)then           ! Escape sequences
            number=0
            number1=0
            call ReadChar(irec,c,i,last,*99)
            if(c.eq.'[')then
              call ReadChar(irec,c,i,last,*99)
              dowhile(c.ge.'0'.and.c.le.'9'.or.c.eq.';'.or.c.eq.'?')
                if(c.eq.';')then
                  number1=number
                  number=0
                elseif(c.ge.'0'.and.c.le.'9')then
                  number=number*10+i-ichar('0')
                endif
                call ReadChar(irec,c,i,last,*99)
              enddo
              if(c.eq.'m')then          ! Start/End Underline
                if(number.eq.0)then
                  ULFlag=.false.
                else
                  ULFLAG=.true.
                endif
              elseif(c.eq.'K')then      ! Beginning of line?
                call WriteLine(Out,Out2,FilNam,icol,OSFlag,ULFlag)
              elseif(c.eq.'H')then      ! line=number1, column=number
                call WriteLine(Out,Out2,FilNam,icol,OSFlag,ULFlag)
                icol=number
              else
                call WriteLine(Out,Out2,FilNam,icol,OSFlag,ULFlag)
                !print*,'           Unknown escape sequence'
              endif
            else
              call WriteLine(Out,Out2,FilNam,icol,OSFlag,ULFlag)
              !print*,'           Unknown escape sequence'
            endif
          else
            call WriteLine(Out,Out2,FilNam,icol,OSFlag,ULFlag)
            !print*,'           Unknown escape sequence'
          endif

        enddo

99      if(Out.ne.' '.or.Out2.ne.' ')
     &   call WriteLine(Out,Out2,FilNam,icol,OSFlag,ULFlag)
        end
c-----------------------------------------------------------------------
        function LenA(a)                        ! Length of string, .ge. 1
        character*(*) a
        n=len(a)
        dowhile(n.gt.1.and.a(n:n).eq.' ')
          n=n-1
        enddo
        LenA=n
        end
c---------------------------------------------------------------------------
        subroutine Init(icol,Out,Out2,OSFlag,ULFlag)   ! Initialize line
        character Out*255,Out2*255
        logical OSFlag,ULFlag
        icol=1
        Out=' '
        Out2=' '
        OSFlag=.false.
        ULFlag=.false.
        end
c---------------------------------------------------------------------------
        subroutine ReadChar(irec,c,i,last,*)
        character*1 c
        data LastOld/-1/
        read(1,rec=irec,end=99,err=99,iostat=ios)c
        if(ios.ne.0)goto 99
        i=ichar(c)
        i=iand(127,i)                           ! Make positive, drop parity bit.
        !if(i.ge.32.and.i.lt.127)then           !debug output
        !  write(2,*)'                          ',i,' ',c
        !else
        !  write(2,*)'                          ',i
        !endif
        c=char(i)
        irec=irec+1
        last=LastOld
        LastOld=i
        return
99      return 1
        end
c---------------------------------------------------------------------------
        subroutine WriteLine(Out,Out2,FilNam,icol,OSFlag,ULFlag) ! Write Line
        character Out*255,Out2*255,FilNam*80
        logical OSFlag,ULFlag
        if(FilNam.eq.' ')then
          print*,Out(1:LenA(Out))
          if(Out2.ne.' ')print*,Out2(1:LenA(Out2))
        else
          write(2,'(a)')Out(1:LenA(Out))
          if(Out2.ne.' ')write(2,'(a)')Out2(1:LenA(Out2))
        endif
        call Init(icol,Out,Out2,OSFlag,ULFlag)
        end
----------------------------CUT HERE-----------------------------
-------------------------------------------------------------------------
Mitchell R Grunes, grunes@nrlvax.nrl.navy.mil.  Opinions are mine alone.



