Velocity Reviews - Computer Hardware Reviews

Velocity Reviews > Newsgroups > Programming > C++ > Free source code diagramming programs

Reply
Thread Tools

Free source code diagramming programs

 
 
idlwizard-1@yahoo.com
Guest
Posts: n/a
 
      04-09-2006
The latest revision of my source code diagramming programs are
available at

http://www.geocities.com/grunes/diagram.html

These programs diagram source code in the following languages:

C and C++<br>
FORTRAN<br>
HTML (very incomplete)<br>
IDL, PV-WAVE, GDL and FL

They do things like draw lines showing the start and end of routines
and blocks, put * next to jumps, and = next to commented out sections,
and can warn you of certain classes of error.

They can help you find problems in your own code, or help you look at
long complicated legacy code other people give you.

The programs themselves are in FORTRAN. I know that is a problem for
users of other programming languages, but it is freely available as g77
or g95 under Cygwin (under Windows) or Linux, and is available on many
other platforms.

 
Reply With Quote
 
 
 
 
mitch grunes
Guest
Posts: n/a
 
      04-10-2006
For people who have trouble reading that web page, see the folowing
message I just posted this message to alt.sources:

My source code diagramming programs

Last revised 4/9/2006

This post to alt.sources is for anyone who has trouble reading
my website

http://www.geocities.com/grunes/diagram.html

INTRODUCTION

These programs diagram source code in the following languages: C and
C++
FORTRAN
HTML (very incomplete)
IDL, PV-WAVE, GDL and FL

They do things like draw lines showing the start and end
of routines and blocks, put * next to jumps, and = next
to commented out sections, and can warn you of certain
classes of error. They can help you find problems in your
own code, or help you look at other people's long
complicated legacy code. For example:

+----------- subroutine a(x) | 1
|+---------- do i=1,5 | 2
||+----------- if(i/2*2.eq.i)then | 3
||| x=x*i | 4
||+----------- else | 5
||| x=x/i | 6
||+----------- endif | 7
|+---------- enddo | 8
+----------- end | 9

The VAX and MS-DOS procedures have not recently been tested.
If you like or dislike these programs, send e-mail to
username grunes at domain yahoo.com. Bug reports must
include sample code on which it failed.

The programs themselves are in FORTRAN. I know that
is a problem for users of other programming languages,
but FORTRAN is freely available as g77 or g95 under
Cygwin (under Windows) or Linux, and is available as
f77, f90 or f95 on many other platforms. Compilation
is simple, e.g.

g77 diagramf.f -o diagramf

The files are at http://www.geocities.com/grunes/diagram.html,
and are also included below. If you request it, I will email you a
diagram.tar.gz archive containing everything.

Included files:

diagramc: Diagrams C, C++
diagramc.f Fortran language source code
Procedures to run diagramc without answering questions:
diagramc.sh Unix csh procedure
diagramc.bat MS-DOS procedure
diagramc.vax VAX VMS DCL procedure

diagramf: Diagrams FORTRAN
diagramf.f Fortran language source code
Procedures to run diagramf without answering questions on card format
code:
diagramf.sh Unix csh procedure
diagramf.bat MS-DOS procedure
diagramf.vax VAX VMS DCL procedure
Procedures to run diagramf without answering questions on free format
code:
diagram9.sh Unix csh procedure
diagram9.bat MS-DOS procedure
diagram9.vax VAX VMS DCL procedure

diagramh: Diagrams HTML (Very Incomplete)
diagramh.f Fortran language source code
Procedures to run diagramh without answering questions:
diagramh.sh Unix csh procedure
diagramh.bat MS-DOS procedure
diagramh.vax VAX VMS DCL procedure

diagrami: Diagrams IDL, PV-WAVE, GDL, FL
diagrami.f Fortran language source code
Procedures to run diagrami without answering questions:
diagrami.sh Unix csh procedure
diagrami.bat MS-DOS procedure
diagrami.vax VAX VMS DCL procedure

undiagram: Try to derive source code from diagram
undiagram.f Fortran language source code

My Home Page: http://www.geocities.com/grunes

-----------------BEGIN diagramc.f-------------------
c EXAMPLE OF OUTPUT (looks better if you choose IBM PC line graphics):

c +------ I_Hate_C() { | 1
c |+------- if (You_Like(C)) { | 2
c || BoyOrGirl=Bad; | 3
c +-|| #ifdef SMART | 4
c | || ReEducate(); | 5
c +-|| #endif | 6
c |+------- } else { | 7
c || BoyOrGirl=Good; | 8
c |+------- } | 9
c +------ } | 10

c Diagrams C language {} constructs, case and default,
c and puts a * next to goto, break, continue, exit and return. It can
c place = next to comment blocks.
c Up to 2 levels of preprocessor constructs (#if--#elif--#endif) are
c diagrammed separately, on the outside.

c Designed by mitch grunes, in his own time.

c Program by Mitchell R Grunes, (grunes at domain yahoo.com).
c Revision date: 8/25/96.
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 diagramc ! Diagrammer
for C
character*80 filnam,filnam2

print*,'C 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 at domain yahoo.com).
character*80 filnam,filnam2
character*160 a,b,bsave
character*5 form
character*8 fm
character*1 c
logical fout
logical find
external find
common icol

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(21 ! (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(20
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
i3pp=0 ! same for
pre-processor
nline=0
icomment=0 ! not inside comment
iunit=1
10 a=' '
read(iunit,'(a160)',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:160)
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(j.le.160.and.a(i:i).ge.'
'.and.a(i:i).lt.char(12)then
b(j:j)=a(i:i)
j=j+1
endif
enddo

a=b
bsave=b
b=' '
i1=i3 ! # nest levels before
! current line
i1pp=i3pp ! same for
pre-processor
i4=0 ! not 0 to flag start
or end
! of block
i4pp=0
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.160) ! 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.eq.0.and.icomment.eq.0)th en
iquote=1-iquote
if(i.gt.1)then
! char(92) is \
if(iquote.eq.0.and.a(i-1:i-1).eq.char(92))
& iquote=1-iquote
endif
endif
if(c.eq.'"' .and.iquote .eq.0.and.icomment.eq.0)then
idquote=1-idquote
if(i.gt.1)then
if(idquote.eq.0.and.a(i-1:i-1).eq.char(92))
& idquote=1-idquote
endif
endif
if(c.eq.'/'.and.i.lt.160.and.iquote.eq.0.and.idquote.eq.0)
! / * ?
& then
if(a(i+1:i+1).eq.'/')icomment3=1 ! // is C++ comment
line
if(a(i+1:i+1).eq.'/')go to 15
if(a(i+1:i+1).eq.'*')then
if(icomment.ne.0)then
PRINT*,'***WARNING--nested comment line',form
if(fout)print*,a
print*,char(7)
endif
icomment=1
icomment3=1
c=' '
i=i+1
endif
endif
if(c.eq.'*'.and.i.lt.160.and.iquote.eq.0.and.idquo te.eq.0)
! * / ?
& then
if(a(i+1:i+1).eq.'/')then
if(icomment.eq.0)then
PRINT*,'***WARNING--*/ without /* clause line',form
if(fout)print*,a
print*,char(7)
endif
icomment=0
c=' '
i=i+1
endif
endif
if(icomment.ne.0)c=' '
if(c.ne.' ')icomment2=1
if(c.eq.'{')then
if(fout.and.i3.eq.0)print*,'Line ',form,' ',a(1:LenA(a))
i3=i3+1
elseif(c.eq.'}')then
i3=i3-1
i4=max(i4,i1-i3)
if(i3.lt.0)then
PRINT*,'***ERROR--INVALID DIAGRAMMING INDEX line',
& form
if(fout)
& WRITE(2,*)'***ERROR--INVALID DIAGRAMMING INDEX!***'
if(fout)print*,a
print*,char(7)
i3=max(i3,0)
endif
endif
if(j.le.160) 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 AT LINE ',form
if(fout)WRITE(2,*)'***ERROR--UNCLOSED QUOTE AT LINE ',form
if(fout)print*,a
print*,char(7)
endif

15 if(find(b,'#if',2).or.find(b,'# if',2))then
i3pp=i3pp+1
i4pp=1
elseif(find(b,'#else',2).or.find(b,'# else',2)
& .or.find(b,'#elif',2).or.find(b,'# elif',2))then
i4pp=1
elseif(find(b,'#endif',2).or.find(b,'# endif',2))then
i3pp=i3pp-1
i4pp=1
endif

igoto=0 ! no goto on line
if(find(a,'go to',64+512).or.find(a,'goto',64+512)
& .or.find(a,'return',32+512)
& .or.find(a,'break',32+512).or.find(a,'continue',32 +512)
& .or.find(a,'exit',32+512))igoto=1

if(find(b,'case',32+512).or.
& 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.or.
& i1pp.lt.0.or.i3pp.lt.0.or.i4pp.lt.0)then
PRINT*,'***ERROR--INVALID DIAGRAMMING INDEX line',form
if(fout)WRITE(2,*)'***ERROR--INVALID DIAGRAMMING INDEX!***'
if(fout)print*,b
print*,char(7)
i1=max(i1,0)
i3=max(i3,0)
i4=max(i4,0)
i1pp=max(i1pp,0)
i3pp=max(i3pp,0)
i4pp=max(i4pp,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
i2pp=max(i1pp,i3pp)
i4pp=max(i4pp,iabs(i3pp-i1pp))

iBlock=1 ! For the present
version.

a=' ' ! Leave space for
diagram
a(12:160)=b ! (must match column
header)

LastUse=1 ! Last usable diagram
col
dowhile(LastUse.lt.160.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.eq.0.and.icomment3.ne.0..and.inotate. ne.0)
& a(1:1)='='

if(i2pp.gt.0)then ! Draw one vertical
line per
do i=2,min(i2pp+1,3) ! nest level.
a(i:i)=BlockContinue(iBlock)
enddo
endif

if(i4pp.ne.0)then ! Draw horizontal lines
inward
do i=i2pp+2,3 ! from above.
a(i:i)=BlockHoriz(iBlock)
enddo
endif

do i=0,i4pp-1 ! May need to replace
some
! vertical lines with
! else symbol
c= BlockElse(iBlock) ! or begin symbol
if(i1pp+i.lt.i3pp)c=BlockBegin(iBlock)! or end symbol
if(i1pp+i.gt.i3pp)c=BlockEnd (iBlock)
j=max(2,min(3,i2pp+1-i))
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)
enddo

if(i2.gt.0)then ! Same for
non-pre-processor
do i=4,min(i2+3,LastUse)
a(i:i)=BlockContinue(iBlock)
enddo
endif

if(i4.ne.0)then
do i=i2+4,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(4,min(LastUse,i2+2+1-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):160).eq.' ')then ! line
#
if(form(1:1).eq.' ')form(1:1)=BlockContinue(iBlock)
a(LCol+11:160)=form
endif

n=LenA(a) ! Output diagrammed
line
if(fout) write(2,'(80a1,80a1)')(a(i:i),i=1,n)
if(.not.fout)write(*,'(1x,80a1,80a1)')(a(i:i),i=1, n)

i1=i3
i1pp=i3pp
goto 10
99 if(iunit.eq.3)then
iunit=1
i1=i1-1
i1pp=i1pp-1
close(3)
goto 10
endif
if(i3.gt.0.or.i3pp.gt.0)then
PRINT*,'***WARNING--SOME NEST LEVELS LEFT HANGING AT END***'
print*,char(7)
endif
end
c-----------------------------------------------------------------------
logical function find(a,b,icond) ! find b in a, subject
to
! conditions:
! icond=sum of the
following:
! 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 at domain 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.
do i=1,ii-jj+1
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)th en
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 at domain 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
------------------END diagramc.f--------------------
-----------------BEGIN diagramc.sh-------------------
#!/bin/csh
# ---diagramc.sh---
#Unix csh procedure to diagram a C language program.

#On some unix systems $1 should be replaced by %1.

# by Mitchell R Grunes.
# for his own use, in his own time

#I assume that the executable and this procedure are in the search
path,
# and that this procedure has execute permission.

#Syntax:
# diagramc.sh
#to be prompted for input parameters.

#Alternate Syntax:
# diagramc.sh filename(s)
#to append diagram of file(s) into diagram.out

if (${?noclobber}) then
unset noclobber
set noclobbersave
endif

if $1a == a then
diagramc
goto quit
endif

loop:
echo ========================-- $1 --========================
#Prompt answers: input from $1, output to diagram2.sc (for now),
# place numbers in column 67, notate comments with =,
# don't use IBM PC graphics.

echo $1 > diagram.sc
echo diagram2.sc >> diagram.sc
echo 67 >> diagram.sc
echo 1 >> diagram.sc
echo 0 >> diagram.sc
diagramc < diagram.sc
cat diagram2.sc >> diagram.out
rm -f diagram.sc
rm -f diagram2.sc
shift
if ! ($1a == a) then
goto loop
endif
quit:
echo Note--This does not delete diagram.out before appending to it.
if (${?noclobbersave}) then
set noclobber
unset noclobbersave
endif
------------------END diagramc.sh--------------------
-----------------BEGIN diagramc.bat-------------------
rem ---diagramc.bat---
rem MS-DOS procedure to diagram a C language program.

rem by Mitchell R Grunes.

rem I assume that the executable is in directory c:\grunes on
rem your PC.

rem Syntax:
rem diagramc
rem to be prompted for input parameters.

rem Alternate Syntax:
rem diagramc filename(s)
rem to append diagram of file(s) into diagram.out

if %1a == a c:\grunes\diagramc
if %1a == a goto quit

echo off
:loop
echo ========================-- %1 --========================
rem Prompt answers: input from %1, output to diagram2.sc (for now),
rem place numbers in column 67, notate comments with =,
rem diagram pre-processor blocks, use IBM PC graphics.

echo %1 > diagram.sc
echo diagram2.sc >> diagram.sc
echo 67 >> diagram.sc
echo 1 >> diagram.sc
echo 1 >> diagram.sc
echo 1 >> diagram.sc
c:\grunes\diagramc < diagram.sc
type diagram2.sc >> diagram.out
del diagram.sc
del diagram2.sc
shift
if not %1a == a goto loop
:quit
echo Note--This does not delete diagram.out before appending to it.
------------------END diagramc.bat--------------------
-----------------BEGIN diagramc.vax-------------------
$! ---diagramc.vax---
$!VAX VMS procedure to diagram a C language program
$!
$! by Mitchell R Grunes.
$!
$!I assume that the executable and this procedure are in the search
path,
$! and that this procedure has execute permission.
$!
$!Syntax:
$! @diagramc.vax
$!to be prompted for input parameters.
$!
$!Alternate Syntax:
$! @diagramc.vax filename(s)
$!to append diagram of file(s) into diagram.out
$
$ if P1 .EQS. ""
$ then
$ define/user sys$input sys$command
$ run diagramc
$ goto quit
$ endif
$
$ write sys$output "========================-- "+P1+"
--========================"
$
$! Must pre-create diagram.out if does not exist
$ open/append/error=noSkip diagram.out diagram.out
$ goto Skip
$noSkip:
$ open/write diagram.out diagram.out
$Skip:
$ close diagram.out
$
$! Must pre-create diagram2.sc with same file attributes
$ open/write diagram2.sc diagram2.sc
$ close diagram2.sc
$
$ !Prompt answers: input from P1, output to diagram2.sc (for now),
$ ! place numbers in column 67, notate comments with =,
$ ! don't use IBM PC graphics.
$
$ open/write diagram.sc diagram.sc
$ write diagram.sc "$Run diagramc"
$ write diagram.sc P1
$ write diagram.sc "diagram2.sc"
$ write diagram.sc "67"
$ write diagram.sc "1"
$ write diagram.sc "0"
$ close diagram.sc
$ @diagram.sc
$ append diagram2.sc diagram.out
$ delete diagram.sc;*
$ delete diagram2.sc;*
$
$ if (P2 .NES. "") then @diagramc.vax 'P2' 'P3' 'P4' 'P5' 'P6' 'P7'
'P8'
$ write sys$output "Note--This does not delete diagram.out before
appending to it."
$quit:
------------------END diagramc.vax--------------------
-----------------BEGIN diagramf.f-------------------
c EXAMPLE OF OUTPUT (looks better if you choose IBM PC line graphics):

c +---------------- subroutine a(x) | 1
c |+--------------- do i=1,5 | 2
c ||+---------------- if(i/2*2.eq.i)then | 3
c ||| x=x*i | 4
c ||+---------------- else | 5
c ||| x=x/i | 6
c ||+---------------- endif | 7
c |+--------------- enddo | 8
c +---------------- end | 9

c Diagrams FORTRAN if-else-elseif-endif, do-enddo and case constructs,
c start and end of routines, type definitions, modules and interfaces;
c puts a * next to goto, return, cycle, exit, stop, end= and err=.

c Designed by mitch grunes, in his own time.

c Program by Mitchell R Grunes, (grunes at domain yahoo.com).
c Revision date: 8/25/96.
c If you find it useful, or find a problem, please send me e-mail.

c -----------------------------------------------------
c It is VERY IMPORTANT that you select the right FORTRAN
c format. In CARD format, a C in column 1 marks a
c comment, and anything in column 6 marks a continuation
c line. That is not true in FREE format. Most traditional
c FORTRAN code is in card format.
c -----------------------------------------------------
c This program was written in FORTRAN, for historic reasons.
c This was written in Fortran 77 (with common extensions) for
c portability. It should also compile under Fortran 90 and Fortran
95,
c provided you tell the compiler it is in card format.
c---------------------------------------------------------------------

c It can be confused if an INCLUDE block contains a structure that
c begins inside and ends outside (or vice-versa).

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
c questions, 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 diagramf ! Diagrammer for
Fortran
character*80 filnam,filnam2

print*,'FORTRAN 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 ',
& '(0 for none; 67 for 80 col screen; 73 to show card format):'
LCol=0
read*,LCol
print*,LCol

print*,'Embed include files (0=no; 1?):'
iembed=1
read*,iembed
print*,iembed
print*,' '
print*,'-----------------------------------------------------'
print*,'It is VERY IMPORTANT that you select the right FORTRAN'
print*,'format. In CARD format, a C in column 1 marks a'
print*,'comment, and anything in column 6 marks a continuation'
print*,'line. That is not true in FREE format.'
print*,'-----------------------------------------------------'
print*,'0=Card format (cols 1-6 special, warnings past 72)'
print*,'1=Free format'
print*,'2=Card format (same as 0, ignore cols past 72)'
print*,'Format # (0?):'
ifree=0
read*,ifree
print*,ifree

print*,'Use IBM PC graphics characters (0=no):'
igraphics=0
read*,igraphics
print*,igraphics

call diagram(filnam,filnam2,LCol,iembed,ifree,igraphics )
end
c-----------------------------------------------------------------------
subroutine diagram(filnam,filnam2,LCol,iembed,ifree,igraphics )
c Program by Mitchell R Grunes, (grunes at domain yahoo.com).
character*80 filnam,filnam2
character*160 a,b,AfterSemi
character*5 form
character*8 fm
character*1 c,c2
logical find
external find
common iCol,iCol1
character*10 label(100)
logical fout

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(21 ! (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(20
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....,.... '

i1=0 ! # of nest levels
before
! current line
i2=0 ! # of nest levels on
! current line
i3=0 ! # of nest levels
after
! current line
i4=0 ! not 0 to flag start
or end
! of block
InSub=0 ! Inside a subroutine,
! function or mainline
InMod=0 ! Inside module or
! contains
nMain=0 ! no mainline program
yet
InElse=0 ! Found elseif, but not
then
nlabel=0 ! # of labels for do
loop
! ends
iAlphaNum=0 ! Last char of line is
! alpha-numeric
iContinueOld=0 ! next line not
continued line
nline=0
iunit=1
10 a=' '
read(iunit,'(a160)',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:160)
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(j.le.160.and.a(i:i).ge.'
'.and.a(i:i).lt.char(12)then
b(j:j)=a(i:i)
j=j+1
endif
enddo

a=' ' ! Pre-processed output
i=1 ! Basic pre-processing
j=1
i72flag=0 ! nothing over column
72
! yet
iOldAlphaNum=iAlphaNum ! last line ended in
! alpha-numeric?
iAlphaNum=0
iContinue=iContinueOld ! This line continued
line?
if(find(b,'&',2,0))iContinue=1 ! will be changed to 2
after
! first non/blank.
if(iContinue.eq.0)then
iquote=0 ! no ' yet
idquote=0 ! no " yet
endif
j=1
! comment line
if((b(1:1).eq.'c'.or.b(1:1).eq.'C').and.ifree.ne.1 )goto 15
if(b(1:1).eq.'*'.or.b(1:2).eq.'??')goto 15

do i=1,LenA(b)
c=b(i:i)
! handle upper case
if(c.ge.'A'.and.c.le.'Z')c=char(ichar(c)+32)
! ASCII 33 is '!'
if(c.eq.char(33).and.iquote.eq.0.and.idquote.eq.0) goto 15

if(i.gt.72.and.c.ne.' ')then
if(ifree.eq.0.and.i72flag.eq.0)then
i72flag=1
PRINT*,'***WARNING--PAST COLUMN 72 at line',form
if(fout)print*,b
print*,char(7)
elseif(ifree.eq.2)then
c=' '
endif
endif

if(c.eq.''''.and.(i.ne.6.or.ifree.ne.0).and.idquot e.eq.0)
& iquote=1-iquote
if(c.eq.'"' .and.(i.ne.6.or.ifree.ne.0).and.iquote .eq.0)
& idquote=1-idquote
if(iquote.eq.1)then
if(find(a,'include ',2,0).and.iembed.ne.0)then
iquote=0
idquote=0
endif
endif
if(iquote.ne.0.or.idquote.ne.0)c=' '
if(j.gt.1)then ! (kill multiple
spaces,
! and spaces around =)
c2=a(j-1:j-1)
if(c.eq.' '.and.c2.eq.' ')j=j-1
if(c.eq.'='.and.c2.eq.' ')j=j-1
if(c.eq.' '.and.c2.eq.'=')j=j-1
if(c.eq.' '.and.c2.eq.'=')c='='
endif
! Look for
! identifiers that wrap
! around lines.
if((i.gt.6.or.ifree.ne.0).and.c.ne.' '.and.c.ne.'&')then
iAlphaNum=0
if((c.ge.'a'.and.c.le.'z').or.
& (c.ge.'0'.and.c.le.'9'))then
iAlphaNum=1
if(iContinue.eq.1)then
if(iOldAlphaNum.ne.0)then
PRINT*,'***POSSIBLE SPLIT IDENTIFIER across
line',form
print*,char(7)
endif
endif
endif
iContinue=2
endif

if(j.le.160)a(j:j)=c
j=j+1
enddo

15 iContinueOld=0
if(a(LenA(a):LenA(a)).eq.'&')iContinueOld=1

i2=i1
i3=i1
i4=0
igoto=0 ! no goto on line
Main1=0 ! (Not mainline)
! Possible mainline
start

16 AfterSemi=' ' ! Break line at
semicolons
if(find(a,';',0,160-1))then
AfterSemi=' '//a(icol:160)
a=a(1:icol1-1)
endif

if(a.ne.' '.and.InSub.eq.0.and.InMod.eq.0)Main1=1
! Mark various types of
jump
if(find(a,'go to',8+64,0).or.find(a,'goto',8+64,0).or.
& find(a,'end=',16,0) .or.find(a,'err=',16,0) .or.
& find(a,'return',8+64,0).or.find(a,'cycle ',8,0).or.
& find(a,'exit ',8,0) .or.find(a,'stop ',8,0))
& igoto=1

if(find(a,')1',64,0).or.find(a,')2',64,0).or.
& find(a,')3',64,0).or.find(a,')4',64,0).or.
& find(a,')5',64,0).or.find(a,')6',64,0).or.
& find(a,')7',64,0).or.find(a,')8',64,0).or.
& find(a,')9',64,0))
& igoto=1

if(find(a,') 1',64,0).or.find(a,') 2',64,0).or.
& find(a,') 3',64,0).or.find(a,') 4',64,0).or.
& find(a,') 5',64,0).or.find(a,') 6',64,0).or.
& find(a,') 7',64,0).or.find(a,') 8',64,0).or.
& find(a,') 9',64,0))
& igoto=1

if(find(a,'::',0,0))then ! To distinguish
iDeclare=iCol ! declarations from
! keywords
else
iDeclare=999
endif

if(find(a,'include ''',2,0).and.iembed.ne.0)then
filnam=a(iCol:160)
if(.not.find(filnam,'''',0,0))goto 20
filnam(iCol-1:80)=' '
if(fout)print*,'including file ',filnam(1:50)
close(3)
open(3,file=filnam,status='old',err=17)
iunit=3
nlinesave=nline
nline=0
i2=i2+1
i3=i3+1
goto 20
17 PRINT*,'***WARNING--Missing include file***'
print*,char(7)
elseif(find(a,'end module ',2,0).or.
& find(a,'endmodule ',2,0).or.
& find(a,'end interface',2,0).or.
& find(a,'endinterface',2,0).or.
& find(a,'end type ',2,0).or.
& find(a,'endtype ',2,0))then
i3=i3-1
InMod=InMod-1
if(find(a,'endmodule ',2,0).or.
& find(a,'end module ',2,0))then
InMod=0
if(InSub.gt.0.or.i3.ne.0)then
PRINT*,'***ERROR--INVALID DIAGRAMMING INDEX line',form
if(fout)WRITE(2,*)
& '***ERROR--INVALID DIAGRAMMING INDEX!***'
if(fout)print*,b
print*,char(7)
endif
endif
InElse=0
elseif(find(a,'enddo ',256,0).or.
& find(a,'end do ',256,0))then
i3=i3-1
nlabel=max(0,nlabel-1)
InElse=0
elseif(find(a,'endif ',256,0).or.
& find(a,'end if ',256,0).or.
& find(a,'endselect ',256,0).or.
& find(a,'end select ',256,0).or.
& find(a,'endforall ',256,0).or.
& find(a,'end forall ',256,0).or.
& find(a,'endforall ',256,0).or.
& find(a,'end where ',256,0).or.
& find(a,'endwhere ',256,0))then
i3=i3-1
InElse=0
elseif(find(a,'end ',256,0).or.
& find(a,'end function ',256,0).or.
& find(a,'endfunction ',256,0).or.
& find(a,'end subroutine ',256,0).or.
& find(a,'endsubroutine ',256,0).or.
& find(a,'end program ',256,0).or.
& find(a,'endprogram ',256,0).or.
& find(a,'end block',256,0).or.
& find(a,'endblock',256,0))then
i3=i3-1
InSub=InSub-1
if(InSub.lt.0.or.(InSub.gt.0.and.InMod.le.0))then
if(InSub.lt.0.and.InMod.gt.0.and.find(a,'end ',256,0))then
InSub=0
InMod=InMod-1
else
PRINT*,'***ERROR--INVALID DIAGRAMMING INDEX line',form
if(fout)
& WRITE(2,*)'***ERROR--INVALID DIAGRAMMING INDEX!***'
if(fout)print*,b
print*,char(7)
endif
endif
if(i3.eq.0)InSub=0
InElse=0
elseif(find(a,'elseif',128+256,0).or.
& find(a,'else if',128+256,0))then
i4=max(i4,1)
InElse=0
if(.not.find(a,'then ',8,0))InElse=1
elseif(find(a,'then ',8,0))then
i2=i2+1
if(InElse.eq.0)i3=i3+1
InElse=0
elseif( find(a,'selectcase',256,0).or.
& find(a,'select case',256,0))then
i2=i2+1
i3=i3+1
i4=max(i4,1)
InElse=0
elseif(find(a,'else ',256,0).or.
& find(a,'entry ',4,0).or.
& find(a,'case ',256,0).or.
& find(a,'case(',256,0).or.
& find(a,'contains ',2,0).or.
& find(a,'elsewhere ',256,0).or.
& find(a,'else where ',256,0))then
i4=max(i4,1)
InElse=0
if(find(a,'contains ',2,0))then
if(fout)print*,'Line ',form,' ',b(1:LenA(b))
InMod=InMod+1
endif
elseif( find(a,'selectcase',256,0).or.
& find(a,'select case',256,0).or.
& find(a,'for all (',256,0).or.
& find(a,'forall (',256,0).or.
& find(a,'for all(',256,0).or.
& find(a,'forall(',256,0))then
i2=i2+1
i3=i3+1
InElse=0
elseif( find(a,'where (',256,0).or.
& find(a,'where(',256,0))then
if(find(a,'(',0,0))iCol=iCol
iCntParen=1
do i=iCol,LenA(a)
if(a(i:i).eq.'(')iCntParen=iCntParen+1
if(a(i:i).eq.')')iCntParen=iCntParen-1
if(iCntParen.eq.0)then
if(a(i:160).eq.')')then
i2=i2+1
i3=i3+1
InElse=0
endif
goto 20
endif
enddo
elseif((find(a,'module ',2,iDeclare).and.
& .not.find(a,'module procedure',2,iDeclare)).or.
& find(a,'interface ',2,iDeclare).or.
& (find(a,'type ',2,iDeclare).and.
& .not.find(a,'(',0,iDeclare)).or.
& (find(a,'type,',2,iDeclare).and.
& .not.find(a,'(',0,iDeclare)))then
if(fout)print*,'Line ',form,' ',b(1:LenA(b))
i2=i2+1
i3=i3+1
Main1=0
if(find(a,'module ',2,iDeclare).and.InMod.ne.0)then
PRINT*,'***ERROR--NESTED MODULES***'
if(fout)WRITE(2,*)'***NESTED MODULES***'
if(fout)print*,b
print*,char(7)
endif
InMod=InMod+1
InElse=0
elseif(find(a,'do while',128+256,0).or.
& find(a,'dowhile',128+256,0))then
i2=i2+1
i3=i3+1
nlabel=min(100,nlabel+1)
label(nlabel)='####'
InElse=0
elseif(find(a,' do ',256,0).or.
& (ifree.ne.0.and.a(1:3).eq.'do '))then
if(ifree.ne.0.and.a(1:3).eq.'do ')iCol=4
if(iCol1.lt.7.or.a(7:max(7,iCol1)).eq.' '.or.
& (ifree.ne.0.and.a(1:3).eq.'do '))then
i2=i2+1
i3=i3+1
iCol2=iCol
dowhile(iCol2.lt.160.and.a(iCol2:iCol2).ge.'0'.and .
& a(iCol2:iCol2).le.'9')
iCol2=iCol2+1
enddo
iCol2=iCol2-1
nlabel=min(100,nlabel+1)
if(iCol2.ge.iCol)then
label(nlabel)=a(iCol:iCol2)
else
label(nlabel)='####'
endif
endif
InElse=0
elseif(find(a,': do ',0,0).or.find(a,':do ',0,0))then
i2=i2+1
i3=i3+1
InElse=0
elseif(find(a,'function ',4,iDeclare).or.
& find(a,'subroutine ',4,iDeclare).or.
& find(a,'program ',2,iDeclare) .or.
& find(a,'block data ',2,iDeclare).or.
& find(a,'blockdata ',2,iDeclare))then
if(fout)print*,'Line ',form,' ',b(1:LenA(b))
if(InSub.ne.0.and.InMod.eq.0)then
PRINT*,'***ERROR--ROUTINE INSIDE ROUTINE***'
if(fout)WRITE(2,*)'***ERROR--ROUTINE INSIDE ROUTINE***'
if(fout)print*,b
print*,char(7)
endif
Main1=0
InSub=InSub+1
i2=i2+1
i3=i3+1
if(InSub.eq.1.and.i3.ne.1.and.InMod.le.0)then
PRINT*,'***ERROR--INVALID DIAGRAMMING INDEX line',form
if(fout)
& WRITE(2,*)'***ERROR--INVALID DIAGRAMMING INDEX!***'
if(fout)print*,b
print*,char(7)
i3=1
endif
InElse=0
endif

20 if(Main1.ne.0)then ! Was start of mainline
if(fout)print*,'Line ',form,' ',b(1:LenA(b))
if(nMain.gt.0)then
PRINT*,'***ERROR--TOO MANY MAINLINES***'
if(fout)WRITE(2,*)'***ERROR--TOO MANY MAINLINES!***'
if(fout)print*,b
print*,char(7)
endif
InSub=InSub+1
nMain=nMain+1
i2=i2+1
i3=i3+1
endif

21 if(b(1:5).ne.' '.or.ifree.ne.0)then ! Search for DO labels
istart=1
dowhile(istart.lt.160.and.b(istart:istart).eq.' ')
istart=istart+1
enddo
iend=istart
dowhile(iend.lt.160.and.
& (b(iend:iend).ge.'0'.and.b(iend:iend).le.'9'))
iend=iend+1
enddo
iend=iend-1
if(iend.ge.1.and.b(1:max(1,iend)).ne.' ')then
do i=1,nlabel
j=nlabel+1-i ! (in reverse order)
if(b(istart:iend).eq.label(j))then
i3=i3-1
nlabel=max(0,j-1)
goto 21
endif
enddo
endif
endif

if(AfterSemi.ne.' ')then
a=AfterSemi
goto 16
endif

a=' '
if(i1.lt.0.or.i2.lt.0.or.i3.lt.0.or.i4.lt.0)then
PRINT*,'***ERROR--INVALID DIAGRAMMING INDEX line',form
if(fout)WRITE(2,*)'***ERROR--INVALID DIAGRAMMING INDEX!***'
if(fout)print*,b
print*,char(7)
i1=max(i1,0)
i2=max(i2,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:160)=b ! (must match column
header)

LastUse=1 ! Last usable diagram
col
dowhile(LastUse.lt.160.and.a(LastUse:LastUse).eq.' ')
LastUse=LastUse+1
enddo
LastUse=LastUse-2

if(igoto.ne.0)a(1:1)='*' ! Place * next to jumps

if(i2.gt.0)then ! Draw one vertical
line per
do i=2,min(i2+1,LastUse) ! nest level.
a(i:i)=BlockContinue(iBlock)
enddo
endif

if(i4.ne.0)then ! Draw horizontal lines
inward
do i=i2+2,LastUse ! from above.
a(i:i)=BlockHoriz(iBlock)
enddo
endif

do i=0,i4-1 ! May need to replace
some
! vertical lines with
c= BlockElse(iBlock) ! else symbol
if(i1+i.lt.i3)c=BlockBegin(iBlock) ! or begin symbol
if(i1+i.gt.i3)c=BlockEnd (iBlock) ! or end symbol
j=max(2,min(LastUse,i2+1-i))
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)
enddo

if(LCol.gt.0.and.a(max(1,LCol+11):160).eq.' ')then ! line
#
if(form(1:1).eq.' ')form(1:1)=BlockContinue(iBlock)
a(LCol+11:160)=form
endif

n=LenA(a) ! Output diagrammed
line
if(fout) write(2,'(80a1,80a1)')(a(i:i),i=1,n)
if(.not.fout)write(*,'(1x,80a1,80a1)')(a(i:i),i=1, n)

i1=i3
goto 10
99 if(iunit.eq.3)then
iunit=1
i1=i1-1
close(3)
nline=nlinesave
goto 10
endif
if(i3.gt.0.or.InSub.ne.0)then
PRINT*,'***WARNING--SOME NEST LEVELS LEFT HANGING AT END***'
print*,char(7)
endif
end
c-----------------------------------------------------------------------
logical function find(a,b,icond,jcol) ! find b in a, subject
! to conditions:
! Column is prior to
jcol
! (if jcol.ne.0)
! icond=sum of the
! following:
! 1: Prior, if exists,
must
! be blank
! 2: Must be first
non-blank
! 4: Prior character,
if
! present, must not be
! alphanumeric.
! 8: Prior character,
if
! present, must be
blank
! or )
! 16: Prior character,
if
! present, must be
blank
! or ,
! 32: Next character
not
! alphanumeric
! 64: Next character
not
! alphabetic
! 128:Next character
must
! be blank or (
! 256:1st non-blank,
! possibly except for
! numeric labels
! 512 Prior character,
if present,
! must be blank or
) or }
! or { or ;
c Program by Mitchell R Grunes, (grunes at domain yahoo.com).
c Revision date: 8/25/96.
character*(*) a,b
character*1 c,cNext,c2
common iCol,iCol1
logical result

ii=len(a)
jj=len(b)
result=.false.
jjcol=999
if(jcol.gt.0)jjcol=jcol
do i=1,min(ii-jj+1,jjcol)
if(a(i:i+jj-1).eq.b)then ! Found--Now do tests
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,1).ne.0.and.icol1.gt.1)th en
result=c.eq.' '
endif

if(result.and.iand(icond,2).ne.0.and.iCol1.gt.1)th en
result=a(1:iCol1-1).eq.' '
endif

if(result.and.iand(icond,4).ne.0)
& result=(c.lt.'0'.or.c.gt.'9').and.(c.lt.'a'.or.c.g t.'z')
if(result.and.iand(icond,.ne.0)result=c.eq.'
'.or.c.eq.')'

if(result.and.iand(icond,16).ne.0)
& result=c.eq.' '.or.c.eq.','

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,12.ne.0)
& result=cNext.eq.' '.or.cNext.eq.'('

if(result.and.iand(icond,256).ne.0.and.iCol1.gt.1) then
do iii=1,iCol1-1
c2=a(iii:iii)
if((c2.lt.'0'.or.c2.gt.'9').and.c2.ne.'
')result=.false.
enddo
endif

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-----------------------------------------------------------------------
function LenA(a) ! Length of string, at
! least 1
c Program by Mitchell R Grunes, (grunes at domain 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
------------------END diagramf.f--------------------
-----------------BEGIN diagramf.sh-------------------
#!/bin/csh
# ---diagramf.sh---
#Unix csh procedure to diagram a (card format) Fortran language
program.

#On some unix systems $1 should be replaced by %1.

# by Mitchell R Grunes.
# for his own use, in his own time

#I assume that the executable and this procedure are in the search
path,
# and that this procedure has execute permission.

#Syntax:
# diagramf.sh
#to be prompted for input parameters.

#Alternate Syntax:
# diagramf.sh filename(s)
#to append diagram of file(s) into diagram.out

if (${?noclobber}) then
unset noclobber
set noclobbersave
endif

if $1a == a then
diagramf
goto quit
endif

loop:
echo ========================-- $1 --========================
#Prompt answers: input from $1, output to diagram2.sc (for now),
# place numbers in column 73, embed include files, don't use free
# format, don't use IBM PC graphics.

echo $1 > diagram.sc
echo diagram2.sc >> diagram.sc
echo 73 >> diagram.sc
echo 1 >> diagram.sc
echo 0 >> diagram.sc
echo 0 >> diagram.sc
diagramf < diagram.sc
cat diagram2.sc >> diagram.out
rm -f diagram.sc
rm -f diagram2.sc
shift
if ! ($1a == a) then
goto loop
endif
quit:
echo Note--This does not delete diagram.out before appending to it.
if (${?noclobbersave}) then
set noclobber
unset noclobbersave
endif
------------------END diagramf.sh--------------------
-----------------BEGIN diagramf.bat-------------------
rem ---diagramf.bat---
rem MS-DOS procedure to diagram a (card format) FORTRAN language
program.
rem (use diagram9.bat to diagram free format Fortran programs)

rem by Mitchell R Grunes.

rem I assume that the executable is in directory c:\grunes on
rem your PC.

rem Syntax:
rem diagramf
rem to be prompted for input parameters.

rem Alternate Syntax:
rem diagramf filename(s)
rem to append diagram of file(s) into diagram.out

if %1a == a c:\grunes\diagramf
if %1a == a goto quit

echo off
:loop
echo ========================-- %1 --========================
rem Prompt answers: input from %1, output to diagram2.sc (for now),
rem place numbers in column 73, embed include files, don't use free
rem format, use IBM PC graphics.

echo %1 > diagram.sc
echo diagram2.sc >> diagram.sc
echo 73 >> diagram.sc
echo 1 >> diagram.sc
echo 0 >> diagram.sc
echo 1 >> diagram.sc
c:\grunes\diagramf < diagram.sc
type diagram2.sc >> diagram.out
del diagram.sc
del diagram2.sc
shift
if not %1a == a goto loop
:quit
echo Note--This does not delete diagram.out before appending to it.
------------------END diagramf.bat--------------------
-----------------BEGIN diagramf.vax-------------------
$! ---diagramf.vax---
$!VAX VMS procedure to diagram a (card format) Fortran language program
$!
$! by Mitchell R Grunes.
$!
$!I assume that the executable and this procedure are in the search
path,
$! and that this procedure has execute permission.
$!
$!Syntax:
$! @diagramf.vax
$!to be prompted for input parameters.
$!
$!Alternate Syntax:
$! @diagramf.vax filename(s)
$!to append diagram of file(s) into diagram.out
$
$ if P1 .EQS. ""
$ then
$ define/user sys$input sys$command
$ run diagramf
$ goto quit
$ endif
$
$ write sys$output "========================-- "+P1+"
--========================"
$ !Prompt answers: input from P1, output to diagram2.sc (for now),
$ ! place numbers in column 73, embed include files, don't use free
$ ! format, don't use IBM PC graphics.
$
$! Must pre-create diagram.out if does not exist
$ open/append/error=noSkip diagram.out diagram.out
$ goto Skip
$noSkip:
$ open/write diagram.out diagram.out
$Skip:
$ close diagram.out
$
$! Must pre-create diagram2.sc with same file attributes
$ open/write diagram2.sc diagram2.sc
$ close diagram2.sc
$
$ open/write diagram.sc diagram.sc
$ write diagram.sc "$Run diagramf"
$ write diagram.sc P1
$ write diagram.sc "diagram2.sc"
$ write diagram.sc "73"
$ write diagram.sc "1"
$ write diagram.sc "0"
$ write diagram.sc "0"
$ close diagram.sc
$ @diagram.sc
$ append diagram2.sc diagram.out
$ delete diagram.sc;*
$ delete diagram2.sc;*
$
$ if (P2 .NES. "") then @diagramf.vax 'P2' 'P3' 'P4' 'P5' 'P6' 'P7'
'P8'
$quit:
$ write sys$output "Note--This does not delete diagram.out before
appending to it."
------------------END diagramf.vax--------------------
-----------------BEGIN diagram9.sh-------------------
#!/bin/csh
# ---diagram9.sh---
#Unix csh procedure to diagram a (free format) FORTRAN language
program.

#On some unix systems $1 should be replaced by %1.

# by Mitchell R Grunes, for his own use, in his own time.

#I assume that the executable and this procedure are in the search
path,
# and that this procedure has execute permission.

#Syntax:
# diagram9.sh
#to be prompted for input parameters.

#Alternate Syntax:
# diagram9.sh filename(s)
#to append diagram of file(s) into diagram.out

if (${?noclobber}) then
unset noclobber
set noclobbersave
endif

if $1a == a then
diagramf
goto quit
endif

loop:
echo ========================-- $1 --========================
#Prompt answers: input from $1, output to diagram2.sc (for now),
# place numbers in column 73, embed include files, use free
# format, don't use IBM PC graphics.

echo $1 > diagram.sc
echo diagram2.sc >> diagram.sc
echo 73 >> diagram.sc
echo 1 >> diagram.sc
echo 1 >> diagram.sc
echo 0 >> diagram.sc
diagramf < diagram.sc
cat diagram2.sc >> diagram.out
rm -f diagram.sc
rm -f diagram2.sc
shift
if ! ($1a == a) then
goto loop
endif
quit:
echo Note--This does not delete diagram.out before appending to it.
if (${?noclobbersave}) then
set noclobber
unset noclobbersave
endif
------------------END diagram9.sh--------------------
-----------------BEGIN diagram9.bat-------------------
rem ---diagram9.bat---
rem MS-DOS procedure to diagram a (free format) FORTRAN language
program.
rem (use diagramf.bat to diagram card format Fortran programs)

rem by Mitchell R Grunes.

rem I assume that the executable is in directory c:\grunes on
rem your PC.

rem Syntax:
rem diagramf
rem to be prompted for input parameters.

rem Alternate Syntax:
rem diagramf filename(s)
rem to append diagram of file(s) into diagram.out

if %1a == a c:\grunes\diagramf
if %1a == a goto quit

echo off
:loop
echo ========================-- %1 --========================
rem Prompt answers: input from %1, output to diagram2.sc (for now),
rem place numbers in column 73, embed include files, use free
rem format, use IBM PC graphics.

echo %1 > diagram.sc
echo diagram2.sc >> diagram.sc
echo 73 >> diagram.sc
echo 1 >> diagram.sc
echo 1 >> diagram.sc
echo 1 >> diagram.sc
c:\grunes\diagramf < diagram.sc
type diagram2.sc >> diagram.out
del diagram.sc
del diagram2.sc
shift
if not %1a == a goto loop
:quit
echo Note--This does not delete diagram.out before appending to it.
------------------END diagram9.bat--------------------
-----------------BEGIN diagram9.vax-------------------
$! ---diagram9.vax---
$!VAX VMS procedure to diagram a (free format) Fortran language program
$!
$! by Mitchell R Grunes.
$!
$!I assume that the executable and this procedure are in the search
path,
$! and that this procedure has execute permission.
$!
$!Syntax:
$! @diagram9.vax
$!to be prompted for input parameters.
$!
$!Alternate Syntax:
$! @diagram9.vax filename(s)
$!to append diagram of file(s) into diagram.out
$
$ if P1 .EQS. ""
$ then
$ define/user sys$input sys$command
$ run diagramf
$ goto quit
$ endif
$
$ write sys$output "========================-- "+P1+"
--========================"
$ !Prompt answers: input from P1, output to diagram2.sc (for now),
$ ! place numbers in column 73, embed include files, use free
$ ! format, don't use IBM PC graphics.
$
$! Must pre-create diagram.out if does not exist
$ open/append/error=noSkip diagram.out diagram.out
$ goto Skip
$noSkip:
$ open/write diagram.out diagram.out
$Skip:
$ close diagram.out
$
$! Must pre-create diagram2.sc with same file attributes
$ open/write diagram2.sc diagram2.sc
$ close diagram2.sc
$
$ open/write diagram.sc diagram.sc
$ write diagram.sc "$Run diagramf"
$ write diagram.sc P1
$ write diagram.sc "diagram2.sc"
$ write diagram.sc "73"
$ write diagram.sc "1"
$ write diagram.sc "1"
$ write diagram.sc "0"
$ close diagram.sc
$ @diagram.sc
$ append diagram2.sc diagram.out
$ delete diagram.sc;*
$ delete diagram2.sc;*
$
$ if (P2 .NES. "") then @diagram9.vax 'P2' 'P3' 'P4' 'P5' 'P6' 'P7'
'P8'
$quit:
$ write sys$output "Note--This does not delete diagram.out before
appending to it."
------------------END diagram9.vax--------------------
-----------------BEGIN diagramh.f-------------------
c EXAMPLE OF OUTPUT (looks better if you choose IBM PC line graphics):


c ++-------- <html><head> | 1
c || | 2
c |+-------- <title>My Title</title> | 3
c || | 4
c |+-------- </head> | 5
c | | 6
c |+-------- <body> | 7
c |+-------- <a href="./doc.html">doc.html</a><br> | 8
c |+-------- </body> | 9
c +--------- </html> | 10

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 at domain yahoo.com).
c Revision date: 8/25/96.
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 at domain 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(21 ! (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(20
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 <html> block
! 1 In <html> block
! 2 <html> block has
already occurred
inhead=0 ! same for <head>
intitle=0 ! same for <title>
inbody=0 ! same for <body>
infont=0 ! same for <font>
inspan=0 ! same for <span>
inh1=0 ! same for <h1>,<h2...>
ina=0 ! same for <a ...>
inb=0 ! same for <b>
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(j.le.360.and.a(i:i).ge.'
'.and.a(i:i).lt.char(12)then
b(j:j)=a(i:i)
j=j+1
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.eq.0.and.icomment.eq.0
& .and.ltgt.ne.0)then
iquote=1-iquote
if(i.gt.1)then
! char(92) is \
if(iquote.eq.0.and.a(i-1:i-1).eq.char(92))
& iquote=1-iquote
endif
endif
if(c.eq.'"' .and.iquote .eq.0.and.icomment.eq.0
& .and.lgt.ne.0)then
idquote=1-idquote
if(i.gt.1)then
if(idquote.eq.0.and.a(i-1:i-1).eq.char(92))
& idquote=1-idquote
endif
endif
if(c.eq.'<'.and.i.lt.359.and.iquote.eq.0.and.idquo te.eq.0)
! <!- ?
& then
if(a(i+1:i+1).eq.'!'.and.a(i+2:i+2).eq.'-')then
if(icomment.ne.0)then
if(fout)print*,a
PRINT*,'***WARNING--nested comment LINE',form
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.eq.0.and.idquote.eq.0)
! -> ?
& then
if(a(i+1:i+1).eq.'>')then
if(icomment.eq.0)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)WRITE(2,*)'***ERROR: nested < LINE ',form
endif
ltgt=1
elseif(c.eq.'>')then
if(ltgt.eq.0)then
PRINT*,'***ERROR-- > without < LINE ',
& form
if(fout)
& WRITE(2,*)'***ERROR-- > without < LINE ',form
if(fout)print*,a
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)WRITE(2,*)'***ERROR--unclosed quote LINE ',form
if(fout)print*,a
print*,char(7)
endif

DO I=1,360
15 if(find(b(i:360),'<html>',1))then
if(InHtml.eq.1)then
PRINT*,'***ERROR--nested <html> LINE ',form
if(fout)WRITE(2,*)'***ERROR--nested <html> LINE ',form
if(fout)print*,a
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)
& WRITE(2,*)
& '***ERROR--<html> has already occurred LINE ',form
if(fout)print*,a
print*,char(7)
endif
InHtml=1
elseif(find(b(i:360),'</html>',1))then
if(InHtml.ne.1)then
PRINT*,'***ERROR--</html> without <html> LINE ',form
if(fout)
& WRITE(2,*)'***ERROR--</html> without <html> LINE ',form
if(fout)print*,a
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))then
if(InHtml.ne.1)then
PRINT*,'***ERROR--<head> not inside <html> LINE ',form
if(fout)WRITE(2,*)
& '***ERROR--<head> not inside <html> LINE ',form
if(fout)print*,a
print*,char(7)
endif
if(inhead.eq.1)then
PRINT*,'***ERROR--nested <head> LINE ',form
if(fout)WRITE(2,*)'***ERROR--nested <head> LINE ',form
if(fout)print*,a
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)WRITE(2,*)
& '***ERROR--<head> has already occurred LINE ',form
if(fout)print*,a
print*,char(7)
endif
inhead=1
elseif(find(b(i:360),'</head>',1))then
if(inhead.ne.1)then
PRINT*,'***ERROR--</head> without <head> LINE ',form
if(fout)
& WRITE(2,*)'***ERROR--</head> without <head> LINE ',form
if(fout)print*,a
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))then
if(inhead.ne.1)then
PRINT*,'***ERROR--<title> not inside <head> LINE ',form
if(fout)WRITE(2,*)
& '***ERROR--<title> not inside <head> LINE ',form
if(fout)print*,a
print*,char(7)
endif
if(intitle.eq.1)then
PRINT*,'***ERROR--nested <title> LINE ',form
if(fout)WRITE(2,*)'***ERROR--nested <title> LINE ',form
if(fout)print*,a
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)WRITE(2,*)
& '***ERROR--<title> has already occurred LINE ',form
if(fout)print*,a
print*,char(7)
endif
intitle=1
elseif(find(b(i:360),'</title>',1))then
if(intitle.ne.1)then
PRINT*,'***ERROR--</title> without <title> LINE ',form
if(fout)
& WRITE(2,*)'***ERROR--</title> without <title> LINE ',
& form
if(fout)print*,a
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)
& WRITE(2,*)'***WARNING--unclosed ',BlockType(i3+1),
& ' LINE ',form
if(fout)print*,a
print*,char(7)
i3=i3-1
enddo
endif
intitle=2
elseif(find(b(i:360),'<body>',1))then
if(InHtml.ne.1)then
PRINT*,'***ERROR--<body> not inside <html> LINE ',form
if(fout)WRITE(2,*)
& '***ERROR--<body> not inside <html> LINE ',form
if(fout)print*,a
print*,char(7)
endif
if(inhead.eq.1)then
PRINT*,'***ERROR--<body> inside <head> LINE ',form
if(fout)WRITE(2,*)
& '***ERROR--<body> inside <head> LINE ',form
if(fout)print*,a
print*,char(7)
endif
if(inhead.eq.0)then
PRINT*,'***ERROR--<body> before <head> LINE ',form
if(fout)WRITE(2,*)
& '***ERROR--<body> before <head> LINE ',form
if(fout)print*,a
print*,char(7)
endif
if(inbody.eq.1)then
PRINT*,'***ERROR--nested <body> LINE ',form
if(fout)WRITE(2,*)'***ERROR--nested <body> LINE ',form
if(fout)print*,a
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)
& WRITE(2,*)'***ERROR--<body> has already occurred LINE ',
& form
if(fout)print*,a
print*,char(7)
endif
inbody=1
elseif(find(b(i:360),'</body>',1))then
if(inbody.ne.1)then
PRINT*,'***ERROR--</body> without <body> LINE ',form
if(fout)
& WRITE(2,*)'***ERROR--</body> without <body> LINE ',form
if(fout)print*,a
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)WRITE(2,*)
& '***ERROR--<font> not inside <body> LINE ',form
if(fout)print*,a
print*,char(7)
endif
if(infont.eq.1)then
PRINT*,'***ERROR--nested <font> LINE ',form
if(fout)WRITE(2,*)'***ERROR--nested <font> LINE ',form
if(fout)print*,a
print*,char(7)
else
i3=i3+1
i4=1
BlockType(i3)='<font>'
endif
infont=1
elseif(find(b(i:360),'</font>',1))then
if(infont.ne.1)then
PRINT*,'***ERROR--</font> without <font> LINE ',form
if(fout)
& WRITE(2,*)'***ERROR--</font> without <font> LINE ',
& form
if(fout)print*,a
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
PRINT*,'***ERROR--<span> not inside <body> LINE ',form
if(fout)WRITE(2,*)
& '***ERROR--<span> not inside <body> LINE ',form
if(fout)print*,a
print*,char(7)
endif
if(Inspan.eq.1)then
PRINT*,'***ERROR--nested <span> LINE ',form
if(fout)WRITE(2,*)'***ERROR--nested <span> LINE ',form
if(fout)print*,a
print*,char(7)
else
i3=i3+1
i4=1
BlockType(i3)='<span>'
endif
inspan=1
elseif(find(b(i:360),'</span>',1))then
if(inspan.ne.1)then
PRINT*,'***ERROR--</span> without <span> LINE ',form
if(fout)
& WRITE(2,*)'***ERROR--</span> without <span> LINE ',
& form
if(fout)print*,a
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)
& WRITE(2,*)'***WARNING--unclosed ',BlockType(i3+1),
& ' LINE ',form
if(fout)print*,a
print*,char(7)
i3=i3-1
enddo
endif
inspan=0
elseif(b(i:i+2).ge.'<h1'.and.b(i:i+2).le.'<h9')the n
if(inbody.ne.1)then
PRINT*,'***ERROR--',b(i:i+4),' not inside <body>
LINE',form
if(fout)WRITE(2,*)
& '***ERROR--',b(i:i+4),' not inside <body> LINE ',form
if(fout)print*,a
print*,char(7)
endif
if(inh1.ne.0)then
PRINT*,'***ERROR--nested <h#> LINE',form
if(fout)WRITE(2,*)'***ERROR--nested <h#> LINE ',form
if(fout)print*,a
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***>'
if(fout)
& WRITE(2,*)'***Incorrect <h#> level LINE ',
& form
endif
if(inh1.eq.0)then
PRINT*,'***ERROR--</h#> without <h#> LINE',form
if(fout)
& WRITE(2,*)'***ERROR--</h#> without <h#> LINE ',
& form
if(fout)print*,a
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)
& WRITE(2,*)'***WARNING--unclosed ',BlockType(i3+1),
& ' LINE ',form
if(fout)print*,a
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)WRITE(2,*)
& '***ERROR--<a> not inside <body> LINE ',form
if(fout)print*,a
print*,char(7)
endif
if(ina.eq.1)then
PRINT*,'***ERROR--nested <a> LINE',form
if(fout)WRITE(2,*)'***ERROR--nested <a> LINE ',form
if(fout)print*,a
print*,char(7)
else
i3=i3+1
i4=1
BlockType(i3)='<a>'
endif
ina=1
elseif(find(b(i:360),'</a>',1))then
if(ina.ne.1)then
PRINT*,'***ERROR--</a> without <a> LINE ',form
if(fout)
& WRITE(2,*)'***ERROR--</a> without <a> LINE ',
& form
if(fout)print*,a
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)
& WRITE(2,*)'***WARNING--unclosed ',BlockType(i3+1),
& ' LINE ',form
if(fout)print*,a
print*,char(7)
i3=i3-1
enddo
endif
ina=0
elseif(find(b(i:360),'<b>',1))then
if(inbody.ne.1)then
PRINT*,'***ERROR--<b> not inside <body> LINE',form
if(fout)WRITE(2,*)
& '***ERROR--<b> not inside <body> LINE ',form
if(fout)print*,a
print*,char(7)
endif
if(inb.eq.1)then
PRINT*,'***ERROR--nested <b> LINE',form
if(fout)WRITE(2,*)'***ERROR--nested <b> LINE ',form
if(fout)print*,a
print*,char(7)
else
i3=i3+1
i4=1
BlockType(i3)='<b>'
endif
inb=1
elseif(find(b(i:360),'</b>',1))then
if(inb.ne.1)then
PRINT*,'***ERROR--</b> without <b> LINE',form
if(fout)
& WRITE(2,*)'***ERROR--</b> without <b> LINE ',
& form
if(fout)print*,a
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)
& WRITE(2,*)'***WARNING--unclosed ',BlockType(i3+1),
& ' LINE ',form
if(fout)print*,a
print*,char(7)
i3=i3-1
enddo
endif
inb=0
elseif(find(b(i:360),'<p>',1))then
if(inbody.ne.1)then
PRINT*,'***ERROR--<p> not inside <body> LINE',form
if(fout)WRITE(2,*)
& '***ERROR--<p> not inside <body> LINE ',form
if(fout)print*,a
print*,char(7)
endif
if(inp.eq.1)then
PRINT*,'***WARNING--prior <p> not closed',form
if(fout)WRITE(2,*)
& '***WARNING--prior <p> not closed LINE ',form
if(fout)print*,a
print*,char(7)
else
i3=i3+1
endif
i4=1
BlockType(i3)='<p>'
inp=1
elseif(find(b(i:360),'</p>',1))then
if(inp.ne.1)then
PRINT*,'***ERROR--</p> without <p> LINE',form
if(fout)
& WRITE(2,*)'***ERROR--</p> without <p> LINE ',
& form
if(fout)print*,a
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)
& WRITE(2,*)'***WARNING--unclosed ',BlockType(i3+1),
& ' LINE ',form
if(fout)print*,a
print*,char(7)
i3=i3-1
enddo
endif
inp=0
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)WRITE(2,*)
& '***ERROR--INVALID DIAGRAMMING INDEX LINE',form
if(fout)print*,b
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.eq.0.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,'(80a1,80a1,80a1,80a1,80a1)')
& (a(i:i),i=1,n)
if(.not.fout)write(*,'(1x,80a1,80a1,80a1,80a1)')
& (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 at domain 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)th en
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 at domain 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
------------------END diagramh.f--------------------
-----------------BEGIN diagramh.sh-------------------
#!/bin/csh
# ---diagramh.sh---
#Unix csh procedure to diagram an HTML language program.

#On some unix systems $1 should be replaced by %1.

# by Mitchell R Grunes.
# for his own use, in his own time

#I assume that the executable and this procedure are in the search
path,
# and that this procedure has execute permission.

#Syntax:
# diagramh.sh
#to be prompted for input parameters.

#Alternate Syntax:
# diagramh.sh filename(s)
#to append diagram of file(s) into diagram.out

if (${?noclobber}) then
unset noclobber
set noclobbersave
endif

if $1a == a then
diagramh
goto quit
endif

loop:
echo ========================-- $1 --========================
#Prompt answers: input from $1, output to diagram2.sc (for now),
# Don't place numbers in column 67, don't use IBM PC graphics,
# warn if 'end' ends if, for, etc.

echo $1 > diagram.sc
echo diagram2.sc >> diagram.sc
echo 0 >> diagram.sc
echo 1 >> diagram.sc
echo 0 >> diagram.sc
echo 0 >> diagram.sc

diagramh < diagram.sc
cat diagram2.sc >> diagram.out
rm -f diagram.sc
rm -f diagram2.sc
shift
if ! ($1a == a) then
goto loop
endif
quit:
echo Note--This does not delete diagram.out before appending to it.
if (${?noclobbersave}) then
set noclobber
unset noclobbersave
endif
------------------END diagramh.sh--------------------
-----------------BEGIN diagramh.bat-------------------
rem ---diagramh.bat---
rem MS-DOS procedure to diagram an HTML language program.

rem by Mitchell R Grunes.

rem I assume that the executable is in directory c:\grunes on
rem your PC.

rem Syntax:
rem diagramh
rem to be prompted for input parameters.

rem Alternate Syntax:
rem diagramh filename(s)
rem to append diagram of file(s) into diagram.out

if %1a == a c:\grunes\diagramh
if %1a == a goto quit

echo off
:loop
echo ========================-- %1 --========================
rem Prompt answers: input from %1, output to diagram2.sc (for now),
rem place numbers in column 67, use IBM PC graphics.

echo %1 > diagram.sc
echo diagram2.sc >> diagram.sc
echo 0 >> diagram.sc
echo 1 >> diagram.sc
echo 0 >> diagram.sc
echo 0 >> diagram.sc

c:\grunes\diagramh < diagram.sc
type diagram2.sc >> diagram.out
del diagram.sc
del diagram2.sc
shift
if not %1a == a goto loop
:quit
echo Note--This does not delete diagram.out before appending to it.
------------------END diagramh.bat--------------------
-----------------BEGIN diagramh.vax-------------------
$! ---diagramh.vax---
$!VAX VMS procedure to diagram an HTML language program
$!
$! by Mitchell R Grunes.
$!
$!I assume that the executable and this procedure are in the search
path,
$! and that this procedure has execute permission.
$!
$!Syntax:
$! @diagramh.vax
$!to be prompted for input parameters.
$!
$!Alternate Syntax:
$! @diagramh.vax filename(s)
$!to append diagram of file(s) into diagram.out
$
$ if P1 .EQS. ""
$ then
$ define/user sys$input sys$command
$ run diagramh
$ goto quit
$ endif
$
$ write sys$output "========================-- "+P1+"
--========================"
$
$! Must pre-create diagram.out if does not exist
$ open/append/error=noSkip diagram.out diagram.out
$ goto Skip
$noSkip:
$ open/write diagram.out diagram.out
$Skip:
$ close diagram.out
$
$! Must pre-create diagram2.sc with same file attributes
$ open/write diagram2.sc diagram2.sc
$ close diagram2.sc
$
$ !Prompt answers: input from P1, output to diagram2.sc (for now),
$ ! don't place line numbers anywhere, don't use IBM PC graphics.
$
$ open/write diagram.sc diagram.sc
$ write diagram.sc "$Run diagramh"
$ write diagram.sc P1
$ write diagram.sc "diagram2.sc"
$ write diagram.sc "0"
$ write diagram.sc "1"
$ write diagram.sc "0"
$ write diagram.sc "0"
$ close diagram.sc
$ @diagram.sc
$ append diagram2.sc diagram.out
$ delete diagram.sc;*
$ delete diagram2.sc;*
$
$ if (P2 .NES. "") then @diagramh.vax 'P2' 'P3' 'P4' 'P5' 'P6' 'P7'
'P8'
$ write sys$output "Note--This does not delete diagram.out before
appending to it."
$quit:
------------------END diagramh.vax--------------------
-----------------BEGIN diagrami.f-------------------
c EXAMPLE OF OUTPUT (looks better if you choose IBM PC line graphics):

c +--------- pro Sample,a,b,c | 1
c | a=indgen(15)^2 | 2
c |+-------- if a eq b then begin | 3
c || print,'A equals B' | 4
c || c=0 | 5
c |+-------- else begin | 6
c || print,'A does not equal B' | 7
c || c=1 | 8
c |+-------- endif | 9
c +--------- end | 10

c Diagrams IDL and PV-Wave begin(or case)-end constructs, functions
c and procedures, places a * next to goto and return statements.

c Designed by mitch grunes, in his own time.

c Program by Mitchell R Grunes, (grunes at domain yahoo.com).
c Revision date: 8/25/96.
c If you find it useful, or find a problem, please send me e-mail.

c -----------------------------------------------------
c This program was written in FORTRAN, for historic reasons.
c This was written in Fortran 77 (with common extensions) for
c portability. It should also compile under Fortran 90 and Fortran
95,
c provided you tell the compiler it is in card format.
c---------------------------------------------------------------------

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 diagrami ! Diagrammer for IDL
and
! PV-WAVE
character*80 filnam,filnam2

print*,'IDL 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*,'Use IBM PC graphics characters (0=no):'
iGraphics=0
read*,iGraphics
print*,iGraphics

print*,'Should I warn if "end" ends if, for... (0=no):'
iWarnEnd=1 ! Drop warnings on 'end'
for 'endif...'
read*,iWarnEnd
print*,iWarnEnd

call diagram(filnam,filnam2,LCol,iGraphics,iWarnEnd)
end
c-----------------------------------------------------------------------
subroutine diagram(filnam,filnam2,LCol,iGraphics,iWarnEnd)
c Program by Mitchell R Grunes, (grunes at domain yahoo.com).
character*80 filnam,filnam2
character*160 a,b
character*5 form
character*8 fm
character*1 c
logical find
external find
common icol,icol1
logical fout

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(21 ! (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(20
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....,.... '

i1=0 ! # nest levels before
! current line
i2=0 ! # nest levels on
! current line
i3=0 ! # of nest levels
after
! current line
i4=0 ! not 0 to flag start
or end
! of block
InSub=0 ! Inside a subroutine
or
! function?
nMain=0 ! no mainline program
yet
InCase=0 ! not inside case
iContinue=0 ! not continued from
prior line
nline=0
10 a=' '
read(1,'(a160)',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:160)
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(j.le.160.and.a(i:i).ge.'
'.and.a(i:i).lt.char(12)then
b(j:j)=a(i:i)
j=j+1
endif
enddo
i=1
j=1
a=' ' ! Pre-processing
iquote=0 ! no ' yet
idquote=0 ! no " yet
j=1
do i=1,LenA(b)
c=b(i:i)
if(c.ge.'A'.and.c.le.'Z')c=char(ichar(c)+32)
if(c.eq.';')goto 15 ! comment
if(c.eq.'@'.and.i.eq.1)goto 15 ! other procedure
includes
if(c.eq.''''.and.idquote.eq.0)then
iquote=1-iquote
c=' '
endif
if(c.eq.'"' .and.iquote .eq.0)idquote=1-idquote
if(iquote.ne.0.or.idquote.ne.0)c=' '
if(j.gt.1)then ! (kill multiple
spaces)
if(c.eq.' '.and.a(j-1:j-1).eq.' ')j=j-1
endif
if(c.eq.':')then ! (put space after
if(j.le.160) a(j:j)=':'
j=j+1
c=' '
endif
if(j.le.160) a(j:j)=c
j=j+1
enddo

15 i2=i1
i3=i1
i4=0
igoto=0 ! no goto on line

if(a.ne.' '.and.InSub.eq.0..and..not.
& (find(a,'function ',2).or.find(a,'pro ',2)))then !
mainline
InSub=InSub+1
nMain=nMain+1
if(fout)print*,'Line ',form,' ',b(1:LenA(b))
if(nMain.gt.1)then
PRINT*,'***ERROR--TOO MANY MAINLINES***'
if(fout)WRITE(2,*)'***ERROR--TOO MANY MAINLINES!***'
if(fout)print*,b
print*,char(7)
endif
i2=i2+1
i3=i3+1
endif

if(find(a,'goto',8+32).or.find(a,'return',1+12)i goto=1

if(find(a,'endif ',2).or.find(a,'endfor ',2)
& .or.find(a,'endelse ',2).or.find(a,'endwhile ',2)
& .or.find(a,'endcase ',2).or.find(a,'endrep ',2))then
i3=i3-1
if(find(a,'begin ',1))i3=i3+1
i4=max(i4,1)
if(i3.lt.InCase)InCase=0
elseif(find(a,'case ',1).or.find(a,'begin ',1))then
InCase=i1
i2=i2+1
i3=i3+1
i4=max(i4,1)
if(find(a,': begin ',0))i4=max(i4,2)
if(find(a,'end ',1))i3=i3-1
elseif(find(a,'end ',2))then
if(i3.gt.0.or.Insub.gt.0)then ! Problem: IDL end may
i3=i3-1 ! actually be an
endif,
! endelse, etc.
if(i3.eq.0.and.InSub.ne.0)InSub=0
if(i3.ne.0.and.iWarnEnd.ne.0)then
print*,'WARNING end at line ',form
print*,' "end" ends non-program!***'
if(fout)WRITE(2,*)'***WARNING--"end" ends
non-program!***'
print*,char(7)
endif
endif
if(i3.lt.InCase)InCase=0
elseif(find(a,'function ',2).or.find(a,'pro ',2))then
if(fout)print*,'Line ',form,' ',b(1:LenA(b))
InSub=InSub+1
i2=i2+1
i3=i3+1
if(InSub.ne.1.or.i3.ne.1)then
PRINT*,'***ERROR--INVALID DIAGRAMMING INDEX line',form
if(fout)
& WRITE(2,*)'***ERROR--INVALID DIAGRAMMING INDEX!***'
if(fout)print*,b
print*,char(7)
i3=1
InSub=1
endif
elseif((find(a,': ',0).or.find(a,':',256)).and.
& InCase.ne.0)then ! simple case instances
i4=max(i4,1)
elseif((find(a,':',0).and.InCase.ne.0))then !other case
instances
ileft=0
iright=0
ileft2=0
iright2=0
do i=1,icol1
if(a(i:i).eq.'(')ileft=ileft+1
if(a(i:i).eq.')')iright=iright+1
if(a(i:i).eq.'[')ileft2=ileft+1
if(a(i:i).eq.']')iright2=iright+1
enddo
if(ileft.eq.iright.and.ileft2.eq.iright2.and.icont inue.eq.0)
& i4=max(i4,1)
endif

icontinue=0
if(find(a,'$ ',0))icontinue=1

a=' '

if(i1.lt.0.or.i2.lt.0.or.i3.lt.0.or.i4.lt.0)then
PRINT*,'***ERROR--INVALID DIAGRAMMING INDEX line',form
if(fout)WRITE(2,*)'***ERROR--INVALID DIAGRAMMING INDEX!***'
if(fout)print*,b
print*,char(7)
i1=max(i1,0)
i2=max(i2,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:160)=b ! (must match column
header)

LastUse=1 ! Last usable diagram
col
dowhile(LastUse.lt.160.and.a(LastUse:LastUse).eq.' ')
LastUse=LastUse+1
enddo
LastUse=LastUse-2

if(igoto.ne.0)a(1:1)='*' ! Place * next to jumps

if(i2.gt.0)then ! Draw one vertical
line per
do i=2,min(i2+1,LastUse) ! nest level.
a(i:i)=BlockContinue(iBlock)
enddo
endif

if(i4.ne.0)then ! Draw horizontal lines
inward
do i=i2+2,LastUse ! from above.
a(i:i)=BlockHoriz(iBlock)
enddo
endif

do i=0,i4-1 ! May need to replace
some
! vertical lines with
c= BlockElse(iBlock) ! else symbol
if(i1+i.lt.i3)c=BlockBegin(iBlock) ! or begin symbol
if(i1+i.gt.i3)c=BlockEnd (iBlock) ! or end symbol
j=max(2,min(LastUse,i2+1-i))
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)
enddo

if(LCol.gt.0.and.a(max(1,LCol+11):160).eq.' ')then ! line
#
if(form(1:1).eq.' ')form(1:1)=BlockContinue(iBlock)
a(LCol+11:160)=form
endif

n=LenA(a) ! Output diagrammed
line
if(fout) write(2,'(80a1,80a1)')(a(i:i),i=1,n)
if(.not.fout)write(*,'(1x,80a1,80a1)')(a(i:i),i=1, n)

i1=i3
goto 10
99 if(i3.gt.0.or.InSub.ne.0)then
PRINT*,'***WARNING--SOME NEST LEVELS LEFT HANGING AT END***'
if(fout)print*,b
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: Prior, if exists,
must
! be blank
! 2: Must be first
non-blank
! 4: Prior character,
if
! present, must not
be
! alphanumeric.
! 8: Prior character,
if
! present, must be
blank
! or )
! 16: Prior character,
if
! present, must be
blank
! or ,
! 32: Next character
not
! alphanumeric
! 64: Next character
not
! alphabetic
! 128:Next character
must be
! blank or (
! 256:1st non-blank,
possibly
! except for
numeric
! labels
c Program by Mitchell R Grunes, (grunes at domain yahoo.com).
c Revision date: 8/25/96.
character*(*) a,b
character*1 c,cNext,c2
common icol,icol1
logical result

ii=len(a)
jj=len(b)
result=.false.
do i=1,ii-jj+1
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,1).ne.0.and.icol1.gt.1)th en
result=c.eq.' '
endif

if(result.and.iand(icond,2).ne.0.and.icol1.gt.1)th en
result=a(1:icol1-1).eq.' '
endif

if(result.and.iand(icond,4).ne.0)
& result=(c.lt.'0'.or.c.gt.'9').and.(c.lt.'a'.or.c.g t.'z')

if(result.and.iand(icond,.ne.0)result=c.eq.'
'.or.c.eq.')'

if(result.and.iand(icond,16).ne.0)result=
& c.eq.' '.or.c.eq.','

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,12.ne.0)
& result=cNext.eq.' '.or.cNext.eq.'('

if(result.and.iand(icond,256).ne.0.and.icol1.gt.1) then
ii=1
do iii=1,icol1-1
c2=a(iii:iii)
if(c2.ge.'0'.and.c2.le.'9')ii=iii+1
if(c2.ne.' '.and.(c2.lt.'0'.or.c2.gt.'9'))goto 20
enddo
20 if(ii.lt.icol1)then
result=a(ii:icol1-1).eq.' '
endif
endif

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 at domain 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
------------------END diagrami.f--------------------
-----------------BEGIN diagrami.sh-------------------
#!/bin/csh
# ---diagrami.sh---
#Unix csh procedure to diagram an IDL or PV-WAVE language program.

#On some unix systems $1 should be replaced by %1.

# by Mitchell R Grunes.
# for his own use, in his own time

#I assume that the executable and this procedure are in the search
path,
# and that this procedure has execute permission.

#Syntax:
# diagrami.sh
#to be prompted for input parameters.

#Alternate Syntax:
# diagrami.sh filename(s)
#to append diagram of file(s) into diagram.out

if (${?noclobber}) then
unset noclobber
set noclobbersave
endif

if $1a == a then
diagrami
goto quit
endif

loop:
echo ========================-- $1 --========================
#Prompt answers: input from $1, output to diagram2.sc (for now),
# Don't place line numbers anyware , don't use IBM PC graphics,
# warn if 'end' ends if, for, etc.

echo $1 > diagram.sc
echo diagram2.sc >> diagram.sc
echo 0 >> diagram.sc
echo 0 >> diagram.sc
echo 0 >> diagram.sc

diagrami < diagram.sc
cat diagram2.sc >> diagram.out
rm -f diagram.sc
rm -f diagram2.sc
shift
if ! ($1a == a) then
goto loop
endif
quit:
echo Note--This does not delete diagram.out before appending to it.
if (${?noclobbersave}) then
set noclobber
unset noclobbersave
endif
------------------END diagrami.sh--------------------
-----------------BEGIN diagrami.bat-------------------
rem ---diagrami.bat---
rem MS-DOS procedure to diagram an IDL or PV-WAVE language program.

rem by Mitchell R Grunes.

rem I assume that the executable is in directory c:\grunes on
rem your PC.

rem Syntax:
rem diagrami
rem to be prompted for input parameters.

rem Alternate Syntax:
rem diagrami filename(s)
rem to append diagram of file(s) into diagram.out

if %1a == a c:\grunes\diagrami
if %1a == a goto quit

echo off
:loop
echo ========================-- %1 --========================
rem Prompt answers: input from %1, output to diagram2.sc (for now),
rem does not show line numbers, use IBM PC graphics.

echo %1 > diagram.sc
echo diagram2.sc >> diagram.sc
echo 0 >> diagram.sc
echo 0 >> diagram.sc
echo 0 >> diagram.sc

c:\grunes\diagrami < diagram.sc
type diagram2.sc >> diagram.out
del diagram.sc
del diagram2.sc
shift
if not %1a == a goto loop
:quit
echo Note--This does not delete diagram.out before appending to it.
------------------END diagrami.bat--------------------
-----------------BEGIN diagrami.vax-------------------
$! ---diagrami.vax---
$!VAX VMS procedure to diagram an IDL or PV-WAVE language program
$!
$! by Mitchell R Grunes.
$!
$!I assume that the executable and this procedure are in the search
path,
$! and that this procedure has execute permission.
$!
$!Syntax:
$! @diagrami.vax
$!to be prompted for input parameters.
$!
$!Alternate Syntax:
$! @diagrami.vax filename(s)
$!to append diagram of file(s) into diagram.out
$
$ if P1 .EQS. ""
$ then
$ define/user sys$input sys$command
$ run diagrami
$ goto quit
$ endif
$
$ write sys$output "========================-- "+P1+"
--========================"
$
$! Must pre-create diagram.out if does not exist
$ open/append/error=noSkip diagram.out diagram.out
$ goto Skip
$noSkip:
$ open/write diagram.out diagram.out
$Skip:
$ close diagram.out
$
$! Must pre-create diagram2.sc with same file attributes
$ open/write diagram2.sc diagram2.sc
$ close diagram2.sc
$
$ !Prompt answers: input from P1, output to diagram2.sc (for now),
$ ! don't place line numbers anywhere, don't use IBM PC graphics.
$
$ open/write diagram.sc diagram.sc
$ write diagram.sc "$Run diagrami"
$ write diagram.sc P1
$ write diagram.sc "diagram2.sc"
$ write diagram.sc "0"
$ write diagram.sc "0"
$ write diagram.sc "0"
$ close diagram.sc
$ @diagram.sc
$ append diagram2.sc diagram.out
$ delete diagram.sc;*
$ delete diagram2.sc;*
$
$ if (P2 .NES. "") then @diagrami.vax 'P2' 'P3' 'P4' 'P5' 'P6' 'P7'
'P8'
$ write sys$output "Note--This does not delete diagram.out before
appending to it."
$quit:
------------------END diagrami.vax--------------------
-----------------BEGIN undiagram.f-------------------
program UnDiagram
c This attempt to extract source code from diagrammed
c programs created by DIAGRAMC, DIAGRAMF and DIAGRAMI.
c Program by Mitchell R Grunes, ATSC/NRL (grunes at domain yahoo.com).
c Revision date: 10/17/95.
c This program was written in FORTRAN, for historic reasons.

c Note that this leaves the headers consisting of the following 3
lines:
c <formfeed>=============--<filenames>--=============
c
.....,....1....,....2....,....3....,....4....,.... 5....,....6....,....7....,....8....,....9....,....

c filename lines, (and the following blank lines) but prints a warning
on the screen.

c It also hasn't been extensively tested.

character*80 FilNam
character*160 Line,Line2
character*1 c,c1,c2,c3,c4,c5
parameter (nIndent=11)

print*,'Input file (with diagrammed code):'
read(*,'(a80)')FilNam
print*,FilNam
open(1,file=FilNam,status='old')

print*,'Output file (with undiagrammed code):'
read(*,'(a80)')FilNam
print*,FilNam
open(2,file=FilNam)

LCol=0 ! column of |
nLine=0

1 read(1,'(a160)',end=99)Line
nLine=nLine+1

Line2=' ' ! Turn tabs to spaces
j=1
do i=1,160
if(Line(i:i).eq.char(9))then
j=(j-1)/8*8+8+1
! Make sure is good ASCII char
elseif(j.le.160.and.Line(i:i).ge.' '.
& and.Line(i:i).lt.char(12)then
Line2(j:j)=Line(i:i)
j=j+1
endif
enddo
Line=Line2

i=LenA(Line)+1
dowhile (LCol.eq.0.and.i.gt.14) ! Find column of ending
| ####
i=i-1
c5=Line(i :i)
c4=Line(i-1:i-1)
c3=Line(i-2:i-2)
c2=Line(i-3:i-3)
c1=Line(i-4:i-4)
if( (c1.eq.'|'.or.c1.eq.char(179).or.c1.eq.char(186)). and.
& (c2.eq.' '.or.(c2.ge.'0'.and.c2.le.'9')).and.
& (c3.eq.' '.or.(c3.ge.'0'.and.c3.le.'9')).and.
& (c4.eq.' '.or.(c4.ge.'0'.and.c4.le.'9')).and.
& ( (c5.ge.'0'.and.c5.le.'9')))then
LCol=i-4
print*,'| column = ',LCol,' from line ',nLine
endif
enddo

if(LCol.gt.0)then ! Remove trailing |
#### field.
i=LenA(Line)
if(i.eq.LCol+4)then
c5=Line(i :i)
c4=Line(i-1:i-1)
c3=Line(i-2:i-2)
c2=Line(i-3:i-3)
c1=Line(i-4:i-4)
if( (c1.eq.'|'.or.c1.eq.char(179).or.c1.eq.char(186)). and.
& (c2.eq.' '.or.(c2.ge.'0'.and.c2.le.'9')).and.
& (c3.eq.' '.or.(c3.ge.'0'.and.c3.le.'9')).and.
& (c4.eq.' '.or.(c4.ge.'0'.and.c4.le.'9')).and.
& ( (c5.ge.'0'.and.c5.le.'9')))
& Line(LCol:160)=' '
endif
endif

i=1 ! Remove diagram marks
iflag=0
c=Line(1:1)
dowhile((c.eq.' '.and.iflag.eq.0).or.c.eq.'+'.or.c.eq.'-'.or.
& c.eq.'|'.or.c.eq.'*'.or.(c.ge.char(179).and.c.le.c har(21))
Line(i:i)=' '
if(c.ne.' ')iflag=1
i=i+1
c=Line(i:i)
enddo

if(Line(1:nIndent).eq.' ')then ! Remove indentation
Line2=Line(nIndent+1:160)
Line=Line2
else
print*,'Wrong indentation at line ',nLine
print*,Line(1:LenA(Line))
print*,char(7)
endif

write(2,'(80a1,80a1)')(Line(i:i),i=1,LenA(Line))
goto 1

99 end
c-----------------------------------------------------------------------
function LenA(a) ! Length of string, at
least 1
c Program by Mitchell R Grunes, ATSC/NRL (grunes at domain yahoo.com).
c Revision date: 10/17/95.
character*(*) a
n=len(a)
dowhile(n.gt.1.and.a(n:n).eq.' ')
n=n-1
enddo
LenA=n
end
------------------END undiagram.f--------------------

 
Reply With Quote
 
 
 
 
Keith Thompson
Guest
Posts: n/a
 
      04-10-2006
"mitch grunes" <(E-Mail Removed)> writes:
> For people who have trouble reading that web page, see the folowing
> message I just posted this message to alt.sources:

[snip]

I suggest that anyone who has trouble reading the web page should
contact you directly. Posting serveral thousand lines of Fortran to
comp.lang.c and comp.lang.c++ is not a good idea.

--
Keith Thompson (The_Other_Keith) http://www.velocityreviews.com/forums/(E-Mail Removed) <http://www.ghoti.net/~kst>
San Diego Supercomputer Center <*> <http://users.sdsc.edu/~kst>
We must do something. This is something. Therefore, we must do this.
 
Reply With Quote
 
Ben Pfaff
Guest
Posts: n/a
 
      04-10-2006
"mitch grunes" <(E-Mail Removed)> writes:

> +----------- subroutine a(x) | 1
> |+---------- do i=1,5 | 2
> ||+----------- if(i/2*2.eq.i)then | 3
> ||| x=x*i | 4
> ||+----------- else | 5
> ||| x=x/i | 6
> ||+----------- endif | 7
> |+---------- enddo | 8
> +----------- end | 9


Do you actually find it easier to follow the lines or to look at
the indentation? I'd take indentation over a snaking maze of
lines any day.
--
"Give me a couple of years and a large research grant,
and I'll give you a receipt." --Richard Heathfield
 
Reply With Quote
 
Brooks Moses
Guest
Posts: n/a
 
      04-11-2006
Ben Pfaff wrote:
> "mitch grunes" <(E-Mail Removed)> writes:
>
>>+----------- subroutine a(x) | 1
>>|+---------- do i=1,5 | 2
>>||+----------- if(i/2*2.eq.i)then | 3
>>||| x=x*i | 4
>>||+----------- else | 5
>>||| x=x/i | 6
>>||+----------- endif | 7
>>|+---------- enddo | 8
>>+----------- end | 9

>
> Do you actually find it easier to follow the lines or to look at
> the indentation? I'd take indentation over a snaking maze of
> lines any day.


If you print out the text with the lines, and trace over them in colored
markers of various colors, they're pretty easy to follow.

- Brooks


--
The "bmoses-nospam" address is valid; no unmunging needed.
 
Reply With Quote
 
Richard Bos
Guest
Posts: n/a
 
      04-11-2006
Brooks Moses <(E-Mail Removed)> wrote:

> Ben Pfaff wrote:
> > "mitch grunes" <(E-Mail Removed)> writes:
> >
> >>+----------- subroutine a(x) | 1
> >>|+---------- do i=1,5 | 2
> >>||+----------- if(i/2*2.eq.i)then | 3
> >>||| x=x*i | 4
> >>||+----------- else | 5
> >>||| x=x/i | 6
> >>||+----------- endif | 7
> >>|+---------- enddo | 8
> >>+----------- end | 9

> >
> > Do you actually find it easier to follow the lines or to look at
> > the indentation? I'd take indentation over a snaking maze of
> > lines any day.

>
> If you print out the text with the lines, and trace over them in colored
> markers of various colors, they're pretty easy to follow.


Well yeah, but it's a lot of hard work to trace over 3914 lines of
useless Usenet post...

Richard
 
Reply With Quote
 
mitch grunes
Guest
Posts: n/a
 
      04-12-2006
>Well yeah, but it's a lot of
>hard work to trace over
>3914 lines of useless Usenet post...


OK, next time I'll limit the source code to alt.sources, or maybe find
another free web hoster that lets me store source code files.

Didn't occur to me that some Usenet reading programs make you read
everything.

As to the Ben Pfaff, who prefered identation, I do that on my own code.
It's good enough for short programs, if I make no mistakes.

But the next time someone hands you a 20000 or so line legacy program
developed by 200 people over 30 years, that no one alive understands,
you may appreciate whatever help you can get. There is a lot of code
out there like that. The definition of a professional is that you do
what you are payed to do.

Brooks Moses's idea of coloring indentation stuff to make it more clear
sounds neat. But a lot of work - I was trying to stay away from
postscript.

 
Reply With Quote
 
slebetman@yahoo.com
Guest
Posts: n/a
 
      04-12-2006
(E-Mail Removed) wrote:
> The latest revision of my source code diagramming programs are
> available at
>
> http://www.geocities.com/grunes/diagram.html
>
> These programs diagram source code in the following languages:
>
> C and C++<br>
> FORTRAN<br>
> HTML (very incomplete)<br>
> IDL, PV-WAVE, GDL and FL
>
> They do things like draw lines showing the start and end of routines
> and blocks, put * next to jumps, and = next to commented out sections,
> and can warn you of certain classes of error.
>
> They can help you find problems in your own code, or help you look at
> long complicated legacy code other people give you.
>
> The programs themselves are in FORTRAN. I know that is a problem for
> users of other programming languages, but it is freely available as g77
> or g95 under Cygwin (under Windows) or Linux, and is available on many
> other platforms.


Well... my favourite text editor already does what your program do and
does it live while I'm editing code. On top of that it also
*highlights* the relevant line when the cursor is on either the opening
or closing brace {}. On top of that it does syntax highlighting. On top
of that it also allows me to fold sections of code to temporarily hide
things I'm not interested in (and remember this is "live" while I'm
editing). And to top it all off it can print, save as RTF save as PDF
and save as HTML the nicely formatted code along with the nice lines.
The only difference is that my editor draws lines based on indentation
while your program auto-indent and draws lines based on braces. But
that's OK, that's what "indent" is for. Oh and yes my editor supports
syntax of more than 40 different languages including C/C++, Tcl,
Fortan, Forth, VB, Perl...

 
Reply With Quote
 
Edward Gregor
Guest
Posts: n/a
 
      04-12-2006
(E-Mail Removed) wrote:
> (E-Mail Removed) wrote:
>> The latest revision of my source code diagramming programs are
>> available at
>>
>> http://www.geocities.com/grunes/diagram.html
>>
>> These programs diagram source code in the following languages:
>>
>> C and C++<br>
>> FORTRAN<br>
>> HTML (very incomplete)<br>
>> IDL, PV-WAVE, GDL and FL
>>
>> They do things like draw lines showing the start and end of routines
>> and blocks, put * next to jumps, and = next to commented out sections,
>> and can warn you of certain classes of error.
>>
>> They can help you find problems in your own code, or help you look at
>> long complicated legacy code other people give you.
>>
>> The programs themselves are in FORTRAN. I know that is a problem for
>> users of other programming languages, but it is freely available as g77
>> or g95 under Cygwin (under Windows) or Linux, and is available on many
>> other platforms.

>
> Well... my favourite text editor already does what your program do and
> does it live while I'm editing code. On top of that it also
> *highlights* the relevant line when the cursor is on either the opening
> or closing brace {}. On top of that it does syntax highlighting. On top
> of that it also allows me to fold sections of code to temporarily hide
> things I'm not interested in (and remember this is "live" while I'm
> editing). And to top it all off it can print, save as RTF save as PDF
> and save as HTML the nicely formatted code along with the nice lines.
> The only difference is that my editor draws lines based on indentation
> while your program auto-indent and draws lines based on braces. But
> that's OK, that's what "indent" is for. Oh and yes my editor supports
> syntax of more than 40 different languages including C/C++, Tcl,
> Fortan, Forth, VB, Perl...
>


May I ask which editor you are using?
 
Reply With Quote
 
Gary L. Scott
Guest
Posts: n/a
 
      04-12-2006
mitch grunes wrote:
>>Well yeah, but it's a lot of
>>hard work to trace over
>>3914 lines of useless Usenet post...

>
>
> OK, next time I'll limit the source code to alt.sources, or maybe find
> another free web hoster that lets me store source code files.
>
> Didn't occur to me that some Usenet reading programs make you read
> everything.
>
> As to the Ben Pfaff, who prefered identation, I do that on my own code.
> It's good enough for short programs, if I make no mistakes.
>
> But the next time someone hands you a 20000 or so line legacy program
> developed by 200 people over 30 years, that no one alive understands,
> you may appreciate whatever help you can get. There is a lot of code
> out there like that. The definition of a professional is that you do
> what you are payed to do.
>
> Brooks Moses's idea of coloring indentation stuff to make it more clear
> sounds neat. But a lot of work - I was trying to stay away from
> postscript.
>

On windows, color would be quite easy using an RTF edit box. You can
then output the RTF content to disk. RTF is widely supported as an
import format to most word processors on other platforms and it remains
editable. Postscript is a printer data stream. It shouldn't be used as
a document interchange format. I would think that it would be
desireable for this output to remain editable so that you can import it
into presentations or other documents and tweak it (fonts, spacing, etc).

--

Gary Scott
(E-Mail Removed)

Fortran Library: http://www.fortranlib.com

Support the Original G95 Project: http://www.g95.org
-OR-
Support the GNU GFortran Project: http://gcc.gnu.org/fortran/index.html

Why are there two? God only knows.


If you want to do the impossible, don't hire an expert because he knows
it can't be done.

-- Henry Ford
 
Reply With Quote
 
 
 
Reply

Thread Tools

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Diagramming code hamilton Python 13 07-17-2012 02:11 PM
Free source code diagramming programs idlwizard-1@yahoo.com C Programming 21 04-14-2006 06:50 PM
Perl flow/code diagramming tools? ixtahdoom Perl Misc 1 09-09-2004 09:01 AM
network diagramming tools? Volatileacid Cisco 7 07-30-2004 09:09 PM
Network diagramming best practices white paper Peter Yardley Cisco 0 12-27-2003 05:35 AM



Advertisments