#-h- cdefio 321 asc 11-may-81 18:14:23 [002,100] ## common block to hold pushed-back input characters # put on a file called 'cdefio' # used by ratfor, macro, roff common /cdefio/ bp, buf(BUFSIZE) integer bp # next available character; init = 0 character buf # pushed-back characters #-t- cdefio 255 local 12/01/80 16:02:52 #-h- cfiles 309 asc 11-may-81 18:14:24 [002,100] ## common block used to hold list of input files # put on a file called 'cfiles' # used by macro, roff common /cfiles/ infile(NFILES), level integer infile # stack of file descriptors integer level # current file is infile(level) #-t- cfiles 243 local 12/01/80 16:02:51 #-h- cmac 156 asc 11-may-81 18:14:26 [002,100] # common block to hold symbol table for macros # put on a file called 'cmac' common /cmac/ mactbl pointer mactbl # symbol table containing macros #-h- cnr 248 asc 11-may-81 18:14:27 [002,100] ## common block holding number registers for format tool # put on a file called "cnr" # used only by the format tool common /cnr/ nr(26) integer nr # number registers a..z #-t- cnr 182 local 12/01/80 16:02:51 #-h- cout 534 asc 11-may-81 18:14:28 [002,100] ## common block holding output lines and info for format tool # put on a file called "cout" # used only by the format tool common /cout/ outp, outw, outwds, outbuf(MAXOUT) integer outp # last char position in outbuf; init = 0 integer outw # width of text currently in outbuf; init = 0 integer outwds # number of words in outbuf; init = 0 character outbuf # lines to be filled collect here # word in outbuf; init=0 #-t- cout 468 local 12/01/80 16:02:51 #-h- cpage 1808 asc 11-may-81 18:14:30 [002,100] ## common block holding misc. page info for format tool # put on a file called "cpage" # (used only by format tool) common /cpage/ curpag,newpag,lineno,plval,m1val,m2val,m3val,m4val, bottom, ehead(MAXLINE), ohead(MAXLINE), ehlim(2), ohlim(2), efoot(MAXLINE), ofoot(MAXLINE), eflim(2), oflim(2), stopx, frstpg, lastpg, print, offset integer curpag # current output page number; init = 0 integer newpag # next output page number; init = 1 integer lineno # next line to be printed; init = 0 integer plval # page length in lines; init = PAGELEN = 66 integer m1val # margin before and including header integer m2val # margin after header integer m3val # margin after last text line integer m4val # bottom margin, including footer integer bottom # last live line on page, = plval-m3val-m4val character ehead # top of page title for even pages;init=NEWLINE character ohead # top of page title for odd pages;init=NEWLINE integer ehlim # left,right margins for even header;init=inval,rmval integer ohlim # left,right margins for odd header;init=inval,rmval character efoot # bot of page title for even pages;init=NEWLINE character ofoot # bot of page title for odd pages;init=NEWLINE integer eflim # left,right margins for even footer;init=inval,rmval integer oflim # left,right margins for odd footer;init=inval,rmval integer stopx # flag for pausing between pages integer frstpg # first page to begin printing with integer lastpg # last page to be printed integer print # flag to indicate whether page should be printed integer offset # number of blanks to offset page by; init = 0 #-t- cpage 1742 local 12/01/80 16:02:51 #-h- cparam 1148 asc 11-may-81 18:14:32 [002,100] ## common block holding misc. line info for format tool # put on a file called "cparam" # (used ony by format tool) common /cparam/ fill, lsval, inval, rmval, tival, ceval, ulval, boval, tjust(3), bsval, rjust, cuval, tabs(INSIZE), cchar integer fill # fill if YES; init = YES integer lsval # current line spacing; init = 1 integer inval # current indent; >= 0; init = 0 integer rmval # current right margin; init = PAGEWIDTH = 60 integer tival # current temporary indent; init = 0 integer ceval # number of lines to center; init = 0 integer ulval # number of lines to underline; init = 0 integer boval # number of lines to boldface; init = 0 integer tjust # justification types for heads and foots; # init = LEFT, CENTER, RIGHT integer bsval # number of lines to blank suppress; init=0 integer rjust # right justify filled lines if YES; init=YES integer cuval # number lines to continuously underline; init = 0 integer tabs # tab stops; init every 8 spaces character cchar # line control character; init = PERIOD #-h- ctemp 358 asc 11-may-81 18:14:33 [002,100] ## common block holding temporary buffers for format tool # put on a file called "ctemp" # (used only by format tool) common /ctemp/ tbuf1(MAXLINE), tbuf2(MAXLINE), ttl(MAXLINE) character tbuf1 # scratch arrays for use by puttl and tabs character tbuf2 # character ttl # #-t- ctemp 292 local 12/01/80 16:02:50 #-h- format.r 35392 asc 11-may-81 18:14:41 [002,100] #-h- defns 2773 asc 11-may-81 16:37:46 [002,100] # format - text formatter # include ratdef # define the following if you want format to output a # page eject character (CNTRL-L) rather than count lines # to finish off a page # define(PAGECONTROL,) define(PAGECONTROL,) define(ARGFLAG,DOLLAR) define(INSIZE,400) define(MAXOUT,400) define(MAXDEF,200) define(NFILES,arith(MAXOFILES,-,4)) define(PAGENUM,SHARP) define(CURRENTDATE,PERCENT) define(PAGEJECT,FF) # FF is ASCII formfeed (control-L) define(PAGEWIDTH,65) define(PAGELEN,62) define(BUFSIZE,400) # push back buffer define(UNKNOWN,0) define(DEFINED,-1) define(LEFT,1) define(CENTER,2) define(RIGHT,3) define(STARTU,-10) # start underscoring define(STOPU,-11) # stop underscoring define(FI,1) define(NF,2) define(BR,3) define(LS,4) define(BP,5) define(SP,6) define(IN,7) define(RM,8) define(TI,9) define(CE,10) define(UL,11) define(HE,12) define(FO,13) define(PL,14) define(PO,15) define(BD,16) define(M1,17) define(M2,18) define(M3,19) define(M4,20) define(EH,21) define(OH,22) define(EF,23) define(OF,24) define(CC,25) define(NE,26) define(BS,27) define(JU,28) define(NJ,29) define(SO,30) define(CU,31) define(DE,32) define(EN,33) define(NR,34) define(ST,35) define(MEMSIZE,5000) # space for macro names and text DRIVER(format) character arg(MAXLINE) integer getarg, open, ctoi integer i, fd, nf, j include cpage include cparam include cout call finit nf = 0 call query ("usage: format [-s] [+n] [-n] [-pon] [files].") for (i = 1; getarg(i, arg, MAXLINE) != EOF; i = i + 1) if (arg(1) == MINUS & (arg(2) == LETS | arg(2) == BIGS)) stopx = 1 else if (arg(1) == MINUS & (arg(2) == LETP | arg(2) == BIGP) & (arg(3) == LETO | arg(3) == BIGO)) { j = 4 call set(offset, ctoi(arg, j), arg(4), 0, 0, rmval-1) } else if (arg(1) == PLUS) { j = 2 frstpg = ctoi(arg, j) } else if (arg(1) == MINUS & arg(2) != EOS) { j = 2 lastpg = ctoi(arg, j) } else { if (arg(1) == MINUS) fd = STDIN else fd = open(arg, READ) if (fd == ERR) { call putlin (arg, ERROUT) call remark (": can't open.") next } call doroff(fd) nf = nf + 1 if (fd != STDIN) call close(fd) } if (nf == 0) # no files, do STDIN call doroff(STDIN) call brk if (plval <= 100 & (lineno > 0 | outp > 0)) call space(HUGE) # flush last output ifdef(PAGECONTROL) call putc(PAGEJECT) call putc(NEWLINE) enddef DRETURN end #-h- bold 727 asc 11-may-81 16:02:40 [002,100] # bold - bold-face or overstrike a line subroutine bold(buf, tbuf, size) integer i, j, size character buf(ARB), tbuf(ARB) j = 1 # expand into tbuf for (i = 1; buf(i) != NEWLINE & j < size-1; i = i + 1) { tbuf(j) = buf(i) j = j + 1 if (buf(i) != BLANK & buf(i) != TAB & buf(i) != BACKSPACE & buf(i) != STARTU & buf(i) != STOPU) { tbuf(j) = BACKSPACE tbuf(j+1) = tbuf(j-1) tbuf(j+2) = BACKSPACE tbuf(j+3) = tbuf(j+1) j = j + 4 } } tbuf(j) = NEWLINE tbuf(j+1) = EOS call scopy(tbuf, 1, buf, 1) # copy it back to buf return end #-t- bold 661 local 12/01/80 16:10:42 #-h- brk 298 asc 11-may-81 16:02:41 [002,100] # brk - end current filled line subroutine brk include cout if (outp > 0) { outbuf(outp) = NEWLINE outbuf(outp+1) = EOS call put(outbuf) } outp = 0 outw = 0 outwds = 0 return end #-t- brk 232 local 12/01/80 16:10:42 #-h- center 260 asc 11-may-81 16:02:42 [002,100] # center - center a line by setting tival subroutine center(buf) character buf(ARB) integer max, width include cparam tival = max((rmval+tival-width(buf))/2, 0) return end #-t- center 194 local 12/01/80 16:10:42 #-h- comand 4607 asc 11-may-81 16:02:44 [002,100] # comand - perform formatting command subroutine comand(buf) character buf(MAXLINE), name(MAXLINE), defn(MAXDEF) integer comtyp, getval, max, getwrd, open, length integer argtyp, ct, spval, val, i, j include cpage include cparam include cfiles include cnr ct = comtyp(buf, defn) if (ct == UNKNOWN) # ignore unknown commands return call doesc(buf, name, MAXLINE) i = 1 # skip command name while (buf(i) != BLANK & buf(i) != TAB & buf(i) != NEWLINE) i = i + 1 val = getval(buf, i, argtyp) if (ct == DEFINED) call eval(buf, defn) else if (ct == FI) { call brk fill = YES } else if (ct == NF) { call brk fill = NO } else if (ct == BR) call brk else if (ct == LS) call set(lsval, val, argtyp, 1, 1, HUGE) else if (ct == CE) { call brk call set(ceval, val, argtyp, 1, 0, HUGE) } else if (ct == UL) { cuval = 0 call set(ulval, val, argtyp, 0, 1, HUGE) } else if (ct == BD) call set(boval, val, argtyp, 0, 1, HUGE) else if (ct == HE) { call gettl(buf, ehead, ehlim) call gettl(buf, ohead, ohlim) } else if (ct == FO) { call gettl(buf, efoot, eflim) call gettl(buf, ofoot, oflim) } else if (ct == BP) { call brk # perform break explicitly if (lineno > 0) call space(HUGE) call set(curpag, val, argtyp, curpag+1, -HUGE, HUGE) newpag = curpag } else if (ct == SP) { call set(spval, val, argtyp, 1, 0, HUGE) call space(spval) } else if (ct == IN) { call brk call set(inval, val, argtyp, 0, 0, rmval-1) tival = inval } else if (ct == RM) call set(rmval, val, argtyp, PAGEWIDTH, tival+1, HUGE) else if (ct == TI) { call brk call set(tival, val, argtyp, 0, 0, rmval) } else if (ct == PL) { call set(plval, val, argtyp, PAGELEN, m1val+m2val+m3val+m4val+1, HUGE) bottom = plval - m3val - m4val } else if (ct == PO) call set(offset, val, argtyp, 0, 0, rmval-1) else if (ct == M1) call set(m1val, val, argtyp, 3, 0, plval-m2val-m3val-m4val-1) else if (ct == M2) call set(m2val, val, argtyp, 2, 0, plval-m1val-m3val-m4val-1) else if (ct == M3) { call set(m3val, val, argtyp, 2, 0, plval-m1val-m2val-m4val-1) bottom = plval - m3val - m4val } else if (ct == M4) { call set(m4val, val, argtyp, 3, 0, plval-m1val-m2val-m3val-1) bottom = plval - m3val - m4val } else if (ct == EH) call gettl(buf, ehead, ehlim) else if (ct == OH) call gettl(buf, ohead, ohlim) else if (ct == EF) call gettl(buf, efoot, eflim) else if (ct == OF) call gettl(buf, ofoot, oflim) else if (ct == CC) { cchar = argtyp if (cchar == EOS | cchar == NEWLINE) cchar = PERIOD if ((lineno + val) > bottom & lineno <= bottom) { call space(val) lineno = 0 } } else if (ct == NE) { if ((lineno + val) > bottom & lineno <= bottom) { call space(val) lineno = 0 } } else if (ct == BS) call set(bsval, val, argtyp, 1, 0, HUGE) else if (ct == JU) rjust = YES else if (ct == NJ) rjust = NO else if (ct == SO) { if (getwrd(buf, i, name) == 0) return if (level + 1 > NFILES) call error("so commands nested too deeply.") infile(level+1) = open(name, READ) if (infile(level+1) != ERR) level = level + 1 } else if (ct == CU) { ulval = 0 call set(cuval, val, argtyp, 0, 1, HUGE) } else if (ct == DE) call dodef(buf, infile(level)) else if (ct == NR) { if (getwrd(buf, i, name) == 0) return call fold(name) if (name(1) < LETA | name(1) > LETZ) call error("invalid number register name.") val = getval(buf, i, argtyp) call set(nr(name(1)-LETA+1), val, argtyp, 0, -HUGE, HUGE) } else if (ct == ST) { if (argtyp == MINUS) spval = plval else spval = 0 call set(spval, val, argtyp, 0, 1, bottom) if (spval > lineno & lineno == 0) call phead if (spval > lineno) call space(spval - lineno) } return end #-t- comand 4541 local 12/15/80 10:12:45 #-h- comtyp 2686 asc 11-may-81 17:34:37 [002,100] # comtyp - decode command type integer function comtyp(buf, defn) character buf(MAXLINE), defn(MAXDEF) character name(MAXNAME) integer i integer ludef, getwrd include cmac i = 2 i = getwrd(buf, i, name) if (i > 2) name(3) = EOS if (ludef(name, defn, mactbl) == YES) comtyp = DEFINED else if (buf(2) == LETF & buf(3) == LETI) comtyp = FI else if (buf(2) == LETN & buf(3) == LETF) comtyp = NF else if (buf(2) == LETB & buf(3) == LETR) comtyp = BR else if (buf(2) == LETL & buf(3) == LETS) comtyp = LS else if (buf(2) == LETB & buf(3) == LETP) comtyp = BP else if (buf(2) == LETS & buf(3) == LETP) comtyp = SP else if (buf(2) == LETI & buf(3) == LETN) comtyp = IN else if (buf(2) == LETR & buf(3) == LETM) comtyp = RM else if (buf(2) == LETT & buf(3) == LETI) comtyp = TI else if (buf(2) == LETC & buf(3) == LETE) comtyp = CE else if (buf(2) == LETU & buf(3) == LETL) comtyp = UL else if (buf(2) == LETH & buf(3) == LETE) comtyp = HE else if (buf(2) == LETF & buf(3) == LETO) comtyp = FO else if (buf(2) == LETP & buf(3) == LETL) comtyp = PL else if (buf(2) == LETP & buf(3) == LETO) comtyp = PO else if (buf(2) == LETB & buf(3) == LETD) comtyp = BD else if (buf(2) == LETM & buf(3) == DIG1) comtyp = M1 else if (buf(2) == LETM & buf(3) == DIG2) comtyp = M2 else if (buf(2) == LETM & buf(3) == DIG3) comtyp = M3 else if (buf(2) == LETM & buf(3) == DIG4) comtyp = M4 else if (buf(2) == LETE & buf(3) == LETH) comtyp = EH else if (buf(2) == LETO & buf(3) == LETH) comtyp = OH else if (buf(2) == LETE & buf(3) == LETF) comtyp = EF else if (buf(2) == LETO & buf(3) == LETF) comtyp = OF else if (buf(2) == LETC & buf(3) == LETC) comtyp = CC else if (buf(2) == LETN & buf(3) == LETE) comtyp = NE else if (buf(2) == LETB & buf(3) == LETS) comtyp = BS else if (buf(2) == LETJ & buf(3) == LETU) comtyp = JU else if (buf(2) == LETN & buf(3) == LETJ) comtyp = NJ else if (buf(2) == LETS & buf(3) == LETO) comtyp = SO # else if (buf(2) == LETC & buf(3) == LETU) # comtyp = CU else if (buf(2) == LETD & buf(3) == LETE) comtyp = DE else if (buf(2) == LETE & buf(3) == LETN) comtyp = EN else if (buf(2) == LETN & buf(3) == LETR) comtyp = NR else if (buf(2) == LETS & buf(3) == LETT) comtyp = ST else comtyp = UNKNOWN return end #-t- comtyp 2593 local 12/01/80 16:10:44 #-h- dodef 829 asc 11-may-81 16:32:29 [002,100] # dodef - define a command; .de xx is in buf subroutine dodef(buf, fd) character buf(MAXLINE) integer fd character name(MAXNAME), defn(MAXDEF) integer i, junk integer getwrd, addstr, addset, ngetln include cparam include cmac i = 1 junk = getwrd(buf, i, name) i = getwrd(buf, i, name) # get name if (i == 0) call error("missing name in command definition.") if (i > 2) name(3) = EOS # truncate to xx i = 1 while (ngetln(buf, fd) != EOF) { if (buf(1) == cchar & buf(2) == LETE & buf(3) == LETN) break junk = addstr(buf, defn, i, MAXDEF) } if (addset(EOS, defn, i, MAXDEF) == NO) call error("definition too long.") call entdef(name, defn, mactbl) return end #-t- dodef 739 local 12/01/80 16:10:45 #-h- doesc 817 asc 11-may-81 16:02:52 [002,100] # doesc - expand escapes in buf subroutine doesc(buf, tbuf, size) character buf(ARB), tbuf(ARB) integer size integer i, j integer itoc include cnr j = 1 # expand into tbuf for (i = 1; buf(i) != EOS & j < size; i = i + 1) if (buf(i) != ESCAPE) { tbuf(j) = buf(i) j = j + 1 } else if (buf(i+1) == ESCAPE) { tbuf(j) = ESCAPE j = j + 1 i = i + 1 } else if (buf(i+1) == LETN & (buf(i+2) >= LETA & buf(i+2) <= LETZ)) { j = j + itoc(nr(buf(i+2)-LETA+1), tbuf(j), size - j - 1) i = i + 2 } else { tbuf(j) = buf(i) j = j + 1 } tbuf(j) = EOS call scopy(tbuf, 1, buf, 1) return end #-t- doesc 751 local 12/01/80 16:10:45 #-h- doroff 601 asc 11-may-81 16:02:53 [002,100] # doroff - format text in file fd subroutine doroff(fd) integer fd character inbuf(INSIZE) integer ngetln include cfiles include cparam infile(1) = fd for (level = 1; level > 0; level = level - 1) { while (ngetln(inbuf, infile(level)) != EOF) if (inbuf(1) == cchar) # it's a command call comand(inbuf) else # it's text call text(inbuf) if (level > 1 & infile(level) >= 0) call close(infile(level)) } return end #-t- doroff 535 local 12/01/80 16:10:45 #-h- dotabs 617 asc 11-may-81 16:03:39 [002,100] # dotabs - expand tabs in buf subroutine dotabs(buf, tbuf, size) character buf(ARB), tbuf(ARB) integer size integer i, j include cparam j = 1 # expand into tbuf for (i = 1; buf(i) != EOS & j < size; i = i + 1) if (buf(i) == TAB) while (j < size) { tbuf(j) = BLANK j = j + 1 if (tabs(j) == YES | j > INSIZE) break } else { tbuf(j) = buf(i) j = j + 1 } tbuf(j) = EOS call scopy(tbuf, 1, buf, 1) return end #-t- dotabs 551 local 12/01/80 16:10:46 #-h- eval 1111 asc 11-may-81 16:03:42 [002,100] # eval - evaluate defined command; push back definition subroutine eval(buf, defn) character buf(MAXLINE), defn(MAXDEF) integer i, j, k, argptr(10) integer length for (j = 1; j <= 10; j = j + 1) # initialize arguments to null argptr(j) = 1 buf(1) = EOS i = 2 for (j = 1; j <= 10; j = j + 1) { call skipbl(buf, i) if (buf(i) == NEWLINE | buf(i) == EOS) break argptr(j) = i while (buf(i) != BLANK & buf(i) != TAB & buf(i) != NEWLINE & buf(i) != EOS) i = i + 1 buf(i) = EOS i = i + 1 } for (k = length(defn); k > 1; k = k - 1) if (defn(k-1) != ARGFLAG) call putbak(defn(k)) else { if (defn(k) < DIG0 | defn(k) > DIG9) call putbak(defn(k)) else { i = defn(k) - DIG0 + 1 i = argptr(i) call pbstr(buf(i)) k = k - 1 # skip over $ } } if (k > 0) # do last character call putbak(defn(k)) return end #-t- eval 1045 local 12/01/80 16:10:47 #-h- finit 1532 asc 11-may-81 16:27:18 [002,100] # finit - set parameters to default values subroutine finit integer i integer mod pointer mktabl include cparam include cpage include cout include cdefio include cnr include cmac DS_DECL(Mem, MEMSIZE) inval = 0 # initialize cparam rmval = PAGEWIDTH tival = 0 lsval = 1 fill = YES ceval = 0 ulval = 0 boval = 0 cchar = PERIOD tjust(1) = LEFT tjust(2) = CENTER tjust(3) = RIGHT bsval = 0 rjust = YES cuval = 0 for (i = 1; i <= INSIZE; i = i + 1) if (mod(i, 8) == 1) tabs(i) = YES else tabs(i) = NO lineno = 0 # initialize cpage curpag = 0 newpag = 1 plval = PAGELEN m1val = 3 m2val = 2 m3val = 2 m4val = 3 bottom = plval - m3val - m4val ehead(1) = NEWLINE ehead(2) = EOS ohead(1) = NEWLINE ohead(2) = EOS efoot(1) = NEWLINE efoot(2) = EOS ofoot(1) = NEWLINE ofoot(2) = EOS ehlim(1) = inval ehlim(2) = rmval ohlim(1) = inval ohlim(2) = rmval eflim(1) = inval eflim(2) = rmval oflim(1) = inval oflim(2) = rmval stopx = 0 frstpg = 0 lastpg = HUGE print = YES offset = 0 outp = 0 # initialize cout outw = 0 outwds = 0 call dsinit (MEMSIZE) mactbl = mktabl (1) # symbol table for macros bp = 0 # initialize cdefio for (i = 1; i <= 26; i = i + 1) # initialize cnr nr(i) = 0 return end #-t- finit 1440 local 12/01/80 16:10:47 #-h- gettl 515 asc 11-may-81 16:03:46 [002,100] # gettl - copy title from buf to ttl subroutine gettl(buf, ttl, lim) character buf(MAXLINE), ttl(MAXLINE) integer i, lim(2) include cparam i = 1 # skip command name while (buf(i) != BLANK & buf(i) != TAB & buf(i) != NEWLINE) i = i + 1 call skipbl(buf, i) # find argument call scopy(buf, i, ttl, 1) # copy titles to ttl lim(1) = inval # set limits lim(2) = rmval return end #-t- gettl 449 local 12/01/80 16:10:48 #-h- getval 395 asc 11-may-81 16:03:47 [002,100] # getval - evaluate optional numeric argument; increment i integer function getval(buf, i, argtyp) character buf(MAXLINE) integer i, argtyp integer ctoi call skipbl(buf, i) # find argument argtyp = buf(i) if (argtyp == PLUS | argtyp == MINUS) i = i + 1 getval = ctoi(buf, i) return end #-t- getval 329 local 12/01/80 16:10:48 #-h- getwrb 530 asc 11-may-81 16:03:49 [002,100] # getwrb - get a word; hangs onto trailing blanks integer function getwrb(in, i, out) character in(ARB), out(ARB) integer i, j j = 1 while (in(i) != EOS & in(i) != BLANK & in(i) != TAB & in(i) != NEWLINE) { out(j) = in(i) i = i + 1 j = j + 1 } while (in(i) == BLANK) { # include trailing blanks out(j) = BLANK i = i + 1 j = j + 1 } out(j) = EOS getwrb = j - 1 return end #-t- getwrb 464 local 12/01/80 16:10:48 #-h- gfield 653 asc 11-may-81 16:03:50 [002,100] # gfield - get next tab or title field integer function gfield(buf, i, n, temp, delim) character buf(ARB), temp(ARB), delim integer i, j, n j = 1 if (n > 0) { if (buf(i) == delim) i = i + 1 while (buf(i) != delim & buf(i) != EOS & buf(i) != NEWLINE & j <= n) { temp(j) = buf(i) j = j + 1 i = i + 1 } } temp(j) = EOS gfield = j - 1 # set to number of characters copied while (buf(i) != delim & buf(i) != EOS & buf(i) != NEWLINE) i = i + 1 return end #-t- gfield 587 local 12/01/80 16:10:48 #-h- jcopy 337 asc 11-may-81 16:03:52 [002,100] # jcopy - scopy without copying EOS subroutine jcopy(from, i, to, j) character from(ARB), to(ARB) integer i, j, k1, k2 k1 = i k2 = j while (from(k1) != EOS) { to(k2) = from(k1) k1 = k1 + 1 k2 = k2 + 1 } return end #-t- jcopy 271 local 12/01/80 16:10:49 #-h- justify 487 asc 11-may-81 16:04:41 [002,100] # justfy - justifies string in its tab column subroutine justfy(in, left, right, type, out) character in(ARB), out(ARB) integer left, right, type, max, j, n, width n = width(in) if (type == RIGHT) call jcopy(in, 1, out, right-n) else if (type == CENTER) { j = max((right+left-n)/2, left) call jcopy(in, 1, out, j) } else call jcopy(in, 1, out, left) return end #-t- justify 421 local 12/01/80 16:10:49 #-h- leadbl 501 asc 11-may-81 16:04:42 [002,100] # leadbl - delete leading blanks, set tival subroutine leadbl(buf) character buf(MAXLINE) integer max integer i, j include cparam call brk for (i = 1; buf(i) == BLANK; i = i + 1) # find 1st non-blank ; if (buf(i) != NEWLINE) tival = tival + i - 1 for (j = 1; buf(i) != EOS; j = j + 1) { # move line to left buf(j) = buf(i) i = i + 1 } buf(j) = EOS return end #-t- leadbl 435 local 12/01/80 16:10:49 #-h- ngetch 355 asc 11-may-81 16:04:45 [002,100] # ngetch - get a (possibly pushed back) character from file fd character function ngetch(c, fd) character c integer fd character getch include cdefio if (bp > 0) { c = buf(bp) bp = bp - 1 } else c = getch(c, fd) ngetch = c return end #-t- ngetch 289 local 12/01/80 16:11:07 #-h- ngetln 479 asc 11-may-81 16:04:47 [002,100] # ngetln - get next line from f into line integer function ngetln(line, f) character line(MAXLINE), c, ngetch integer f for (ngetln = 0; ngetch(c, f) != EOF; ) { if (ngetln < MAXLINE - 1) { ngetln = ngetln + 1 line(ngetln) = c } if (c == NEWLINE) break } line(ngetln+1) = EOS if (ngetln == 0 & c == EOF) ngetln = EOF return end #-t- ngetln 413 local 12/01/80 16:11:07 #-h- pbstr 269 asc 11-may-81 16:04:48 [002,100] # pbstr - push string back onto input subroutine pbstr(in) character in(MAXLINE) integer length integer i for (i = length(in); i > 0; i = i - 1) call putbak(in(i)) return end #-t- pbstr 203 local 12/01/80 16:11:07 #-h- pfoot 417 asc 11-may-81 16:37:55 [002,100] # pfoot - put out page footer subroutine pfoot integer mod include cpage call skip(m3val) if (m4val > 0) { if (mod(curpag, 2) == 1) call puttl(efoot, eflim, curpag) else call puttl(ofoot, oflim, curpag) ifnotdef(PAGECONTROL) call skip(m4val-1) enddef } return end #-t- pfoot 330 local 12/01/80 16:11:08 #-h- phead 709 asc 11-may-81 16:37:57 [002,100] # phead - put out page header subroutine phead include cpage integer c(MAXLINE) integer mod curpag = newpag if (curpag >= frstpg & curpag <= lastpg) print = YES else print = NO if(stopx > 0 & print == YES) call prmpt(stopx) newpag = newpag + 1 ifdef(PAGECONTROL) if (stopx == 0 & print == YES) call putc(PAGEJECT) enddef if (m1val > 0) { call skip(m1val-1) if (mod(curpag, 2) == 0) call puttl(ehead, ehlim, curpag) else call puttl(ohead, ohlim, curpag) } call skip(m2val) lineno = m1val + m2val + 1 return end #-t- phead 644 local 12/01/80 16:11:08 #-h- prmpt 464 asc 11-may-81 17:09:34 [002,100] # prmpt - pause for paper insertion; prompt if i == 1; increment i subroutine prmpt(i) integer i integer open, getlin, prompt integer tin, tout, junk character line(MAXLINE) string tell "Type return to begin a page" string trmin TERMINAL_IN tin = open(trmin, READ) if (tin == ERR) return if (i == 1) junk = prompt(tell, line, tin) else junk = getlin(line, tin) call close(tin) i = i + 1 return end #-h- put 1564 asc 11-may-81 16:06:43 [002,100] # put - put out line with proper spacing and indenting subroutine put(buf) character buf(MAXLINE) integer min, width integer i, j, k, w, c, cuflg include cpage include cparam data cuflg /NO/ if (lineno == 0 | lineno > bottom) call phead if (print == YES) { for (i = 1; i <= offset; i = i + 1) # page offset call putc(BLANK) for (i = 1; i <= tival; i = i + 1) # indenting call putc(BLANK) for (i = 1; buf(i) != EOS & buf(i) != NEWLINE; i = i + 1) if (buf(i) == STARTU) cuflg = YES else if (buf(i) == STOPU) cuflg = NO else if (cuflg == YES) { # underlining for (j = i; buf(i) != STOPU & buf(i) != NEWLINE & buf(i) != EOS; i = i + 1) ; c = buf(i) buf(i) = EOS w = width(buf(j)) for (k = 1; k <= w; k = k + 1) call putch(UNDERLINE, STDOUT) for (k = 1; k <= w; k = k + 1) call putch(BACKSPACE, STDOUT) for (; j < i; j = j + 1) call putch(buf(j), STDOUT) buf(i) = c i = i - 1 } else call putch(buf(i), STDOUT) call putch(NEWLINE, STDOUT) } tival = inval call skip(min(lsval-1, bottom-lineno)) lineno = lineno + lsval if (lineno > bottom) call pfoot return end #-t- put 1498 local 12/01/80 16:11:09 #-h- putbak 287 asc 11-may-81 16:06:45 [002,100] # putbak - push character back onto input subroutine putbak(c) character c include cdefio bp = bp + 1 if (bp > BUFSIZE) call error("too many characters pushed back.") buf(bp) = c return end #-t- putbak 221 local 12/01/80 16:11:09 #-h- puttl 1298 asc 11-may-81 16:06:47 [002,100] # puttl - put out title line with optional page number & date subroutine puttl(buf, lim, pageno) character buf(MAXLINE), chars(MAXCHARS), delim, cdate(20) integer pageno, lim(2) integer nc, itoc, i, j, n, left, right, gfield, ncd, now (7) integer length include cpage include cparam include ctemp if (print == NO) return left = lim(1) + 1 right = lim(2) + 1 nc = itoc(pageno, chars, MAXCHARS) call getnow (now) call fmtdat (cdate, tbuf1, now, 0) ncd = length(cdate) i = 1 delim = buf(i) for (j = 1; j < right; j = j + 1) ttl(j) = BLANK n = 0 repeat { n = n + 1 # update title counter if (gfield(buf, i, right-left, tbuf1, delim) > 0) { call subst(tbuf1, PAGENUM, tbuf2, chars, nc) call subst(tbuf2, CURRENTDATE, tbuf1, cdate, ncd) call justfy(tbuf1, left, right, tjust(n), ttl) } } until (buf(i) == EOS | buf(i) == NEWLINE | n == 3) while (ttl(right-1) == BLANK) # trim blanks right = right - 1 ttl(right) = NEWLINE ttl(right+1) = EOS for (i = 1; i <= offset; i = i + 1) call putc(BLANK) # offset call putlin(ttl, STDOUT) return end #-t- puttl 1232 local 12/01/80 16:11:09 #-h- putwrd 1008 asc 11-may-81 16:06:48 [002,100] # putwrd - put a word in outbuf; includes margin justification subroutine putwrd(wrdbuf) character wrdbuf(INSIZE) integer length, width integer last, llval, nextra, w include cout include cparam w = width(wrdbuf) last = length(wrdbuf) + outp # new end of outbuf llval = rmval - tival if (outw + w > llval | last >= MAXOUT) { # too big last = last - outp nextra = llval - outw for (outp = outp + 1; outp > 1; outp = outp - 1) if (outbuf(outp-1) == BLANK) nextra = nextra + 1 else break if (rjust == YES) { call spread(outbuf, outp, nextra, outwds) if (nextra > 0 & outwds > 1) outp = outp + nextra } call brk # flush previous line } call scopy(wrdbuf, 1, outbuf, outp+1) outp = last outw = outw + w outwds = outwds + 1 return end #-t- putwrd 942 local 12/01/80 16:11:10 #-h- set 579 asc 11-may-81 16:06:50 [002,100] # set - set parameter and check range subroutine set(param, val, argtyp, defval, minval, maxval) integer max, min integer argtyp, defval, maxval, minval, param, val if (argtyp == NEWLINE) # defaulted param = defval else if (argtyp == PLUS) # relative + param = param + val else if (argtyp == MINUS) # relative - param = param - val else # absolute param = val param = min(param, maxval) param = max(param, minval) return end #-t- set 513 local 12/01/80 16:11:10 #-h- skip 259 asc 11-may-81 16:06:51 [002,100] # skip - output n blank lines subroutine skip(n) integer i, n include cpage if (print == YES) for (i = 1; i <= n; i = i + 1) call putc(NEWLINE) return end #-t- skip 193 local 12/01/80 16:11:10 #-h- space 390 asc 11-may-81 16:06:53 [002,100] # space - space n lines or to bottom of page subroutine space(n) integer min integer n include cpage call brk if (lineno > bottom) return if (lineno == 0) call phead call skip(min(n, bottom+1-lineno)) lineno = lineno + n if (lineno > bottom) call pfoot return end #-t- space 324 local 12/01/80 16:11:11 #-h- spread 999 asc 11-may-81 16:06:54 [002,100] # spread - spread words to justify right margin subroutine spread(buf, outp, nextra, outwds) character buf(MAXOUT) include cparam integer min integer dir, i, j, nb, ne, nextra, nholes, outp, outwds data dir /0/ if (nextra <= 0 | outwds <= 1) return dir = 1 - dir # reverse previous direction ne = nextra nholes = outwds - 1 if (tival != inval & nholes > 1) nholes = nholes - 1 i = outp - 1 j = min(MAXOUT-2, i+ne) # leave room for NEWLINE, EOS while (i < j) { buf(j) = buf(i) if (buf(i) == BLANK & buf(i-1) != BLANK) { if (dir == 0) nb = (ne-1) / nholes + 1 else nb = ne / nholes ne = ne - nb nholes = nholes - 1 for ( ; nb > 0; nb = nb - 1) { j = j - 1 buf(j) = BLANK } } i = i - 1 j = j - 1 } return end #-t- spread 933 local 12/01/80 16:11:11 #-h- subst 553 asc 11-may-81 16:06:56 [002,100] # subst - substitutes a string for a specified character subroutine subst(in, char, out, subara, n) character in(ARB), char, out(ARB), subara(ARB) integer i, j, k, n j = 1 for (i = 1; in(i) != EOS; i = i + 1) if (in(i) == char) for (k = 1; k <= n; k = k + 1) { out(j) = subara(k) j = j + 1 } else { out(j) = in(i) j = j + 1 } out(j) = EOS return end #-t- subst 487 local 12/01/80 16:11:11 #-h- text 1855 asc 11-may-81 16:06:58 [002,100] # text - process text lines subroutine text(inbuf) character inbuf(INSIZE), wrdbuf(INSIZE) integer getwrb, length integer i, cuflg include cparam data cuflg /NO/ call doesc(inbuf, wrdbuf, INSIZE) # expand escapes call dotabs(inbuf, wrdbuf, INSIZE) # expand tabs if (inbuf(1) == BLANK | inbuf(1) == NEWLINE) call leadbl(inbuf) # move left, set tival if (ulval > 0) { # word underlining call underl(inbuf, wrdbuf, INSIZE) ulval = ulval - 1 } if (cuval > 0) { # continuous underlining if (cuflg == NO) { call scopy(inbuf, 1, wrdbuf, 1) inbuf(1) = STARTU call scopy(wrdbuf, 1, inbuf, 2) cuflg = YES } cuval = cuval - 1 if (cuflg == YES & cuval == 0) { i = length(inbuf) inbuf(i) = STOPU inbuf(i+1) = NEWLINE inbuf(i+2) = EOS cuflg = NO } } if (boval > 0) { # boldfacing call bold(inbuf, wrdbuf, INSIZE) boval = boval - 1 } if (ceval > 0) { # centering call center(inbuf) call put(inbuf) ceval = ceval - 1 } else if (inbuf(1) == NEWLINE) # all blank line call put(inbuf) else if (fill == NO) # unfilled text call put(inbuf) else { # filled text i = length(inbuf) inbuf(i) = BLANK if (inbuf(i-1) == PERIOD) { i = i + 1 inbuf(i) = BLANK } inbuf(i+1) = EOS for (i = 1; getwrb(inbuf, i, wrdbuf) > 0; ) call putwrd(wrdbuf) } return end #-t- text 1789 local 12/01/80 16:11:12 #-h- underl 592 asc 11-may-81 17:43:47 [002,100] # underl - underline words in a line subroutine underl(buf, tbuf, size) integer i, j, size character buf(ARB), tbuf(ARB) j = 1 # expand into tbuf for (i = 1; buf(i) != NEWLINE & j < size-1; i = i + 1) { if (buf(i) != BLANK & buf(i) != TAB & buf(i) != BACKSPACE & buf(i) != UNDERLINE) { call chcopy(UNDERLINE, tbuf, j) call chcopy(BACKSPACE, tbuf, j) } call chcopy(buf(i), tbuf, j) } tbuf(j) = NEWLINE tbuf(j+1) = EOS call scopy(tbuf, 1, buf, 1) # copy it back to buf return end #-h- width 457 asc 11-may-81 16:07:01 [002,100] # width - compute width of character string integer function width(buf) character buf(MAXLINE) integer i width = 0 for (i = 1; buf(i) != EOS; i = i + 1) if (buf(i) == BACKSPACE) width = width - 1 else if (buf(i) >= BLANK & buf(i) <= TILDE) width = width + 1 return end #-t- width 325 local 12/01/80 16:11:13 #-t- format.r 36935 local 12/15/80 10:19:01 #-h- addstr 226 asc 11-may-81 17:09:39 [002,100] integer function addstr(s, str, j, maxsiz) character s(ARB), str(ARB) integer j, maxsiz, i integer length if ((length(s) + j) > maxsiz) return(NO) for (i=1; s(i) != EOS; i=i+1) call chcopy(s(i), str, j) return(YES) end #-h- format.rof 7612 asc 11-may-81 18:14:57 [002,100] .pl 60 .bp 1 .in 0 .he 'FORMAT (1)'3/12/80'FORMAT (1)' .fo ''-#-'' .sp 2 .in +3 .fi .ti -3 NAME .br format (roff) - format text .nf .sp .ti -3 SYNOPSIS .br format [+n] [-n] [-s] [-pon] [files...] .fi .sp .ti -3 DESCRIPTION .br Format formats text according to request lines embedded in the text of the given files or standard input if no files are given. If nonexistent filenames are encountered they are ignored. The optional flags are as follows: .in +5 .sp .ti -5 +n Start printing at the first page with number "n". .sp .ti -5 -n Stop printing at the first page numbered higher than "n". .sp .ti -5 -s Stop before each page, including the first (useful for paper manipulation). The prompt "Type return to begin a page" is given just once before the first page. .sp .ti -5 -pon Move the entire document "n" spaces (default=0) to the right ("page offset"). .sp .in -5 Input consists of intermixed text lines, which contain information to be formatted, and request lines, which contain instructions about how to format the text lines. Request lines begin with a distinguishing "control character", normally a period. .sp Output lines are automatically "filled"; that is, their right margins are justified, without regard to the format of the input text lines. (Right justification may be turned on and off through the use of the ".ju" and ".nj" commands, though.) Strings of embedded spaces are retained so that the output line will contain at least as many spaces between words as the input line. However, input lines beginning with a space are output without modification. Line "breaks" may be caused at specified places by certain commands, or by the appearance of an empty input line or an input line beginning with a space. .sp Because of the nature of its output (backspace and tab characters and a fixed number of lines per page), it is generally necessary to have a tool developed especially for printing the output on the local printers. On most systems this is a combination of the tools 'os' and 'detab', plus some sort of page eject control of the printer. If such as tool exists, it should be described in Section 3 of this manual. .sp The capabilities of format are specified in the attached Request Summary. Numerical values are denoted by "n", titles by "t", and single characters by "c". Numbers may be signed + or -, in which case they signify relative changes to a quantity; otherwise they signify an absolute setting. Missing "n" fields are ordinarily taken to be 1, missing "t" fields to be empty, and "c" fields to shut off the appropriate special interpretation. .sp Running titles may appear at the top and bottom of every page. A title line consists of a line with three distinct fields: the first is text to be placed flush with the left margin, the second centered, and the third flush with the right margin. The first non-blank character in the title will be used as the delimiter to separate the three fields. Any "#" characters in a title are replaced by the current page number, and any "%" characters are replaced by the current date. .sp The ".nr" defines number registers; there are 26 registers named a-z. The command ".nr x m" sets number register x to m; ".nr x +m" increments number register by m; and ".nr x -m" decrements x by m. The value of number register x is placed in the text by the appearance of @@nx; a literal @@ may be inserted using @@@@. .sp Additional commands may be defined using ".de xx". For example, .sp .in +3 .nf .cc + .de PG .sp .ti +3 .en +cc . .in -3 .sp .fi defines a "paragraph" command PG. Defined commands may also be invoked with arguments. Arguments are separated by blanks or tabs. Within the definition of a defined command, arguments are referenced using $1, $2, etc. There is a maximum of 9 arguments. Omitted arguments default to the null string. $0 references the command name itself. For example, the following version of the paragraph command uses the argument to determine the amount of indentation. .sp .in +3 .nf .cc + .de PG .sp .ti +$1 .en +cc . .in -3 .sp .fi This command could be invoked by .sp .in +3 .nf .cc + .PG 3 +cc . .in -3 .sp .fi to get the same effect as the previous version. .sp The ".so file" command causes the contents of file to be inserted in place of the ".so" command; ".so" commands may be nested. .sp .ti -3 FILES .br None .sp .ti -3 SEE ALSO .br Kernighan & Plauger's "Software Tools", pages 219-250 .br whatever tool has been devised for printing formatted output .br The roff and nroff/troff UNIX commands .br The "nroff" and "troff" users manuals by Joseph F. Ossana, Bell Laboratories, Murray Hill, New Jersey .sp .ti -3 DIAGNOSTICS .br .in +3 .ti -3 invalid number register name .br names of number registers must be a single letter a-z .ti -3 missing name in command definition .br a macro was defined using the '.de' command, but no 2-letter name for it was given .ti -3 so commands nested too deeply .br the limit for nesting included source files is dependent upon the MAXOFILES definition in the standard symbols definition file .ti -3 too many characters pushed back .br the buffer holding input characters has been exceeded; its size is determined by the BUFSIZE definition in the source code .in -3 .sp .ti -3 AUTHORS .br Original version by Kernighan and Plauger, with modifications by David Hanson and friends (U. of Arizona), Joe Sventek and Debbie Scherrer (Lawrence Berkeley Laboratory) .nf .ne 38 .in 0 .ce .sp REQUEST SUMMARY .sp Request Initial Default Break Meaning .sp .cc + .bd n n=1 no boldface the next n lines .bp n n=1 n=+1 yes begin new page and number it n .br yes break .cc c c=. c=. no control character becomes c .ce n n=1 yes center the next n input lines .de xx no command xx; ends at .en .ef t t="" t="" no foots on even pages are t .eh t t="" t="" no heads on even pages are t .en no terminate command definition .fi yes yes begin filling output lines .fo /l/c/r f="" f="" no foot titles are l(eft), c(enter), r(ight) .he /l/c/r t="" t="" no head title is l(eft), c(enter), r(ight) .in n n=0 n=0 yes set left margin to column n+1 .ju yes yes no begin justifying filled lines .ls n n=1 n=1 no set line spacing to n .m1 n n=3 n=3 no space between top of page and head .m2 n n=2 n=2 no space between head and text .m3 n n=2 n=2 no space between text and foot .m4 n n=3 n=3 no space between foot and bottom .ne n n=0 y/n need n lines; break if new page .nf no yes stop filling .nj no no stop justifying .nr x m x=0 m=0 no set number register x to m, +ti +30 -m, +m for decrement, increment .of t t="" t="" no foots on odd pages are t .oh t t="" t="" no heads on odd pages are t .pl n n=66 n=66 no set page length to n lines .po n n=0 n=0 no set page offset to n spaces .rm n n=65 n=65 no set right margin to column n .so file no switch input to file .sp n n=1 yes space n lines, except at top of page .st n n=0 yes space to line n from top; -n +ti +30 spaces to line n from bottom .ti n n=0 yes temporarily indent next output +ti +30 line n spaces .ul n n=1 no underline words in the next n +ti +30 input lines +cc . #-t- format.doc 7619 local 12/01/80 16:02:49