#-h- edcbl 4825 asc 10-sep-80 09:35:08 #-h- edsym 1535 asc 10-sep-80 09:34:50 # definitions for editor # put on a file called 'edsym' # Used only by the editor define(MAXPAT,132) define(MAXARG,132) define(COUNT,1) define(PREVCL,2) define(START,3) define(CLOSIZE,4) define(BOL,PERCENT) define(ANY,QMARK) define(EOL,DOLLAR) define(CLOSURE,STAR) define(CCL,LBRACK) define(CCLEND,RBRACK) define(NCCL,LETN) define(CHAR,LETA) define(GLOBAL,LETG) define(PRINT,LETP) define(LIST,LETL) define(MARKED,LETY) define(NOMARK,LETN) define(FORWARD,0) define(BACKWARD,-1) define(EXCLUDE,LETX) define(APPENDCOM,LETA) define(CHANGE,LETC) define(DELCOM,LETD) define(ENTER,LETE) define(JOINCOM,LETJ) define(PRINTFIL,LETF) define(READCOM,LETR) define(WRITECOM,LETW) define(INSERT,LETI) define(PRINTCUR,EQUALS) define(MOVECOM,LETM) define(QUIT,LETQ) define(SUBSTITUTE,LETS) define(CURLINE,PERIOD) define(LASTLINE,DOLLAR) define(BACKUPLINE,MINUS) define(SCAN,SLASH) define(BACKSCAN,BACKSLASH) define(NOSTATUS,1) define(LINE0,1) define(PREV,0) define(NEXT,1) define(MARK,2) define(TEXT,3) define(MAXBUF,3008) #size of line pointer array #(each line needs 4 words) #BKY define(MAXBUF,1002) #BKY needs 1 word/line; also smaller buffer define(SEEKADR,3) define(LENG,4) define(BUFENT,4) define(BROWSE,LETB) define(SCREENSIZE,22) define(SPAWNCOM,ATSIGN) define(COMMENT,SHARP) define(FORWARD,PLUS) define(CENTER,PERIOD) define(BACKWARD,MINUS) define(MAXTBUFS,3) #-h- cbuf 892 asc 13-may-80 10:09:35 # /cbuf/ common block # put on a file called 'cbuf' # Used only by the editor common /cbuf/ buf(MAXBUF), lastbf, free #NOTBKY integer buf, lastbf, free #NOTBKY #buf(k+0) PREV previous line #buf(k+1) NEXT next line #buf(k+2) MARK mark for global commands #buf(k+3) SEEDADR where line is on scratch file #------------------------------------------------------------- #Special version for BKY #BKY common /cbuf/ buf(MAXBUF, lastbf, #BKY descr(NTYPS), locb(NTYPS), mskb(NTYPS) #BKY integer buf, lastb, descr, locb, mskb #BKY # structure of line pointers for all lines #BKY # MARK (LENG) SEEKADR PREV NEXT #BKY # 3 -- 18 15 15 #BKY #Variables in the arrays 'descr', 'locb', and 'mskb' describe #BKY #the line pointer structures. They are all initialized in #BKY #subroutine ed. #-h- cfile 174 asc 13-may-80 10:09:36 ## cfile common block - for editor # put on a file named 'cfile' # Used only by the editor common /cfile/ savfil(FILENAMESIZE) character savfil #remembered file name #-h- clines 820 asc 13-may-80 10:09:36 # /clines/ - common block for editor; holds line flags # put on a file called 'clines' # Used only by the editor common /clines/ line1, line2, nlines, curln, lastln, print, cursav, oldlin, oldndx, ifmod, notify integer line1 # first line number integer line2 # second line number integer nlines # number of line numbers specified integer curln # current line: value of dot integer lastln # last line: value of $ integer print # flag to cause/suppress printing of line count integer cursav # value of current line before new command integer oldlin # last line number used by getind integer oldndx # last index returned by getind integer ifmod # if buffer has been modified since last write integer notify # if user has been notified of no write since last change #-h- cpat 156 asc 13-may-80 10:09:37 # /cpat/ - common block for editor # put on a file named 'cpat' # Used only by the editor common /cpat/ pat(MAXPAT) character pat # pattern #-h- cscrat 316 asc 13-may-80 10:09:38 # /cscrat/ - common block for editor; holds scratch file info # put on a file called 'cscrat' # Used only by the editor common /cscrat/ scr, scrend(2) , scrfil(FILENAMESIZE) integer scr # scratch file id integer scrend # end of info on scratch file character scrfil # name of scratch file #-h- ctxt 184 asc 13-may-80 10:09:39 # /ctxt/ - common block for editor # put on a file called 'ctxt' # Used only by the editor common /ctxt/ txt(MAXLINE) character txt # text line for matching and output #-h- ctbufs 108 asc 13-may-80 10:09:39 common / ctbufs / edtbuf(FILENAMESIZE, MAXTBUFS) character edtbuf # name of scratch files for temp buffs #-h- csclin 199 asc 13-may-80 10:09:40 ## csclin common block - for editor # put on a file named 'csclin' # Used only by the editor common /csclin/ lin(MAXLINE) character lin # scratch line for reading lines to be injected #-h- main 391 asc 07-may-80 12:13:53 #--------------------------------------------------------------------- # include symbol definitions # include symbols include edsym # #--------------------------------------------------------------------- ## main - main calling program for editor # call initr4 # call ed # call endr4 # end #-------------------------------------------------------------------- #-h- eds 2119 asc 07-may-80 12:13:55 # ------------------------------------------------------- # ## ed - driver subroutine for editor # subroutine ed subroutine main character lin(MAXLINE), pstr(11), clower integer ckglob, docmd, doglob, doread, getarg, prompt, getlst integer i, status, clrbuf include cfile include clines include cpat include cbuf #Initialize flag for printing/suppression of line counts data print /YES/ data pstr(1), pstr(2), pstr(3)/COLON, BLANK, EOS/ #Initialize BKY line pointer descriptions #BKY data desc /PREV, NEXT, MARK, SEEKADR / #BKY data locb / 45, 0, 3, 30 / #BKY data mskb /77777b, 77777b, 7b, 777777b/ # Initialize variables and buffers call inited call setbuf pat(1) = EOS savfil(1) = EOS #BKY filtyp = ASCII #Pick up file name and possible flag(s) for (i=1; getarg(i, lin, MAXLINE) != EOF; i=i+1) { if (lin(1) == DASH) { if (lin(2) == EOS) print = NO else if (clower(lin(2)) == LETP) { lin(13) = EOS call scopy(lin, 3, pstr, 1) } } else { call scopy (lin, 1, savfil, 1) if (doread (0, savfil, ENTER) == ERR) call remark ('?.') } } repeat { status = prompt(pstr, lin, STDIN) if (status == EOF) # MUST clear buffer on EOF of input file { status = clrbuf(EOF) break } else if (status != ERR) { i = 1 cursav = curln if (getlst(lin, i, status) == OK) { if (ckglob(lin, i, status) == OK) status = doglob(lin, i, cursav, status) else if (status != ERR) status = docmd(lin, i, NO, status) # else error, do nothing } } if (status == ERR) { call remark('?.') curln = cursav } else if (status == EOF) if (clrbuf(QUIT) == OK) # will return ERR if changes since last w break # else OK, loop } call ended return end #-h- append 538 asc 07-may-80 12:13:57 ## append - append lines after 'line' /*/sor/edr/append integer function append(line, glob) integer getlin, inject integer line, glob include clines include csclin if (glob == YES) append = ERR else { curln = line for (append = NOSTATUS; append == NOSTATUS; ) if (getlin(lin, STDIN) == EOF) append = EOF else if (lin(1) == PERIOD & lin(2) == NEWLINE) append = OK else if (inject(lin) == ERR) append = ERR } return end #-h- ckglob 1110 asc 07-may-80 12:13:59 ## ckglob - if global prefix, mark lines to be affected /*/sor/edr/ckglob integer function ckglob(lin, i, status) character lin(MAXLINE) integer defalt, getind, gettxt, match, nextln, optpat integer gflag, i, k, line, status character clower include cbuf include clines include cpat include ctxt if (clower(lin(i)) != GLOBAL & clower(lin(i)) != EXCLUDE) status = EOF else { if (clower(lin(i)) == GLOBAL) gflag = YES else gflag = NO i = i + 1 if (optpat(lin, i) == ERR | defalt(1, lastln, status) == ERR) status = ERR else { i = i + 1 for (line = line1; line <= line2; line = line + 1) { k = gettxt(line) if (match(txt, pat) == gflag) call setb (k, MARK, YES) else call setb (k, MARK, NO) } for (line=nextln(line2); line!=line1; line=nextln(line)) { k = getind(line) call setb (k, MARK, NO) } status = OK } } ckglob = status return end #-h- ckp 431 asc 13-may-80 10:10:02 ## ckp - check for 'p' or 'l' after command /*/sor/edr/ckp integer function ckp(lin, i, pflag, status) character lin(MAXLINE), c integer i, j, pflag, status character clower j = i c = clower(lin(j)) if (c == PRINT | c == LIST) { j = j + 1 pflag = c } else pflag = NO if (lin(j) == NEWLINE) status = OK else status = ERR ckp = status return end #-h- clrbuf 499 asc 07-may-80 12:14:02 ## clrbuf - dispose of editor scratch file /*/sor/edr/clrbuf integer function clrbuf(comand) character comand include cscrat include clines if (comand == QUIT & ifmod == YES & notify == NO) # no w since last change { notify = YES call remark("CHANGES SINCE LAST WRITE - RETYPE COMMAND TO CONFIRM.") clrbuf = ERR } else { call close(scr) #BKY call close (wscr) #BKY - close both open instances of file call remove(scrfil) clrbuf = OK } return end #-h- conct 438 asc 07-may-80 12:14:04 ## conct - concat line to next line if necessary integer function conct (nbr, lin) integer nbr, i, gettxt, junk character lin(ARB) include clines include ctxt conct = OK for (i=1; lin(i)!=EOS; i=i+1) #check for lack of NEWLINE if (lin(i) == NEWLINE) return if (nbr+1 > lastln) #no next line { conct = ERR return } junk = gettxt (nbr+1) call scopy (txt, 1, lin, i) call delete (nbr+1, nbr+1, junk) return end #-h- defalt 342 asc 07-may-80 12:14:05 ## defalt - set defaulted line numbers /*/sor/edr/defalt integer function defalt(def1, def2, status) integer def1, def2, status include clines if (nlines == 0) { line1 = def1 line2 = def2 } if (line1 > line2 | line1 <= 0) status = ERR else status = OK defalt = status return end #-h- delete 569 asc 07-may-80 12:14:06 ## delete - delete lines 'from' through 'to' /*/sor/edr/delete integer function delete(from, to, status) integer getind, nextln, prevln integer from, k1, k2, status, to, start, stop include clines if (from <= 0) status = ERR else { k1 = getind(prevln(from)) k2 = getind(nextln(to)) start = getind(from) stop = getind(to) lastln = lastln - (to - from + 1) curln = prevln(from) call relink(k1, k2, k1, k2) call ptfndx(start, stop) status = OK } delete = status return end #-h- docmd 4265 asc 10-sep-80 09:35:15 ## docmd - handle all editor commands except globals /*/sor/edr/docmd integer function docmd(lin, i, glob, status) character file(FILENAMESIZE), lin(MAXLINE), sub(MAXPAT) integer append, delete, doprnt, doread, dowrit, lmove, subst integer ckp, defalt, getfn, getone, getrhs, nextln, optpat, prevln character clower, comand integer gflag, glob, i, line3, pflag, status, dospwn, browse, dolist integer dojoin integer clrbuf include cfile include clines include cpat pflag = NO # may be set by d, m, s status = ERR comand = clower(lin(i)) # make sure comparing with lower case if (comand == APPENDCOM) { if (lin(i + 1) == NEWLINE) status = append(line2, glob) } else if (comand == CHANGE) { if (lin(i + 1) == NEWLINE) andif (defalt(curln, curln, status) == OK) andif (delete(line1, line2, status) == OK) status = append(prevln(line1), glob) } else if (comand == DELCOM) { if (ckp(lin, i + 1, pflag, status) == OK) andif (defalt(curln, curln, status) == OK) andif (delete(line1, line2, status) == OK) andif (nextln(curln) != 0) curln = nextln(curln) } else if (comand == INSERT) { if (lin(i + 1) == NEWLINE) status = append(prevln(line2), glob) } else if (comand == JOINCOM) { if (ckp(lin, i+1, pflag, status) == OK) andif(defalt(curln, nextln(curln), status) == OK) status = dojoin(line1, line2) } else if (comand == PRINTCUR) { if (ckp(lin, i + 1, pflag, status) == OK) { call putdec(line2, 1) call putc(NEWLINE) } } else if (comand == MOVECOM) { i = i + 1 if (getone(lin, i, line3, status) == EOF) status = ERR if (status == OK) andif (ckp(lin, i, pflag, status) == OK) andif (defalt(curln, curln, status) == OK) status = lmove(line3) } else if (comand == SUBSTITUTE) { i = i + 1 if (optpat(lin, i) == OK) andif (getrhs(lin, i, sub, gflag) == OK) andif (ckp(lin, i + 1, pflag, status) == OK) andif (defalt(curln, curln, status) == OK) status = subst(sub, gflag) } else if (comand == SPAWNCOM) { i = i + 1 status = dospwn(lin, i) } else if (comand == ENTER) { if (nlines == 0) andif (getfn(lin, i, file) == OK) if (clrbuf(QUIT) == OK) { call scopy(file, 1, savfil, 1) call setbuf status = doread(0, file, ENTER) } else status = OK } else if (comand == PRINTFIL) { if (nlines == 0) andif (getfn(lin, i, file) == OK) { call scopy(file, 1, savfil, 1) call putlin(savfil, STDOUT) call putc(NEWLINE) status = OK } } else if (comand == READCOM) { if (getfn(lin, i, file) == OK) status = doread(line2, file, READCOM) } else if (comand == WRITECOM) { if (getfn(lin, i, file) == OK) andif (defalt(1, lastln, status) == OK) status = dowrit(line1, line2, file) } else if (comand == PRINT) { if (lin(i + 1) == NEWLINE) andif (defalt(curln, curln, status) == OK) status = doprnt(line1, line2) } else if (comand == LIST) { if (lin(i+1) == NEWLINE) andif (defalt(curln, curln, status) == OK) status = dolist(line1, line2) } else if (comand == BROWSE) { i = i + 1 if (defalt(curln, curln, status) == OK) status = browse(line2, lin, i) } else if (comand == COMMENT) status = OK else if (lin(i) == NEWLINE) { if (nlines == 0) line2 = nextln(curln) status = doprnt(line2, line2) } else if (lin(i) == BACKUPLINE) { if (nlines == 0) line2 = prevln(curln) status = doprnt(line2, line2) } else if (comand == QUIT) { if (lin(i + 1) == NEWLINE & nlines == 0 & glob == NO) status = EOF } # else status is ERR if (status == OK) if (pflag == PRINT) status = doprnt(curln, curln) else if (pflag == LIST) status = dolist(curln, curln) docmd = status return end #-h- doglob 1067 asc 07-may-80 12:14:12 ## doglob - do command at lin(i) on all marked lines /*/sor/edr/doglob integer function doglob(lin, i, status) character lin(MAXLINE) integer docmd, getind, getlst, nextln integer value(2) integer count, i, istart, k, line, status, last include cbuf include clines for (last = length(lin); lin(last - 1) == ATSIGN; last = length(lin)) { lin(last - 1) = NEWLINE junk = getlin(lin(last),STDIN) } status = OK count = 0 line = line1 istart = i repeat { k = getind(line) call getb(k, MARK, value) if (value(1) == YES) { call setb(k, MARK, NO) cursav = line i = istart repeat { curln = line if (getlst(lin, i, status) == OK) andif (docmd(lin, i, YES, status) == OK) count = 0 while(lin(i) != NEWLINE) i = i + 1 i = i + 1 if (lin(i) == EOS) break } } else { line = nextln(line) count = count + 1 } } until (count > lastln | status != OK) doglob = status return end #-h- doprnt 381 asc 07-may-80 12:14:13 ## doprnt - print lines 'from' through 'to' integer function doprnt(from, to) integer gettxt integer from, i, j, to include clines include ctxt if (from <= 0) doprnt = ERR else { for (i = from; i <= to; i = i + 1) { j = gettxt(i) call putlin(txt, STDOUT) } curln = to doprnt = OK } return end #-h- doread 1102 asc 07-may-80 12:14:15 ## doread - read 'file' into scratch after 'line' /*/sor/edr/doread integer function doread(line, file, comand) character file(FILENAMESIZE), comand integer getlin, inject, open, access #BKY integer equal, gettyp integer count, fd, line include clines include cfile include csclin if (comand == ENTER) # enter new file - open at READWRITE access = READWRITE else # read command - open at READ access = READ call findit(file, lin) fd = open(lin, access) if (fd == ERR) doread = ERR else { #BKY if (equal(savfil,file) == YES) #pick up file type #BKY junk = gettyp (fd, filtyp) curln = line doread = OK for (count = 0; getlin(lin, fd) != EOF; count = count + 1) { doread = inject(lin) if (doread == ERR) break } call close(fd) if (print == YES) { call putdec (count, 1) call putc (NEWLINE) } if (comand == ENTER) # reset changes since last write switches { ifmod = NO notify = NO } } return end #-h- dowrit 815 asc 07-may-80 12:14:17 integer function dowrit(from, to, file) character file(MAXLINE), lin(FILENAMESIZE) integer create, gettxt integer fd, from, k, line, to include ctxt include clines include cfile call findit(file, lin) fd = create(lin, WRITE) if (fd == ERR) dowrit = ERR else { #BKY call settyp (fd, filtyp) #Set output file to type of input file for (line = from; line <= to; line = line + 1) { k = gettxt(line) call putlin(txt, fd) } call close(fd) if (print == YES) { call putdec (to-from+1, 1) call putc (NEWLINE) } dowrit = OK ifmod = NO # reset changes since last w flags notify = NO } return end ## dowrit - write 'from' through 'to' into file /*/sor/edr/dowrit #-h- getb 573 asc 07-may-80 12:14:18 ## getb - retrieve 'value' of 'type' in buf(index) /*/sor/edr/getb subroutine getb (index, type, value) integer index, type integer value(2) include cbuf # ------ IAS and VMS version (16- and 32--bit words) if (type == PREV) #this word also holds MARK bit value(1) = abs(buf(index)) else if (type == NEXT) value(1) = buf(index+1) else if (type == MARK) { if (buf(index) < 0) value(1) = YES else value(1) = NO } else if (type == SEEKADR) { value(1) = buf(index+2) value(2) = buf(index+3) } return end #-h- getfn 729 asc 08-sep-80 10:34:23 ## getfn - get file name frm lin(i) /*/sor/edr/getfn integer function getfn(lin, i, file) character lin(MAXLINE), file(MAXLINE) integer i, j, k include cfile getfn = ERR if (lin(i + 1) == BLANK) { j = i + 2 # get new file name call skipbl(lin, j) for (k = 1; lin(j) != NEWLINE; k = k + 1) { file(k) = lin(j) j = j + 1 } file(k) = EOS if (k > 1) getfn = OK } else if (lin(i + 1) == NEWLINE & savfil(1) != EOS) { call scopy(savfil, 1, file, 1) # or old name getfn = OK } # else error # if (getfn == OK & savfil(1) == EOS) # call scopy(file, 1, savfil, 1) # save if no old one return end #-h- getind 657 asc 07-may-80 12:14:21 ## getind - locate line index in buffer /*/sor/edr/getind integer function getind(line) integer line, k, j integer nextln, prevln include clines data oldndx /ERR/ data oldlin /-2/ if (oldndx != ERR & line == nextln(oldlin)) call getb(oldndx, NEXT, k) else if (oldndx != ERR & line == oldlin) k = oldndx else if (oldndx != ERR & line == prevln(oldlin)) call getb(oldndx, PREV, k) else { k = LINE0 if (line < lastln/2) for (j=0; j=line; j=j-1) #search backwards call getb(k, PREV, k) } oldlin = line oldndx = k getind = k return end #-h- getlst 665 asc 07-may-80 12:14:23 ## getlst - collect line numbers at lin(i), increment i /*/sor/edr/getlst integer function getlst(lin, i, status) character lin(MAXLINE) integer getone integer i, num, status include clines line2 = 0 for (nlines = 0; getone(lin, i, num, status) == OK; ) { line1 = line2 line2 = num nlines = nlines + 1 if (lin(i) != COMMA & lin(i) != SEMICOL) break if (lin(i) == SEMICOL) curln = num i = i + 1 } nlines = min(nlines, 2) if (nlines == 0) line2 = curln if (nlines <= 1) line1 = line2 if (status != ERR) status = OK getlst = status return end #-h- getnum 1219 asc 07-may-80 12:14:24 ## getnum - convert one term to line number /*/sor/edr/getnum integer function getnum(lin, i, pnum, status) character lin(MAXLINE) integer ctoi, index, optpat, ptscan integer i, pnum, status include clines include cpat # string digits '0123456789' character digits(11) data digits(01)/DIG0/ data digits(02)/DIG1/ data digits(03)/DIG2/ data digits(04)/DIG3/ data digits(05)/DIG4/ data digits(06)/DIG5/ data digits(07)/DIG6/ data digits(08)/DIG7/ data digits(09)/DIG8/ data digits(10)/DIG9/ data digits(11)/EOS/ getnum = OK if (index(digits, lin(i)) > 0) { pnum = ctoi(lin, i) i = i - 1 # move back; to be advanced at the end } else if (lin(i) == CURLINE) pnum = curln else if (lin(i) == LASTLINE) pnum = lastln else if (lin(i) == SCAN | lin(i) == BACKSCAN) { if (optpat(lin, i) == ERR) # build the pattern getnum = ERR else if (lin(i) == SCAN) getnum = ptscan(FORWARD, pnum) else getnum = ptscan(BACKWARD, pnum) } else getnum = EOF if (getnum == OK) i = i + 1 # point at next character to be examined status = getnum return end #-h- getone 1011 asc 07-may-80 12:14:27 ## getone - evaluate one line number expression /*/sor/edr/getone integer function getone(lin, i, num, status) character lin(MAXLINE) integer getnum integer i, istart, mul, num, pnum, status include clines istart = i num = 0 call skipbl(lin, i) if (getnum(lin, i, num, status) == OK) # first term repeat { # + or - terms call skipbl(lin, i) if (lin(i) != PLUS & lin(i) != MINUS) { status = EOF break } if (lin(i) == PLUS) mul = +1 else mul = -1 i = i + 1 call skipbl(lin, i) if (getnum(lin, i, pnum, status) == OK) num = num + mul * pnum if (status == EOF) status = ERR } until (status != OK) if (num < 0 | num > lastln) status = ERR if (status == ERR) getone = ERR else if (i <= istart) getone = EOF else getone = OK status = getone return end #-h- getrhs 521 asc 07-may-80 12:14:29 ## getrhs - get substitution string for 's' command /*/sor/edr/getrhs integer function getrhs(lin, i, sub, gflag) character lin(MAXLINE), sub(MAXPAT) integer maksub integer gflag, i character clower getrhs = ERR if (lin(i) == EOS) return if (lin(i + 1) == EOS) return i = maksub(lin, i + 1, lin(i), sub) if (i == ERR) return if (clower(lin(i+1)) == GLOBAL) { i = i + 1 gflag = YES } else gflag = NO getrhs = OK return end #-h- gettxt 464 asc 07-may-80 12:14:31 ## gettxt - locate text for line, copy to txt /*/sor/edr/gettxt integer function gettxt(line) character null(1) integer getind integer line, len, j, k integer loc(2) include cbuf include cscrat include ctxt data null/EOS/ k = getind(line) if (line != 0) { call getb (k, SEEKADR, loc) call seek (loc, scr) call readf (txt, dummy, scr) } else call scopy(null, 1, txt, 1) gettxt = k return end #-h- inject 576 asc 07-may-80 12:14:32 ## inject - insert lin after curln, write scratch /*/sor/edr/inject integer function inject(lin) character lin(MAXLINE) integer getind, maklin, nextln integer i, k1, k2, k3 include clines for (i = 1; lin(i) != EOS; ) { i = maklin(lin, i, k3) if (i == ERR) { inject = ERR break } k1 = getind(curln) k2 = getind(nextln(curln)) call relink(k1, k3, k3, k2) call relink(k3, k2, k1, k3) curln = curln + 1 lastln = lastln + 1 inject = OK } return end #-h- lmove 832 asc 07-may-80 12:14:34 ## lmove - move line1 through line2 after line 3 /*/sor/edr/lmove integer function lmove(line3) integer getind, nextln, prevln integer k0, k1, k2, k3, k4, k5, line3, delta include clines if (line1 <= 0 | (line1 <= line3 & line3 <= line2)) lmove = ERR else { k0 = getind(prevln(line1)) k3 = getind(nextln(line2)) k1 = getind(line1) k2 = getind(line2) call relink(k0, k3, k0, k3) delta = line2 - line1 + 1 lastln = lastln - delta if (line3 > line1) { curln = line3 line3 = line3 - delta } else curln = line3 + delta k4 = getind(line3) k5 = getind(nextln(line3)) call relink(k4, k1, k2, k5) call relink(k2, k5, k4, k1) lastln = lastln + delta lmove = OK } return end #-h- maklin 1051 asc 07-may-80 12:14:35 ## maklin - make new line entry, copy text to scratch /*/sor/edr/maklin integer function maklin(lin, i, newind) character lin(MAXLINE) integer addset, gtfndx integer i, j, junk, newind, txtend include cbuf include cscrat include ctxt include clines maklin = ERR oldndx = ERR if (gtfndx(newind) == ERR) { # no room for new line entry call remark ('File size exceeded.') return } txtend = 1 for (j = i; lin(j) != EOS; ) { junk = addset(lin(j), txt, txtend, MAXLINE) j = j + 1 if (lin(j - 1) == NEWLINE) break } if (addset(EOS, txt, txtend, MAXLINE) == NO) { call ptfndx(newind, newind) # return free index block return } call setb (newind, SEEKADR, scrend) call seek (scrend, scr) call putlin (txt, scr) #NOTBKY #BKY call putlin(txt, wscr) call markl (scr, scrend) call setb (newind, MARK, NO) maklin = j # next character to be examined in lin return end #-h- nextln 206 asc 07-may-80 12:14:37 ## nextln - get line after 'line' /*/sor/edr/nextln integer function nextln(line) integer line include clines nextln = line + 1 if (nextln > lastln) nextln = 0 return end #-h- optpat 567 asc 07-may-80 12:14:38 ## optpat - make pattern if specified at lin(i) /*/sor/edr/optpat integer function optpat(lin, i) character lin(MAXLINE) integer makpat integer i include cpat if (lin(i) == EOS) i = ERR else if (lin(i + 1) == EOS) i = ERR else if (lin(i + 1) == lin(i)) # repeated delimiter i = i + 1 # leave existing pattern alone else i = makpat(lin, i + 1, lin(i), pat) if (pat(1) == EOS) i = ERR if (i == ERR) { pat(1) = EOS optpat = ERR } else optpat = OK return end #-h- prevln 206 asc 07-may-80 12:14:40 ## prevln - get line before 'line' /*/sor/edr/prevln integer function prevln(line) integer line include clines prevln = line - 1 if (prevln < 0) prevln = lastln return end #-h- ptscan 509 asc 07-may-80 12:14:41 ## ptscan - scan for next occurrence of pattern /*/sor/edr/ptscan integer function ptscan(way, num) integer gettxt, match, nextln, prevln integer k, num, way include clines include cpat include ctxt num = curln repeat { if (way == FORWARD) num = nextln(num) else num = prevln(num) k = gettxt(num) if (match(txt, pat) == YES) { ptscan = OK return } } until (num == curln) ptscan = ERR return end #-h- readf 309 asc 07-may-80 12:14:42 ## readf - read line from file (random access) subroutine readf (buffer, count, int) #note--in this implementation, a call to getlin is made rather #than reading a specified number of characters integer count, int, getlin, junk character buffer(ARB) junk = getlin (buffer, int) return end #-h- relink 239 asc 07-may-80 12:14:44 ## relink - rewrite two half line links /*/sor/edr/relink subroutine relink(a, x, y, b) integer a, b, x, y include clines oldndx = ERR call setb (x, PREV, a) call setb (y, NEXT, b) ifmod = YES return end #-h- setb 667 asc 07-may-80 12:14:45 ## setb - Set 'type' in buf(index) to 'value' /*/sor/edr/setb subroutine setb (index, type, value) integer index, type integer value(2) include cbuf # ------ VMS and IAS version (32- and 16-bit words) if (type == PREV) #the leftmost bit of this word holds MARK { if (buf(index) < 0) buf(index) = -value(1) else buf(index) = value(1) } else if (type == NEXT) buf(index+1) = value(1) else if (type == MARK) { if (value(1) == YES) buf(index) = -abs(buf(index)) else buf(index) = abs(buf(index)) } else if (type == SEEKADR) { buf(index+2) = value(1) buf(index+3) = value(2) } return end #-h- setbuf 1055 asc 07-may-80 12:14:47 ## setbuf - create scratch file, set up line 0 /*/sor/edr/setbuf subroutine setbuf integer create #BKY integer open integer k, j include cbuf include clines include cscrat character fil(4) # string null '' character null(1) data fil(1)/LETE/ data fil(2)/LETD/ data fil(3)/LETS/ data fil(4)/EOS/ data null(1) /EOS/ call scratf(fil, scrfil) #get unique name for scratch file scr = create(scrfil, READWRITE) #NOTBKY #BKY scr = create(scrfil, READ) if (scr == ERR) call cant(scrfil) #For BKY - needs file opened twice - once at READ and one at WRITE access #BKY wscr = open(scrfil, WRITE) #BKY if (wscr == ERR) #BKY call cant (scrfil) call markl (scr, scrend) lastbf = LINE0 free = 0 # initialize free list call maklin(null, 1, k) # create empty line 0 call relink(k, k, k, k) # establish initial linked list curln = 0 lastln = 0 cursav = 0 ifmod = NO # initialize changes since last w variables notify = NO return end #-h- subst 1465 asc 07-may-80 12:14:48 ## subst - substitute "sub" for occurrences of pattern /*/sor/edr/subst integer function subst(sub, gflag) character new(MAXLINE), sub(MAXPAT) integer addset, amatch, gettxt, inject, conct integer gflag, j, junk, k, lastm, line, m, status, subbed include clines include cpat include ctxt subst = ERR if (line1 <= 0) return for (line = line1; line <= line2; line = line + 1) { j = 1 subbed = NO junk = gettxt(line) lastm = 0 for (k = 1; txt(k) != EOS; ) { if (gflag == YES | subbed == NO) m = amatch(txt, k, pat) else m = 0 if (m > 0 & lastm != m) { # replace matched text subbed = YES call catsub(txt, k, m, sub, new, j, MAXLINE) lastm = m } if (m == 0 | m == k) { # no match or null match junk = addset(txt(k), new, j, MAXLINE) k = k + 1 } else # skip matched text k = m } if (subbed == YES) { if (addset(EOS, new, j, MAXLINE) == NO) { subst = ERR break } subst = conct(line, new) #check for conctenation if (subst == ERR) break call delete(line, line, status) # remembers dot subst = inject(new) if (subst == ERR) break subst = OK } } return end #-h- dospwn 1039 asc 20-aug-80 12:18:41 # spawns a shell command from within the editor # integer function dospwn(lin, i) character lin(ARB), proces(FILENAMESIZE), args(ARGBUFSIZE), sh(3), desc(PIDSIZE) integer i, j, spawn, init, k, int, create, loccom include ctbufs data init/YES/ data sh/LETS, LETH, EOS/ if (init == YES) { call impath(args) # get search path if (loccom(sh, args, proces) != BINARY) { call remark("Cannot find sh image file.") dospwn = ERR return } k = 1 call stcopy(sh, 1, args, k) call chcopy(BLANK, args, k) for (j=1; j <= MAXTBUFS; j=j+1) { call stcopy(edtbuf(1,j), 1, args, k) args(k) = BLANK k = k + 1 } args(k) = EOS init = NO } call skipbl(lin, i) # extra blanks not necessary if (lin(i) == NEWLINE | lin(i) == EOS) # no shell command dospwn = spawn(proces, sh, desc, WAIT) else { int = create(edtbuf(1,1), WRITE) if (int == ERR) dospwn = ERR else { call putlin(lin(i), int) call close(int) dospwn = spawn(proces, args, desc, WAIT) } } return end #-h- browse 736 asc 07-may-80 12:14:52 integer function browse(line, lin, i) character lin(ARB), direc integer line, i, screen, curscr, ctoi, lin1, lin2 include clines data screen, curscr/SCREENSIZE, SCREENSIZE/ if (lin(i) == NEWLINE) { direc = FORWARD screen = curscr } else { if (lin(i) == FORWARD | lin(i) == CENTER | lin(i) == BACKWARD) { direc = lin(i) i = i + 1 } else direc = FORWARD screen = ctoi(lin, i) - 1 if (screen <= 0) screen = curscr else curscr = screen } if (direc == FORWARD) lin1 = line else if (direc == CENTER) lin1 = line - (screen / 2) else lin1 = line - screen lin2 = lin1 + screen lin1 = max(1, lin1) lin2 = min(lin2, lastln) browse = doprnt(lin1, lin2) return end #-h- inited 278 asc 07-may-80 12:14:54 subroutine inited character num(2), edt(4) integer i, j, junk, itoc include ctbufs data edt/LETE, LETD, LETT, EOS/ for (j=1; j <= MAXTBUFS; j=j+1) { i = j - 1 junk = itoc(i, num, 2) edt(3) = num(1) call scratf(edt, edtbuf(1,j)) } return end #-h- ended 124 asc 07-may-80 12:14:55 subroutine ended integer i include ctbufs for (i=1; i <= MAXTBUFS; i=i+1) call remove(edtbuf(1,i)) return end #-h- gtfndx 325 asc 07-may-80 12:14:56 integer function gtfndx(newind) include cbuf if (free != 0) # something in free list { newind = free call getb(free, NEXT, free) # relink free list } else if (lastbf + BUFENT <= MAXBUF) { newind = lastbf lastbf = lastbf + BUFENT } else newind = ERR gtfndx = newind return end #-h- ptfndx 127 asc 07-may-80 12:14:57 subroutine ptfndx(start, stop) integer start, stop include cbuf call setb(stop, NEXT, free) free = start return end #-h- findit 280 asc 07-may-80 12:14:58 subroutine findit(in, out) character in(ARB), out(ARB) integer i, n, ctoi include ctbufs call scopy(in, 1, out, 1) if (in(1) == DOLLAR) { i = 2 n = ctoi(in, i) + 1 if (n > 1 & n <= MAXTBUFS) call scopy(edtbuf(1,n), 1, out, 1) } return end #-h- dolist 707 asc 13-may-80 10:10:14 ## dolist - print lines 'from' through 'to' with control chars expanded integer function dolist(from, to) integer gettxt integer from, i, j, to, k character c include clines include ctxt if (from <= 0) dolist = ERR else { for (i = from; i <= to; i = i + 1) { j = gettxt(i) for (k=1; txt(k) != EOS; k=k+1) if (txt(k) >= BLANK | txt(k) == NEWLINE) call putch(txt(k), STDOUT) else { call putch(CARET, STDOUT) c = txt(k) + ATSIGN call putch(c, STDOUT) } } curln = to dolist = OK } return end #-h- dojoin 810 asc 10-sep-80 09:53:46 ## dojoin - join (from,to) into one line integer function dojoin(from, to) integer from, to integer status, j, i, junk, k, savcln integer gettxt, prevln, delete, inject include clines include csclin include ctxt if (from <= 0) status = ERR else { status = OK if (from < to) { j = 1 for (i=from; i <= to; i=i+1) { junk = gettxt(i) for (k=1; txt(k) != NEWLINE & txt(k) != EOS; k=k+1) if (j >= MAXCARD) { status = ERR break 2 } else { lin(j) = txt(k) j = j + 1 } } lin(j) = NEWLINE lin(j+1) = EOS if (status == OK) { savcln = curln curln = prevln(curln) if (delete(from, to, status) == OK) status = inject(lin) else curln = savcln } } } dojoin = status return end