home *** CD-ROM | disk | FTP | other *** search
- /* generate list of a any source file */
- trace off
- signal on BREAK_C
- say 'time='time('e')
- parse arg srcnam '\' optn
-
- parse upper value optn with 'PITCH='pitch .
- if pitch = '' then pitch = '0f'
- pitch = x2c(pitch)
-
- parse upper value optn with 'SPACE='space .
- if space = '' then space = 1
-
- parse upper value optn with 'MARGIN='margin .
- if space = '' then margin = 0
-
- parse upper value optn with 'LINES='parm1 .
- if datatype(parm1,'N') = 0
- then do
- parm1 = 50
- end
-
- parse value optn with '>'parm2 .
- if parm2 = ''
- then parm2 = 'prt:'
-
- srcnam = trim(srcnam)
-
- date = date('W') date('U') time()
-
- call open('list',parm2,'W')
- call writech('list','1b7703'x)
-
- openstat = open('srctxt',srcnam,'R')
- if openstat = 0
- then do
- say 'FILE NOT FOUND ('srcnam')'
- exit
- end
-
- say srcnam
- linect = 0
- pagect = 0
-
- hd1 = ''
- hd2 = ''
- hd3 = ''
-
- call sethd
-
- do forever
- if eof('srctxt') then leave
-
- if linect = 0
- then do
- pagect = pagect + 1
- srcnam = substr(srcnam,1,30)
- call writech('list','12'x)
- prtline = 'FILE: 'srcnam 'DATE: 'date' PAGE: 'pagect
- call writeln('list',prtline)
- call writeln('list',prtline)
- call writech('list',pitch)
- if hd1 ~= ''
- then do
- call writeln('list',' ')
- call writeln('list',hd1)
- call writeln('list',' ')
- linect = linect + 3
- end
- if hd2 ~= ''
- then do
- call writeln('list',hd2)
- linect = linect + 1
- end
- if hd3 ~= ''
- then do
- call writeln('list',hd3)
- linect = linect + 1
- end
- call writeln('list',' ')
- call writeln('list',' ')
- end
-
- linect = linect + 1
- call writeln('list',record)
- do space-1
- linect = linect + 1
- call writeln('list','')
- end
-
- if linect > parm1
- then do
- linect = 0
- call writech('list','0c'x)
- end
-
- call sethd
-
- end
- if linect > 0
- then do
- call writech('list','0c'x)
- end
-
- call writech('list','12'x)
- call close('srctxt')
- call close('list')
- say 'time='time('e')
- exit
-
- sethd:
- signal on break_c
- do forever
- record = readln('srctxt')
- parse value record with op h a v
- parse value record with ':'opc'.'.
- select
- when op = '.set'
- then do
- if a ~= '=' then return
- if h = 'hd1' then hd1 = v
- if h = 'hd2' then hd2 = v
- if h = 'hd3' then hd3 = v
- end
- when op = '.cp'
- then do
- if h = '' then h = parm1
- if parm1 - linect - h <= 0
- then do
- linect = 0
- call writech('list','0c'x)
- end
- end
- when op = '.df'
- then do
- parse value record with '.df' font data
- df.font = data
- end
- when op = '.bf'
- then do
- parse value record with '.bf' font .
- if df.font = 'DF.'font
- then
- say 'Font' font 'not defined.'
- else
- call writech('list',df.font)
- end
- when opc = 'ol'
- then do
- if ol = 'OL' then ol = 0
- ol = ol + 1
- ol.ol = 0
- end
- when opc = 'ul'
- then do
- if ol = 'OL' then ol = 0
- ol = ol + 1
- ol.ol = substr('o+*-',ol,1)
- end
- when opc = 'li'
- then do
- parse value record with ':'opc'.'record
- if ol.ol = 'OL.'ol
- then say not within list
- else do
- if datatype(ol.ol,'n')
- then do
- ol.ol = ol.ol+1
- record = ol.ol'). 'record
- end
- else
- record = ol.ol' 'record
- end
- return
- end
- when opc = 'eol' | opc = 'eul'
- then do
- drop ol.ol
- if ol = 'OL' then ol = 0
- ol = ol - 1
- if ol < 0 then say eol error
- end
- otherwise
- return
- end
- if eof('srctxt') then return
- end
- return
-
- BREAK_C:
- exit
-