Program HTML2HLP implicit integer (a-z) parameter (mbitmaps=20,mconfigs=100) character*(100) SourceFile character*127 DestFile character*20000 buffer character*100 lastag,tag,URL,tURL,title,upcase character*200 cline character*12 HelpFile /'WWHelp.HTM'/ character*12 HelpProj /'WWHelp.HPJ'/ character*12 HelpRTF /'WWHelp.RTF'/ character*100 bitmaps(mbitmaps) logical title_out,fexists external upcase,htmlp c SourceFile = 'c:n3000.cnv'//char(0) inquire(file=HelpRTF,exist=fexists) if(fexists) then open(2,file=HelpRTF,status='unknown',err=900) close(2,status='delete') endif inquire(file=HelpProj,exist=fexists) if(fexists) then open(2,file=HelpProj,status='unknown',err=900) close(2,status='delete') endif open(2,file=HelpRTF,status='unknown',err=900) open(3,file=HelpProj,status='unknown',err=920) call initRTF call initProj title = 'Automagically Generated from HTML2HLP' title_out = .false. lastag = '
'
llast = 6
c
nconfigs = 0
nbitmaps = 0
call = 0
1 status = htmlp(SourceFile,lbuffer,buffer,ltag,tag,
& ltURL,tURL,call)
if(status.lt.0) goto 910
if(status.gt.0) goto 2
call = call + 1
if(ltURL.ne.0) then
URL = tURL
lURL = ltURL
endif
c
c convert tags ...
c
tag = upcase(tag,ltag)
if(tag(:4).eq.'') then
write(2,'(a)') '{\\strike '//buffer(:lbuffer)//'}'
write(2,'(a)') '{\\v '//
& '!MakeDocument("'//URL(:lURL)//'",0);'//
& 'GetCacheNameCopy(0," ");'//
& 'EP("HTML2HLP.EXE",1);'//
& 'EP("HC31.EXE WWHELP",1)}'
else
call putRTF(buffer,lbuffer,lastag,llast,title_out)
endif
if(tag(:3).ne.'') then
write(3,'(a)') 'title = '//buffer(:lbuffer)
title_out = .true.
return
else if(tag(:4).eq.'
') then write(2,'(a)') '\\pard\\plain' else if(tag(:3).eq.'') then write(2,'(a)')
'\\b{' else if(tag(:4).eq.'') then write(2,'(a)') '}' else if(tag(:6).eq.''.or. &
tag(:6).eq.'
'.or.
& tag(:7).eq.'
') then
write(2,'(a)') '\\par \\tx360 \\li720 \\fi-360 \\ql'
else if(tag(:7).eq.'
') then
write(2,'(a)') '\\line\\pard\\plain'
else if(tag(:4).eq.'') then
write(2,'(a)') '\\line'
write(2,'(a)') '{\\f0\\''B7} \\tab'
endif
if(lbuffer.ne.0) write(2,'(a)') buffer(:lbuffer)
end
character*(*) function upcase(char,lc)
character*(*) char
character*26 up /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
character*26 lo /'abcdefghijklmnopqrstuvwxyz'/
upcase = char
do i=1,lc
ipos = index(lo,char(i:i))
if (ipos.ne.0) upcase(i:i) = up(ipos:ipos)
end do
end
Subroutine initProj
write(3,'(a)') '; Automagically generated from HTML2HLP'
write(3,'(a)') '[OPTIONS]'
write(3,'(a)') 'copyright= (c) J.J.Bunn 1994 '
write(3,'(a)') 'oldkeyphrase=off'
write(3,'(a)') 'compress=high'
write(3,'(a)') 'warning=3'
end
Subroutine endProj
close(3)
end
integer function htmlp(SourceFile,lbuffer,buffer,
& ltag,tag,lURL,URL,call)
implicit integer (a-z)
integer ipos
character*(*) SourceFile
character*20000 buffer
character*100 context,tag,URL
character*200 cline
character*100 null
save ipos,cline,lline,ilevel,ntags
c
lbuffer = 0
ltag = 0
lURL = 0
if(call.eq.0) then
lsf = index(SourceFile,char(0))-1
write(3,'(a)') '; Source file '//sourcefile(:lsf)
if(lsf.le.0) goto 900
open(1,file=SourceFile(:lsf),status='old',err=902)
write(3,*) '; Source file opened'
ntags = 0
null = ' '
context = null
goto 1
else
goto 3
end if
1 read(1,'(a)',end=2,err=2) cline
lline = lenocc(cline)
if(lline.le.0) goto 1
cline = cline(:lline)//' '
lline = lline + 1
c
ipos = 0
ilevel = 0
3 ipos = ipos+1
if(ipos.gt.lline) goto 1
if(cline(ipos:ipos).eq.'<'.and.ilevel.eq.0) then ntags="ntags" + 1 iend="index(cline(ipos:lline),'">')
if(iend.ne.0) then
tag = cline(ipos:ipos+iend-1)
ltag = iend
ipos = ipos + iend - 1
ihref=max(index(tag,'href='),index(tag,'HREF='))
URL = ' '
lURL = 0
if(ihref.ne.0) then
URL = tag(ihref+5:ltag-1)
if(URL(1:1).eq.'"') then
URL = URL(2:)
endif
l1 = 999
l2 = 999
l3 = 999
if(index(URL,'"').gt.0) then
l1 = index(URL,'"')-1
else if(index(URL,' ').gt.0) then
l2 = index(URL,' ')-1
else
l3 = index(URL,'>')-1
endif
lURL = min(l1,l2,l3)
endif
htmlp = 0
goto 1000
else
goto 901
endif
else
lbuffer = lbuffer + 1
buffer(lbuffer:lbuffer) = cline(ipos:ipos)
endif
goto 3
2 close(1)
htmlp = ntags
write(3,'(a,i6,a)') '; Source file : ',ntags,' tags'
goto 1000
900 htmlp = -5000
goto 1000
901 htmlp = -5001
goto 1000
902 htmlp = -5002
1000 continue
end
integer function lenocc(c)
character*(*) c
lenocc = 0
do lenocc=len(c),1,-1
if(c(lenocc:lenocc).ne.' ') return
end do
end
subroutine initRTF
write(2,'(a)') '{\\rtf1\\ansi \\deff3\\deflang1024'
write(2,'(a)') '{\\fonttbl'
write(2,'(a)') '{\\f0\\froman Times New Roman;}'
write(2,'(a)') '{\\f1\\froman Symbol;}'
write(2,'(a)') '{\\f2\\fswiss Arial;}'
write(2,'(a)') '{\\f3\\froman Tms Rmn;}'
write(2,'(a)') '{\\f4\\fswiss Helv;}'
write(2,'(a)') '{\\f5\\fdecor ZapfDingbats;}'
write(2,'(a)') '{\\f6\\fmodern Courier;}}'
write(2,'(a)') '{\\stylesheet'
write(2,'(a)') '{\\fs10\\lang1033 \\snext0 Normal;}'
write(2,'(a)') '}'
end
subroutine endRTF
write(2,'(a)') '}'
end