program MakeDocumentationProcedure; {written in Turbo Pascal by Glenn Brooke 4/14/85 Public Use Intended. Reads a text file (documentation file) and creates a new file containing a Turbo-Pascal procedure that will print this file onscreen (w/ pagination), ready for inclusion into other programs. This means you can write your documentation with a word processor, then run this program to create the procedure to list the information for the user running your program. No more writeln(' '); statements to type! Enjoy. note : the program handles apostrophes, so you won't have to modify your text file for any reason.} const ScreenLength = 22; {display 22 lines plus [more] message} type filename = string[14]; str80 = string[80]; line = string[255]; var abort : boolean; doc, proc : text; procname, docname : filename; proctitle : string[14]; text_line : line; page : array [1..screenlength] of line; function Exist(T : filename) : boolean; {returns true if T exists, false if it doesn't exist} var fil : file; begin assign(fil,T); {$I-} reset(fil); {$I+} Exist := (IOresult=0) end; procedure Header; {writes opening code of procedure} begin writeln(proc,'procedure ',proctitle,';'); writeln(proc); writeln(proc,'begin'); writeln(proc,'clrscr;'); end; procedure More; {writes code for pagination control} begin writeln(proc,'write('' [more] '');'); writeln(proc,'repeat until keypressed;'); end; procedure Tail; {writes end of procedure code} begin writeln(proc,'write('' Press any key to continue...'');'); writeln(proc,'repeat until keypressed;'); writeln(proc,'clrscr;'); writeln(proc,'end; {of ',procname,' }'); end; procedure GetLines; {fills page array with lines from .doc file} var i : integer; begin for i := 1 to Screenlength do begin page[i] := ''; readln(doc,text_line); page[i] := text_line; end; end; procedure AdaptLines; {creates writeln statements from text lines} var i,j : integer; where : integer; T : line; begin for i := 1 to Screenlength do begin {check for apostrophes in text, add another if find one} j := 1; T := page[i]; repeat if T[j] = chr(39) then insert(chr(39),T,j+1); j := j + 2; until j >= length(T); page[i] := T; {create writeln statement from fixed line} page[i] := 'writeln('' ' + page[i] + ' '');'; {write the statement to the procedure file} writeln(proc,page[i]); end; end; procedure BigDash; {purely for looks} var i : integer; begin for i := 1 to 79 do write('='); end; function ConstStr(C : char; N : integer) : str80; {needed for centering function} var S : string[80]; begin if N < 0 then N := 0; S[0] := chr(N); fillchar(S[1],n,c); constStr := S; end; function Centered(TheString:str80) : str80; begin Centered := constStr(' ',((80-length(TheString)) div 2)) + TheString; end; procedure OpenFiles; {opens valid files, allows early abort if desired.} var i,site : integer; openok : boolean; begin clrscr; gotoxy(1,1); bigdash; writeln(centered('MAKING A DOCUMENTATION PROCEDURE FROM A TEXT FILE')); writeln(centered('v 1.2 April 1985')); writeln(centered('written by Glenn Brooke for Z-Node')); bigdash; gotoxy(10,8); abort := false; repeat {get name of text file, abort if cr} write('Name of text file to process ( CR to quit ) :'); readln(docname); writeln; abort := length(docname) <= 0; if not abort then begin for I := 1 to length(docname) do docname[i] := upcase(docname[i]); if not Exist(docname) then writeln(' ',docname,' not found...') else OPENOK := true; end; until openok or abort; if not abort then begin {get output procedure file if not aborting} writeln(' Enter the name of the procedure -- no filename extents'); writeln(' permitted, or the program will crash. The procedure will'); writeln(' be written to your procedure name + .PRO . Example : '); writeln(' You enter : b:docum'); writeln(' Your procedure is named : docum '); writeln(' Your output file is called : b:docum.pro'); writeln; gotoxy(10,18); write('Name of procedure (output) file : '); readln(procname);writeln; if length(procname) <= 0 then procname := 'lst:'; for i := 1 to length(procname) do procname[i] := upcase(procname[i]); proctitle := procname; {remove drive signature from procedure title} if pos(':',proctitle) = 2 then delete(proctitle,1,2); {add extent of .PRO to output filename} procname := procname + '.PRO'; assign(doc,docname); reset(doc); {set up to read input file} assign(proc,procname); rewrite(proc); {set up to write to output file -- note} end; {if file exists, will write over it!} end; {openfiles} begin {main program body} OpenFiles; if not abort then begin writeln;write(' Working.....'); Header; while not eof(doc) do begin GetLines; AdaptLines; More; end; Tail; close(doc); {closing files is imperative!} close(proc); writeln('Job finished. '); gotoxy(1,24); end; end.