); the user may remove this', 1 'and refine the presentation after conversion. Alternatively,', 1 'pairs ofanddirectives may be pre-inserted', 1 'in the HELP file to protect tables, etc., and formatted', 1 'output produced (the default).', 1 ' ', 1 'Usage : the program expects a Help file prefix, eg. "FOOBAR".', 1 'It will then read FOOBAR.HLP, creating the Hypertext files', 1 'FOOBAR.HTML,FOOBAR_1.HTML,FOOBAR_2.HTML, etc. plus FOOBAR.HREF,', 1 'a list of the references created which may be used to add', 1 'further cross-references manually.', 1 'Depending on the format of the original HLP file, the', 1 'hypertext output may start either in FOOBAR.HTML or in', 1 'FOOBAR_1.HTML.', 1 ' ' / integer maxlevel parameter (maxlevel=9) ! max. no. of levels in HLP file character*80 filenm character*132 title character*40 path integer pathn character*30 prefix character*80 word,words(maxlevel) character*132 line,line2 integer nch integer wns(maxlevel) integer level,prev_level,k,j integer wn, fln,pxn,tn integer partn,nl,refn character*34 part,parts(maxlevel) character*7 ref integer nquotes character*1 pre_flag c== 1 type *,'Enter Help file prefix (blank for help):' accept 101,pxn,prefix 100 format(a) if (prefix.eq.' ') then type *,descrip goto 1 endif type *,'Default to pre-formatted HTML (y/n) ?' accept 100,pre_flag if (pre_flag.eq.'y') pre_flag = 'Y' type *,'Enter optional href filename path (default blank):' accept 101,pathn,path if (pathn.eq.0) then c avoid trouble with path(1:0); squash will eat extra space pathn = 1 path = ' ' endif prev_level = 0 level = 0 partn = 0 refn = 0 nquotes = 0 open(unit=maxlevel+2,file=prefix//'.hlp',status='old',readonly,err=1) open(unit=maxlevel+1,file=prefix//'.href',status='new', 1 carriagecontrol='list') write(maxlevel+1,*) 'List of references for ',prefix c create base file filenm=path(1:pathn)//prefix//'.html' call squash(filenm,fln) type *,'Creating file ',filenm(1:fln) open(unit=0,file=filenm,status='new', 1 carriagecontrol='list') c write header for new file write(level,100) ' ' write(level,100) 'Help for ',prefix(1:pxn), 1 ' ' write(level,100) '' if (pre_flag.eq.'Y') write(level,100) '' ! default pre-formatted 2 read(maxlevel+2,101,end=99) nch,line 101 format(q,a) nl = nl + 1 if (nch.eq.0.or.line.eq.' ') then if (level.gt.0) write(level,100) '' write(k,100) '' write(k,100) '' ! paragraph goto 2 endif if ((line(1:1).lt.'1').or.(line(1:1).gt.'9')) goto 3 read(line,102,err=3) level 102 format(bn,i1) 66 word = line(2:nch) wn = nch - 1 wns(level) = wn words(level) = word c type *,'Level ',level,' Key "',word(1:wn),'"' if (level.lt.prev_level) then do k=prev_level,level+1,-1 if (pre_flag.eq.'Y') write(k,100) '
Converted from .HLP to .HTML by ' write(k,100) 1 '', 1 'HLPTOHTML.
' write(k,100) '' ! close <>'s in file close(unit=k) ! close all intermediate level files type *,'Closing unit ',k enddo part = parts(level) ! restore filename to old level filenm=path(1:pathn)//part//'.html' call squash(filenm,fln) write(level,100) '' ! close list if (pre_flag.eq.'Y') write(level,100)'
' ! restore pre-formatting endif if (level.gt.prev_level+1) type *,'ERROR - skipped level in HELP file' if (level.gt.prev_level) then partn = partn + 1 write(part,103) prefix,partn 103 format(a,'_',i3) parts(level) = part filenm=path(1:pathn)//part//'.html' call squash(filenm,fln) type *,'Creating file ',filenm(1:fln) open(unit=level,file=filenm(1:fln),status='new', 1 carriagecontrol='list') c write header for new file title= words(1)(1:wns(1)) tn = wns(1) do k=2,level-1 title= title(1:tn)//':'//words(k)(1:wns(k)) call squash(title,tn) enddo write(level,100) '' write(level,100) '' write(level,100) '' write(k,100) '' write(k,100) '',title(1:tn),' ' write(level,100) '' write(level,100) '' if (pre_flag.eq.'Y') write(level,100) '' ! default pre-formatted if (pre_flag.eq.'Y') write(prev_level,100)'' if (level.gt.1) then write(prev_level,100)'Additional Information on:
' else write(prev_level,100)' Information available on:
' endif endif ! (level.gt.prev_level) c if (level.le.prev_level) then refn = refn + 1 write(ref,104) refn 104 format('Ref',i4.4) c write keyword in new file as heading and name write(level,100) 1 ' '//word(1:wn)//'
' c write keyword in parent file as href and list item write(level-1,100) 1 ''// 1 word(1:wn)//' ' c write in list of references write(maxlevel+1,100) 1 ''// 1 word(1:wn)//'' prev_level=level goto 2 3 if (level.lt.0) goto 2 c support for pre-conditioning of HLP file formatting if ( (index(line,' ').gt.0.or.index(line,'').gt.0) 1 .or. (index(line,'&').eq.0.and. 1 index(line,'>').eq.0.and.index(line,'<').eq.0) ) then write(level,100) line(1:nch) goto 2 else c quote HTML reserved characters j = 0 do k=1,nch if (line(k:k).eq.'&') then line2(j+1:j+5) = '&' j = j + 5 elseif (line(k:k).eq.'<') then line2(j+1:j+5) = '<' j = j + 4 elseif (line(k:k).eq.'>') then line2(j+1:j+5) = '>' j = j + 4 else j = j + 1 line2(j:j) = line(k:k) endif enddo write(level,100) line2(1:j) c type *,'Reserved characters quoted, line',nl nquotes = nquotes + 1 goto 2 endif 99 do k=level,0,-1 if (pre_flag.eq.'Y') write(k,100) '').gt.0) 1 .or. (index(line,'').gt.0.or.index(line,'Converted from .HLP to .HTML by ' write(k,100) 1 '', 1 'HLPTOHTML.
' write(k,100) '' ! close <>'s in file close(unit=k) ! close all intermediate level files type *,'Closing unit ',k enddo type *,'HTML reserved characters were quoted on ',nquotes,' lines' close(maxlevel+1) close(maxlevel+2) end subroutine squash(word,nc) c remove spaces from char. string character*(*) word character*132 cooked integer nr,nc,k,j last= .false. j = 0 nr = len(word) do k=1,nr if (word(k:k).eq.' '.or.word(k:k).eq.' ') then if (last) then c j=j+1 c cooked(j:j)= '_' endif last = .false. else j=j+1 cooked(j:j) = word(k:k) last = .true. endif enddo nc=j if (nc.gt.0) word=cooked(1:nc) return end