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. It can c place = next to comment blocks. c Designed by mitch grunes, in his own time. c Program by Mitchell R Grunes, (grunes@yahoo.com). c Revision date: 6/19/2015. 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 Versions: To diagram Fortran: diagramf.f c IDL/PV-WAVE: diagrami.f c C: diagramc.f c MS-DOS procedures to call above programs without asking so many questions, c append output to file diagram.out: c Fortran: diagramf.bat (card format) c diagram9.bat (free format) c IDL/PV-WAVE: diagrami.bat c C: diagramc.bat c Similar Unix csh procedures: c Fortran: diagramf.sh (card format) c diagram9.sh (free format) c IDL/PV-WAVE: diagrami.sh c C: diagramc.sh c Similar Vax VMS DCL procedures: c Fortran: diagramf.vax (card format) c diagram9.vax (free format) c IDL/PV-WAVE: diagrami.vax c C: diagramc.vax program diagramh ! Diagrammer for HTML character*80 filnam,filnam2 print*,'HTML source filename?' read(*,'(a80)')filnam print*,filnam print*,'Output file (blank=screen)?' read(*,'(a80)')filnam2 print*,filnam2 print*,'Column in which to write line #''s ', & '(67 for 80 col screen, 0 for none):' LCol=0 read*,LCol print*,LCol print*,'Notate comments with = (0=no, 1=yes; 1?):' inotate=1 read*,inotate print*,inotate print*,'Use IBM PC graphics characters (0=no):' iGraphics=0 read*,iGraphics print*,iGraphics call diagram(filnam,filnam2,LCol,inotate,iGraphics) end c----------------------------------------------------------------------- subroutine diagram(filnam,filnam2,LCol,inotate, & iGraphics) c Program by Mitchell R Grunes, (grunes@yahoo.com). character*80 filnam,filnam2 character*360 a,b,bsave character*5 form character*8 fm character*1 c logical fout logical find external find common icol c Type of block character*16 BlockType(1000) c 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 c Same, 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 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) BlockEnd (2)=char(211) 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 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,a49,/)') ! Write column header & '....,....1....,....2....,....3....,....4....,....5', & '....,....6....,....7....,....8....,....9....,....' if(.not.fout)write(*,'(11x,a50,a49,/)')' ', & '....,....1....,....2....,....3....,....4....,....5', & '....,....6....,....7....,....8....,....9....,....' 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 inspan=0 ! same for <span> inh1=0 ! same for <h1>,<h2...> - but has value of size ina=0 ! same for <a ...> 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 iunit=1 10 a=' ' read(iunit,'(a360)',end=99)a nline=nline+1 fm=' ' write(fm,'(i5)')nline form=fm if(a(1:1).eq.char(12))then if(fout)write(2,'(a1,:)')char(12) if(.not.fout)print*,'------------FORM FEED------------' b=a(2:360) a=b endif b=' ' ! Turn tabs to spaces j=1 do i=1,LenA(a) if(a(i:i).eq.char(9))then j=(j-1)/8*8+8+1 ! Make sure is good ASCII char elseif(a(i:i).ge.' '.and.a(i:i).lt.char(128))then if(j.le.360)b(j:j)=a(i:i) j=j+1 if(a(i:i).ne.' '.and.j.ge.360-10)then print*,'***WARNING---> Line too long to diagram: LINE ', & form if(fout)print*,a if(fout)write(2,*) & '***WARNING---> Line too long to diagram: ',a print*,char(7) endif endif enddo a=b 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.360) ! 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.360-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)then print*,'***WARNING--nested comment LINE',form if(fout)print*,a if(fout)print*,a if(fout)WRITE(2,*) & '***WARNING--nested comment LINE',form print*,char(7) endif icomment=1 icomment3=1 c=' ' i=i+2 endif endif if(c.eq.'-'.and.i.lt.360.and.iquote.ne.1.and.idquote.ne.1) ! -> ? & then if(a(i+1:i+1).eq.'>')then if(icomment.ne.1)then print*,'***WARNING---> without <!- clause LINE',form if(fout)print*,a if(fout)write(2,*) & '***WARNING---> without <!- clause LINE',form print*,char(7) endif 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)then print*,'***ERROR: nested < LINE ',form if(fout)print*,a if(fout)write(2,*)'***ERROR: nested < LINE ',form endif ltgt=1 elseif(c.eq.'>')then if(ltgt.ne.1)then print*,'***ERROR-- > without < LINE ', & form if(fout)print*,a if(fout)write(2,*)'***ERROR-- > without < LINE ',form print*,char(7) ltgt=max(ltgt,0) endif ltgt=0 endif if(j.le.360) 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)then print*,'***ERROR--unclosed quote LINE ',form if(fout)print*,a if(fout)write(2,*)'***ERROR--unclosed quote LINE ',form print*,char(7) endif DO I=1,360 15 if(find(b(i:360),'<html>',1).or. & find(b(i:360),'<html/',1).or. & find(b(i:360),'<html ',1))then if(InHtml.eq.1)then print*,'***ERROR--nested <html> LINE ',form if(fout)print*,a if(fout)write(2,*)'***ERROR--nested <html> LINE ',form print*,char(7) else i3=i3+1 i4=1 BlockType(i3)='<html>' endif if(InHtml.eq.2)then print*,'***ERROR--<html> has already occurred LINE ',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--<html> has already occurred LINE ',form print*,char(7) endif InHtml=1 elseif(find(b(i:360),'</html>',1).or. & find(b(i:360),'</html/',1).or. & find(b(i:360),'</html ',1))then if(InHtml.ne.1)then print*,'***ERROR--</html> without <html> LINE ',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--</html> without <html> LINE ',form print*,char(7) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<html>') print*,'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form if(fout)print*,a if(fout)write(2,*)'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form print*,char(7) i3=i3-1 enddo endif InHtml=2 elseif(find(b(i:360),'<head>',1).or. & find(b(i:360),'<head/',1).or. & find(b(i:360),'<head ',1))then if(InHtml.ne.1)then print*,'***ERROR--<head> not inside <html> LINE ',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--<head> not inside <html> LINE ',form print*,char(7) endif if(inhead.eq.1)then print*,'***ERROR--nested <head> LINE ',form if(fout)print*,a if(fout)write(2,*)'***ERROR--nested <head> LINE ',form print*,char(7) else i3=i3+1 i4=1 BlockType(i3)='<head>' endif if(inhead.eq.2)then print*,'***ERROR--<head> has already occurred LINE ',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--<head> has already occurred LINE ',form print*,char(7) endif inhead=1 elseif(find(b(i:360),'</head>',1).or. & find(b(i:360),'</head/',1).or. & find(b(i:360),'</head ',1))then if(inhead.ne.1)then print*,'***ERROR--</head> without <head> LINE ',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--</head> without <head> LINE ',form print*,char(7) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<head>') print*,'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form if(fout)print*,a if(fout)write(2,*)'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form print*,char(7) i3=i3-1 enddo endif inhead=2 elseif(find(b(i:360),'<title>',1).or. & find(b(i:360),'<title/',1).or. & find(b(i:360),'<title ',1))then if(inhead.ne.1)then print*,'***ERROR--<title> not inside <head> LINE ',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--<title> not inside <head> LINE ',form print*,char(7) endif if(intitle.eq.1)then if(fout)print*,a print*,'***ERROR--nested <title> LINE ',form if(fout)write(2,*)'***ERROR--nested <title> LINE ',form print*,char(7) else i3=i3+1 i4=1 BlockType(i3)='<title>' endif if(intitle.eq.2)then print*,'***ERROR--<title> has already occurred LINE ',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--<title> has already occurred LINE ',form print*,char(7) endif intitle=1 elseif(find(b(i:360),'',1).or. & find(b(i:360),' without LINE ',form if(fout)print*,a if(fout)write(2,*) & '***ERROR-- without LINE ',form print*,char(7) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<title>') print*,'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form if(fout)print*,a if(fout)write(2,*)'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form print*,char(7) i3=i3-1 enddo endif intitle=2 elseif(find(b(i:360),'<body>',1).or. & find(b(i:360),'<body/',1).or. & find(b(i:360),'<body ',1))then if(InHtml.ne.1)then print*,'***ERROR--<body> not inside <html> LINE ',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--<body> not inside <html> LINE ',form print*,char(7) endif if(inhead.eq.0)then print*,'***ERROR--<body> inside <head> LINE ',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--<body> inside <head> LINE ',form print*,char(7) endif if(inhead.eq.0)then print*,'***ERROR--<body> before <head> LINE ',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--<body> before <head> LINE ',form print*,char(7) endif if(inbody.eq.1)then print*,'***ERROR--nested <body> LINE ',form if(fout)print*,a if(fout)write(2,*)'***ERROR--nested <body> LINE ',form print*,char(7) else i3=i3+1 i4=1 BlockType(i3)='<body>' endif if(inbody.eq.2)then print*,'***ERROR--<body> has already occurred LINE ',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--<body> has already occurred LINE ',form print*,char(7) endif inbody=1 elseif(find(b(i:360),'</body>',1).or. & find(b(i:360),'</body/',1).or. & find(b(i:360),'</body ',1))then if(inbody.ne.1)then print*,'***ERROR--</body> without <body> LINE ',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--</body> without <body> LINE ',form print*,char(7) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<body>') print*,'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form if(fout)print*,a if(fout)write(2,*)'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form print*,char(7) i3=i3-1 enddo endif inbody=2 elseif(find(b(i:360),'<font ',1))then if(inbody.ne.1)then print*,'***ERROR--<font> not inside <body> LINE ',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--<font> not inside <body> LINE ',form print*,char(7) endif if(infont.ne.0)then print*,'***ERROR--nested <font> LINE ',form if(fout)print*,a if(fout)write(2,*)'***ERROR--nested <font> LINE ',form print*,char(7) else i3=i3+1 i4=1 BlockType(i3)='<font>' endif infont=1 elseif(find(b(i:360),'</font>',1).or. & find(b(i:360),'</font/',1).or. & find(b(i:360),'</font ',1))then if(infont.ne.1)then print*,'***ERROR--</font> without <font> LINE ',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--</font> without <font> LINE ',form print*,char(7) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<font>') print*,'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form if(fout)print*,a if(fout)write(2,*)'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form print*,char(7) i3=i3-1 enddo endif infont=0 elseif(find(b(i:360),'<span ',1))then if(inbody.ne.1)then if(fout)print*,a print*,'***ERROR--<span> not inside <body> LINE ',form if(fout)write(2,*) & '***ERROR--<span> not inside <body> LINE ',form print*,char(7) endif if(Inspan.ne.0)then print*,'***ERROR--nested <span> LINE ',form if(fout)print*,a if(fout)write(2,*)'***ERROR--nested <span> LINE ',form print*,char(7) else i3=i3+1 i4=1 BlockType(i3)='<span>' endif inspan=1 elseif(find(b(i:360),'</span>',1).or. & find(b(i:360),'</span/',1).or. & find(b(i:360),'</span ',1))then if(inspan.ne.1)then print*,'***ERROR--</span> without <span> LINE ',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--</span> without <span> LINE ',form print*,char(7) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<span>') print*,'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form if(fout)print*,a if(fout)write(2,*)'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form print*,char(7) i3=i3-1 enddo endif inspan=0 elseif(b(i:i+2).ge.'<h1'.and.b(i:i+2).le.'<h9')then if(inbody.ne.1)then print*,'***ERROR--',b(i:i+4),' not inside <body> LINE',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--',b(i:i+4),' not inside <body> LINE ',form print*,char(7) endif if(inh1.ne.0)then print*,'***ERROR--nested <h#> LINE',form if(fout)print*,a if(fout)write(2,*)'***ERROR--nested <h#> LINE ',form print*,char(7) else i3=i3+1 i4=1 BlockType(i3)='<h#>' endif inh1=ichar(b(i+2:i+2)) endif if(b(i:i+4).ge.'</h1'.and.b(i:i+4).le.'</h9')then if(ichar(b(i+3:i+3)).ne.inh1)then print*,'***Incorrect <h#> level***>',form if(fout)print*,a if(fout)write(2,*)'***Incorrect <h#> level LINE ',form endif if(inh1.eq.0)then print*,'***ERROR--</h#> without <h#> LINE',form if(fout)print*,a if(fout)write(2,*)'***ERROR--</h#> without <h#> LINE ',form print*,char(7) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<h#>') print*,'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form if(fout)print*,a if(fout)write(2,*)'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form print*,char(7) i3=i3-1 enddo endif inh1=0 elseif(find(b(i:360),'<a ',1))then if(inbody.ne.1)then print*,'***ERROR--<a> not inside <body> LINE',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--<a> not inside <body> LINE ',form print*,char(7) endif if(ina.ne.0)then print*,'***ERROR--nested <a> LINE',form if(fout)print*,a if(fout)write(2,*)'***ERROR--nested <a> LINE ',form print*,char(7) else i3=i3+1 i4=1 BlockType(i3)='<a>' endif ina=1 elseif(find(b(i:360),'</a>',1).or. & find(b(i:360),'</a/',1).or. & find(b(i:360),'</a ',1))then if(ina.ne.1)then print*,'***ERROR--</a> without <a> LINE ',form if(fout)print*,a if(fout)write(2,*)'***ERROR--</a> without <a> LINE ',form print*,char(7) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<a>') print*,'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form if(fout)print*,a if(fout)write(2,*)'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form print*,char(7) i3=i3-1 enddo endif ina=0 elseif(find(b(i:360),'<b>',1).or. & find(b(i:360),'<b/',1).or. & find(b(i:360),'<b ',1))then if(inbody.ne.1)then print*,'***ERROR--<b> not inside <body> LINE',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--<b> not inside <body> LINE ',form print*,char(7) endif if(inb.ne.0)then print*,'***ERROR--nested <b> LINE',form if(fout)print*,a if(fout)write(2,*)'***ERROR--nested <b> LINE ',form print*,char(7) else i3=i3+1 i4=1 BlockType(i3)='<b>' endif inb=1 elseif(find(b(i:360),'</b>',1).or. & find(b(i:360),'</b/',1).or. & find(b(i:360),'</b ',1))then if(inb.ne.1)then print*,'***ERROR--</b> without <b> LINE',form if(fout)print*,a if(fout)write(2,*)'***ERROR--</b> without <b> LINE ',form print*,char(7) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<b>') print*,'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form if(fout)print*,a if(fout)write(2,*)'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form print*,char(7) i3=i3-1 enddo endif inb=0 elseif(find(b(i:360),'<u>',1).or. & find(b(i:360),'<u/',1).or. & find(b(i:360),'<u ',1))then if(inbody.ne.1)then print*,'***ERROR--<u> not inside <body> LINE',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--<u> not inside <body> LINE ',form print*,char(7) endif if(inu.ne.0)then print*,'***ERROR--nested <u> LINE',form if(fout)print*,a if(fout)write(2,*)'***ERROR--nested <u> LINE ',form print*,char(7) else i3=i3+1 i4=1 BlockType(i3)='<u>' endif inu=1 elseif(find(b(i:360),'</u>',1).or. & find(b(i:360),'</u/',1).or. & find(b(i:360),'</u ',1))then if(inu.ne.1)then print*,'***ERROR--</u> without <u> LINE',form if(fout)print*,a if(fout)write(2,*)'***ERROR--</u> without <u> LINE ',form print*,char(7) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<u>') print*,'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form if(fout)print*,a if(fout)write(2,*)'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form print*,char(7) i3=i3-1 enddo endif inu=0 elseif(find(b(i:360),'<table>',1).or. & find(b(i:360),'<table/',1).or. & find(b(i:360),'<table ',1))then if(inbody.ne.1)then print*,'***ERROR--<table> not inside <body> LINE',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--<table> not inside <body> LINE ',form print*,char(7) endif if(intr.ne.0.or.inth.ne.0)then print*,'***ERROR--<table> is inside <tr> or <th> LINE',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--<table> is inside <tr> or <th> LINE ',form print*,char(7) endif if(intable.ne.0)then print*,'***ERROR--nested <table> LINE',form if(fout)print*,a if(fout)write(2,*)'***ERROR--nested <table> LINE ',form print*,char(7) else i3=i3+1 i4=1 BlockType(i3)='<table>' endif intable=1 elseif(find(b(i:360),'</table>',1).or. & find(b(i:360),'</table/',1).or. & find(b(i:360),'</table ',1))then if(intr.ne.0.or.inth.ne.0)then print*,'***ERROR--</table> is inside <tr> or <th> LINE',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--</table> is inside <tr> or <th> LINE ',form print*,char(7) endif if(intable.ne.1)then print*,'***ERROR--</table> without <table> LINE',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--</table> without <table> LINE ',form print*,char(7) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<table>') print*,'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form if(fout)print*,a if(fout)write(2,*)'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form print*,char(7) i3=i3-1 enddo endif intable=0 elseif(find(b(i:360),'<th>',1).or. & find(b(i:360),'<th/',1).or. & find(b(i:360),'<th ',1))then if(intable.ne.1)then print*,'***ERROR--<th> not inside <table> LINE',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--<th> not inside <table> LINE ',form print*,char(7) endif if(intr.ne.1)then print*,'***ERROR--<th> is not inside <tr> LINE',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--<th> is notinside <tr> LINE ',form print*,char(7) endif if(inth.ne.0)then print*,'***ERROR--nested <th> LINE',form if(fout)print*,a if(fout)write(2,*)'***ERROR--nested <th> LINE ',form print*,char(7) else i3=i3+1 i4=1 BlockType(i3)='<th>' endif inth=1 elseif(find(b(i:360),'</th>',1).or. & find(b(i:360),'</th/',1).or. & find(b(i:360),'</th ',1))then if(intr.ne.1)then print*,'***ERROR--</th> not inside <tr> LINE',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--</th> inside <tr> LINE ',form print*,char(7) endif if(inth.ne.1)then print*,'***ERROR--</th> without <th> LINE',form if(fout)print*,a if(fout)write(2,*)'***ERROR--</th> without <th> LINE ',form print*,char(7) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<th>') print*,'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form if(fout)print*,a if(fout)write(2,*)'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form print*,char(7) i3=i3-1 enddo endif inth=0 elseif(find(b(i:360),'<tr>',1).or. & find(b(i:360),'<tr/',1).or. & find(b(i:360),'<tr ',1))then if(intable.ne.1)then print*,'***ERROR--<tr> not inside <table> LINE',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--<tr> not inside <table> LINE ',form print*,char(7) endif if(inth.ne.0)then print*,'***ERROR--<tr> inside <th> LINE',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--<tr> inside <th> LINE ',form print*,char(7) endif if(intr.ne.0)then print*,'***ERROR--nested <tr> LINE',form if(fout)print*,a if(fout)write(2,*)'***ERROR--nested <tr> LINE ',form print*,char(7) else i3=i3+1 i4=1 BlockType(i3)='<tr>' endif intr=1 elseif(find(b(i:360),'</tr>',1).or. & find(b(i:360),'</tr/',1).or. & find(b(i:360),'</tr ',1))then if(inth.ne.0)then print*,'***ERROR--</tr> inside <th> LINE',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--</tr> inside <th> LINE ',form print*,char(7) endif if(intr.ne.1)then print*,'***ERROR--</tr> without <tr> LINE',form if(fout)print*,a if(fout)write(2,*)'***ERROR--</tr> without <tr> LINE ',form print*,char(7) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<tr>') print*,'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form if(fout)print*,a if(fout)write(2,*)'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form print*,char(7) i3=i3-1 enddo endif intr=0 elseif(find(b(i:360),'<td>',1).or. & find(b(i:360),'<td/',1).or. & find(b(i:360),'<td ',1))then if(intr.ne.1)then print*,'***ERROR--<td> not inside <tr> LINE',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--<td> not inside <tr> LINE ',form print*,char(7) endif if(inth.ne.0)then print*,'***ERROR--<td> inside <th> LINE',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--<td> inside <th> LINE ',form print*,char(7) endif if(intd.ne.0)then print*,'***ERROR--nested <td> LINE',form if(fout)print*,a if(fout)write(2,*)'***ERROR--nested <td> LINE ',form print*,char(7) else i3=i3+1 i4=1 BlockType(i3)='<td>' endif intd=1 elseif(find(b(i:360),'</td>',1).or. & find(b(i:360),'</td/',1).or. & find(b(i:360),'</td ',1))then if(inth.ne.0)then print*,'***ERROR--</td> inside <th> LINE',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--</td> inside <th> LINE ',form print*,char(7) endif if(intd.ne.1)then print*,'***ERROR--</td> without <td> LINE',form if(fout)print*,a if(fout)write(2,*)'***ERROR--</td> without <td> LINE ', & form print*,char(7) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<td>') print*,'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form if(fout)print*,a if(fout)write(2,*)'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form print*,char(7) i3=i3-1 enddo endif intd=0 elseif(find(b(i:360),'<p>',1).or. & find(b(i:360),'<p/',1).or. & find(b(i:360),'<p ',1))then if(inbody.ne.1)then print*,'***ERROR--<p> not inside <body> LINE',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--<p> not inside <body> LINE ',form print*,char(7) endif if(inp.ne.0)then if(fout)print*,a print*,'***WARNING--prior <p> not closed',form if(fout)write(2,*) & '***WARNING--prior <p> not closed LINE ',form print*,char(7) else i3=i3+1 endif i4=1 BlockType(i3)='<p>' inp=1 elseif(find(b(i:360),'</p>',1).or. & find(b(i:360),'</p/',1).or. & find(b(i:360),'</p ',1))then if(inp.ne.1)then print*,'***ERROR--</p> without <p> LINE',form if(fout)print*,a if(fout)write(2,*)'***ERROR--</p> without <p> LINE ',form print*,char(7) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<p>') print*,'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form if(fout)print*,a if(fout)write(2,*)'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form print*,char(7) i3=i3-1 enddo endif inp=0 elseif(find(b(i:360),'<script>',1).or. & find(b(i:360),'<script/',1).or. & find(b(i:360),'<script ',1))then if(inscript.eq.1)then if(fout)print*,a print*,'***ERROR--nested <script> LINE ',form if(fout)write(2,*)'***ERROR--nested <script> LINE ',form print*,char(7) else i3=i3+1 i4=1 BlockType(i3)='<script>' endif inscript=1 elseif(find(b(i:360),'</script>',1).or. & find(b(i:360),'</script/',1).or. & find(b(i:360),'</script ',1))then if(inscript.ne.1)then print*,'***ERROR--</script> without <script> LINE ',form if(fout)print*,a if(fout)write(2,*) & '***ERROR--</script> without <script> LINE ',form print*,char(7) else i3=i3-1 i4=1 dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<script>') print*,'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form if(fout)print*,a if(fout)write(2,*)'***WARNING--unclosed ', & BlockType(i3+1),' LINE ',form print*,char(7) i3=i3-1 enddo endif inscript=2 c### ADD MORE SEARCH ITEMS HERE endif ENDDO igoto=0 ! no goto on line c if(find(a,'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) 20 b=bsave a=' ' if(i1 .lt.0.or.i3 .lt.0.or.i4 .lt.0)then print*,'***ERROR--INVALID DIAGRAMMING INDEX LINE ',form if(fout)print*,b if(fout)write(2,*) & '***ERROR--INVALID DIAGRAMMING INDEX LINE',form print*,char(7) i1=max(i1,0) i3=max(i3,0) i4=max(i4,0) endif i2=max(i1,i3) ! # of nests on current line i4=max(i4,iabs(i3-i1)) ! not 0, to flag start or ! end of block iBlock=1 ! For the present version. a=' ' ! Leave space for diagram a(12:360)=b ! (must match column header) LastUse=1 ! Last usable diagram col dowhile(LastUse.lt.360.and.a(LastUse:LastUse).eq.' ') LastUse=LastUse+1 enddo LastUse=LastUse-2 if(igoto.ne.0)a(1:1)='*' ! Place * next to jumps if(icomment2.ne.1.and.icomment3.ne.0..and.inotate.ne.0) & a(1:1)='=' if(i2.gt.0)then ! Same for non-pre-processor do i=1,min(i2,LastUse) a(i:i)=BlockContinue(iBlock) enddo endif if(i4.ne.0)then do i=i2+1,LastUse a(i:i)=BlockHoriz(iBlock) enddo endif do i=0,i4-1 c= BlockElse(iBlock) if(i1+i.lt.i3)c=BlockBegin(iBlock) if(i1+i.gt.i3)c=BlockEnd (iBlock) j=max(1,min(LastUse,i2-i)) 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) enddo if(LCol.gt.0.and.a(max(1,LCol+11):360).eq.' ')then ! line # if(form(1:1).eq.' ')form(1:1)=BlockContinue(iBlock) a(LCol+11:360)=form endif n=LenA(a) ! Output diagrammed line if(fout) write(2,'(128(128a1))') & (a(i:i),i=1,n) if(.not.fout)write(*,'(128(128a1))') & (a(i:i),i=1,n) i1=i3 goto 10 99 if(iunit.eq.3)then iunit=1 i1=i1-1 close(3) goto 10 endif if(i3.gt.0)then print*,'***WARNING--SOME NEST LEVELS LEFT HANGING AT END***' if(fout)write(2,*) & '***WARNING--SOME NEST LEVELS LEFT HANGING AT END***' print*,char(7) endif if(inhead.eq.0)then print*,'***ERROR--<head> never occurred***' if(fout)write(2,*)'***ERROR--<head> never occurred!***' print*,char(7) endif if(intitle.eq.0)then print*,'***ERROR--<title> never occurred***' if(fout)write(2,*)'***ERROR--<title> never occurred!***' print*,char(7) endif if(inbody.eq.0)then print*,'***ERROR--<body> never occurred***' if(fout)write(2,*)'***ERROR--<body> never occurred!***' print*,char(7) endif 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 Program by Mitchell R Grunes, (grunes@yahoo.com). c Revision date: 8/25/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 return end c----------------------------------------------------------------------- function LenA(a) ! Length of string, at least 1 c Program by Mitchell R Grunes, (grunes@yahoo.com). c Revision date: 8/25/96. character*(*) a n=len(a) dowhile(n.gt.1.and.a(n:n).eq.' ') n=n-1 enddo LenA=n end