****************************************************************************** * * Routine to handle UniVerse Spooled Device Management * * Module %M% Version %I% Date %H% * * (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved * This is unpublished proprietary source code of Ardent Software Inc. * The copyright notice above does not evidence any actual or intended * publication of such source code. * ******************************************************************************* * * Maintenence log - insert most recent change descriptions at top * * Date.... GTAR# WHO Description........................................ * 10/13/98 23801 RGA Change copyright info. * 10/29/92 10493 TMC Add EDT, Ultimate's ED * ******************************************************************************* * * * @(#) EDITOR - ULTIMATE COMPATIBLE EDITOR * Author: Rick Poleshuck * Date: 6/14/90 * Last modified: 1/9/91 * $OPTIONS PICK * * $include EQUATES * EQU TRUE TO 1 EQU FALSE TO 0 EQU TAB TO CHAR(9) EQU SUB.END TO 32000 * list of commands EQU COM.NULL TO 1 EQU COM.EXIT TO 2 EQU COM.EXITALL TO 3 EQU COM.QUESTION TO 4 EQU COM.WILDCARD TO 5 EQU COM.LIST TO 6 EQU COM.GOTO TO 7 EQU COM.SUPPRESS TO 8 EQU COM.LENGTH TO 9 EQU COM.TOP TO 10 EQU COM.UP TO 11 EQU COM.BOTTOM TO 12 EQU COM.BREAK TO 13 EQU COM.COLUMN TO 14 EQU COM.FILEDELETE TO 15 EQU COM.HEX TO 16 EQU COM.JOIN TO 17 EQU COM.DISP.PRE TO 18 EQU COM.EXE.PRE TO 19 EQU COM.SET.PRE TO 20 EQU COM.DOWN TO 21 EQU COM.ZONE TO 22 EQU COM.TABS TO 23 EQU COM.INSERT TO 24 EQU COM.FILE TO 25 EQU COM.FILESAVE TO 26 EQU COM.FLIP TO 27 EQU COM.CANCEL TO 28 EQU COM.CANCELALL TO 29 EQU COM.COPY TO 30 EQU COM.DELETELINE TO 31 EQU COM.MERGE TO 32 EQU COM.REPLACE TO 33 EQU COM.REP.UNIVERSAL TO 34 EQU COM.APPEND TO 35 EQU COM.BREAKLINE TO 36 $include UNIVERSE.INCLUDE TTY * * $include INIT * PROMPT "" wildcard = TRUE suppress = FALSE found = TRUE hex = FALSE dummy = @(0,0) search.lines = 0 search.string = "" search.start = 0 search.stop = 0 zonestart = 1 zonestop = SUB.END multitems = FALSE pre.execute = "" DIMENSION prestore( 10 ) prestore( 1 ) = "L22" FOR i = 2 TO 10 prestore( i ) = "" NEXT i TTYGET tty$ THEN tty.save = tty$ CC.QUIT = -1 TTYSET tty$ THEN NULL END * Get filename and file pointer * input: ARG. * output: filename - name of current file * fp - current filepointer * itemlist - dynamic array of all specified items * nitems - number of items to process * * $include GETFN * dict = FALSE GET ( ARG. ) filename ELSE filename = "" BEGIN CASE CASE filename = "" STOPE 200 CASE filename = "DICT" dict = TRUE GET ( ARG. ) filename OPEN "DICT", filename TO fp ELSE STOPE 202, filename END CASE filename = "DATA" GET ( ARG. ) filename OPEN "DATA", filename TO fp ELSE STOPE 202, filename END CASE 1 OPEN filename TO fp ELSE STOPE 202, filename END END CASE * * get list of itemids * itemlist = "" nitems = 0 LOOP GET ( ARG. ) item ELSE item = "" UNTIL item = "" DO * check for single * as argument IF itemlist = "" AND item = "*" THEN itemlist = "*" nitems = 1 EXIT END itemlist = itemlist:item:@VM nitems += 1 REPEAT * Check for no items specified IF nitems = 0 THEN * is select list active IF SYSTEM(11) = 0 THEN STOPE 203 END ELSE multitems = TRUE itemlist = "" LOOP NULL WHILE READNEXT tmp itemlist = itemlist:tmp(0):@VM nitems += 1 REPEAT END END ELSE * if Argument = * then loop thru get list of items IF itemlist = "*" THEN * Get list of items nitems = 0 multitems = TRUE itemlist = "" SELECT fp TO selectlist LOOP NULL WHILE READNEXT tmp,junk FROM selectlist itemlist = itemlist:tmp:"":@VM nitems += 1 REPEAT END IF nitems > 1 THEN multitems = TRUE END * * Loop thru all items * FOR item.no = 1 TO nitems item = FIELD ( itemlist, @VM, item.no ) modified = FALSE nattr = 0 READ record FROM fp,item THEN nattr = DCOUNT( record, @AM ) new.item = FALSE END ELSE PRINT @SYS.BELL:"New item" record = "" new.item = TRUE END xrecord = record xline = "" xlineno = 0 IF nattr = 0 THEN lastline = TRUE curline = 0 END ELSE lastline = FALSE curline = 1 END IF multitems = TRUE THEN PRINT item PRINT "Top" * * main editing loop * exited = FALSE LOOP GOSUB getcommand GOSUB docommand WHILE exited = FALSE REPEAT NEXT item.no * * End of main routine * TTYSET tty.save ELSE NULL STOP * * subroutine section * getcommand: * * $include GETCOMMAND * * 1 2 3 * 123456789012345678901234567890123 EQU comlist TO "ABCDEFGHIJLMNPQRSTUXZ0123456789^?" * * look for a valid command * valid = FALSE LOOP retry: IF pre.execute <> "" THEN * get prestore command comline = FIELD ( pre.execute, @SM, 1 ) IF COL2() THEN pre.execute = pre.execute[ COL2()+1, SUB.END ] END ELSE pre.execute = "" END END ELSE PRINT ".": INPUT comline IF comline = "" THEN PRINT @(-10): END comline = TRIMB( TRIMF( comline ) ) IF comline = "" THEN command = COM.NULL RETURN END command = INDEX ( comlist, UPCASE( comline[1,1] ), 1 ) ON command GOSUB gca, gcb, gcc, gcd, gce, gcf, gcg, gch, gci, gcj, gcl, gcm, gcn, gcp, gcq, gcr, gcs, gct, gcu, gcx, gcz, gc0, gc1, gc2, gc3, gc4, gc5, gc6, gc7, gc8, gc9, gcup, gcquest WHILE valid = FALSE PRINT "Cmnd?" REPEAT RETURN gca: BEGIN CASE CASE UPCASE(comline) = "A" IF search.string <> "" THEN parm1 = search.lines parm2 = search.string parm3 = search.start parm4 = search.stop valid = TRUE command = COM.LIST END CASE UPCASE( comline[2,1] ) = "L" command = COM.APPEND comline = comline[3,SUB.END] GOSUB parsenumber parm1=parm IF parm1 = 0 THEN parm1 = 1 sep=comline[1,1] parm2=FIELD( comline[2,SUB.END], sep, 1 ) valid = TRUE CASE UPCASE ( comline[2,1] ) = "S" PRINT "AS not available" END CASE RETURN gcb: BEGIN CASE CASE UPCASE(comline) = "B" command = COM.BOTTOM valid = TRUE CASE UPCASE(comline[1,2]) = "BL" comline = comline[2,SUB.END] GOSUB parseline * parm1 = number of lines to break * parm2 = search string * parm3 = starting column * parm4 = ending column * search string is required for BL IF parm2 <> "" THEN * * fixup parameters * IF parm1 = 0 THEN parm1 = 1 IF parm3 = 0 THEN parm3 = 1 BEGIN CASE CASE parm4 = 0 parm4 = SUB.END CASE parm4 <= parm3 parm4 = 1 CASE 1 parm4 = ( parm4 - parm3 ) + 1 END CASE command = COM.BREAKLINE valid = TRUE END END CASE RETURN gcc: BEGIN CASE CASE UPCASE(comline) = "C" command = COM.COLUMN valid = TRUE CASE UPCASE( comline[2,1] ) = "L" command = COM.COPY comline = TRIMF( comline[3,SUB.END] ) GOSUB parsenumber IF parm <> 0 THEN parm1 = parm comline = TRIMF( comline ) IF comline[1,1] = "-" THEN comline = TRIMF( comline[2,SUB.END] ) GOSUB parsenumber parm2 = parm END command = COM.COPY valid = TRUE END END CASE RETURN gcd: IF UPCASE( comline[2,1] ) = "E" THEN comline = comline[2,SUB.END] GOSUB parseline * * fixup parameters * IF parm3 = 0 THEN parm3 = 1 BEGIN CASE CASE sep = ":" AND parm3 <> 1 * if specified search from beginning ':' but don't * look at first column then just return FALSE RETURN CASE parm4 = 0 parm4 = SUB.END CASE parm4 <= parm3 parm4 = 1 CASE 1 parm4 = ( parm4 - parm3 ) + 1 END CASE command = COM.DELETELINE valid = TRUE END RETURN gce: BEGIN CASE CASE UPCASE( comline ) = "EX" command = COM.EXIT valid = TRUE CASE UPCASE( comline ) = "EXT" command = COM.EXITALL valid = TRUE CASE 1 NULL END CASE RETURN gcf: chr = UPCASE( comline[2,1] ) BEGIN CASE CASE chr = "" command = COM.FLIP valid = TRUE RETURN CASE chr = "D" command = COM.FILEDELETE valid = TRUE * filedelete takes no parameters RETURN CASE chr = "I" command = COM.FILE CASE chr = "S" command = COM.FILESAVE CASE 1 PRINT "Cmnd?" RETURN to retry END CASE * * parm1 = overwrite flag * parm2 = item name * parm3 = filename * * set overwrite flag IF UPCASE ( comline[3,1] ) = "O" THEN parm1 = TRUE comline = comline[4,SUB.END] END ELSE parm1 = FALSE comline = comline[3,SUB.END] END * set new file name IF comline[1,1] = "(" THEN * is it a DICT file comline = comline[2,SUB.END] tmp = FIELD( comline, " ", 1 ) IF tmp = "DICT" THEN tmp = TRIMF(comline[COL2()+1,SUB.END]) parm3 = "DICT ":FIELD( comline, " ", 1 ) comline = comline[ COL2()+1, SUB.END ] END ELSE parm3 = tmp comline = comline[ COL2()+1, SUB.END ] END * if filename specified and no item specified * then use same item name parm2 = TRIMF( comline ) IF parm2 = "" THEN parm2 = item END END ELSE parm2 = FIELD( comline , " ", 1 ) parm3 = "" END valid = TRUE RETURN gcg: comline = TRIMF( comline[2, SUB.END] ) IF NUM ( comline ) = TRUE THEN command = COM.GOTO parm1 = comline valid = TRUE END RETURN gch: IF UPCASE(comline[1,2]) = "HX" THEN command = COM.HEX valid = TRUE END RETURN gci: IF UPCASE(comline) = "I" THEN parm1 = "" END ELSE parm1 = comline[3,SUB.END] END command = COM.INSERT valid = TRUE RETURN gcj: IF UPCASE(comline[1,2]) = "JL" THEN command = COM.JOIN valid = TRUE END RETURN gcl: GOSUB parseline command = COM.LIST * * fixup parameters * IF parm3 = 0 THEN parm3 = 1 BEGIN CASE CASE sep = ":" AND parm3 <> 1 * if specified search from beginning ':' but don' look at first * column then just return FALSE RETURN CASE parm4 = 0 parm4 = SUB.END CASE parm4 <= parm3 parm4 = 1 CASE 1 parm4 = ( parm4 - parm3 ) + 1 END CASE search.lines = parm1 search.string = parm2 search.start = parm3 search.stop = parm4 valid = TRUE RETURN gcm: IF UPCASE ( comline[2,1] ) = "E" THEN * parm1 = number of lines * parm2 = filename * parm3 = item-id * parm4 = start line comline = TRIMF( comline[3,SUB.END] ) GOSUB parsenumber parm1 = parm comline = TRIMF( comline ) IF comline[1,1] <> "(" THEN * merge in same file parm2 = filename sep = comline[1,1] comline = comline[2,SUB.END] parm3 = FIELD( comline, sep, 1 ) * null itemid specified defaults to current itemid IF parm3 = "" THEN parm3 = item comline = comline[ COL2() + 1, SUB.END ] GOSUB parsenumber parm4 = parm END ELSE * is it a DICT file comline = comline[2,SUB.END] tmp3 = FIELD( comline, ")", 1 ) comline = comline[COL2()+1,SUB.END] GOSUB parsenumber parm4 = parm IF tmp3[1,5] = "DICT " THEN tmp1 = TRIMF(tmp3[6,SUB.END]) parm2 = "DICT ":FIELD( tmp1, " ", 1 ) tmp3 = tmp1[ COL2()+1, SUB.END ] END ELSE parm2 = FIELD( tmp3, " ", 1 ) tmp3 = tmp3[ COL2()+1, SUB.END ] END * if filename specified and no item specified * then use same item name parm3 = TRIMF( tmp3 ) IF parm3 = "" THEN parm3 = item END END valid = TRUE command = COM.MERGE END RETURN gcn: comline = TRIMF( comline[2,SUB.END] ) parm1 = 0 IF LEN ( comline ) > 0 THEN GOSUB parsenumber parm1 = parm END IF LEN ( comline ) = 0 THEN valid = TRUE command = COM.DOWN END RETURN gcp: BEGIN CASE CASE UPCASE( comline ) = "PD" command = COM.DISP.PRE valid = TRUE CASE LEN ( comline ) = 2 AND NUM( comline[2,1] ) * prestores are called as 0 based but stored 1 based command = COM.EXE.PRE parm1 = comline[2,1] + 1 valid = TRUE CASE UPCASE( comline ) = "P" * P with no arguments is P0 command = COM.EXE.PRE parm1 = 1 valid = TRUE CASE NUM( comline[2,1] ) command = COM.SET.PRE valid = TRUE parm1 = comline[2,1] + 1 parm2 = comline[4,SUB.END] END CASE RETURN gcq: RETURN gcr: * parm1 = number of lines * parm2 = search string * parm3 = replace string * parm4 = start column * parm5 = end column IF UPCASE( comline[2,1] ) = "U" THEN command = COM.REP.UNIVERSAL comline = comline[3,SUB.END] END ELSE command = COM.REPLACE comline = comline[2,SUB.END] END GOSUB parsenumber parm1 = parm comline = TRIMF( comline ) IF comline = "" THEN * simple replace command parm4 = 0 valid = TRUE RETURN END sep = comline[1,1] parm2 = FIELD( comline, sep, 2 ) comline = comline[ COL2() + 1, SUB.END ] IF comline = "" THEN PRINT "Strng?" RETURN END parm3 = FIELD( comline, sep, 1 ) comline = TRIMF( comline[ COL2() + 1, SUB.END ] ) parm4 = 1 parm5 = 0 IF LEN ( comline ) <> 0 THEN GOSUB parsenumber parm4 = parm comline = TRIMF( comline ) IF LEN( comline ) > 0 THEN IF comline[1,1] <> "-" THEN PRINT "Col#?" RETURN END comline = comline[2,SUB.END] GOSUB parsenumber parm5=parm END END IF sep = ":" THEN * universal search would make no sense command = COM.REPLACE END IF parm2 = "" AND command = COM.REP.UNIVERSAL THEN PRINT "Strng?" RETURN END BEGIN CASE CASE sep = ":" AND parm4 <> 1 * if specified search from beginning ':' but don' look at first * column then just return RETURN CASE parm5 = 0 parm5 = SUB.END CASE parm5 <= parm4 parm5 = parm4 END CASE valid = TRUE RETURN gcs: IF comline[2,1] = "?" THEN command = COM.LENGTH END ELSE command = COM.SUPPRESS END valid = TRUE RETURN gct: IF UPCASE(TRIM( comline )) = "T" THEN command = COM.TOP valid = TRUE END RETURN gcu: parm1 = 0 comline = TRIMF( comline[2,SUB.END] ) IF LEN ( comline ) > 0 THEN GOSUB parsenumber parm1 = parm END IF LEN ( comline ) = 0 THEN valid = TRUE command = COM.UP END RETURN gcx: BEGIN CASE CASE UPCASE( comline ) = "X" command = COM.CANCEL valid = TRUE CASE UPCASE ( comline ) = "XF" command = COM.CANCELALL valid = TRUE END CASE RETURN gcz: parm1 = 1 parm2 = SUB.END comline = TRIMF ( comline[2,SUB.END] ) IF LEN (comline ) > 0 THEN GOSUB parsenumber parm1 = parm IF LEN( comline ) > 0 THEN IF comline[1,1] <> "-" THEN PRINT "Col#?" RETURN TO retry END comline = comline[2,SUB.END] GOSUB parsenumber parm2 = parm IF LEN( comline ) > 0 THEN PRINT "Col#?" RETURN TO retry END END END valid = TRUE command = COM.ZONE RETURN * * numbers * gc0: gc1: gc2: gc3: gc4: gc5: gc6: gc7: gc8: gc9: IF NUM( comline ) = TRUE THEN valid = TRUE command = COM.GOTO parm1 = comline END RETURN gcup: valid = TRUE command = COM.WILDCARD RETURN gcquest: valid = TRUE command = COM.QUESTION RETURN parsenumber: * * inputs: comline - command line * outputs: parm - parameter * comline - points to after parameter * tmp = LEN( comline ) parm = 0 FOR i = 1 TO tmp IF NUM( comline[1,1] ) THEN parm = parm*10 + comline[1,1] comline = comline[2,SUB.END] END ELSE i = tmp END NEXT i RETURN parseline: parm2 = "" parm3 = 0 parm4 = 0 sep = "" comline = TRIMF( comline[2,SUB.END] ) GOSUB parsenumber parm1 = parm IF LEN ( comline ) > 0 THEN sep = comline[1,1] parm2 = FIELD( comline, sep, 2 ) comline = comline[ COL2() + 1, SUB.END ] IF LEN ( comline ) > 0 THEN GOSUB parsenumber parm3 = parm IF LEN ( comline ) > 0 THEN IF comline[1,1] <> "-" THEN PRINT "Col#?" RETURN TO retry END comline = comline[2,SUB.END] GOSUB parsenumber parm4 = parm IF LEN ( comline ) > 0 THEN PRINT "Col#?" RETURN TO retry END END END END RETURN docommand: * * $include DOCOMMAND * BEGIN CASE CASE command = COM.NULL GOSUB disp.line GOSUB iseoi CASE command = COM.QUESTION IF LEN ( curline ) > 3 THEN PRINT item:" L ":curline END ELSE PRINT item:" L ":FMT(curline,"R%%%") END CASE command = COM.WILDCARD IF wildcard = TRUE THEN wildcard = FALSE PRINT "/^\ on" END ELSE wildcard = TRUE PRINT "/^\ off" END CASE command = COM.APPEND curline -= 1 tmp3 = curline + parm1 -1 FOR i = curline TO tmp3 modified = TRUE record = record:parm2 GOSUB disp.line GOSUB iseoi IF curline >= nattr THEN i = tmp3 lastline = TRUE END NEXT i CASE command = COM.BREAKLINE curline -= 1 found = TRUE FOR i = 1 TO parm1 IF parm2 <> "" THEN start = parm3 stop = parm4 search = parm2 GOSUB locate END IF found THEN modified = TRUE position += LEN( parm2 ) * Add length of search to break position record = record[1,position -1]:@AM:record[position,65536] nattr += 1 GOSUB disp.line GOSUB disp.line GOSUB iseoi END ELSE curline += 1 IF curline >= nattr THEN lastline = TRUE END END IF lastline = TRUE THEN i = parm1 END NEXT i CASE command = COM.COLUMN IF suppress = FALSE THEN PRINT " ": tmp = @CRTWIDE - 3 END ELSE tmp = @CRTWIDE END PRINT " 1 2 3 4 5 6 7" [ 1, tmp ] IF suppress = FALSE THEN PRINT " ": PRINT " 123456789012345678901234567890123456789012345678901234567890123456789012345678" [ 1, tmp ] CASE command = COM.EXIT OR command = COM.EXITALL IF modified = TRUE THEN GOSUB sure IF tmp = FALSE THEN RETURN END END PRINT "'":item:"' exited" IF command = COM.EXITALL THEN STOP END exited = TRUE CASE command = COM.COPY IF parm2 < parm1 THEN parm2 = parm1 modified = TRUE * build list of attributes to move tmp = "" FOR i = parm1 TO parm2 tmp = tmp:record IF i < parm2 THEN tmp = tmp:@AM DEL record NEXT i * adjust curline for deletion before insertion IF curline > parm1 THEN curline = curline - ( parm2 - parm1 + 1 ) END IF curline = nattr THEN record = record:@AM:tmp END ELSE INS tmp BEFORE record END CASE command = COM.DELETELINE IF parm1 = 0 THEN parm1 = 1 curline -= 1 lastline = FALSE IF curline < 1 THEN curline = 1 IF curline > nattr THEN PRINT "Seqn?" GOTO enddelete END nattr.saved = nattr FOR i = 1 TO parm1 WHILE curline <= nattr IF parm2 <> "" THEN start = parm3 stop = parm4 search = parm2 GOSUB locate END ELSE found = TRUE END IF found THEN modified = TRUE DEL record nattr -= 1 END ELSE curline += 1 END NEXT i IF curline > nattr OR nattr = 0 THEN PRINT "EOI ": lno = nattr.saved GOSUB disp.number lastline = TRUE PRINT END RETURN enddelete: NULL CASE command = COM.FLIP curline = 1 PRINT "Top" lastline = FALSE CASE command = COM.FILEDELETE IF modified = TRUE THEN GOSUB sure IF tmp = TRUE THEN DELETE fp, item exited = TRUE PRINT "'":item:"' deleted." END END ELSE DELETE fp, item exited = TRUE PRINT "'":item:"' deleted." END CASE command = COM.FILE OR command = COM.FILESAVE * if parm3 isn't specified use same file IF parm3 = "" THEN * if parm2 isn't specified than just rewrite item IF parm2 = "" THEN WRITE record TO fp, item THEN modified = FALSE END ELSE PRINT "Write error!" END END ELSE * if overwrite flag isn't specified * and item exists then don't write record IF parm1 = FALSE THEN READU dummy FROM fp, parm2 THEN PRINT "Cmnd?" GOTO file.end END END WRITE record TO fp, parm2 THEN modified = FALSE END ELSE PRINT "Write error!" END END END ELSE * if parm3 is specified use different file IF parm2 = "" THEN parm2 = item * open specified filename OPEN parm3 TO tmp ELSE PRINT "Open error!" GOTO file.end END * if overwrite flag isn't specified * and item exists then don't write record IF parm1 = FALSE THEN READU dummy FROM tmp, parm2 THEN PRINT "Cmnd?" GOTO file.end END END WRITE record TO tmp,item THEN modified = FALSE END ELSE PRINT "Write error!" END CLOSE tmp END IF command = COM.FILE THEN exited = TRUE END xrecord = record xline = "" IF exited = FALSE THEN curline = 1 PRINT "Top" lastline = FALSE END ELSE PRINT "'":item:"' filed" END file.end: NULL CASE command = COM.HEX IF hex = TRUE THEN hex = FALSE PRINT "Hex off" END ELSE hex = TRUE PRINT "Hex on" END CASE command = COM.INSERT IF parm1 = "" THEN IF curline = 0 THEN curline = 1 * handle screw line number display IF new.item = TRUE THEN lno = curline END ELSE lno = curline -1 END LOOP IF LEN( lno ) > 3 THEN PRINT lno:"+": END ELSE PRINT FMT( lno, "R%%%" ):"+": END INPUT parm1 UNTIL parm1 = "" IF new.item = TRUE THEN lno += 1 GOSUB insert.line REPEAT END ELSE GOSUB insert.line END new.item = FALSE CASE command = COM.JOIN IF curline > 1 THEN * join line is really remove an @AM tmp = INDEX ( record, @AM, curline - 1 ) record = record[1,tmp-1]:record[tmp+1,65556] modified = TRUE curline -= 1 nattr -= 1 GOSUB disp.line GOSUB iseoi END CASE command = COM.LIST GOSUB istop found = TRUE ;* disp.line lists only found lines - default to found IF parm1 = 0 THEN IF parm2 = "" THEN parm1 = 1 ELSE * special case - parm1 = 0/locate first match in item found = FALSE LOOP * disp.line only prints line if found = TRUE * else it increments pointer start = parm3 stop = parm4 search = parm2 GOSUB locate GOSUB disp.line GOSUB iseoi UNTIL lastline OR found REPEAT END END FOR i = 1 TO parm1 WHILE lastline = FALSE IF parm2 <> "" THEN start = parm3 stop = parm4 search = parm2 GOSUB locate END * disp.line only prints line if found = TRUE else * it increments pointer GOSUB disp.line GOSUB iseoi NEXT i CASE command = COM.MERGE * parm1 = number of lines * parm2 = filename * parm3 = item-id * parm4 = start line IF parm2 <> "" THEN * merge from different file OPEN parm2 TO mergefp ELSE PRINT "Not on file" RETURN END END ELSE * merge from same file mergefp = fp END READ mergerecord FROM mergefp,parm3 ELSE PRINT "Not on file" RETURN END modified = TRUE tmp1 = parm1 + parm4 - 1 tmp2 = "" j = 0 * get all attributes to merge nmattr = DCOUNT ( mergerecord, @AM ) FOR i = parm4 to tmp1 WHILE i <= nmattr tmp3 = mergerecord tmp2 = tmp2:tmp3 j = j + 1 IF i <> tmp1 THEN tmp2 = tmp2:@AM END NEXT i * insert merged attributes and update counts INS tmp2 BEFORE record nattr += j IF nattr <> 0 THEN new.item = FALSE curline += j * release memory tmp2 = "" tmp3 = "" mergerecord = "" CASE command = COM.REPLACE OR command = COM.REP.UNIVERSAL * parm1 = number of lines * parm2 = search string * parm3 = replace string * parm4 = start column * parm5 = end column IF parm1 = 0 THEN parm1 = 1 curline -= 1 lastline = FALSE ;* backed up so lastline is false IF curline <= 0 THEN curline = 1 IF parm4 = 0 THEN * simple replace - prompting for input IF curline >= nattr THEN curline = nattr FOR i = 1 TO parm1 IF NOT(suppress) THEN lno = curline GOSUB disp.number END PRINT " ": INPUT insert.buf IF insert.buf = "" THEN i = parm1 ELSE modified = TRUE record = insert.buf END IF curline >= nattr THEN PRINT "EOI ":nattr i = parm1 END curline += 1 NEXT i END ELSE * search and replace tmp = parm1 - curline - 1 IF tmp > nattr THEN parm1 = tmp FOR replace = 1 TO parm1 WHILE curline <= nattr search = parm2 start = parm4 stop = parm5 foundlist="" LOOP GOSUB locate IF found THEN position = position + start -1 foundlist = foundlist:position:@AM END WHILE command = COM.REP.UNIVERSAL AND found = TRUE AND start < stop start = position + LEN( parm2 ) REPEAT IF foundlist <> "" THEN j = DCOUNT( foundlist, @AM ) -1 modified = TRUE line = record lensrch = LEN ( parm2 ) FOR i = j TO 1 STEP -1 k = foundlist line = line[1,k-1]:parm3:line[k+lensrch,SUB.END] NEXT i record = line GOSUB disp.line line = "" found = TRUE END ELSE curline += 1 END NEXT replace END GOSUB iseoi CASE command = COM.DISP.PRE FOR i = 1 TO 10 PRINT "P":i-1:" ":prestore(i) NEXT i CASE command = COM.EXE.PRE pre.execute = prestore( parm1 ) CASE command = COM.SET.PRE prestore(parm1) = parm2 CASE command = COM.SUPPRESS IF suppress = TRUE THEN suppress = FALSE PRINT "Suppress off" END ELSE suppress = TRUE PRINT "Suppress on" END CASE command = COM.LENGTH PRINT "Item length is ":LEN(record):" bytes" CASE command = COM.TOP lastline = FALSE PRINT "Top" curline = 1 CASE command = COM.BOTTOM PRINT "EOI ":nattr curline = nattr+1 CASE command = COM.UP lastline = FALSE curline -= parm1 curline -= 1 IF curline < 1 THEN PRINT "Top" curline = 1 END ELSE GOSUB disp.line GOSUB iseoi END CASE command = COM.DOWN curline += parm1 IF curline >= nattr THEN PRINT "EOI ": curline = nattr lno = curline GOSUB disp.number PRINT lastline = TRUE END ELSE GOSUB disp.line GOSUB iseoi END CASE command = COM.GOTO lastline = FALSE IF parm1 = 0 THEN curline = 1 PRINT "Top" END ELSE curline = parm1 GOSUB disp.line GOSUB iseoi END CASE command = COM.ZONE zonestart = parm1 zonestop = parm2 - parm1 + 1 CASE command = COM.CANCEL PRINT "Undo not available" CASE command = COM.CANCELALL record = xrecord nattr = DCOUNT( record, @AM ) lastline = FALSE curline = 1 lno = xlineno GOSUB disp.number END CASE RETURN * * subroutines * disp.number: IF LEN( lno ) > 3 THEN PRINT lno: END ELSE PRINT FMT( lno, "R%%%" ): END RETURN disp.line: IF lastline = TRUE THEN IF new.item = TRUE THEN PRINT "New item" END GOSUB istop END IF curline <= nattr THEN IF new.item = FALSE AND nattr <> 0 THEN * don't display when searching and not found IF command <> COM.LIST OR found = TRUE THEN IF suppress = FALSE THEN lno = curline GOSUB disp.number END GOSUB putline END curline += 1 END END RETURN sure: PRINT "Sure(Y/N=CR)?": INPUT tmp IF UPCASE( TRIMF(tmp)[1,1] ) = "Y" THEN tmp = TRUE END ELSE tmp = FALSE END RETURN putline: tmp = record[zonestart, zonestop] tmp1 = LEN ( tmp ) IF hex = TRUE THEN * * format hex string * tmp2 = "" FOR j = 1 TO tmp1 tmp2 = tmp2:OCONV( tmp[j,1], "MX" ) NEXT j tmp = tmp2 END * * filter nonprintable characters * length = LEN( tmp ) tmp1 = "" FOR j = 1 TO length chr = tmp[j,1] IF ( chr >= " " AND chr <= "~" ) OR chr = TAB THEN tmp1 = tmp1:chr END ELSE tmp1 = tmp1:"." END NEXT j PRINT " ":tmp1 RETURN * * locate string in line * input: record: string to search * start = starting column * stop = ending column * search = string to find * sep: separator - ":" means only match from start of line * wildcard: TRUE|FALSE * output: found - TRUE|FALSE * position - position of found string locate: IF search = "" THEN * special case - search for // position = 1 found = TRUE RETURN END line = record[ start, stop ]:SPACE(256) * * look for exact match * IF wildcard = FALSE OR INDEX( search, "^", 1 ) = 0 THEN IF sep = ":" THEN IF search = line[ 1, LEN( search ) ] THEN found = TRUE position = 1 END ELSE found = FALSE END END ELSE position = INDEX( line, search, 1 ) IF position = 0 THEN found = FALSE END ELSE found = TRUE END END END ELSE tline = line IF sep = ":" THEN * must start in column 1 GOSUB wildcompare IF found = TRUE THEN position = 1 END ELSE position = 1 found = FALSE LOOP IF search[1,1] = '^' THEN * wildcard always matches first char tpos = 1 END ELSE * wildcard always matches first char tpos = INDEX ( tline, search[1,1], 1 ) END IF tpos <> 0 THEN * first character not found tline = tline[tpos,SUB.END] position = position + tpos -1 END WHILE tline <> "" AND tpos <> 0 GOSUB wildcompare IF found = TRUE THEN GOTO locate.found END ELSE tline = tline[2,SUB.END] END REPEAT END END locate.found: tline = "" line = "" RETURN insert.line: * Trailing Attribute mark denotes empty line - just remove it * embedded attribute marks are inserted * tmp = LEN(parm1) IF ( parm1[tmp,1] = @AM ) THEN parm1 = parm1[1,tmp-1] IF curline = nattr THEN record = record:@AM:parm1 END ELSE INS parm1 BEFORE record END modified = TRUE tmp = DCOUNT ( parm1, @AM ) * line with no @AM is still one attribute IF tmp = 0 THEN tmp = 1 * increment curline and total number of attributes curline += tmp nattr += tmp IF curline > nattr THEN lastline = TRUE RETURN wildcompare: * * input: search - search string * line - searched string k = LEN ( search ) found = TRUE FOR j = 1 TO k IF search[j,1] <> '^' AND search[j,1] <> tline[j,1] THEN found = FALSE j = k END NEXT j RETURN iseoi: IF curline > nattr OR nattr = 0 THEN PRINT "EOI ": lno = nattr GOSUB disp.number lastline = TRUE PRINT END RETURN istop: IF curline > nattr OR lastline = TRUE THEN curline = 1 PRINT @SYS.BELL:"Top" lastline = FALSE END RETURN END