c EXAMPLE OF OUTPUT (looks better if you choose IBM PC line graphics): c /--------- | 1 c | | 2 c |/-------- | 3 c |+-------- My Title | 4 c |\-------- | 5 c | | 6 c |/-------- | 7 c |+-------- doc.html
| 8 c |\-------- | 9 c | | 10 c \--------- | 11 c Diagrams HTML language constructs, c and puts a * next to internal links. c It places = next to lines with only comments. c Designed by mitch grunes, in his own time. c Program by Mitchell R Grunes. c Revision date: 5/15/2017. c If you find it useful, or find a problem, please send me e-mail. c This program was written in FORTRAN, for historic reasons. c (For this reason, people who mostly program in C will probably be c unwilling to use this program, even as a utility.) c WARNING: The "/*" sequences will confuse compilers like SGI Fortran c that use a C pre-processor by default on Fortran programs, so you c must use a compiler switch like "-nocpp" to turn that off. c It can be confused if an INCLUDE block contains a structure that c begins inside and ends outside (or vice-versa). c It also does not diagram IF, FOR, ELSE, WHILE, etc., unless you use c { and } to enclose the conditionally executed statement-- c e.g. it will not draw any lines next to c if(condition) c for (i=0; i<10; i++) c a[i]=2; c else c b=3; c I hope this works for you, but bear in mind that nothing short of c a full-fledged language parser could really do the job. Perhaps c worth about what you paid for it. (-: c There are procedures to run this from a command line, and there are c versions for Fortran (card and free formats),IDL, PV-WAVE, GDL, FL, c C, C++, and HTML. c See http://mgrunes.com/diagram/index.html for more info. c----------------------------------------------------------------------- function LenA(a) ! Length of string, at least 1 c Program by Mitchell R Grunes. c Revision date: 5/15/2017. character*(*) a n=len(a) dowhile(n.gt.1.and.a(n:n).eq.' ') n=n-1 enddo LenA=n end c----------------------------------------------------------------------- function iRd(a,iDefault) ! Read prompted integer from stdin. ! if user enters "/", pick iDefault. ! Echo result to standard output. c Program by Mitchell R Grunes. c Revision date: 5/15/2017. character*(*) a print*,a(1:lenA(a))//':' i=iDefault read*,i print*,i iRd=i end c----------------------------------------------------------------------- character*5000 function aRd(a) ! Read prompted string from stdin. ! Echo result to standard output. ! Used for filenames. c Program by Mitchell R Grunes. c Revision date: 5/15/2017. character*(*) a character*5000 b print*,a(1:len(a))//':' b=' ' read(*,'(100(100a1))')(b(i:i),i=1,5000) print*,b(1:lenA(b)) aRd=b end c----------------------------------------------------------------------- subroutine Warn(Message,form,fout,a) ! Issue a warning c Program by Mitchell R Grunes. c Revision date: 5/15/2017. character*(*) Message character*(*) form logical fout character*5000 a if(fout)write(2,*)'***WARNING ',Message,': Line ',form print*, '***WARNING ',Message,': Line ',form if(fout)print*,a(1:LenA(a)) print*,char(7) end c----------------------------------------------------------------------- subroutine Errr(Message,form,fout,a) ! Issue an error c Program by Mitchell R Grunes. c Revision date: 5/15/2017. character*(*) Message character*(*) form logical fout character*5000 a if(fout)write(2,*)'***ERROR ',Message,': Line ',form print*, '***ERROR ',Message,': Line ',form if(fout)print*,a(1:LenA(a)) print*,char(7) end c----------------------------------------------------------------------- logical function find(a,b,icond) ! find b in a, subject to ! conditions: ! icond=sum of the following: ! 1: Must be first character ! 2: Must be first non-blank ! 32: Next character not alphanumeric ! 64: Next character not alphabetic ! 512 Prior character, if present, ! must be blank or ) or } ! or { or ; C Caution: This program varies from one main program to the next. c Program by Mitchell R Grunes. c Revision date: 5/15/96. character*(*) a,b character*1 c,cNext common icol logical result ii=len(a) jj=len(b) result=.false. loopend=ii-jj+1 if(iand(icond,1).ne.0)loopend=min(loopend,1) do i=1,loopend if(a(i:i+jj-1).eq.b)then icol1=i ! icol1=column of item found icol =i+jj ! icol =column after item ! found c=' ' cNext=' ' if(icol1.gt.1)c=a(icol1-1:icol1-1) if(icol .le.ii)cNext=a(icol:icol) result=.true. if(result.and.iand(icond,2).ne.0.and.icol1.gt.1)then result=a(1:icol1-1).eq.' ' endif if(result.and.iand(icond,32).ne.0) & result=(cNext.lt.'0'.or.cNext.gt.'9').and. & (cNext.lt.'a'.or.cNext.gt.'z') if(result.and.iand(icond,64).ne.0) & result=(cNext.lt.'a'.or.cNext.gt.'z') if(result.and.iand(icond,512).ne.0)result=c.eq.' ' & .or.c.eq.';'.or.c.eq.')'.or.c.eq.'{'.or.c.eq.'}' find=result if(result)return endif enddo find=result end c----------------------------------------------------------------------- ! Advance to '>' after current ! '<' field. subroutine AdvanceGT(a,i,iErr,form,fout) ! If iErr.ne.0, give error if > ! is not found c Program by Mitchell R Grunes. c Revision date: 11/22/96. character*(*) a character*5 form logical fout iSave=i n=lena(a) do while(a(i:i).eq.'<'.or.a(i:i).eq.' ') i=i+1 ! Move past initial < enddo dowhile(a(i:i).ne.'>'.and.i.lt.n) if(a(i:i).eq.'<')then call Errr('Found < before > - missing >??',form,fout,a) print*,'Point before advancing past < field:', & a(iSave:lena(a)) print*,'Spurious < at:', & a(i:lena(a)) return endif i=i+1 enddo if(a(i:i).ne.'>'.and.iErr.ne.0) & call Errr('Missing >',form,fout,a) return end c----------------------------------------------------------------------- Function iRdLin(iUnit,fOut,MaxL,a,nLine,form)! Read line from input file... ! Function returns Returns non-zero ! at end of file. ! Handle form feeds, expand tabs, ! and drop non-ascii characters. ! --- Inputs -- integer iUnit ! File unit # logical fOut ! .true. if outputing to a file. integer MaxL ! Length over which should issue warning. ! --- Outputs -- character*5000 a ! The output line. character*5 form ! Output formatted line #. ! --- Input and Output --- integer nLine ! Line number -- incremented c Program by Mitchell R Grunes. c Revision date: 5/15/2017. character*5000 b a=' ' read(iUnit,'(100(100a1))',end=99)(a(i:i),i=1,5000) nLine=nLine+1 b=' ' ! Format line # write(b,'(i5)')nLine form=b if(a(1:1).eq.char(12))then if(fout)write(2,'(a1,:)')char(12) if(.not.fout)print*,'------------FORM FEED------------' a=a(2:5000) endif b=' ' ! Expand tabs to spaces, ! Drop non-ascii characters. i2Long=0 ! not yet marked too long iLong=0 ! not yet marked long j=1 ! Output Column # do i=1,LenA(a) if(a(i:i).eq.char(9))then ! char(9) is tab j=(j-1)/8*8+8+1 ! Ascii printable characters ! are between ' ' and char(128) elseif(a(i:i).ge.' '.and.a(i:i).lt.char(128))then if(j.le.5000)b(j:j)=a(i:i) j=j+1 if(a(i:i).ne.' '.and.j.ge.5000-10.and.i2Long.eq.0)then call Warn('Line too long to diagram',form,fout,a) i2Long=1 elseif(a(i:i).ne.' '.and.j.gt.MaxL.and.iLong.eq.0)then call Warn('Line over warning length',form,fout,a) iLong=1 endif endif enddo a=b iRdLin=0 return 99 iRdLin=1 end c----------------------------------------------------------------------- program diagramh ! Diagrammer for HTML character*5000 FilNam,FilNam2,aRd FilNam= aRd('HTML source file name') FilNam2=aRd('Output file (blank=screen)') LCol=iRd('Column in which to write line #''s '// & '(67 for 80 col screen, 0 for none)',67) iGraphics=iRd('Use IBM PC graphics characters (0=no)',0) MaxL=iRd('Maximum line length without warning(5000?)',5000) if(MaxL.eq.0)MaxL=5000 call diagram(FilNam,FilNam2,LCol,iGraphics,MaxL) end c----------------------------------------------------------------------- ! Format Output Line subroutine FormLine(b,fout,nColPre,i1,i2,i3,i4, & i1pp,i2pp,i3pp,i4pp,igoto,LCol,form,icomment,icomment2, & icomment3,iGraphics) c Program by Mitchell R Grunes. c Revision date: 11/22/2017. implicit none ! --- Inputs (some may actually be modified) -- character*5000 b ! Source code Line being output logical fout ! Outputing to file (unit 2)? integer nColPre ! # of cols used to diagram preprocessor directives; 0=none. ! 12 for diagramc; 0 for diagramf, diagramh, diagrami. integer i1 ! # of nest levels before current line integer i2 ! # of nest levels on current line integer i3 ! # of nest levels after current line integer i4 ! Non 0 if start or end of block integer i1pp,i2pp,i3pp,i4pp ! Similar to above for preprocessor integer igoto ! non 0 if there is a goto in line integer LCol ! Column in which to write line #'s; 0=none character*5 form ! Formatted line # integer icomment ! Non 0 if inside comment. integer icomment2 ! Is there anything outside comment? integer icomment3 ! Did a comment occur? ! --- Input and Output --- integer iGraphics ! Non-0 to use IBM PC graphics characters ! --- Internal --- integer iBlock ! Index into Block begin array (1=single line, 2=double) integer nColLin ! # of cols available to diagram, ! including preprocessor stuff=12. external LenA integer LenA ! Symbols which will mark block actions: character*1 BlockBegin (2) /'/','/'/ ! Start of block character*1 BlockEnd (2) /'\','\'/ ! End of block character*1 BlockElse (2) /'+','+'/ ! Else construct character*1 BlockContinue (2) /'|','|'/ ! Block continues w/o change character*1 BlockHoriz (2) /'-','-'/ ! Horizontal to start of line ! Same as above, but allows horizontal line to continue through: character*1 BlockBeginH (2) /'/','/'/ ! Start of block character*1 BlockEndH (2) /'\','\'/ ! End of block character*1 BlockElseH (2) /'+','+'/ ! Else construct character*5000 a ! formatted output line integer n,i,j,LastUse character*1 c if(iGraphics.ne.0)then iGraphics=1 BlockBegin (1)=char(218) ! (1)=normal BlockEnd (1)=char(192) BlockElse (1)=char(195) BlockContinue(1)=char(179) BlockHoriz (1)=char(196) BlockBeginH (1)=char(194) BlockEndH (1)=char(193) BlockElseH (1)=char(197) BlockBegin (2)=char(214) ! (2)=DO/FOR loops (doubled) BlockEnd (2)=char(211) ! (not yet used) BlockElse (2)=char(199) BlockContinue(2)=char(186) BlockHoriz (2)=char(196) BlockBeginH (2)=char(209) BlockEndH (2)=char(208) BlockElseH (2)=char(215) endif iBlock=1 ! Not using doubled lines for now nColLin=12 ! Output Columns Usage ! -------------- ------------------------------ ! 1 '='=Comment, '*'=jump ! 2 to 1+nColPre Diagrams preprocessor directives ! 2+nColPre to 1+nColLin Diagrams everything else; ! blank lines at start of code also used. ! 2+nColLin to 5000 The Code ! Also continued horizontal lines from ! above ! 1+nColLin+LCol:+nColLin+LCol If, blank, | and line # a=' ' if(i1.lt.0.or.i2.lt.0.or.i3.lt.0.or.i4.lt.0)then call Errr('Invalid diagramming index',form,fout,b) i1=max(i1,0) i2=max(i2,0) i3=max(i3,0) i4=max(i4,0) endif i2=max(i1,i3) ! Revise i2 i4=max(i4,iabs(i3-i1)) ! Fix if i3.gt.i1 a=' ' a(2+nColLin:5000)=b if(1+nColLin+LenA(b).gt.5000) & call Errr('Too many columns to diagram',form,fout,b) if(igoto.ne.0)a(1:1)='*' ! Place * next to jumps if(icomment.ne.0)icomment3=1 if(icomment2.ne.1.and.icomment3.ne.0.)a(1:1)='=' ! Place = next to line with only comments LastUse=2 ! Last usable diagram col - includes blank space at start of code dowhile(LastUse.lt.5000.and.a(LastUse:LastUse).eq.' ') LastUse=LastUse+1 enddo LastUse=LastUse-2 ! But leave one blank space before. if(max(i2,i3).gt.0)then ! Draw one vertical line per nest level do i=1,max(i2,i3) j=i + 1+nColPre if(j.le.LastUse) a(j:j)=BlockContinue(iBlock) enddo if(i4.ne.0)then ! Draw horizontal lines inward from above do i=j+1,LastUse a(i:i)=BlockHoriz(iBlock) enddo endif endif do i=1,i4 ! May need to replace some ! vertical lines with c= BlockElse(iBlock) ! else symbol if(i1.lt.i3)c=BlockBegin(iBlock) ! or begin symbol if(i1.gt.i3)c=BlockEnd (iBlock) ! or end symbol j=max(2+nColPre,i2+1-i+1) if(j.le.LastUse)then a(j:j)=c if(a(j+1:j+1).eq.BlockElse (iBlock)) ! Continue horizontal lines & a(j+1:j+1) = BlockElseH (iBlock) if(a(j+1:j+1).eq.BlockBegin (iBlock)) & a(j+1:j+1) = BlockBeginH(iBlock) if(a(j+1:j+1).eq.BlockEnd (iBlock)) & a(j+1:j+1) = BlockEndH (iBlock) endif enddo if(nColPre.gt.0)then ! Similar for preprocessor if(i1pp.lt.0.or.i2pp.lt.0.or.i3pp.lt.0.or.i4pp.lt.0)then call Errr('Invalid diagramming index',form,fout,b) i1pp=max(i1pp,0) i2pp=max(i2pp,0) i3pp=max(i3pp,0) i4pp=max(i4pp,0) endif i2pp=max(i1pp,i3pp) i4pp=max(i4pp,iabs(i3pp-i1pp)) LastUse=1+nColPre if(max(i2pp,i3pp).gt.0)then do i=1,max(i2pp,i3pp) j=i + 1+nColPre if(j.le.LastUse) a(j:j)=BlockContinue(iBlock) enddo if(i4pp.ne.0)then do i=j+1,LastUse a(i:i)=BlockHoriz(iBlock) enddo endif endif do i=1,i4pp c= BlockElse(iBlock) if(i1pp.lt.i3pp)c=BlockBegin(iBlock) if(i1pp.gt.i3pp)c=BlockEnd (iBlock) j=max(2+nColPre,i2pp+1-i+1) if(j.le.LastUse)then a(j:j)=c if(a(j+1:j+1).eq.BlockElse (iBlock)) & a(j+1:j+1) = BlockElseH (iBlock) if(a(j+1:j+1).eq.BlockBegin (iBlock)) & a(j+1:j+1) = BlockBeginH(iBlock) if(a(j+1:j+1).eq.BlockEnd (iBlock)) & a(j+1:j+1) = BlockEndH (iBlock) endif enddo endif if(LCol.gt.0.and.a(1+nColLin+LCol:5000).eq.' ')then ! Include line # if(form(1:1).eq.' ')form(1:1)=BlockContinue(iBlock) a(1+nColLin+LCol:5000)=form endif n=LenA(a) ! Output diagrammed line if(.not.fout)write(*,'(1x,100(100a1))')(a(i:i),i=1,n) if(fout) write(2,'(100(100a1))')(a(i:i),i=1,n) if(.not.fout)write(*,'(100(100a1))')(a(i:i),i=1,n) i1=i3 i1pp=i3pp return end c----------------------------------------------------------------------- subroutine diagram(FilNam,FilNam2,LCol, & iGraphics,MaxL) c Program by Mitchell R Grunes. character*5000 FilNam,FilNam2 character*5000 a,b,bsave character*5 form character*8 fm character*1 c character*1 inhl logical fout logical find c Type of block character*16 BlockType(0:1000) open(1,file=FilNam,status='old') fout=FilNam2.gt.' ' if(fout)open(2,file=FilNam2,status='unknown') ! ASCII 12 is a form feed if(fout)write(2,*)char(12), & '=============--',FilNam(1:LenA(FilNam)),'--=============' if(fout) write(2,'(11x,a50,a30,/)') ! Write column header & '....,....1....,....2....,....3....,....4....,....5', & '....,....6....,....7....,....8' if(.not.fout)write(*,'(11x,a50,a30,/)') & '....,....1....,....2....,....3....,....4....,....5', & '....,....6....,....7....,....8' i3=0 ! # nest levels after ! current line ltgt=0 ! < > nesting InHtml=0 ! 0 Not in block ! 1 In block ! 2 block has already occurred inhead=0 ! same for intitle=0 ! same for inscript=0 ! same for <script> inbody=0 ! same for <body> infont=0 ! 0 Not in <html> block ! 1 In <html> block inhl='0' ! same for <h1>,<h2...> - but has value of size level ina=0 ! same for <a ...> inname=0 ! But treat <a name=...> separately, ! so can nest other <a without error. inb=0 ! same for <b> inu=0 ! same for <u> intable=0 ! same for <table> inth=0 ! same for <th> intr=0 ! same for <tr> intd=0 ! same for <td> inp=0 ! same for <p> nLine=0 icomment=0 ! not inside comment ispan=0 ! number of nest levels for <span> iunit=1 10 if(iRdLin(iUnit,fOut,MaxL,a,nLine,form).ne.0)goto 99 ! Read line from input file... b=a bsave=b b=' ' i1=i3 ! # nest levels before ! current line i4=0 ! not 0 to flag start or end ! of block iquote=0 ! no ' yet idquote=0 ! no " yet icomment2=0 ! anything outside comment? icomment3=icomment ! no comment occurred? i=1 j=1 dowhile(i.le.5000-10) ! handle upper case c=a(i:i) if(c.ge.'A'.and.c.le.'Z')c=char(ichar(c)+32) if(c.eq.''''.and.idquote.ne.1.and.icomment.ne.1 & .and.ltgt.ne.0)then iquote=1-iquote if(i.gt.1)then ! char(92) is \ if(iquote.ne.1.and.a(i-1:i-1).eq.char(92)) & iquote=1-iquote endif endif if(c.eq.'"' .and.iquote .ne.1.and.icomment.ne.1 & .and.lgt.ne.0)then idquote=1-idquote if(i.gt.1)then if(idquote.ne.1.and.a(i-1:i-1).eq.char(92)) & idquote=1-idquote endif endif if(c.eq.'<'.and.i.lt.5000-1.and.iquote.ne.1.and.idquote.ne.1) ! <!- ? & then if(a(i+1:i+1).eq.'!'.and.a(i+2:i+2).eq.'-')then if(icomment.ne.0) & call Warn('nested comment',form,fout,a) icomment=1 icomment3=1 c=' ' i=i+2 endif endif if(c.eq.'-'.and.i.lt.5000.and.iquote.ne.1.and.idquote.ne.1) ! -> ? & then if(a(i+1:i+1).eq.'>')then if(icomment.ne.1) & call Warn('=> without <!',form,fout,a) icomment=0 c=' ' i=i+2 endif endif if(icomment.ne.0)c=' ' if(c.ne.' ')icomment2=1 if(c.eq.'<')then if(ltgt.ne.0) & call Errr('nested <',form,fout,a) ltgt=1 elseif(c.eq.'>')then if(ltgt.ne.1)then call Errr('> without <',form,fout,a) ltgt=max(ltgt,0) endif ltgt=0 endif if(j.le.5000) b(j:j)=c if(j.gt.1)then ! (kill multiple spaces) if(c.eq.' '.and.b(j-1:j-1).eq.' ')j=j-1 endif j=j+1 i=i+1 enddo if(iQuote.ne.0.or.idquote.ne.0) & call Errr('unclosed quote',form,fout,a) n=min(LenA(b),5000-10) !DO I=1,n) ! Not used so can advance i i=1 dowhile (i.le.n) if(find(b(i:5000),'<html>',1).or. & find(b(i:5000),'<html/',1).or. & find(b(i:5000),'<html ',1))then if(InHtml.eq.1)then call Errr('nested <html>',form,fout,a) else i3=i3+1 i4=1 BlockType(i3)='<html>' endif if(InHtml.eq.2) & call Errr('<html> has already occurred',form,fout,a) InHtml=1 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'</html>',1).or. & find(b(i:5000),'</html/',1).or. & find(b(i:5000),'</html ',1))then if(InHtml.ne.1)then call Errr('</html> without <html>',form,fout,a) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<html>') call Warn('unclosed '//BlockType(i3+1),form,fout,a) i3=i3-1 enddo endif InHtml=2 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'<head>',1).or. & find(b(i:5000),'<head/',1).or. & find(b(i:5000),'<head ',1))then if(InHtml.ne.1) & call Errr('<head> not inside <html>',form,fout,a) if(inhead.eq.1)then call Errr('nested <head>',form,fout,a) else i3=i3+1 i4=1 BlockType(i3)='<head>' endif if(inhead.eq.2) & call Errr('<head has already occurred',form,fout,a) inhead=1 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'</head>',1).or. & find(b(i:5000),'</head/',1).or. & find(b(i:5000),'</head ',1))then if(inhead.ne.1)then call Errr('</head> without <head>',form,fout,a) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<head>') call Warn('unclosed '//BlockType(i3+1),form,fout,a) i3=i3-1 enddo endif inhead=2 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'<title>',1).or. & find(b(i:5000),'<title/',1).or. & find(b(i:5000),'<title ',1))then if(inhead.ne.1) & call Errr('<title> not inside <head>',form,fout,a) if(intitle.eq.1)then call Errr('nested <title>',form,fout,a) else i3=i3+1 i4=1 BlockType(i3)='<title>' endif if(intitle.eq.2) & call Errr('<title> has already occurred',form,fout,a) intitle=1 call AdvanceGT(b,i,0,form,fout) elseif(find(b(i:5000),'',1).or. & find(b(i:5000),' without ',form,fout,a) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<title>') call Warn('unclosed '//BlockType(i3+1),form,fout,a) i3=i3-1 enddo endif intitle=2 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'<body>',1).or. & find(b(i:5000),'<body/',1).or. & find(b(i:5000),'<body ',1))then if(InHtml.ne.1) & call Errr('<body> not inside <html>',form,fout,a) if(inhead.eq.1) & call Errr('<body> inside <head>',form,fout,a) if(inhead.ne.2) & call Errr('<body> before <head>',form,fout,a) if(inbody.eq.1)then call Errr('nested <body>',form,fout,a) else i3=i3+1 i4=1 BlockType(i3)='<body>' endif if(inbody.eq.2) & call Errr('<body> has already occurred',form,fout,a) inbody=1 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'</body>',1).or. & find(b(i:5000),'</body/',1).or. & find(b(i:5000),'</body ',1))then if(inbody.ne.1)then call Errr('</body> without <body>',form,fout,a) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<body>') call Warn('unclosed '//BlockType(i3+1),form,fout,a) i3=i3-1 enddo endif inbody=2 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'<font ',1))then if(inbody.ne.1) & call Errr('<font> not inside <body>',form,fout,a) if(infont.ne.0)then call Errr('nested <font>',form,fout,a) else i3=i3+1 i4=1 BlockType(i3)='<font>' endif infont=1 call AdvanceGT(b,i,0,form,fout) elseif(find(b(i:5000),'</font>',1).or. & find(b(i:5000),'</font/',1).or. & find(b(i:5000),'</font ',1))then if(infont.ne.1)then call Errr('</font> without <font>',form,fout,a) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<font>') call Warn('unclosed '//BlockType(i3+1),form,fout,a) i3=i3-1 enddo endif infont=0 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'<span>',1).or. & find(b(i:5000),'<span ',1))then if(inbody.ne.1) & call Errr('<span> not inside <body>',form,fout,a) i3=i3+1 i4=1 BlockType(i3)='<span>' iSpan=iSpan+1 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'</span>',1).or. & find(b(i:5000),'</span/',1).or. & find(b(i:5000),'</span ',1))then if(iSpan.lt.1)then call Errr('</span> without <span>',form,fout,a) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<span>') call Warn('unclosed '//BlockType(i3+1),form,fout,a) i3=i3-1 enddo endif elseif(b(i:i+2).ge.'<h1'.and.b(i:i+2).le.'<h9')then if(inbody.ne.1) & call Errr(b(i:i+4)//' not inside <body>',form,fout,a) if(inhl.ne.'0')then call Errr('nested <h#>',form,fout,a) else i3=i3+1 i4=1 BlockType(i3)='<h#>' endif inhl=b(i+2:i+2) call AdvanceGT(b,i,1,form,fout) elseif(b(i:i+3).ge.'</h1'.and.b(i:i+3).le.'</h9')then if(b(i+3:i+3).ne.inhl)then print*,'***Incorrect <h#> level LINE ',form if(fout)write(2,*) & '***Incorrect <h#> level LINE ',form if(fout)print*,a endif if(inhl.eq.'0')then call Errr('</h#> without <h#>',form,fout,a) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<h#>') call Warn('unclosed '//BlockType(i3+1),form,fout,a) i3=i3-1 enddo endif inhl='0' call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'<http',1))then call Errr('<http> not valid',form,fout,a) elseif(find(b(i:5000),'http://http',1))then call Errr('http://http not valid',form,fout,a) elseif(find(b(i:5000),'<a http',1))then call Errr('<a http should be <a href=http',form,fout,a) elseif(find(b(i:5000),'<a href=>',1))then call Errr('<a href=> not valid',form,fout,a) i3=i3+1 i4=1 BlockType(i3)='<a>' ina=1 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'<a name=',1))then if(inbody.ne.1) & call Errr('<a> not inside <body>',form,fout,a) if(inname.ne.0)then call Errr('nested <a name=...>',form,fout,a) else i3=i3+1 i4=1 BlockType(i3)='<a name>' endif inname=1 call AdvanceGT(b,i,1,form,fout) if(find(b(i+1:5000),'</a',2)) & call Errr('</a> immediately after <a name=...>', & form,fout,a) elseif(find(b(i:5000),'<a ',1))then if(inbody.ne.1) & call Errr('<a> not inside <body>',form,fout,a) if(ina.ne.0)then call Errr('nested <a>',form,fout,a) else i3=i3+1 i4=1 BlockType(i3)='<a>' endif ina=1 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'</a>',1).or. & find(b(i:5000),'</a/',1).or. & find(b(i:5000),'</a ',1))then if(ina.eq.0.and.inname.eq.0)then call Errr('</a> without <a>',form,fout,a) else i3=i3-1 i4=1 dowhile(i3.gt.0.and. & BlockType(i3+1).ne.'<a>'.and. & BlockType(i3+1).ne.'<a name>') call Warn('unclosed '//BlockType(i3+1),form,fout,a) i3=i3-1 enddo endif if(BlockType(i3+1).eq.'<a>')then ina=0 elseif(BlockType(i3+1).eq.'<a name>')then inname=0 else call Errr('</a> closes '//BlockType(i3+1),form,fout,a) endif call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'<b>', 1).or. & find(b(i:5000),'<b/', 1).or. & find(b(i:5000),'<b ', 1))then if(inbody.ne.1)then call Errr('<b> not inside <body>',form,fout,a) endif if(inb.ne.0)then call Errr('nested <b>',form,fout,a) else i3=i3+1 i4=1 BlockType(i3)='<b>' endif inb=1 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'</b>',1).or. & find(b(i:5000),'</b/',1).or. & find(b(i:5000),'</b ',1))then if(inb.ne.1)then call Errr('</b> without <b>',form,fout,a) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<b>') call Warn('unclosed '//BlockType(i3+1),form,fout,a) i3=i3-1 enddo endif inb=0 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'<u>',1).or. & find(b(i:5000),'<u/',1).or. & find(b(i:5000),'<u ',1))then if(inbody.ne.1) & call Errr('<u> not inside <body>',form,fout,a) if(inu.ne.0)then call Errr('nested <u>',form,fout,a) else i3=i3+1 i4=1 BlockType(i3)='<u>' endif inu=1 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'</u>',1).or. & find(b(i:5000),'</u/',1).or. & find(b(i:5000),'</u ',1))then if(inu.ne.1)then call Errr('</u> without <u>',form,fout,a) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<u>') call Warn('unclosed '//BlockType(i3+1),form,fout,a) i3=i3-1 enddo endif inu=0 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'<table>',1).or. & find(b(i:5000),'<table/',1).or. & find(b(i:5000),'<table ',1))then if(inbody.ne.1) & call Errr('<table> not inside <body>',form,fout,a) if(intr.ne.0.or.inth.ne.0) & call Errr('<table> is inside <tr> or <th>',form,fout,a) if(intable.ne.0)then call Errr('nested <table>',form,fout,a) else i3=i3+1 i4=1 BlockType(i3)='<table>' endif intable=1 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'</table>',1).or. & find(b(i:5000),'</table/',1).or. & find(b(i:5000),'</table ',1))then if(intr.ne.0.or.inth.ne.0) & call Errr('</table> inside <tr>',form,fout,a) if(intable.ne.1)then call Errr('</table> without <table>',form,fout,a) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<table>') call Warn('unclosed '//BlockType(i3+1),form,fout,a) i3=i3-1 enddo endif intable=0 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'<th>',1).or. & find(b(i:5000),'<th/',1).or. & find(b(i:5000),'<th ',1))then if(intable.ne.1) & call Errr('<th> not inside <table>',form,fout,a) if(intr.ne.1) & call Errr('<th> not inside <tr>',form,fout,a) if(inth.ne.0)then call Errr('nested <th>',form,fout,a) else i3=i3+1 i4=1 BlockType(i3)='<th>' endif inth=1 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'</th>',1).or. & find(b(i:5000),'</th/',1).or. & find(b(i:5000),'</th ',1))then if(intr.ne.1) & call Errr('</th> not inside <tr>',form,fout,a) if(inth.ne.1)then call Errr('</th> without <th>',form,fout,a) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<th>') call Warn('unclosed '//BlockType(i3+1),form,fout,a) i3=i3-1 enddo endif inth=0 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'<tr>',1).or. & find(b(i:5000),'<tr/',1).or. & find(b(i:5000),'<tr ',1))then if(intable.ne.1) & call Errr('<tr> not inside <table>',form,fout,a) if(inth.ne.0) & call Errr('<tr> inside <th>',form,fout,a) if(intr.ne.0)then call Errr('nested <tr>',form,fout,a) else i3=i3+1 i4=1 BlockType(i3)='<tr>' endif intr=1 call AdvanceGT(b,i,1,form,fout) ii=i+1 ! Nothing can be between <tr> and (<td> or </tr>) if(ii.lt.5000)then dowhile(b(ii:ii).eq.' '.and.ii.lt.5000-10) ii=ii+1 enddo if(b(ii:ii+2).ne.'<td'.and.b(ii:ii+3).ne.'</tr)' & .and.b(ii:5000).ne.' ')then call Errr('Something is between <tr> and <td>', & form,fout,a) print*,'Error occured at position ',b(ii:LenA(b)) endif endif elseif(find(b(i:5000),'</tr>',1).or. & find(b(i:5000),'</tr/',1).or. & find(b(i:5000),'</tr ',1))then if(inth.ne.0) & call Errr('</tr> inside <th>',form,fout,a) if(intr.ne.1)then call Errr('</tr> without <tr>',form,fout,a) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<tr>') call Warn('unclosed '//BlockType(i3+1),form,fout,a) i3=i3-1 enddo endif intr=0 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'<td>',1).or. & find(b(i:5000),'<td/',1).or. & find(b(i:5000),'<td ',1))then if(intr.ne.1) & call Errr('<td> not inside <tr>',form,fout,a) if(inth.ne.0) & call Errr('<td> inside <th>',form,fout,a) if(intd.ne.0)then call Errr('nested <td>',form,fout,a) else i3=i3+1 i4=1 BlockType(i3)='<td>' endif intd=1 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'</td>',1).or. & find(b(i:5000),'</td/',1).or. & find(b(i:5000),'</td ',1))then if(inth.ne.0) & call Errr('</td> inside <th>',form,fout,a) if(intd.ne.1)then call Errr('</td> without <td>',form,fout,a) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<td>') call Warn('unclosed '//BlockType(i3+1),form,fout,a) i3=i3-1 enddo endif intd=0 call AdvanceGT(b,i,1,form,fout) ii=i+1 ! Nothing can be between </td> and (<td> or </tr>) if(ii.lt.5000)then dowhile(b(ii:ii).eq.' '.and.ii.lt.5000-10) ii=ii+1 enddo if(b(ii:ii+2).ne.'<td'.and.b(ii:ii+3).ne.'</tr' & .and.b(ii:5000).ne.' ')then call Errr('Something is between </td> and <td>', & form,fout,a) print*,'Error occured at position ',b(ii:LenA(b)) endif endif elseif(find(b(i:5000),'<p>',1).or. & find(b(i:5000),'<p/',1).or. & find(b(i:5000),'<p ',1))then if(inbody.ne.1) & call Errr('<p> not inside <body>',form,fout,a) if(inp.ne.0)then call Warn('prior <p> not closed',form,fout,a) else i3=i3+1 endif i4=1 BlockType(i3)='<p>' inp=1 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'</p>',1).or. & find(b(i:5000),'</p/',1).or. & find(b(i:5000),'</p ',1))then if(inp.ne.1)then call Errr('</p> without <p>',form,fout,a) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<p>') call Warn('unclosed '//BlockType(i3+1),form,fout,a) i3=i3-1 enddo endif inp=0 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'<script>',1).or. & find(b(i:5000),'<script/',1).or. & find(b(i:5000),'<script ',1))then if(inscript.eq.1)then call Errr('nested <script>',form,fout,a) else i3=i3+1 i4=1 BlockType(i3)='<script>' endif inscript=1 call AdvanceGT(b,i,1,form,fout) elseif(find(b(i:5000),'</script>',1).or. & find(b(i:5000),'</script/',1).or. & find(b(i:5000),'</script ',1))then if(inscript.ne.1)then call Errr('</script> without <script>',form,fout,a) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<script>') call Warn('unclosed '//BlockType(i3+1),form,fout,a) i3=i3-1 enddo endif inscript=2 call AdvanceGT(b,i,1,form,fout) c### ADD MORE SEARCH ITEMS HERE endif if(i1 .lt.0.or.i3 .lt.0.or.i4 .lt.0)then call Errr('Invalid diagramming index',form,fout,b) i1=max(i1,0) i3=max(i3,0) i4=max(i4,0) endif I=I+1 ! Because didn't really use DO loop ENDDO igoto=0 ! no goto on line c if(find(b,'go to',64+512).or.find(a,'goto',64+512) c & .or.find(a,'return',32+512) c & .or.find(a,'break',32+512).or.find(a,'continue',32+512) c & .or.find(a,'exit',32+512))igoto=1 c if(find(b,'case',32+512).or. c & find(b,'default ',512).or.find(b,'default:',512))i4=max(1,i4) b=bsave nColPre=0 call FormLine(b,fout,nColPre,i1,i2,i3,i4, & i1pp,i2pp,i3pp,i4pp,igoto,LCol,form,icomment,icomment2, & icomment3,iGraphics) goto 10 99 if(iunit.eq.3)then iunit=1 i1=i1-1 close(3) goto 10 endif if(i3.gt.0) & call Errr('Nest levels left hanging at end',form,fout,a) if(inhead.eq.0) & call Errr('<head> never occurred',form,fout,a) if(intitle.eq.0) & call Errr('<title> never occurred',form,fout,a) if(inbody.eq.0) & call Errr('<body> never occurred',form,fout,a) end