Trailing-Edge
-
PDP-10 Archives
-
tops20tools_v6_9-jan-86_dumper
-
tools/sed-for-vms/sed1cm.mar
There are 5 other files named sed1cm.mar in the archive. Click here to see a list.
.TITLE SED1CM - General SED File-changing Commands
.LIBRARY /SEDITB.MLB/
.ENABLE DEBUG
.DISABLE GLOBAL
.PSECT CODE,NOWRT,EXE,LONG
.NOCROSS ;Don't cross-reference the symbol definitions
FLGDEF ;Define the flag bits
SEQDEF ; and the command sequence definitions
TRMDEF ; and the terminal table offset definitions
PRMDEF ; and the SED parameters
$NAMDEF ; and the name block definitions
$XABPRODEF ; and the protection XAB definitions
$IODEF ; and the I/O function definitions
.CROSS ;Proceed with cross-referencing
.SUBTITLE Linefeed command
;***************************************************************************
;Here on linefeed, which erases the line that the cursor goes to
;NOTE: this command is obsolete; replaced by ERASE-LINE
LNFPAR::BBC #V_LSD,F1,KILPAR ;Is linefeed really a cursor down?
MOVL #$CURDN,R9 ;Yes - do a down instead
JMP DWNARG
KILPAR::MOVL #PARBUF,PARPTR ;Point to start of parameter buffer
BBSC #V_CMV,F,10$ ;Clear cursor move flag - on?
BRW ENTERM ;No - clear bottom line, prompt, and loop
10$: MOVQ SAVPOS,R7 ;Yes - restore saved position
BRW ENTERM ;Now clear, prompt, and loop
LNFEED::BBC #V_LSD,F1,10$ ;Is linefeed really a cursor down?
MOVL #$CURDN,R9 ;Yes - do a down instead
JMP DOWN
10$: BBC #V_RDO,F,20$ ;Is file read-only?
JMP RDOERR ;Yes - command is illegal
20$: DECL ISVCNT ;Decrement incremental save counter
BISL #M_CHG,F ;Say file has been modified
CMPL R7,LPP.1 ;At bottom of screen?
BEQL LNFERR ;Yes - illegal
INCL R7 ;Move to next row
MOVB #^O15,(R5)+ ;Move to start of line
JSB CDOWN ;Move down one
JSB CLRLNA ;Erase the entire line
JSB POSCUR
BICL #M_XPL!M_PCM,F ;Say line pointer is good; kill mask
JSB MAKLPT ;and make it (in LINPTR and R6)
LNFED1: MOVZBL (R6)+,R1 ;Get a character
CMPB R1,#^O15 ;Carriage return?
BEQL LNFED3 ;Yes - check for end of line
LNFED2: CLRB -1(R6) ;Else null out the character
BRB LNFED1 ;and get another
LNFED3: MOVZBL (R6),R1 ;Get (maybe) linefeed
CMPB R1,#^O12 ;Is it really?
BNEQ LNFED2 ;No - just null out the <CR>
BISL #M_XPC,F ;Say character pointer is bad
JMP LOOP ;Done
LNFERR: MOVAB LNFERM,R1
JMP ERROR
LNFERM: .ASCIZ /#Can't erase last line of display/
.SUBTITLE Erase line, move beg & end line
;Here to erase all characters from the cursor to the end of the line
;ENTER ERASE-LINE erases parameter (KILPAR)
ERASLN::BBC #V_RDO,F,10$ ;Is file read-only?
JMP RDOERR ;Yes - command is illegal
10$: MOVL #1000,R1 ;Set to close a lot of spaces
BRW CLSNP0 ;Let close-spaces handle it
;****************************************************************************
;Here to move to the beginning of the line, unless cursor is at beginning,
;in which case it moves to the end
LINARG::BBSS #V_CMV,F,LINE ;Already doing cursor movement?
JSB MARKUP ;No - put cursor back in text
LINE:: TSTL R8 ;Already at beginning?
BEQL LINEND ;Yes - move to end instead
CLRL R8 ;No - move to beginning
BISL #M_XPC,F ;Character pointer is bad
JMP DISCUR ;Display the cursor and loop
LINEND::BISL #M_XPC!M_XPL,F ;Character and line pointers are bad
INCL R7 ;Go do a wordwise backtab from next line
BRW WBTAB
;**********************************************************************
;Here on enter-control-character command. Set flag so if next
;character is ASCII it will be made a control character
;(else there is no effect)
ENTCCH::BISL #M_CCH,F ;Set that ol' flag
JMP LOOP ;That's all
.SUBTITLE Insert Mode Command Processor
;***********************************************************************
;Here on insert mode toggle command. Set flag so characters typed
;will be inserted at cursor position, and not replace the existing character
;Typing the command again reverses this effect
;Routine to toggle the insert mode bit
INSCOM: BITL #M_IMD,F ;Test the bit
BEQL 10$ ;Is it set?
BICL #M_IMD,F ;Yes - reset it
RSB
10$: BISL #M_IMD,F ;No - set it
RSB
INSMOD::BSBB INSCOM ;Toggle the insert mode flag
BITL #M_XCT!M_XBN,F1 ;Executing?
BEQL 10$ ;No
JMP LOOP ;Yes - done now
10$: BBS #V_BEP,F1,INSBEP ;Want to beep instead of working with message?
JSB FIXBLN ;No - repair the bottom line
JSB POSCUR ;Reposition the cursor
JMP LOOP ;and loop
INSBEP: BBS #V_IMD,F,INSBP1 ;Now in insert mode?
MOVB #7,ECHBUF ;Beep once
$QIOW_S CHAN=TTCHAN,-
FUNC=#IO$_WRITEVBLK!IO$M_NOFORMAT,-
P1=ECHBUF,-
P2=#1
SNOOZE 400 ;Sleep for 400 milliseconds
INSBP1: MOVB #7,ECHBUF ;Beep again
$QIOW_S CHAN=TTCHAN,-
FUNC=#IO$_WRITEVBLK!IO$M_NOFORMAT,-
P1=ECHBUF,-
P2=#1
JMP LOOP
;Save the file
SAVEIT::BBS #V_RDO,F,10$ ;Is file read-only? Yes - don't save
BBC #V_CHG,F,10$ ; or is it unmodified? Yes - don't save
BSBB INCSAV ;Save the file
JMP LOOP ;That's all
10$: MOVAB 20$,R1 ;Point to the error message
JMP ERROR ; and go issue it
20$: .ASCIZ /####File not changed - not saved/
.SUBTITLE Incremental Save Routine
INCSAV::CLRB JRNCRE ;Clear the journal create flag
MOVQ ISVNUM,ISVCNT ;Reset command & typein inc save counts
MOVL #SQZVAL,SQZCNT ;Reset # of commands to skip between squeezes
MOVAB INCSVM,R1 ;Point to the message
JSB PUTBTM ;Put message on bottom line
JSB PROTOF
JSB PUTTYP
SUBL3 #BUFFER,EN,OUTSIZ ;Compute the size of the file
DIVL3 #512,OUTSIZ,R1 ;Compute the number of blocks
INCL R1
$FAB_STORE FAB=OUTPUT_FAB,ALQ=R1,- ;Set the proper attributes
FAC=<BIO,PUT>,FNA=FILSPC,-
FNS=FSPLEN,ORG=SEQ,RFM=STM
TSTB BAKFLG ;Is a backup wanted?
BEQL 5$ ;No
TSTB FILE_SAVED ;Yes - has one already been made?
BNEQ 5$ ;Yes - just supersede it
$FAB_STORE FOP=MXV ;Create a new version
BRB 6$
5$: $FAB_STORE FOP=SUP ;Supersede it
6$: CLRW OUTPUT_FAB+FAB$W_IFI
MOVW OUTPUT_XAB+XAB$W_PRO,SAVE_PROT ;Save the needed protection
CVTBW #-1,OUTPUT_XAB+XAB$W_PRO; and allow all access to the file
$CREATE FAB=OUTPUT_FAB
BLBS R0,10$
MOVW SAVE_PROT,OUTPUT_XAB+XAB$W_PRO ;Restore the protection
BISL #M_FLG2,F1 ;Indicate no need to reconvert file
MOVL OUTPUT_FAB+FAB$L_STV,R1 ;Get the sub-error code
JMP SVEERR
10$: PUSHR #^M<R1,R2,R3,R4,R5>
MOVC3 #100,RESULT_NAME,FILSPC ;Save the real file spec
MOVZBL MAIN_NAM+NAM$B_RSL,FSPLEN ;and the length of the filespec
POPR #^M<R1,R2,R3,R4,R5>
$CONNECT RAB=OUTPUT_RAB
MOVB #-1,FILE_SAVED ;Indicate the file has been saved once
MOVAB BUFFER,R3 ;Point to the buffer
MOVL OUTSIZ,R2 ;Get the size of the file
MOVL #1,R4 ;Point to the correct block
30$: MOVL R4,OUTPUT_RAB+RAB$L_BKT ;Save the record number
MOVL R3,OUTPUT_RAB+RAB$L_RBF ;and the buffer address
CMPL R2,#^X8000 ;Do we need to write in chunks?
BGTR 40$ ;Yes
MOVW R2,OUTPUT_RAB+RAB$W_RSZ ;Store the byte count
BRB 50$
40$: MOVW #^X8000,OUTPUT_RAB+RAB$W_RSZ ;and the byte count
50$: $WRITE RAB=OUTPUT_RAB ;Write the blocks
;Need to check for errors here
ADDL #^X8000,R3 ;Increment the buffer pointer
ADDL #^X40,R4 ;and the block number
SUBL #^X8000,R2 ;Count down the file size
BGTR 30$ ;Do some more if needed
$DISCONNECT RAB=OUTPUT_RAB
;Check for errors here
$CLOSE FAB=OUTPUT_FAB ;Close the file
MOVW SAVE_PROT,OUTPUT_XAB+XAB$W_PRO ;Restore the protection
BBC #V_JRW,F1,60$ ;Writing a journal?
JSB JRNSTT ;Yes - start up a new one
60$: BISL #M_XPL!M_XPC,F ;Line and character pointers are now bad
JSB FIXBLN ;Repair the bottom line
JMP POSCUR ;Re-position the cursor and return
INCSVM: .ASCIZ /SAVING FILE - WAIT/
.SUBTITLE Add blank lines to the buffer
;*************************************************************
;Here to add blank lines to the buffer
OPENLN::BBC #V_RDO,F,10$ ;Is file read-only?
JMP RDOERR ;Yes - command is illegal
10$: MOVL ADDLNS,R4 ;Get last time's nominal
BBC #V_ENT,F,OPLNPM ;Is there a parameter typed? No
MOVL R4,PARG1
JSB PEEL.1 ;Read new parm, if any
MOVL PARG1,R4 ;Get lines to add
MOVL R4,ADDLNS ;Save as new nominal
BBC #V_CMV,F,30$ ;Cursor movement?
ADDL3 PARG2,SAVPOS+4,R1 ;Yes - get spaces to open, too
ADDL3 R1,SL,ADDLSP ;Count spaces from left margin
BRB OPLNP0
30$: CLRL ADDLSP ;If no cursor move, clear extra spaces
OPLNP0: JSB ERASPM ;Reset enter mode
BBC #V_XCI,F1,OPLNPM ;Initializing for an execute?
JMP LOOP ;Yes - done now
OPLNPM::TSTL R4 ;Opening zero lines?
BGTR 10$
BRW CLSLNE ;Yes - done
10$: DECL ISVCNT ;Decrement incremental save counter
BICL #M_PCM,F ;Cancel the pick-close mark, if any
BSBW MAKCPT ;Re-make cursor position
CMPB R3,#9 ;Is character at cursor a tab?
BNEQ 20$
JSB RPLTAB ;Yes - replace it with spaces
20$: MULL3 ADDLNS,#2,NUMCHR ;Get number of chars to add
;Add that many <LF>s
MOVB #^O12,CHARAC ; (change half of 'em to <CR>s later)
JSB MAKCHR
BISL #M_XPB!M_CHG,F ;Say bottom pointer bad; file modified
MOVL CHRPTR,R6 ;Get pointer to cursor position
MOVL ADDLNS,R4 ; and number of lines to add
30$: MOVB #^O15,(R6)+ ;Set up a new line
INCL R6
SOBGTR R4,30$ ;Loop until all lines set up
MOVL ADDLSP,R4 ;Now got some spaces to add?
BLEQ OPNLD0 ;No - just re-display
MOVL R4,NUMCHR
MOVL CHRPTR,R0
MOVL R6,CHRPTR
MOVL R0,R6
MOVL R6,-(SP)
JSB MAKSPC ;Add the spaces
MOVL (SP)+,R6 ;Restore the real character pointer
MOVL CHRPTR,R0
MOVL R6,CHRPTR
MOVL R0,R6
OPNLD0: MOVL ADDLNS,R4 ;Get size of open
BBC #V_RST,F,OPNLDA ;Want to restore the nominal parameters?
MOVL #1,ADDLNS ;Yes - set it back to one line
CLRL ADDLSP ; and no spaces
OPNLDA: BSBB OPENLD ;Open up the screen **may not return**
TSTL R8 ;Starting within a line?
BNEQ OPNLDX
TSTL ADDLSP ;Else ending with a partial line?
BEQL OPNLX1 ;No - just position and loop
JSB CDOWN ;Yes - move down
OPNLDX: JSB DISONE ;Re-do that line
OPNLX1: JSB FIXBLW ;Repair the bottom line
JMP DISCUR ;Re-position cursor and return
.SUBTITLE Open lines on the screen
;Subroutine to open (R4) lines on the screen (used by OPENLN, PUT)
;Note: will not return if rest of screen must be displayed (JMPS to LOOP)
;If insert is longer than lines below the cursor,
; if terminal can clear to EOP, do the clear (return if PUT, else LOOP)
; else display the entire screen (LOOP)
;Else if insert fits within the screen
; if terminal can insert lines, insert them (return)
; else if cursor is home and terminal can roll down, roll down (return)
; else display from cursor to end of screen (LOOP)
OPENLD::SUBL3 R7,LPP(R10),R1 ;Find number of lines below cursor
CMPL R1,R4 ;Adding more than that?
BLEQ OPNLD2 ;Yes - kill the return
MOVL ILN(R10),R3 ;Can terminal open its own lines?
BEQL OPNLDR ;No - go redisplay from here down
JSB POSCUR ;Yes - position the cursor
BICL #M_FBL,F ;Bottom line will be in good shape
MOVL R7,-(SP) ;Save the line number
TSTL R8 ;Within a line?
BEQL OPNLD3 ;No
JSB CLRLNR ;Yes - clear to end of line
INCL R7 ;Adjust line number (primarily for VT100)
MOVB #^O15,(R5)+ ;Drop to start of next line
OPNLD1: JSB CDOWN
OPNLD3: MOVL R3,R1 ;Open up one line
JSB PUTSEQ
SOBGTR R4,OPNLD1 ;Loop through all lines
MOVL (SP)+,R7 ;Restore the proper line number
RSB ;Done
OPNLD2: TSTL CPG(R10) ;Is there a sequence for clear-to-eop?
BNEQ 10$ ;Yes
JMP DISALL ;No - go display entire screenful
10$: JSB POSCUR ;Position the cursor
JSB CLEARP ;Clear to end of screen
CMPL R9,#$PUT ;Got a put command?
BNEQ 20$ ;No
RSB ;Yes - return to put the buffer
20$: MOVL (SP)+,R0 ;No - kill return to caller
JSB PUTTYP ;Output all this
JMP LOOP ;and get a new command
OPNLDR: TSTL R7 ;If not home just do display
BNEQ OPLDR1
TSTL R8
BNEQ OPLDR1
TSTL RLD(R10) ;No roll down sequence,
BEQL OPLDR1
CMPL R4,LPP(R10) ; or inserting longer than screen size?
BGEQ OPLDR1 ;Yes - display anyway
JSB CHOME ;Home the cursor
10$: JSB ROLLDN ;Roll and clear a line
SOBGTR R4,10$ ;Do the physical roll of the screen
RSB ;Done
OPLDR1: MOVL (SP)+,R0 ;Display from here down and loop
JMP DISDWN
.SUBTITLE Close-Lines Command
;Here to remove lines from the buffer (null them over, really)
CLOSLN::BBC #V_RDO,F,10$ ;Is the file read-only?
JMP RDOERR ;Yes - command is illegal
10$: MOVL ADDLNS,R4 ;Set up last time's nominal
BBC #V_ENT,F,CLLNPM ;Is there a parameter typed?
MOVL R4,PARG1
JSB PEEL.1 ;Read new parm, if any
MOVL PARG1,R4 ;Get spaces to add
MOVL R4,ADDLNS ;Save as new nominal
BBC #V_CMV,F,30$ ;Cursor movement?
ADDL3 PARG2,SAVPOS+4,R1 ;Yes - get spaces to close, too
ADDL SL,R1
TSTL R4 ;Closing zero lines?
BNEQ 20$
MOVL PARG2,R1 ;Yes - count only spaces passed over
20$: MOVL R1,ADDLSP ;Save number of spaces to close
BRB 40$
30$: CLRL ADDLSP ;If no cursor move, clear extra spaces
40$: JSB ERASPM ;Erase parameter
BBC #V_XCI,F1,CLLNPM ;Initializing for an execute?
JMP LOOP ;Yes - done now
CLLNPM::MOVQ ADDLNS,ADDLNX ;Move nominals to fraggable area
DECL ISVCNT ;Decrement incremental save counter
BBC #V_PCM,F,10$ ;Has a mark been made?
BRW CLSMRK ;Yes - do things differently
10$: TSTL R4 ;If closing some lines, continue
BGTR 20$
TSTL ADDLSX ;If zero lines, got zero spaces too?
BNEQ 20$
BRW CLSLNE ;Yes - nothing to do
20$: MOVL R4,ROLLS ;Save number of lines for rolling at end
BISL #M_INS!M_XPB!M_CHG,F ;Let line be extended; BOTPTR bad; file mod'd
BSBW MAKCPT ;Re-make cursor position
BICL #M_INS,F
CMPB R3,#9 ;Is character at cursor a tab?
BNEQ 30$
JSB RPLTAB ;Yes - replace with spaces before cursor
30$: MOVL CHRPTR,R6 ;Get current cursor position
BSBW CLSGPT ;Set up the pointer into the delete buffer
MOVL ADDLNX,R4 ;Get number of lines to close
BNEQ CLSLN1 ;Any lines?
BRB CLSLN3 ;No - just go close spaces
CLSLN1: CMPL EN,R6 ;At end of useable buffer?
BNEQ 10$
BRW CLOSEN ;Yes - do end of buffer-y things
10$: MOVZBL (R6)+,R1 ;Get a character
BEQL CLSLN1 ;If null, get another one
CLRB -1(R6) ;Replace it with a null
CLSLN2: CMPL R3,#CLSBUF+PCBSIZ
BNEQ 10$
PUSHR #^M<R1> ;Save the character while we overflow to disk
BSBW CLSOVF ;If about to overflow, store on disk
POPR #^M<R1> ;Restore the character
10$: MOVB R1,(R3)+ ;Save character in the close buffer
INCL CLSCNT ;Bump count
CMPB R1,#^O15 ;Carriage return?
BNEQ CLSLN1 ;No - drive on
MOVZBL (R6)+,R1 ;Yes - pick up the <LF>
CLRB -1(R6) ;Replace it with a null
CMPB R1,#^O12 ;Is it really a linefeed?
BNEQ CLSLN2 ;No - it's not the end of the line
SOBGTR R4,CLSLN2 ;Yes - loop thru desired number of rows
CMPL R3,#CLSBUF+PCBSIZ
BNEQ 20$
PUSHR #^M<R1> ;Save the character
BSBW CLSOVF ;If about to overflow, store on disk
POPR #^M<R1> ;Restore it
20$: MOVB R1,(R3)+ ;Save the linefeed in the close buffer
INCL CLSCNT ;Bump count for <LF>
CLSLN3: MOVL ADDLSX,R4 ;Got some spaces to close, too?
BLEQ CLSLN4
BSBW CLLSPS ;Yes - do them
CLSLN4: BBC #V_RST,F,5$ ;Want to restore the nominal parameters?
BSBW CLLRST ;Yes - do them
5$: MOVL R3,CLAFLG ;Save the ending pointer
CLRB (R3)+ ;End buffer with a null
INCL CLSCNT ;Bump count for <LF>
BBC #V_COV,F,10$ ;Has buffer overflowed?
BSBW CLSLST ;Yes - write out the last piece
10$: JSB CCREOL ;Make sure the file ends with a CRLF
SOBGTR SQZCNT,20$ ;Time to do a squeeze?
BSBW SQUEZW ;Yes - remove all null words
20$: BBCC #V_PCM,F,30$ ;Was there a mark?
JMP DISALL ;Yes - re-display the screen and loop
30$: TSTL ADDLNX ;Really close any lines?
BNEQ 40$
BRW CLSLNL ;No - just spaces - re-do one line
40$: MOVL DLN(R10),R3 ;Can terminal do its own close?
BNEQ 50$
BRW CLSLNR ;No - display all from here on down
50$: SUBL3 R7,LPP(R10),R4 ;Yes - get number of lines per page less current
SUBL ADDLNX,R4 ; position less size of delete, gives lines left
BGTR 60$ ;If none (big delete),
JMP DISDWN ; just re-display
60$: BITL #M_FNC!M_FBL,F ;Got fence or fragged bottom line?
BEQL 70$
JSB CBOTOM ;Yes - erase it
70$: MOVL R7,R4 ;Move to start of line the cursor is on
JSB POSLIN
MOVL ADDLNX,R2 ;Get size of delete
BITL #M_FBL!M_FNC,F ;Is bottom line O.K.?
BEQL 80$ ;Yes
INCL ROLLS ;No - rewrite one more line
80$: MOVL R3,R1 ;Get code to close lines
JSB PUTSEQ ;Close a line
SOBGTR R2,80$ ;Loop thru all lines
TSTL ADDLSX
BNEQ 90$
TSTL R8 ;Jump if at start of a line
BEQL 100$
90$: MOVL LINPTR,R6
JSB DISONE ;Else display single closed-up line
100$: SUBL3 ADDLNX,LPP(R10),R4 ;Get line number of start of rewrite
BBC #V_FBL,F,110$ ;Is bottom line O.K.?
DECL R4 ;No - re-do it, too
110$: MOVL R4,SAVEAC ;Set it up in R4 and SAVEAC
BSBW ROLFW1 ;and rewrite from there down
JMP LOOP
CLSLNL: JSB DISLIN ;Display rest of line cursor is on
JMP DISCUR ;Restore cursor and loop
CLSLNR: TSTL R7 ;If not home, just do display
BNEQ 10$
TSTL R8
BEQL 20$
10$: JMP DISDWN
20$: TSTL ADDLSX ;Deleted any spaces?
BNEQ 10$ ;Yes - display anyway
TSTL RUP(R10) ;No roll-up sequence?
BEQL 10$ ;No - display anyway
MOVL ADDLNX,R4 ;Get number of lines deleted
CMPL R4,LPP(R10) ;Longer than a screen size?
BEQL 10$ ;Yes - display anyway
BSBW ROLFW0 ;and display by doing a roll (at last)
JMP LOOP ;Done
;Here if end of buffer reached during the close
CLOSEN: MOVL R3,CLAFLG ;Save pointer to end of close buffer
BBC #V_RST,F,5$ ;Want to restore the nominal parameters?
BSBW CLLRST ;Yes - do so
5$: ADDL3 #1,CHRPTR,R6 ;Get pointer to first deleted character + 1
MOVL R6,EN ;Save as new end of buffer
TSTL SL ;Did close start at start of a line?
BNEQ 10$
TSTL R8
BEQL 20$
10$: BSBW ADDCR ;No - put a <CRLF> after that partial line
20$: BBC #V_COV,F,30$ ;Has buffer overflowed?
BSBB CLSLST ;Yes - write out the last piece
30$: JSB POSCUR ;Put cursor where it belongs
TSTL CPG(R10) ;Can terminal clear to end of screen?
BNEQ 40$
JMP DISALL ;No - re-display the entire screen
40$: JSB FIXBLC ;Yes - clear and put up the fence
JMP DISCUR ;Re-position the cursor and get a new command
;Subroutine to write out the last piece of the close buffer
CLSLST: CLRB (R3)+ ;Done - end pick buffer with a null
SUBL3 #CLSBUF,R3,R1 ;Compute length of final portion
$RAB_STORE RAB=CLS_RAB,RSZ=R1 ;Store it in the RAB
BSBW CLSOV1 ; and write out the last part
RSB ;Then return
;Here to restore insert-delete lines nominals (maybe), re-set cursor, and loop
CLSLNE: BBC #V_RST,F,10$ ;Want to restore the nominal parameters?
BSBB CLLRST ;Yes - do so
10$: JMP DISCUR ;Re-position and loop
CLLRST: MOVL #1,ADDLNS ;Set back to one line
CLRL ADDLSP ; and no spaces
RSB ;Done
;Subroutine for when user wants to close some spaces after closing lines
;(which he's indicated by using cursor movement)
CLLSPS: BISL #M_FLG,F ;Set to null the characters as they are found
MOVL CLSCNT,R2 ;Get number of spaces closed
BSBW SPCBFZ ;Null out (R4)s worth of characters
BICL #M_FLG,F ;Clear nulling flag
ADDL SPCCNT,CLSCNT ;Add count of characters to total count
RSB
;Here if mark was made - close from starting character to current position
;Note: does nothing about starting or ending in a tab
CLSMRK: BSBW MAKCPT ;Re-make cursor position
BISL #M_CHG,F ;Say file is changed
BSBB MRKSET ;Set up to use mark
CLRL ADDLNX ;Clear lines to add (re-compute below)
BSBW CLSGPT ;Set up the pointer into the delete buffer
CLRL R2 ;Clear character count
CLRL R4
CLSMK1: CMPL R6,MRKPTR ;At end of the close?
BEQL CLSMKE ;Yes - finish off
CMPL R3,#CLSBUF+PCBSIZ
BNEQ 10$
BSBW CLSOVF ;Write to disk on close buffer overflow
10$: MOVZBL (R6)+,R1 ;Get a character
BEQL CLSMK1 ;Skip if null
MOVB R1,(R3)+ ;Save it in the close buffer
CLRB -1(R6) ;Null out the character in the file
CMPB R1,#9 ;Tab?
BNEQ 20$ ;No
BISL #7,R4 ;Yes - count its length in spaces
20$: CMPB R1,#^O15 ;End of a line?
BEQL 40$ ;Maybe
30$: INCL R2 ;No - count character and loop
INCL R4
BRB CLSMK1
40$: CMPB #^O12,(R6) ;Got a LF after the CR?
BNEQ 30$ ;No - count CR as just another character
CVTBL #-1,R4 ;Yes - clear number of spaces (after LF found)
INCL ADDLNX ;Bump number of lines
INCL R2 ;Count character
BRB CLSMK1 ;and loop
CLSMKE: MOVL R2,CLSCNT ;Save count of characters closed
MOVL R4,ADDLSX ; and spaces to add
MOVL ADDLNX,ROLLS ;Save number of lines for rolling at end
BRW CLSLN4 ;Finish off
MRKSET::MOVL MRKPTR,R4 ;Get the starting display pointer
CMPL R4,DISPTR ;Has display pointer changed during marking?
BNEQ 10$ ;Yes
BICL #M_PCM,F ;No - clear mark flag (to help displaying)
10$: MOVL CHRPTR,R2 ;Get pointer to ending position
MOVL R2,MRKPTR ;Save it as pointer to end of region
MOVL MRCPTR,R6 ;Get pointer to starting position
CMPL R2,R6 ;Going forwards?
BLSS MRKST1 ;No - finish off differently
JSB PUSMKS ;Yes - stack the ending display pointer
MOVL R4,DISPTR ;Move back to the starting display pointer
MOVQ SVPMRK,R7 ; and the starting row and column
MOVQ MRLPTR,LINPTR ;Set up starting line and cursor pointers
RSB ;Done
MRKST1: MOVL R4,R0 ;Backward - stack the ending display pointer
MOVL DISPTR,R4
MOVL R0,DISPTR
JSB PUSMKS
MOVL R4,DISPTR ;Put back the starting display pointer
MOVL R6,R0 ;Swap start and end pointers
MOVL MRKPTR,R6
MOVL R0,MRKPTR
RSB ;Done
;Subroutine to set up R3/ptr to close buffer. Clears the character
;count iff the previous command was not a delete-lines.
;Else appends to the previously-deleted stuff.
;Also, if buffer has overflowed, re-opens disk file for appending
;Saves R1; uses R2, R3
CLSGPT: MOVL CLAFLG,R3 ;Get close-append pointer
BNEQ 10$ ;Any? Yes
MOVAB CLSBUF,R3 ;No - point to start of buffer,
BRB CLSGPS ; clear count and return
10$: CMPL #CLSBUF,R3 ;Point to start of buffer?
BEQL CLSGPS ;Yes
BBS #V_COV,F,20$ ;Has delete buffer overflowed?
RSB ;No - done
20$: SUBL3 #CLSBUF,CLAFLG,R1 ;Calculate number of bytes in last blocks
BITL #^X1FF,R1 ;Already at a block boundary?
BEQL 40$ ;Yes
30$: BISL #^X1FF,R1 ;Round to an integral number of blocks
INCL R1
40$: $RAB_STORE RAB=CLS_RAB,USZ=R1,RBF=#0,RSZ=#0,-
UBF=CLSBUF,BKT=CLSOPN
$READ RAB=CLS_RAB ;Read the last blocks
BLBS R0,50$ ;Skip if no errors
HALT
50$: SUBL #<PCBSIZ/512>,CLSOPN ;Set block number for next write
RSB
CLSGPS: BICL #M_COV,F ;Say delete buffer hasn't overflowed (so far)
CLRL CLSCNT ;Clear count of characters deleted
RSB ;Done
.SUBTITLE Move data into special buffer
;Subroutine to find (R4) real characters (not nulls) at (R6), which is fragged
;and put them in the area pointed to by R3
;If FLG is set, nulls the character in the file buffer; else leaves it alone
;Stops when counted out. If end of line reached, pads with spaces
;Returns count of characters moved in SPCCNT
;Note: Pick or close buffer CAN'T overflow while in this routine, as long as
;buffer size is larger than one screenful (80*20 = 1600 bytes)
;That's because this is reached from a cursor move command, and cursor move
;can't encompass more than a screenful.
;Well, almost: Real long lines CAN overflow, so beware of, say, object files
SPCBFZ: CLRL SAVEAC ;Clear starting column number
TSTL R2 ;Picked nothing so far?
BNEQ SPCBF0
SPCBUF::MOVL R8,SAVEAC ;Right - save column position instead
SPCBF0: MOVL R4,WRTNUM ;Save number of chars to null
CLRL SPCCNT ;Clear count of characters moved
CLRL NUMCHR ;Clear # spaces to add
SPCBF1: CMPL R6,EN ;At end of buffer?
BEQL SPCBF4 ;Yes - put in some spaces and finish up
MOVZBL (R6)+,R2 ;No - get a character
BEQL SPCBF1 ;Ignore if null
CMPL R2,#^O15 ;Is it a <CR>?
BNEQ 20$ ;No
CMPB (R6),#^O12 ;Yes - is it followed by a LF?
BEQL SPCBF4 ;Yes - finish off and return
20$: INCL SPCCNT ;Bump count of characters
BBC #V_FLG,F,30$ ;Else want to null it out?
CLRB -1(R6) ;Yes - zap
30$: CMPL R2,#9 ;Is it a tab?
BEQL SPCBTB ;Yes - see how long the tab is
MOVB R2,(R3)+ ;No - save character in the desired buffer
SOBGTR R4,SPCBF1 ;Count it and loop if not enough
SPCBEN: TSTL NUMCHR ;Got any spaces to add?
BEQL 10$
BBSC #V_FLG,F,20$ ;Really want to add them?
10$: RSB ;No - just return
20$: BRW MAKSPC ;Yes - add them and return
SPCBF4: ADDL R4,SPCCNT ;Count the extra spaces
20$: MOVB #^A" ",(R3)+ ;Pad with spaces until counted out
SOBGTR R4,20$
RSB ;Done for keeps
SPCBTB: ADDL3 WRTNUM,SAVEAC,R0 ;Get length of delete plus starting cursor pos
SUBL R4,R0 ; less number to go, gives present position
BICL #^C7,R0 ;Find negative size of tab
SUBL #8,R0
ADDL R0,R4 ;Count off that many spaces from delete
BLEQ 10$
MOVB R2,(R3)+ ;If still more to go, save tab
BRB SPCBF1 ; and continue
10$: DECL SPCCNT ;Remove tab from count of characters
MNEGL R4,R1 ;Get count of spaces to add to file
ADDL R1,NUMCHR
SUBL R0,R4 ;Get count of spaces to add to buffer
20$: MOVB #^A" ",(R3)+ ;Save off those spaces
INCL SPCCNT ;Bump count of characters
SOBGTR R4,20$
BRB SPCBEN ;and finish off
;Subroutine for overflow of close buffer - save on disk; set COV flag
CLSOVF: CLRB (R3)+ ;Save a null at end of close buffer
BBSS #V_COV,F,CLSOV1 ;Is close file already open?
TSTL CLSOPN ;No - have we used it before?
BNEQ 20$ ;Yes
$CREATE FAB=CLS_FAB ;Create the temporary file
BLBS R0,10$ ;Any errors?
MOVL CLS_FAB+FAB$L_STV,R1 ;Yes - get the auxiliary error number
BRB CLSOVE ; and go display the error
10$: $CONNECT RAB=CLS_RAB
BLBS R0,20$ ;Able to connect?
MOVL CLS_RAB+RAB$L_STV,R1 ;Get the auxiliary error number
BRB CLSOVE ;Go report the error
20$: $RAB_STORE RAB=CLS_RAB,UBF=#0,USZ=#0,RBF=CLSBUF,RSZ=#PCBSIZ
MOVL #<-<PCBSIZ/512>+1>,CLSOPN ;Set the open flag and prev block no
CLSOV1: ADDL #<PCBSIZ/512>,CLSOPN ;Increment the block number
$RAB_STORE RAB=CLS_RAB,BKT=CLSOPN ;Set up the RAB parameters
$WRITE RAB=CLS_RAB ;Output the block
BLBS R0,10$ ;Any errors?
MOVL CLS_RAB+RAB$L_STV,R1 ;Get the auxiliary error number
BRB CLSOVE ; and go output the errors
10$: MOVAB CLSBUF,R3 ;Start the buffer afresh
RSB ;No - return
CLSOVE: MOVAB CLOVER,R2 ;Point to the right error message
BSBW BUFOVE ;Output all the messages
BICL #M_COV!M_PCM,F ;Don't let him get anything from a corrupt buffer
CLRL CLSCNT
JMP DISALL ;Redisplay the screen and return
CLOVER: .ASCIZ /Error overflowing close buffer to disk/
.SUBTITLE Add spaces to the buffer
;******************************************************************
;Here to add spaces to the buffer
OPENSP::MOVL ADDSPC,PARG1 ;Set up last time's nominal as default
BSBW PEEL.1 ;Read new parm, if any
MOVL PARG1,R4 ;Get spaces to add
BBC #V_CMV,F,10$ ;Doing cursor movement?
BSBW SPSCUR ;Yes - handle things a little differently
10$: MOVL R4,ADDSPC ;Save new nominal
JSB ERASPM ;Erase parameter
BBC #V_XCI,F1,OPSNPM ;Initializing for an execute?
JMP LOOP ;Yes - done now
OPSNPM::BBC #V_RDO,F,10$ ;Is file read-only?
JMP RDOERR ;Yes - command is illegal
10$: DECL ISVCNT ;Decrement incremental save counter
MOVL ADDSPC,R1 ;Set up last time's nominal
BGTR 20$
BRW OPNSPE ;Done, if nothing to add
20$: BISL #M_XPB!M_CHG!M_INS,F ;Say bottom pointer bad; file modified
BRB OPSNP2
OPSNP1: BISL #M_INS,F ;Let line be extended, if necessary
OPSNP2: BSBW MAKCPT ;Re-make cursor position
BICL #M_INS!M_PCM,F
MOVL R1,NUMCHR ;Add the right number of spaces
CMPL R3,#9 ;Is character at cursor a tab?
BNEQ OPNSP1 ;No - continue
ADDL TABSIZ,NUMCHR ;Convert the tab to spaces
CLRB @TABPTR ;and null out the tab
TSTL TABSPC ;Pointing to start of tab?
BNEQ OPNSP1
BISL #M_XPC,F ;No - character pointer is bad
OPNSP1: BSBW MAKSPC ;Go add the spaces
MOVL ADDSPC,R4 ;Get number of spaces to add
MOVL ISP(R10),R3 ;Can terminal open spaces on its own?
BEQL 10$ ;No
BSBW OPNSPI ;Yes - let it
BLBC R0,20$
10$: JSB DISLIN ;No - rewrite the line cursor is on
20$: SOBGEQ ADDSLN,30$ ;Want to work with other lines?
JMP OPNSPE ;No - just get another command
30$: BISL #M_XPC!M_XPL,F ;Yes - re-make some pointers
MOVL ADDSPC,R1 ;Get size of insert
INCL R7 ; and do the same with the next line
BRW OPSNP1
OPNSPE: BBC #V_RST,F,10$ ;Want to restore the nominal parameter?
MOVL #1,ADDSPC ;Yes - set it back to 1
10$: JMP DISCUR ;Re-position the cursor and loop
.SUBTITLE Insert and Delete Spaces on Screen
;Subroutines to use the terminal hardware to insert or delete spaces
;Enter with R4/ number of times to output (R3)
;Return with R0/1: Line has tabs, must be re-displayed
; or it's smarter to rewrite line
;Return with R0/0: Line has been handled; no further action necessary
CLSSPI: CMPL R4,#7 ;If more than 7 spaces, it's usually faster to
BLEQ 10$ ; just rewrite the line
MOVL #1,R0
RSB
10$: MOVL CHRPTR,R2 ;See if there are any tabs from here to EOL
SUBL3 ADDSPC,CPL(R10),R0 ;Get length of remainder of line
SUBL R8,R0
CLSSI1: MOVZBL (R2)+,R1
BEQL CLSSI1 ;Ignore if null
CMPB R1,#9 ;Tab?
BNEQ 20$ ;No
10$: MOVL #1,R0 ;Yes - go re-display entire line
RSB
20$: CMPB R1,#^O15 ;End of line?
BEQL 30$ ;Yes
SOBGTR R0,CLSSI1 ;No - keep looking
30$: TSTL R0 ;No tab - if line is long, go redisplay
BLEQ 10$
JSB POSCUR ;Point to the right position
40$: MOVL R3,R1 ;Get code to do the close
JSB PUTSEQ ;Close one space
SOBGTR R4,40$ ;Loop through all spaces
CLRL R0 ;Set up for skip return
JMP PUTTYP ;Output the buffer and skip return
OPNSPI::MOVL #1,R0 ;Set for normal return
CMPL R4,#7 ;If more than 7 spaces, it's usually faster to
BLEQ 10$ ; just rewrite the line
RSB
10$: MOVL CHRPTR,R2 ;See if there are any tabs from here to EOL
OPNSI1: MOVZBL (R2)+,R1
CMPB R1,#9 ;Tab?
BNEQ 10$ ;No
RSB ;Yes - go re-display entire line
10$: CMPB R1,#^O15 ;End of line?
BNEQ OPNSI1 ;No - keep looking
JSB POSCUR ;Point to the right position
20$: MOVL R3,R1 ;Get code to do the open
JSB PUTSEQ ;Open one space
SOBGTR R4,20$ ;Loop through all spaces
CLRL R0 ;Set up for skip return
JMP PUTTYP ;Output the buffer and skip return
.SUBTITLE Delete Previous Character
;Here to delete the previous character from the buffer
DELCHR::BBC #V_RDO,F,10$ ;Is file read-only?
JMP RDOERR ;Yes - command is illegal
10$: TSTL R8 ;Do nothing if at start of line
BNEQ 20$
15$: JMP LOOP
20$: DECL ISVCNT ;Decrement incremental save counter
BSBW MAKCPT ;Re-make the cursor pointer
MOVL R8,SAVEAC ;Save the current column position
CMPB #^O15,R3 ;Is the cursor at or beyond end of the line?
BNEQ 30$ ;No
BSBW ERSWDL ;Yes - first position to end of line
CMPL R8,SAVEAC ;Was the cursor beyond the end of the line?
BNEQ 15$ ;Yes - it moved to the end; done
30$: BISL #M_CHG,F ;Say file has been modified
BICL #M_PCM,F ;Cancel the pick-close mark, if any
MOVL CHRPTR,R6 ;Get character pointer
MOVL R6,SAVEAC ;Store it in a safe place
DELCH2: MOVZBL -(R6),R1 ;Get the previous character
BEQL DELCH2 ;Skip over it if null
MOVL #1,DELCNT ;Set size of delete buffer to 1, too
MOVB R1,DELBUF ;Save it in the delete buffer
MOVL R1,R2 ;Keep the character in R2
CMPL R3,#9 ;Is the character under the cursor a tab?
BEQL DELCHT ;Yes - handle specially
CLRB (R6) ;Null out the live character
CMPB #9,R1 ;Was it a tab?
BEQL 10$ ;Yes
DECL R8 ;No - correct the display and loop
BRW CLSNP3
10$: JSB CALCML ;Position to the character before the tab
BRW CLSLNL ;Re-display the rest of the line; loop
;Here when the character under the cursor is a tab. Find the position
;of the previous character. If the cursor is next to it, delete it;
;if thfe cursor is within the tab, delete the tab
;R6/ pointer to one past previous character; SAVEAC/ pointer to one past the tab
DELCHT: MOVL R8,SAVEAC+4 ;Save cursor position
JSB CALCML ;Position to the character before the tab
CMPL R8,SAVEAC+4 ;Is the cursor next to the character?
BEQL DELCT1 ;Yes - delete the character
CLRB @SAVEAC ;No - delete the tab
MOVZBL #9,DELBUF ;Note that the deleted character was the tab
BRW CLSLNL ;Re-display the rest of the line and loop
DELCT1: CLRB -(R6) ;Delete the character
DECL R8
BRW CLSNP3 ;Finish up the display and loop
.SUBTITLE Remove Characters from the Buffer
;Here to remove characters from the buffer
CLOSSP::BBC #V_RDO,F,10$ ;Is file read-only?
JMP RDOERR ;Yes - command is illegal
10$: BBS #V_ENT,F,20$ ;Is there a parameter typed?
BRB CLSNPM ;No - use the one already set up
20$: MOVL ADDSPC,PARG1 ;Set up last time's nominal
CLSSP1: BSBW PEEL.1 ;Read new parm, if any
MOVL PARG1,R4 ;Get spaces to delete
BBC #V_CMV,F,10$ ;Doing cursor movement?
BSBW SPSCUR ;Yes - handle things a little differently
10$: MOVL R4,ADDSPC ;Save new nominal
JSB ERASPM ;Erase parameter
BICL #M_CMV,F ;Clear cursor move flag (if coming from ERASWD)
BBC #V_XCI,F1,CLSNPM ;Initializing for an execute?
JMP LOOP ;Yes - done now
CLSNPM::MOVL ADDSPC,R1 ;Got anything to delete?
BGTR CLSNP0
BRW CLOSP1 ;No - done
CLSNP0: DECL ISVCNT ;Yes - decrement incremental save counter
BICL #M_PCM,F ;Cancel the pick-close mark, if any
MOVL R1,ADDSPS ;Set up the value
BISL #M_CHG,F ;Say file is modified
CLSNP1: BSBW MAKCPT ;Re-make character pointer
CLRL NUMCHR ;Assume a tab won't be broken
CMPB R3,#9 ;Is character at cursor a tab?
BNEQ CLSNP2 ;No - continue
MOVL TABSPC,NUMCHR ;Yes - add spaces left of tab, after close
CLSNP2: MOVL CHRPTR,R6
MOVL ADDSPS,R4 ;Get number of spaces to close
BSBW WRTNUL ;Null out that many characters
MOVL R4,WRTNUM ;Save size of leftover, if it's short
TSTL NUMCHR ;Want to add spaces for a broken tab?
BEQL 10$ ;No
BSBW MAKSPC ;Yes - do it
10$: SUBL3 WRTNUM,ADDSPS,R4 ;Get number of spaces to close
TSTL WRTNUM ;Delete past the end of the line?
BNEQ CLSN2A ;Yes - just clear to end of line if possible
CLSNP3: MOVL DSP(R10),R3 ;Can terminal close spaces on its own?
BEQL 20$ ;No
BSBW CLSSPI ;Yes - let it (skip returns)
BLBC R0,CLSNP4
20$: BSBB CLOSP0 ;No - rewrite the line cursor is on
CLSNP4: DECL ADDSLN ;Want to do it with another line?
BLSS CLOSP1 ;No - just get another command
BISL #M_XPC!M_XPL,F ;Yes - re-make some pointers
INCL R7 ; and do the same on the next line
BRB CLSNP1
CLSN2A: TSTL CLN(R10) ;Can terminal clear to end of line?
BEQL CLSNP3 ;No - do it some other way
JSB POSCUR ;Yes - re-position the cursor
MOVL CLN(R10),R1 ;Clear to end of line
JSB PUTSEQ
BRB CLSNP4 ;and finish off
CLOSP0: TSTL NUMCHR ;Started with a tab?
BEQL 10$ ;No
BSBW MAKCK1 ;Yes - make sure the cursor pointer is right
10$: JMP DISLIN ;Re-write rest of line the cursor is on; return
CLOSP1: SOBGTR SQZCNT,10$ ;Time to do a squeeze? No
BSBW SQUEZW ;Yes - remove all null words
10$: BRW OPNSPE ;Finish up and get another command
;Here for cursor move OPENSP or CLOSSP - count lines and spaces
SPSCUR: MOVL R4,ADDSLN ;Save lines to work with
MOVL PARG2,R4 ;Get number of spaces
BNEQ 10$ ;Any?
MOVL ADDSPC,R4 ;No - use current nominal
10$: RSB
.SUBTITLE Pick Command
;Here to take lines from the buffer and put them in the pick buffer
PICK:: MOVL PICKLN,PARG1 ;Set up last time's nominal
BSBW PEEL.1 ;Read new parm, if any
MOVL PARG1,R4 ;Get lines to pick
TSTL R1 ;If got a token, read zero lines
BNEQ 10$
CLRL PICKLN
MOVL R4,PICKSP ; and given number of spaces
BRB PICK0 ;Continue
10$: MOVL R4,PICKLN ;Save as new nominal
BBC #V_CMV,F,20$ ;Cursor movement?
MOVL PARG2,PICKSP ;Yes - get spaces to pick, too
TSTL R4 ;If no lines, count spaces from cursor
BEQL PICK0
ADDL3 PICKSP,SAVPOS+4,R1 ;If some lines, count from left margin
ADDL3 R1,SL,PICKSP
BRB PICK0
20$: CLRL PICKSP ;If no cursor move, clear extra spaces
PICK0: JSB ERASPM ;Erase parameter
BBC #V_XCI,F1,PIKNPM ;Initializing for an execute?
JMP LOOP ;Yes - done now
PIKNPM::BSBW MAKCPT ;Re-make cursor pointer
BBC #V_PCM,F,10$ ;Has a mark been made?
BRW PIKMRK ;Yes - do things differently
10$: MOVL R3,R1 ;Save character at cursor
MOVL CHRPTR,R6 ;Get current cursor position
BSBW PIKGPT ;Set up the pointer to the pick buffer
CLRL R2 ;Clear count (in case there aren't any lines)
MOVL PICKLN,R4 ;Get number of lines to pick
BLEQ PICK3 ;Any? No - see if want to pick spaces
CMPB R1,#9 ;Got a tab at the cursor?
BNEQ 60$ ;No - skip this
MOVL R6,R2 ;Get cursor ptr again for scratch
40$: MOVZBL (R2)+,R1 ;Get character cursor points to
CMPB R1,#9 ;Found the tab?
BNEQ 40$ ;No - keep looking
TSTL TABSPC ;Yes - at beginning of tab?
BLEQ 60$ ;Yes - don't touch the tab, then
MOVL R2,R6 ;Within - point after tab
SUBL3 TABSPC,TABSIZ,R2 ;Get tab's size to right of cursor
MOVL R2,-(SP) ;Save count for a while
50$: MOVB #^A" ",(R3)+ ;Put some spaces in the pick buffer
SOBGTR R2,50$
MOVL (SP)+,R2 ;Restore count of spaces put in
BRB PICK1
60$: CLRL R2 ;Clear count of characters picked
PICK1: CMPL EN,R6 ;At end of usable buffer?
BNEQ 10$
BRW PIKPAD ;Yes - pad in the remaining <CRLF>s
10$: CMPL R3,#PIKBUF+PCBSIZ
BNEQ 20$
BSBW PIKOVF ;Write to disk on pick buffer overflow
20$: MOVZBL (R6)+,R1 ;Get a character
BEQL PICK1 ;Skip if null
MOVB R1,(R3)+ ;Save it in the pick buffer
CMPB R1,#^O15 ;Carriage return?
BEQL 30$
INCL R2 ;No - ignore it
BRB PICK1
30$: CMPL R3,#PIKBUF+PCBSIZ
BNEQ 40$
BSBW PIKOVF ;Write to disk on pick buffer overflow
40$: MOVZBL (R6)+,R1 ;Yes - pick up the <LF>
MOVB R1,(R3)+ ;Save it in the pick buffer
ADDL #2,R2 ;Count it
CMPB R1,#^O12 ;Is it really?
BNEQ PICK1 ;No - it's not the end of the line
SOBGTR R4,PICK1 ;Yes - loop through desired number of lines
PICK3: ADDL R2,PIKCNT ;Save count of characters picked
MOVL PICKSP,R4 ;Done with lines - got any spaces?
BLEQ PICK4
BSBW PIKSPS ;Yes - pick them too
PICK4: TSTL APPFLG ;Appending?
BEQL 5$ ;No
MOVL R3,APPFLG ;Yes - save the latest pointer
5$: CLRB (R3)+ ;Done - end pick buffer with a null
CMPL R3,#PIKBUF+PCBSIZ-1280
BLSS 10$
CVTBL #-1,INDFLG ;If pick is large say tail of buffer fragged
10$: BBC #V_POV,F,PICK5 ;Has buffer overflowed?
CVTBL #-1,INDFLG ;Yes - tail of buffer is fragged
SUBL3 #PIKBUF,R3,R1 ;Compute length of final portion
$RAB_STORE RAB=PIK_RAB,RSZ=R1 ;Store it in the RAB
BSBW PIKOV1 ;Yes - write out the last part
PICK5: BBC #V_RST,F,PICK6 ;Want to restore the nominal parameters?
MOVL #1,PICKLN ;Yes - set back to one line
CLRL PICKSP ; and no spaces
PICK6: BBCC #V_PCM,F,10$ ;Was there a mark?
JSB DISPLL ;Yes - re-display the screen
10$: JSB POSCUR ;Re-position the cursor
JMP LOOP ;and loop
;Subroutine to set up R3/pick pointer. Clears the character count iff
;the pointer points to the start of the buffer and POV is not set
;also, if buffer has overflowed, re-opens disk file for appending
;Saves R1; uses R2
PIKGPT: MOVL APPFLG,R3 ;Get append pointer
BNEQ 10$ ;Any? Yes
MOVAB PIKBUF,R3 ;No - point to start of buffer,
BRB PIKGPS ; clear count and return
10$: CMPL #PIKBUF,R3 ;Point to start of buffer?
BEQL PIKGPS ;Yes
BBS #V_POV,F,20$ ;Has pick buffer overflowed?
RSB ;No - done
20$: SUBL3 #PIKBUF,APPFLG,R1 ;Calculate number of bytes in last blocks
BITL #^X177,R1 ;Already at a block boundary?
BEQL 40$ ;Yes
30$: BISL #^X177,R1 ;Round to an integral number of blocks
INCL R1
40$: $RAB_STORE RAB=PIK_RAB,USZ=R1,RBF=#0,RSZ=#0,-
UBF=PIKBUF,BKT=PIKOPN
$READ RAB=PIK_RAB ;Read the last blocks
BLBS R0,50$ ;Skip if no errors
HALT
50$: SUBL #<PCBSIZ/512>,PIKOPN ;Set block number for next write
RSB
PIKGPS: BICL #M_POV,F ;Say pick buffer hasn't overflowed (so far)
CLRL PIKCNT ;Clear count of characters picked
RSB ;Done
;Here if pick extends beyond file, to pad out with extra <CR>s
;(ie, you always get the number of lines you ask for)
PIKPAD: CMPL R3,#PIKBUF+PCBSIZ
BNEQ 10$
BSBB PIKOVF ;Write to disk on pick buffer overflow
10$: MOVB #^O15,(R3)+ ;Save off another <CRLF>
CMPL R3,#PIKBUF+PCBSIZ
BNEQ 20$
BSBB PIKOVF ;Write to disk on pick buffer overflow
20$: MOVB #^O12,(R3)+
ADDL #2,R2 ;Count the <CRLF>
SOBGTR R4,PIKPAD ;Continue through all leftover lines
BRW PICK3 ;Then finish off
;Here to pick (R4) extra spaces after the lines
PIKSPS: BICL #M_FLG,F ;Don't null out the picked characters
BSBW SPCBFZ ;Pick (R4)s worth of characters and return
ADDL SPCCNT,PIKCNT ;Add count of characters to total count
RSB ;Done
;Here if mark was made - pick from starting character to (MRKPTR)
;Note: does nothing about starting or ending in a tab
PIKMRK: BSBW MRKSET ;Set up to use the mark
BSBW PIKGPT ;Set up the pointer to the pick buffer
CLRL R2 ;Clear count of characters
PIKMK1: CMPL R6,MRKPTR ;At end of the pick?
BEQL PIKMKE ;Yes - finish off
CMPL R3,#PIKBUF+PCBSIZ
BNEQ 10$
BSBB PIKOVF ;Write to disk on pick buffer overflow
10$: MOVZBL (R6)+,R1 ;Get a character
BEQL PIKMK1 ;Skip if null
MOVB R1,(R3)+ ;Save it in the pick buffer
INCL R2 ;Count character
BRB PIKMK1 ; and loop
PIKMKE: ADDL R2,PIKCNT ;Save count of characters picked
BBS #V_PCM,F,10$ ;Want to re-display the cursor?
BSBW MRKRES ;No - repair the screen as it is
10$: BRW PICK4 ;and loop
;Subroutine for overflow of pick buffer - save on disk; set POV flag
PIKOVF: CLRB (R3)+ ;Save a null at end of pick buffer
BBSS #V_POV,F,PIKOV1 ;Is pick file already open?
TSTL PIKOPN ;No - have we used it before?
BNEQ 20$ ;Yes
$CREATE FAB=PIK_FAB ;Create the temporary file
BLBS R0,10$ ;Any errors?
MOVL PIK_FAB+FAB$L_STV,R1 ;Yes - get the auxiliary error message
BRB PIKOVE ;Inform the user
10$: $CONNECT RAB=PIK_RAB
BLBS R0,20$ ;Able to connect?
MOVL PIK_RAB+RAB$L_STV,R1 ;Yes - get the auxiliary error message
BRB PIKOVE ;No - error
20$: $RAB_STORE RAB=PIK_RAB,UBF=#0,USZ=#0,RBF=PIKBUF,RSZ=#PCBSIZ
MOVL #<-<PCBSIZ/512>+1>,PIKOPN ;Set the open flag and prev block no
PIKOV1: ADDL #<PCBSIZ/512>,PIKOPN ;Increment the block number
$RAB_STORE RAB=PIK_RAB,BKT=PIKOPN ;Set up the RAB parameters
$WRITE RAB=PIK_RAB ;Output the block
BLBS R0,10$ ;Any errors?
MOVL PIK_RAB+RAB$L_STV,R1 ;Yes - get the auxiliary error message
BRB PIKOVE ;Yes
10$: MOVAB PIKBUF,R3 ;Start the buffer afresh
RSB ;No - return
;Come here on pick overflow error
PIKOVE: MOVAB PKOVER,R2 ;Point to the right error message
BSBB BUFOVE ;Output all the messages
BICL #M_POV,F ;Don't let him get anything from a corrupt buffer
CLRL PIKCNT
BRW PICK5 ;Go finish off
PKOVER: .ASCIZ /Error overflowing pick buffer to disk/
.SUBTITLE Report errors overflowing pick and close buffers
;Handle errors overflowing the pick and close buffers to disk
;The pointer to pick or close message is in R2, the message numbers
;are in R0 and R1
BUFOVE: MOVL R1,-(SP) ;Save the auxiliary message
MOVL R0,-(SP) ;and the system error message
MOVL R2,R1 ;Point to the error message
JSB ERRDSP ;Output it
MOVL (SP)+,R0 ;Get the error message
JSB GETMSG ;Convert it from number to text
MOVZWL ERROR_MESS_LENGTH,R1
CLRB L^ERROR_MESSAGE(R1) ;Make the system text into .ASCIZ
MOVAB ERROR_MESSAGE,R1
JSB ERRDSP ;and output the system message
MOVL (SP)+,R0 ;Get the auxiliary error code
BNEQ 10$ ;Don't output if it's zero
RSB
10$: JSB GETMSG ;Get the text of the message
MOVZWL ERROR_MESS_LENGTH,R1 ;Make the message .ASCIZ
CLRB L^ERROR_MESSAGE(R1)
MOVAB ERROR_MESSAGE,R1
JMP ERRDSP ;and output it and return
.SUBTITLE Put Command
;Here to put the contents of the pick buffer into the buffer
;Here, specifically, to do an in-line put: put text in the middle of a line
PUT:: BBC #V_RDO,F,10$ ;Is file read-only?
JMP RDOERR ;Yes - command is illegal
10$: DECL ISVCNT ;Decrement incremental save counter
CLRL PIKJFN ;Assume not reading from disk
BISL #M_INS,F ;Let line be extended if necessary
BSBW MAKCPT ;Re-make cursor position
BICL #M_INS!M_PCM,F
CMPB R3,#9 ;Is character at cursor a tab?
BNEQ 20$
BSBW RPLTAB ;Yes - replace it with spaces
20$: MOVAB PIKBUF,R3
MOVL R3,PUTPTR ;Assume will read from put buffer
BBS #V_ENT,F,40$ ;Is there a parameter typed?
BRW PUTNPM ;No - use the pick buffer
40$: BSBW PELS.1 ;Get string to put, if any
TSTL R1 ;If enter-put typed go use the close buffer
BNEQ 50$
BRW PUTCLS
50$: BICL #M_POV,F ;If immediate, buffer can't overflow
CLRL APPFLG ; and appending must be turned off
MOVL R1,PIKCNT ;Save size of string
MOVL R1,NUMCHR ;Save as number of characters to add
JSB ERASPM ;Clean the screen up
BBC #V_XCI,F1,60$ ;Initializing for an execute?
JMP LOOP ;Yes - done now
60$: BISL #M_CHG!M_WRH,F ;Set to read from pick buffer
BSBW MAKCPT ;Re-make cursor position, if cursor mvmt used
MOVL PIKCNT,R1 ;Get count of characters picked
BNEQ 70$ ;Any?
BRW PUTERR ;No - error
70$: BSBW MAKCHR ;Yes - go put them in
;Here for an in-line put (ie, no <CRLF>s in buffer)
PUT0: BBCC #V_XPL,F,10$ ;Is line pointer O.K.?
BSBW MAKLPT ;No - re-make it
10$: MOVL NUMCHR,R4 ;Get distance to open
MOVL ISP(R10),R3 ;Can terminal open spaces on its own?
BEQL PUT0D ;No
BSBW OPNSPI ;Yes - open up the line
BLBS R0,PUT0D ;No - rewrite the line cursor is on
JSB POSCUR ;Get back to start of newly-opened spaces
MOVL PUTPTR,R1 ;Write pick or close buffer there
JSB PUTSTS
CMPL R7,LPP.1 ;Putting on bottom line?
BEQL 20$
JMP DISCUR ;No - re-display the cursor and loop
20$: BBCC #V_FNC,F,30$ ;Yes - is fence up?
JSB CLRLNA ;Yes - erase it
30$: JMP DISCUR ;Then re-display the cursor and loop
PUT0D: JSB DISLIN ;Terminal can't help - re-do rest of line
CMPL R7,LPP.1 ;Putting on bottom line?
BNEQ 10$ ;No
BICL #M_FNC,F ;Yes - if fence was up, it ain't no mo
10$: JMP DISCUR ;Re-position cursor and return
;Here to put old contents of pick buffer
PUTNPM::MOVL PIKCNT,R1 ;Get count of characters picked
BNEQ 10$ ;Any?
BRW PUTERR ;No - error
10$: MOVL R1,NUMCHR ;Save as number of characters to add
DECL ISVCNT ;Decrement incremental save counter
BISL #M_CHG!M_WRH,F ;Set to read from the pick buffer
BBC #V_POV,F,PUTNP2 ;Want to read off disk?
MOVAL PIK_RAB,PUTJFN ;Point to the right RAB
PUTNP2: CLRL MAKLNS ;Clear number of <CRLF>s in buffer
BSBW MAKCHR ;Put in buffer
MOVL MAKLNS,R4 ;Are there <CRLF>s in the pick buffer?
BNEQ 10$
BRW PUT0 ;No - just rewrite one line
10$: BISL #M_XPB,F ;Yes - bottom pointer is bad
BSBW OPENLD ;Open up, somehow **note: may not return**
JSB POSCUR ;Position to start of put
MOVL MAKLNS,R4 ;Get number of lines to display
TSTL R8
BNEQ 20$ ;Jump if not at start of a column
MOVZBL @MAKPTR,R1 ;Get last character put
CMPB R1,#^O12 ;End of line?
BEQL 30$
20$: INCL R4 ;Do one more line if start or end w/in line
30$: SUBL3 R7,LPP(R10),R1 ;Find number of lines before cursor
CMPL R1,R4 ;Is put longer than that?
BGTR 40$
MOVL R1,R4 ;Yes - display only what will fit
40$: MOVL CHRPTR,R6 ;Display from cursor position
JSB DISPLY
JSB FIXBLW ;Restore fence if needed
JMP DISCUR ;Re-position cursor and return
;Here to put the contents of the close buffer
PUTCLS: MOVAB CLSBUF,PUTPTR ;Set to read from close buffer
JSB ERASPM ;Erase parameter
BISL #M_CHG!M_WRH,F ;Want to read from the close buffer
BBC #V_COV,F,PUTCS1 ;Want to read off disk?
MOVAL CLS_RAB,PUTJFN ;Point to the close buffer RAB
PUTCS1: MOVL CLSCNT,R1 ;Get count of chars in buffer
BLEQ PUCERR ;If none, error
MOVL R1,NUMCHR ;Yes - save as number of characters to add
BRW PUTNP2 ;Go put them
PUCERR: MOVAB PUCERM,R1
BRW ERROR
PUTERR: MOVAB PUTERM,R1
BRW ERROR
PUCERM: .ASCIZ /#######Close buffer is empty/
PUTERM: .ASCIZ /########Put buffer is empty/
.SUBTITLE Real-tab command
;*********************************************************************
;Here to insert a real tab in the file - same as if user typed E-C-C I
REALTB::MOVZBL #9,R1 ;Get an I
CVTBL #-1,R9 ;Note that a command is active
JMP ALPNU1 ;Treat it like E-C-C I
.SUBTITLE Mark Command
;*********************************************************************
;Here to mark position for pick or close-lines, The next such command
;will take text from the mark to the cursor position.
MARK:: JSB MAKCPT ;Get a correct cursor pointer
MOVQ LINPTR,MRLPTR ;Save line and cursor pointer for later
MOVL DISPTR,MRKPTR ;Save current display pointer
BISL #M_PCM,F ;Set mark flag
MOVQ R7,SVPMRK ;Save starting position
BSBW MRKCUR ;Mark the cursor position
MOVL R3,SVPMRK+8 ;Save the character marked
JSB POSCUR ;Re-position and output
JMP LOOP ;That's all
;Here on enter mark, which cancels the mark
MRKARG::BBSC #V_PCM,F,10$ ;Cancel the mark - got one?
JMP TBCLRX ;No - repair screen and go home
10$: MOVQ MRLPTR,LINPTR ;Restore cursor and line pointers
MOVL DISPTR,R1 ;Restore the old display pointer
MOVL MRKPTR,DISPTR
CMPL R1,DISPTR ;Has display pointer changed?
BEQL MRKAG0 ;No - repair the screen as it is
MOVQ SVPMRK,R7 ;Restore saved row and column
BICL #M_ENT!M_XPL!M_XPC,F ;Cancel the enter; say cur, lin ptrs good
BISL #M_XPB,F ;but bottom pointer is not
JMP DISALL ;Re-display the screen and loop
MRKAG0: JSB ERASPM ;Fix up the screen
MOVQ SVPMRK,R7 ;Restore saved row and column
BSBB MRKAG1 ;De-blip the mark
JMP LOOP ;Re-position and loop
MRKAG1: MOVB SVPMRK+8,CHRCUR ;Get character marked
BRW RESTP1 ;De-blip the mark and return
MRKRES: MOVL R7,R0 ;De-blip the mark at the starting point
MOVL SVPMRK,R7
MOVL R0,SVPMRK
MOVL R8,R0
MOVL SVPMRK+4,R8
MOVL R0,SVPMRK+4
BSBB MRKAG1
MOVQ SVPMRK,R7 ;Get the real position back
RSB ;Done
.SUBTITLE Case Command Processor
;Here to change the case of stuff at the cursor. If the switch
;/RAISE is on the letter will become upper; if /NORAISE, lower
CHGCAS::BBC #V_RDO,F,10$ ;Is file read-only?
BRW RDOERR ;Yes - command is illegal
10$: MOVL CASSPS,R4 ;Get last time's nominal
BBC #V_ENT,F,CASNPM ;Is there a parameter typed?
MOVL R4,PARG1 ;Yes
BSBW PEEL.1 ;Read new parm, if any
MOVL PARG1,R4 ;Get count of characters
BBC #V_CMV,F,30$ ;Cursor movement?
MOVL R4,CASLNS ;Yes - save lines to work with
MOVL PARG2,R4 ;Get real spaces to work with
TSTL CASLNS ;Got any lines?
BEQL CASNP0 ;No - use spaces as is
ADDL SAVPOS+4,R4 ;Yes - count them from left margin
ADDL SL,R4
BRB CASNP0
30$: CLRL CASLNS ;If no cursor move, clear extra lines
CASNP0: MOVL R4,CASSPS ;Save space count as new nominal
JSB ERASPM ;Reset enter mode
JSB POSCUR ;Re-position the cursor
BBC #V_XCI,F1,CASNPM ;Initializing for an execute?
JMP LOOP ;Yes - done now
CASNPM::MOVL CASLNS,R1 ;Get lines to work with
BEQL 10$
MOVL #1000,R4 ;Set to do entire line
10$: TSTL R4 ;If got zero spaces,
BGTR 20$
JMP DISCUR ; done
20$: MOVL R1,CASLIN ;Else save lines in a fraggable place
DECL ISVCNT ;Decrement incremental save count
MOVL R4,SAVEAC ;Save space count
BSBW MAKCPT ;Get a good character pointer
MOVL SAVEAC,R4 ;Get space count back
BISL #M_CHG,F ;Say file has been changed
TSTB INVFLG ;Want to invert the case?
BNEQ 30$ ;No
BRW CASINV ;Yes - go do it
30$: TSTB UPCFLG ;Want lower case?
BNEQ CASUC0 ;No - make it upper case
;Here to change lower case to upper
MOVAL CASLC2,R6 ;Yes - set up LC return address
CASLC1: MOVZBL @CHRPTR,R1 ;Get the next character from the file
INCL CHRPTR
TSTB R1
BNEQ 10$ ;If null, check for end of buffer
BRW CASENB
10$: CMPB R1,#^A"a" ;Is it lower case?
BGEQ 30$
20$: BRW CASSKP ;No - just skip over it
30$: CMPB R1,#^A"z"
BGTR 20$
SUBB #^O40,R1 ;Yes - convert to upper
BSBW CASSAV ;Store and output the changed character
CASLC2: SOBGTR R4,CASLC1 ;Handle the next character
BICL #M_LFF,F ;Clear return-from-cursor-move flag
CASEND: BBC #V_RST,F,10$ ;Want to restore the nominal parameter?
MOVL #1,CASSPS ;Yes - set it back to one character
CLRL CASLNS ; and no lines
10$: JMP DISCUR ;Position cursor, continue
;Here to change upper case to lower
CASUC0: MOVAL CASUC2,R6 ;Get uppercase return address
CASUC1: MOVZBL @CHRPTR,R1 ;Get next character from the file
INCL CHRPTR
TSTB R1 ;If null, check for end of buffer
BEQL CASENB
CMPB R1,#^A"A" ;Is character upper case?
BGEQ 20$
10$: BRW CASSKP ;No - just skip over it
20$: CMPB R1,#^A"Z"
BGTR 10$
ADDB #^O40,R1 ;Yes - convert to lower
BSBB CASSAV ;Save and output the character
CASUC2: SOBGTR R4,CASUC1 ;Handle the next character
CASUC3: BICL #M_LFF,F ;Clear return-from-cursor-move flag
BRB CASEND ;Position cursor; done
;Here to invert the case: upper goes to lower and vice versa
CASINV: MOVAL CASIV2,R6 ;Get invert case return address
CASIV1: MOVZBL @CHRPTR,R1 ;Get the next character from the file
INCL CHRPTR
TSTB R1 ;If null check for end of buffer
BEQL CASENB
CMPB R1,#^A"A" ;Is character upper case?
BGEQ 10$ ;Yes
BRW CASSKP ;No - just skip over it
10$: CMPB R1,#^A"Z"
BGTR CASIVL ;No - check for lower case
ADDB #^O40,R1 ;Yes - convert to lower
CASIL1: BSBB CASSAV ;Save and output the character
CASIV2: SOBGTR R4,CASIV1 ;Handle the next character
CASIV3: BICL #M_LFF,F ;Clear return-from-cursor-move flag
BRW CASEND
CASIVL: CMPB R1,#^A"a" ;Is character lower case?
BGEQ 10$
BRW CASSKP
10$: CMPB R1,#^A"z"
BGTR CASSKP
SUBB #^O40,R1 ;Yes - convert to upper
BRB CASIL1 ; and continue
CASENB: CMPL EN,CHRPTR ;Found a null - at end of buffer?
BEQL CASIV3 ;Yes - quit now
INCL R4 ;No - loop
JMP (R6)
CASSAV: MOVL CHRPTR,R2
MOVB R1,-1(R2) ;Save it over the other one
TSTL R8 ;Done if off the left of the screen
BLSS CASSV1
BBS #V_XCT,F1,CASSV1 ;Done if executing
CMPL R8,CPL.1 ; or off the right side
BGEQ CASSV1 ;Yes - no echo
MOVL R1,SAVEAC ;No - save the character to echo
BBCC #V_LFF,F,10$ ;Already positioned?
JSB POSCUR ;No - position cursor
10$: MOVL SAVEAC,ECHBUF ;Get the character back
$QIOW_S CHAN=TTCHAN,- ;Echo it
FUNC=#IO$_WRITEVBLK!IO$M_NOFORMAT,-
P1=ECHBUF,-
P2=#1
CASSV1: INCL R8 ;Adjust column position and return
RSB
CASSKP: CMPB R1,#^O15 ;End of line?
BEQL CASSKC ;Maybe - check it out
TSTL R8 ;No display if off the left of the screen
BLSS CASSK2
CMPL R8,CPL.1 ;Off the right side?
BLSS 10$
INCL R8 ;Yes - no display either
JMP (R6)
10$: CMPB R1,#9 ;Tab?
BEQL CASSKT ;Yes
CASSK1: BISL #M_LFF,F ;Flag that cursor has moved
CASSK2: INCL R8
JMP (R6)
CASSKT: ADDL R8,R4 ;Got a tab - subtract its length from the count
BISL #7,R8 ;Move over to the tab boundary
SUBL R8,R4 ;Complete the subtraction
BRB CASSK1 ;Back to the flow
CASSKC: MOVL CHRPTR,R2 ;Get character after the carriage return
MOVZBL (R2)+,R1
CMPB R1,#^O12 ;Is it a linefeed?
BNEQ CASSK1 ;No - just skip over the CR
MOVL R2,CHRPTR ;Yes - don't count it as a character
MNEGL SL,R8 ;Move to the next line
INCL R7
CMPL R7,LPP(R10) ;Working on bottom line?
BLSS 10$ ;No
BSBB CASROL ;Yes - roll down a line
10$: BISL #M_XPL!M_XPC!M_LFF,F ;Line and character pointers are invalid
SOBGEQ CASLIN,20$ ;Got more lines to do? Yes
BRW CASUC3 ;No - done
20$: MOVL #1000,R4 ;Set to do one more line
TSTL CASLIN ;Is this the last line?
BNEQ 30$ ;No
MOVL CASSPS,R4 ;Yes - get spaces in last line
BEQL 50$ ;Any? No
30$: INCL R4
40$: JMP (R6)
50$: BRW CASUC3 ;No - done
CASROL: MOVL #1,R4 ;Roll up one line
MOVL R4,ROLLS
MOVL R6,-(SP)
BSBW ROLFW ;Go do the actual rolling
MOVL (SP)+,R6
RSB
.SUBTITLE Erase the previous word
ERASWD::BBC #V_RDO,F,10$ ;Is file read-only?
BRW RDOERR ;Yes - command is illegal
10$: DECL ISVCNT ;Decrement incremental save counter
BISL #M_XPC,F ;Force re-make of character pointer
BSBW MAKCPT ;Re-make it
CMPB #^O15,R3 ;Is cursor at or beyond end of the line?
BNEQ 20$ ;No
BSBW ERSWDL ;Yes - position to end of line
20$: MOVL CHRPTR,R6 ;Get character pointer
TSTL R8 ;If at left margin,
BNEQ ERAWD0
BRW ERAWDE ; move to end of line
ERAWD0: MOVQ R7,SAVPOS ;Save current position
BISL #M_CHG!M_XPC,F ;Say character pointer bad; file modified
BICL #M_PCM!M_FLG,F ;Cancel the pick-close mark, if any
ERAWD1: BSBW ERAGET ;Get next-most-recent character
CMPB #^O12,R1 ;Linefeed?
BNEQ 5$ ;No
BSBW ERAGET ;Yes - get (maybe) the carriage return
CMPB #^O15,R1 ;Is it?
BNEQ 3$ ;Yes - end of the erase
BRW ERAWDB
3$: DECL R8 ;No - treat like a normal char
BRB ERAW2A
5$: CMPB R1,#^A" " ;Space?
BEQL 15$ ;Yes - move over it
CMPB R1,#9 ;Tab?
BNEQ 20$
BISL #M_FLG,F ;Yes - set found-a-tab fiag
15$: DECL R8 ;Move over it
BRB ERAWD1
20$: CMPB R1,#^A"0" ;Numeric?
BLSS 30$
CMPB R1,#^A"9"
BGTR 30$
DECL R8 ;Yes - phase two
BRB ERAWD2
30$: CMPB R1,#^A"A" ;Alphabetic?
BLSS 40$ ;No
CMPB R1,#^A"Z"
BLEQ 50$
40$: DECL R8 ;No - stop on the special character
BRB ERAWDX
50$: DECL R8
ERAWD2: BSBW ERAGET ;Get next-most-recent character
ERAW2A: CMPB R1,#^A"0" ;Numeric?
BLSS 20$
CMPB R1,#^A"9"
BGTR 20$
10$: DECL R8 ;Yes - move over it
BRB ERAWD2
20$: CMPB R1,#^A"A" ;Alphabetic?
BLSS ERAWDX
CMPB R1,#^A"Z"
BLEQ 10$ ;Yes
ERAWDX: TSTL R8 ;Back to the start of the line?
BGEQ 10$
CLRL R8
10$: BBCC #V_FLG,F,ERAWX1 ;Were any tabs found?
BSBB ERAWDT ;Yes - R8 must be made right
ERAWX1: BISL #M_CMV,F ;Pretend all this was cursor movement
MOVL #$DELSP,R9 ; and that delete-spaces was typed
MOVQ SAVPOS,R1 ;Swap current and starting positions
MOVQ R7,SAVPOS
MOVQ R1,R7
BSBW PEEL.1 ;Read new parm, if any
MOVL PARG1,R4 ;Get spaces to delete
BSBW SPSCUR
BICL #M_CMV,F ;Clear cursor move flag (if coming from ERASWD)
MOVL R4,R1 ;Put spaces to delete in the right AC
BNEQ 10$ ;Any?
JMP DISCUR ;No - done
10$: BRW CLSNP0 ;Yes - go do the close-spaces
ERAWDB: CLRL R8 ;Move to the beginning of the line
BICL #M_FLG,F ;Don't care if a tab was found
BRB ERAWX1 ;Go finish off
ERAWDT: MOVL CHRPTR,R4 ;Get old character pointer
MOVL R6,CHRPTR ;Save pointer to ending character
BISL #M_XPC!M_XPL,F
BSBW CALCML ;Find where R8 really is
MOVL R4,CHRPTR ;Restore old pointer
RSB ;Done
;Here if starting at or beyond the end of a line
;Position to the end of the line, then erase the word
;(Called also by DELCHR)
ERSWDL: BSBW CALCML ;Calculate proper value of R8
JMP POSCUR ;Position the cursor and return
;Here if starting at start of line - delete last word of previous line
ERAWDE: DECL R7 ;Move up a row
BLSS ERAWE2 ;Jump if at the top
SUBL #2,R6 ;Back the character pointer up
MOVL R6,CHRPTR
BSBW MAKLPT ;Get pointer to that row
BSBW CALCCM ;Find character position
BRW ERAWD0
ERAWE2: CLRQ R7 ;If user started at home,
JMP DISCUR ; leave him there
;Subroutine to get the next-latest file character
ERAGET: MOVZBL -(R6),R1 ;Get next-most-recent character
BEQL ERAGET ;Skip if null
CMPL R1,#^A"a" ;Lower case (maybe)?
BLSS 10$
SUBB #^O40,R1 ;Yes - convert to (maybe) upper
10$: RSB ;Done
.SUBTITLE Recover command - put the contents of the delete buffer back in the file
RECOVR::JSB ERASPM ;Clean up enter mode
JSB POSCUR ;Re-position the cursor
BISL #M_INS!M_CHG,F ;Let line be extended if necessary
BSBW MAKCPT ;Make cure the cursor pointer is right
BICL #M_INS!M_PCM,F
MOVL DELCNT,R4 ;Get size of the delete buffer - any?
BNEQ 10$ ;Yes
JMP DISCUR ;No - nothing to do
10$: CMPL #1,R4 ;Want to put in one character?
BEQL RECOV1 ;Yes - handle specially
MOVL R4,NUMCHR ;Save number of characters to add
MOVAB DELBUF,PUTPTR ;Set to read from delete buffer
BISL #M_WRH,F ;Set use-buffer flag for MAKCHR
BRW PUTNP2 ;Go put them in
;Here to recover one character - simulate insert-mode type-in
RECOV1: MOVZBL DELBUF,R1 ;Get the character to insert
JMP ALPIMD ;Insert the character, done
.SUBTITLE Substitute command
;Here for the substitute command - search for the search key, replace it
;with the substitute string; loop the given number of times
SUBSTI::BBCC #V_CMV,F,10$ ;Did user use cursor movement?
BRW SUMERR ;Yes - illegal
10$: CLRB @PARPTR ;End buffer with a null
CLRL SUBNUM
MOVAB PARBUF,R4 ;Get pointer to parameter buffer
SUBST0: CLRL R1 ;Clear things for peel routines
CLRL R3
MOVZBL (R4)+,R2 ;Get first character of parameter
CMPB R2,#^A"a" ;Lower case?
BLSS 10$ ;No
SUBB #^O40,R2 ;Yes - convert to upper
10$: CMPB R2,#^A"S" ;Set up the search key?
BEQL SUBSRC ;Yes - do it
CMPB R2,#^A"R" ;Set up the substitute string?
BEQL SUBSUB
;Here to set up a number of iterations
BSBW PEEL1A ;Read (hopefully) a number
TSTL R1 ;Error if token
BNEQ 20$
15$: BRW SUMERR
20$: MOVL PARG1,R1 ;Else get number of iterations
BLEQ 15$ ;Any? No - error
MOVL R1,SUBCNT ;Yes - save as new nominal
MOVL R1,SUBNUM ; and note that it's new
CMPB R2,#^O177 ;End with a delimiter?
BEQL SUBST0 ;Yes - find what's next
BRB SUBDUN ;No - finish up
;Here to set up the substitute key as the search key (SUBSRC)
; or the substitute string (SUBSUB)
;Enter with R4/ pointer to start of key in PARBUF
SUBSRC: PUSHR #^M<R1,R2,R3,R4,R5>
MOVC3 #35,SRCKEY,SROKEY ;Save current key as previous
POPR #^M<R1,R2,R3,R4,R5>
MOVAB SRCKEY,R3
BSBW PELST2 ;Get search key
MOVL R1,SRCKLN ;Save its length
CMPB R2,#^O177 ;End with a delimiter?
BNEQ SUBDUN ;No - finish up
BRB SUBST0 ;Yes - find what's next
SUBSUB: MOVAB SUBSTG,R3
BSBW PELST2 ;Get substitute string
MOVL R1,SUBSLN ;Save its length
PUSHR #^M<R7> ;Save the row number
MOVL R8,R1 ;Save the real cursor position
CLRL R8 ;See how long the string is
BSBW SUBCB0 ;(to see if there are any tabs in it)
CMPL R8,SUBSLN ;Are there tabs?
BEQL 10$ ;No
MNEGL SUBSLN,SUBSLN ;Yes - indicate with a negative length
10$: MOVL R1,R8 ;Restore the real position
POPR #^M<R7> ;Restore the real row
CMPB R2,#^O177 ;End with a delimiter?
BNEQ SUBDUN ;No
BRW SUBST0 ;Yes - find what's next (else fall to finish)
;Here to finish with parameters - do command only if iterations were given
SUBDUN: JSB ERASPM ;Erase the parameter from the screen
BBS #V_XCI,F1,10$ ;Initializing for an execute?
TSTL SUBNUM ;No - was a number of iterations given?
BNEQ SUBNPM ;Yes
10$: JMP LOOP ;No init, no number - done
;Here to do the substitute from the parameters set up above
SUBNPM::BBC #V_RDO,F,10$ ;Is the file read-only?
BRW RDOERR ;Yes - command is illegal
10$: MOVL SUBCNT,R1 ;Want to do any substitutes?
BGTR 20$ ;Yes
BRW SUNERR ;No - error
20$: MOVL R1,SUBNUM ;Save decrementable number to do
BBC #V_RST,F,30$ ;Want to restore the nominal parameter?
MOVL #1,SUBCNT ;Yes - set it back to one
30$: CLRL SAVEAC+4 ;Clear bottom line message flag
BICL #M_PCM,F ;Cancel the pick-close mark, if any
BISL #M_CHG,F ;Say file has changed
MOVL F1,SAVEAC+32 ;Save old setting of XCT flag
BSBW SUBCCR ;Count CRLFs in both strings
SUBNP0: JSB SRFNPM ;Search for the key
MOVL SRCKLN,R4 ;Null it out
MOVL CHRPTR,R6
SUBNP1: MOVZBL (R6)+,R1 ;Get a character
BEQL SUBNP1 ;Ignore if null
CLRB -1(R6) ;Else null it out
CMPB R1,#^X0D ;Was it a carriage return?
BNEQ 10$ ;No
BISL #M_FLG,F ;Yes - remember that fact
10$: SOBGTR R4,SUBNP1 ;Loop thru all characters
MOVL SUBSLN,R4 ;Get size of substitute string
BEQL SUBNP2 ;Any? - no - nothing to do
MOVL R4,NUMCHR ;Save number of characters to add
BGEQ 20$ ;If number of characters is negative,
MNEGL R4,NUMCHR ; make it positive
20$: MOVAB SUBSTG,PUTPTR ;Set to read from substitute buffer
BISL #M_WRH,F ;Set use-buffer flag for MAKCHR
MOVL SAVEAC,-(SP) ;Save the off-screen flag
BSBW MAKCHR ;Put the stuff in
MOVL (SP)+,SAVEAC ;Restore the off-screen flag
SUBNP2: BISL #M_XPC,F ;Mark cursor pointer as invalid
TSTL SAVEAC+4 ;Was display pointer moved during last search?
BEQL 10$
BISL #M_XCT,F1 ;Yes - pretend executing to turn off display
BRW 20$
10$: TSTL SUBDIF ;Did the number of lines change?
BNEQ 90$ ;Yes
TSTL SUBLNS ;No - was there more than one line?
BEQL 15$ ;No
BRW 150$ ;Yes - output it differently
15$: JSB DISLIN ;Just display the remainder of the line
BRW 20$ ;Then continue
90$: BLSS 130$ ;Yes - are there now fewer lines? Yes
SUBL3 R7,LPP(R10),R4 ;Get number of lines remaining on screen
CMPL R4,SUBLNS ;Will the re-display fit in the screen?
BLEQ 100$ ;No - display from here on down
MOVL ILN(R10),R1 ;Yes - insert lines - can the terminal do it?
BNEQ 110$ ;Yes
100$: JSB DISDWN ;No - just display from here on down
BRW 20$
110$: ADDL3 #1,R7,R4 ;Position to the next line
JSB POSLIN ; for inserting lines
MOVL SUBDIF,R4 ;Get the number of new lines needed
INCL R7 ;Get on the right line (for VT100)
120$: MOVL ILN(R10),R1 ;Get the insert-lines sequence
JSB PUTSEQ ;Insert the needed lines
SOBGTR R4,120$
DECL R7 ;Correct the line number
BRB 150$ ;Now go display the lines
;Here if need to delete lines from the display
130$: TSTL DLN(R10) ;Can the terminal delete lines?
BEQL 100$ ;No - just display from here on down
ADDL3 #1,R7,R4 ;Yes - position to the next line
JSB POSLIN ;for deleting
MNEGL SUBDIF,R4 ;Get number of lines to delete
INCL R7 ;Correct line number for VT100
140$: MOVL DLN(R10),R1 ;Get the delete-lines sequence
JSB PUTSEQ ;Delete a line
SOBGTR R4,140$ ;Do all of them
DECL R7 ;Get back to right line number
MNEGL SUBDIF,ROLLS ;Set number of lines rolled
ADDL3 SUBDIF,LPP(R10),R4 ;Get line number of start of rewrite
MOVL R4,SAVEAC
JSB ROLFW1 ;Repair the bottom of the screen
150$: JSB POSCUR ;Position the cursor
JSB CLRLNR ;Clear to the end of the line
ADDL3 #1,SUBLNS,R4 ;Get number of lines to display
MOVL CHRPTR,R6 ;and pointer to start of first line
JSB DISPLY ;Display the lines
BISL #M_XPL!M_XPB,F ;Note that line ptr and bot ptr must be changed
20$: MOVL R8,R1 ;Save old cursor position
BSBB SUBCTB ;Move cursor to last character of sub-string
DECL SUBNUM ;Got more to do?
BLEQ SUBNP3 ;No
BBSC #V_FLG,F,40$ ;Yes - took out a carriage return?
30$: DECL R8 ;No - just loop
BGEQ 35$
CLRL R8 ;Don't let the column number be negative
35$: BRW SUBNP0
40$: JSB CCREOL ;Yes - if at end of file put the CR back
TSTL R2 ;Done if it was end of file
BNEQ 30$ ;Else loop
SUBNP3: MOVL SAVEAC+32,R0 ;No - get saved flags and save old pointer
MOVL R1,SAVEAC+32
MOVL R0,R1
BBS #V_XCT,R1,40$ ;Was an execute in progress?
BICL #M_XCT,F1 ;No - clear execute flag
40$: BICL #M_FLG,F ;Clear the carriage-return flag
DECL R8
BGEQ 45$
CLRL R8 ;Don't let the column number be negative
45$: TSTL SAVEAC+4 ;Move off the screen?
BEQL 50$ ;No
JMP DISALL ;Yes - rewrite the screen and return
50$: JMP DISCUR ;No - make current position right and loop
;Subroutine to count the length of the substitute string. Uses SUBSLN if it's
;positive; if negative, there are tabs or carriage returns in the string, so
;the count must be made for each substitute.
;Updates R7 and R8; uses R0, R3; preserves R1, R2
SUBCTB: MOVL SUBSLN,R3 ;Any tabs in the string?
BLEQ SUBCB0 ;Yes - go count them the hard way
ADDL R3,R8 ;No - advance the cursor over the string
RSB ;Done
SUBCB0: MOVAB SUBSTG,R3 ;Get pointer to the substitute string
SUBCB1: MOVZBL (R3)+,R0 ;Get a character of the string
BNEQ 10$
RSB ;Done if null
10$: CMPB R0,#^X0D ;Carriage return?
BEQL 30$ ;Yes - check for line feed
CMPB R0,#9 ;Tab?
BNEQ 20$ ;No
BISL #7,R8 ;Yes - move to the next tab stop
20$: INCL R8 ;Else count it
BRB SUBCB1 ;and get another one
30$: CMPB (R3),#^X0A ;Is the next char a line feed?
BNEQ 20$ ;No - just count the CR
INCL R3 ;Yes - count past the LF
INCL R7 ;Step to the next row
CLRL R8 ; and to column 0
BISL #M_XPL,F ;Say the line pointer is bad
BRB SUBCB1 ;Continue
;Subroutine to count the number of lines involved in the substitute
;Sets up SUBDIF as the difference in number of lines before and after substitute
;SUBLNS is the number of lines to be displayed after substituting
SUBCCR: CLRL R1 ;Clear the line counter
MOVAB SUBSTG,R3 ;Point to the substitute string
10$: MOVZBL (R3)+,R0 ;Get a character
BEQL 20$ ;Done? Yes
CMPB R0,#^X0D ;Carriage return?
BNEQ 10$ ;No
MOVZBL (R3)+,R0 ;Yes - see if it's followed by LF
BEQL 20$
CMPB R0,#^X0A ;Is it?
BNEQ 10$ ;No
INCL R1 ;Yes - count it as another line
BRB 10$ ;and check further
20$: MOVL R1,SUBLNS ;Save the number of lines minus 1
CLRL R1 ;Start over with the search key
MOVAB SRCKEY,R3
30$: MOVZBL (R3)+,R0 ;Get a character
BEQL 40$ ;Done if null
CMPB R0,#^X0D ;Is it a carriage return?
BNEQ 30$ ;No - keep searching
MOVZBL (R3)+,R0 ;Yes - get the next character
BEQL 40$
CMPB R0,#^X0A ;Is this a line feed?
BNEQ 30$ ;No
INCL R1 ;Yes - count another line
BRB 30$
40$: SUBL3 R1,SUBLNS,SUBDIF ;Compute thfe difference
RSB ;Then return
SUNERR: MOVAB SUNERM,R1
BRW ERROR
SUMERR::MOVAB SUMERM,R1
MOVQ SAVPOS,R7 ;Restore the old cursor position
BRW ERROR
SUNERM: .ASCIZ /######Can't do 0 iterations/
SUMERM: .ASCIZ /#####Cursor movement is illegal/
.SUBTITLE JUSTIFY Routines
;Here to justify lines of text between /LM: and /RM:
;with a paragraph indent of /PIND: and a prefix string of /JPRE:.
;If /FILL is set, aligns the right margin; /NOFILL leaves it ragged
JUSTIF::BBC #V_RDO,F,10$ ;Is file read-only?
BRW RDOERR ;Yes - command is illegal
10$: CLRB @PARPTR ;End parameter buffer with a null
MOVAB PARBUF,R6 ;Point to the parameter buffer
BSBW SWHLUR ;Read parameter character
CMPB R1,#^A"C" ;Want to center this line?
BNEQ 20$ ;No
BRW JUSCEN ;Yes - go do it
20$: MOVL JUSLNS,R4 ;Get last time's nominal
BBC #V_ENT,F,JUSNPM ;Is there a parameter? No
MOVL R4,PARG1
BSBW PEEL.1 ;Read new parameter, if any
MOVL PARG1,R4 ;Get number of lines to justify
MOVL R4,JUSLNS ;Save it as the new nominal
TSTL R1 ;If token,
BNEQ 30$
CVTBL #-1,SAVEAC+8 ; flag it so
MOVL #1000,R4 ;and set number of lines big
BRB JUSTI1
30$: CLRL SAVEAC+8 ;Clear the token flag
JUSTI1: JSB ERASPM ;Reset enter mode
BBC #V_XCI,F1,10$ ;Initializing for an execute?
JMP LOOP ;Yes - done now
10$: BBC #V_RST,F,JUSNPM ;Want to restore the nominal parameter?
MOVL #1,JUSLNS ;Yes - set it back to one
JUSNPM::TSTL R4 ;Any lines?
BNEQ 10$ ;Yes
JMP DISCUR ;No - nothing to do
10$: MOVL R4,SAVEAC+4 ;Else save fraggable count
MOVL R4,SAVEAC+24 ;Save also for displaying at end
DECL ISVCNT ;Decrement incremental save counter
CLRL R8 ;Move the cursor to the start of the line
BISL #M_XPC,F ;Force pointer to be re-made
BSBW MAKCPT ;Get a good character pointer
MOVL CHRPTR,R6 ;Point to the start of the text
BICL #M_FLG,F ;Clear the paragraph flag
BISL #M_PCM!M_CHG,F ;Set spacer flag so leading spaces are skipped
;Pass 1: Look through the entire range. Change CRLF's to a space; change
;multiple tabs, spaces, and CRLF's to a single space. If end of a paragraph
;(two CRLF's or CRLF-spacers) is found, leave one CRLF to mark it.
;FLG == CRLF found; spacers or CRLF is start of a new paragraph
;PCM == space found; null any others
;Set up pointer to end of range. Check for end of file here;
;ignore it in pass 2
;Token justify: set flag; end pass 1 on first end of paragraph
;SAVEAC+00: pointer to place to put a CRLF back in
; +04: fraggable JUSLNS
; +08: -1 == token parameter, else zero
; ...
; +24: JUSLNS again (used by JUSDPY)
BSBW JUSSTR ;Strip the leading string off the first line
JUSTP1: CLRL R0 ;Clear the space pointer
JUSP1A: MOVZBL (R6)+,R1 ;Get a character
CMPB R1,#^A" " ;Special character?
BLEQ JUS1A3 ;Maybe - check further
JUS1A2: BICL #M_FLG!M_PCM,F ;Other character - clear CLRF and spacer flags
BRB JUSTP1 ;Count it and do some more
JUS1A3: CMPL R6,EN ;Reached the end of the file?
BLSS 10$ ;No
BRW JUSP2T ;Yes - end of pass 1
10$: TSTB R1
BEQL JUSP1A ;Ignore nulls
CMPB R1,#^A" " ;Space?
BNEQ 30$ ;No
20$: BRW JUS1SP ;Yes - do spacer stuff
30$: CMPB R1,#9 ;Or tab?
BEQL 20$ ;Yes
CMPB R1,#13 ;Carriage return?
BNEQ JUS1A2 ;No - skip the normal character
;Yes - fall to check for linefeed
;Here when a carriage return is found. If not followed by a linefeed, it's
;just another character. Otherwise count another line of the range (done if
;counted out). Set CRLF and spacer flags (FLG, PCM); change the CRLF to
;space, null; save pointer to the former CRLF in case of end of paragraph
MOVL R6,R2 ;Get pointer to the CR
40$: MOVZBL (R6)+,R1 ;Get the next character
BEQL 40$ ;Ignore nulls
CMPB R1,#10 ;Is it a CRLF?
BNEQ JUS1A2 ;No - treat lone CR like a normal character
BBCS #V_FLG,F,50$ ;Yes - set CRLF flag - already set?
BRW JUS1C4 ;Yes - it's end of paragraph - leave the CRLF
50$: MOVL R2,SAVEAC ;No - save the pointer to the former CRLF
BBS #V_PCM,F,JUS1C1 ;Is the spacer flag set? Yes - skip this
MOVB #^A" ",-1(R2) ;No - cover the CR with a space
MOVL R2,R0 ;Save the pointer to the space
BRB JUS1C2 ; and continue
JUS1C1: CLRB -1(R2) ;Yes - cover the CR with a null
JUS1C2: CLRB -1(R6) ;and cover the LF with a null
JUS1C3: BISL #M_PCM,F ;Set the spacer flag
SOBGTR SAVEAC+4,10$ ;Decrement count of lines - done?
BRW JUSTP2 ;Yes - it's time for pass 2
10$: BSBW JUSSTR ;No - strip the header string from the next line
BRW JUSP1A ;and continue with pass 1
;Here on the end of a paragraph. If a token parameter was given, end pass 1
JUS1C4: TSTL R0 ;Is there a space to null out?
BEQL JUS1C5 ;No
CLRB -1(R0) ;Yes - do so
CLRL R0 ;Clear pointer to space
JUS1C5: TSTL SAVEAC+8 ;End of paragraph - was it a token parm?
BEQL 10$
BRW JUSP2T ;Yes - done with pass 1
10$: TSTL SAVEAC ;No - got end of paragraph already?
BEQL JUS1C1 ;Yes - null over the whole CRLF
CLRL SAVEAC ;No - note that EOP's CRLF is already there
BRB JUS1C3 ;and continue
;Subroutine called at the start of each line
;Removes the header string, if it's present, from the line.
;If it's not present, no sweat.
JUSSTR: MOVL JSHCNT,R4 ;Want to remove anything?
BNEQ 10$
RSB ;No - nothing to do
10$: PUSHR #^M<R2> ;Save a work AC
PUSHR #^M<R6> ;and the pointer to the start of the line
MOVAB JUSHED,R3 ;Point to the start of the string
JUSTR1: MOVZBL (R6)+,R1 ;Get the next character
BNEQ 10$ ;Check it if not null
CMPL R6,EN ;At or past the end pointer?
BLSS JUSTR1 ;No - continue checking
10$: MOVZBL (R3)+,R2 ;Get the next character of the string
CMPB R2,R1 ;Still matching?
BNEQ JUSTRX ;No - don't strip
SOBGTR R4,JUSTR1 ;Yes - loop through the entire string
POPR #^M<R6> ;It all matches - get back to start
MOVL JSHCNT,R3 ;Get the length of the string
JUSTR2: MOVZBL (R6)+,R1 ;Get the next character
BEQL JUSTR2 ;Skip it if null
CLRB -1(R6) ;Else null it out
SOBGTR R3,JUSTR2 ;Count it and loop
JUSTR3: POPR #^M<R2> ;Restore the work AC
RSB ;Done
JUSTRX: POPR #^M<R6> ;Restore all the interesting ACs
BRB JUSTR3 ;Done
;Here if a space is found in pass 1. Set the spacer flag (PCM). If it was
;set null out the space. If the CRLF flag (FLG) is on it's the end of a
;paragraph. Change a tab to a space.
JUS1SP: BBSS #V_PCM,F,JUS1S1 ;Mark the spacer - if already one, null it out
CMPB R1,#9 ;Is the character a tab?
BNEQ 10$ ;No
MOVB #^A" ",-1(R6) ;Yes - change it to a space
10$: MOVL R6,R0 ;Save the pointer to the space
BRW JUSP1A ;and continue with pass 1
JUS1S1: CLRB -1(R6) ;Null out this spacer
BBC #V_FLG,F,10$ ;Is this the end of a paragraph?
MOVL SAVEAC,R2 ;Yes - get ptr to former CRLF - already done?
BNEQ 20$ ;No
10$: BRW JUSP1A ;No or done - go continue with pass 1
20$: TSTL R0 ;Is there a space to null?
BEQL JUS1S2 ;No
CLRB -1(R0) ;Yss - do so
JUS1S2: MOVW #^X0A0D,-1(R2) ;Put CRLF back in to mark end of paragraph
CLRL SAVEAC ;Note that this paragraph has been marked
BRW JUSTP1 ;Continue with pass 1
;Here for pass 2. R6/ end of the region, R9/ # chars in range.
;Now there is only one space between each word and a CRLF marks the
;end of a paragraph
;Carve off full words until line count is satisfied, then indent, justify,
;and add a CRLF at the end (but don't justify if it's the end of the
;paragraph).
;SAVEAC+00: pointer to start of current line
; +04: pointer to the place to save the line
; +08: number of words in this line
; +12: pointer to end of region
; +16: indent for this line
; +20: Number of lines in region after justify
; +24: Number of lines in region before justify (used by JUSDPY)
; +28: Number of characters up to the latest word
JUSP2T: MNEGL SAVEAC+4,R1 ;Here from a token parameter
INCL R1 ;Find number of lines in region
ADDL SAVEAC+24,R1
MOVL R1,SAVEAC+24 ;Save for the display routine
BBS #V_RST,F,JUSTP2 ;Want to restore the nominal parameter?
MOVL R1,JUSLNS ;No - save line count for next time
JUSTP2: BICL #M_PCM,F ;Clean up from pass 1
BISL #M_FLG,F ;Turn paragraph flag on
MOVL R6,SAVEAC+12 ;Save pointer to end of region
MOVL R6,ADJWRD ;Save it also for adjusting
;Find out how many nulls to add:
ADDL3 LMARGN,PARIND,R1 ;Get left margin plus the indent
ADDL #20,R1 ; plus 20 spaces per line
MULL3 SAVEAC+24,R1,NUMCHR ; times number of lines in the range
BSBW MAKNUL ;Punch a hole in the file
MOVL ADJWRD,SAVEAC+12 ;Get adjusted end-of-region address
CLRL ADJWRD ; and clear it
MOVL CHRPTR,R1 ;Get pointer to start of nulls
MOVL R1,LINPTR ;It's the start of the first line, too
MOVL R1,SAVEAC+4 ;and the start of the justified text
MOVL R4,R6 ;Get pointer to start of unjustified text
CLRL R4
CLRL SAVEAC+20 ;Clear count of ending lines
JUSP2S: MOVL RMARGN,R3 ;Get count of characters this line
MOVL LMARGN,R2 ;Find the indentation
BBC #V_FLG,F,10$ ;Did a paragraph just start?
ADDL PARIND,R2 ;Yes - add paragraph indent, too
10$: TSTL R2 ;Got a negative total indent?
BGEQ 20$
CLRL R2 ;Yes - force it to zero
20$: MOVL R2,SAVEAC+16 ;Save this line's indent
SUBL R2,R3 ;and subtract it from number of chars wanted
SUBL JSHCHR,R3 ;Subtract the length of the header, too
CLRL R0 ;Clear count of characters in this line
CLRL SAVEAC+8 ;Clear count of words in this line
MOVL R6,SAVEAC ;Save pointer to start of this line
JUSP2A: CMPL R6,SAVEAC+12 ;Reached the end of the region?
BNEQ 10$ ;No
BRW JUS2ND ;Yes - finish off and display
10$: MOVZBL (R6)+,R1 ;Get a character
CMPB R1,#^A" " ;Space or less?
BGTR JUSP2B ;No
BRW JUS2CK ;Yes - check further
JUSP2B: BICL #M_FLG,F ;Say it's no longer the end of a paragraph
SOBGEQ R3,JUSP2A ;Count the character - loop if not end of line
;Here when counted out to end of line - do the justification
;FLG == the end of the paragraph
;PCM == the end of the region
JUS2EL: TSTL R0 ;Was a space found in the line?
BNEQ 10$ ;Yes
MOVL R6,R0 ;No - set to wrap the line around
CLRL R3 ;Remember that line wrapped
BRB 20$
10$: CVTBL #-1,R3 ;Note that line didn't wrap
20$: MOVL SAVEAC,R6 ;Get pointer to the start of the line
MOVL SAVEAC+4,R2 ;and pointer to the place to store the line
BSBW JUSINS ;Indent the line
MOVL #^XFFFF,R9 ;Get default number of words (big)
CLRL R1 ;Get default spaces per word (one)
TSTB FLLFLG ;Use default if not filling
BEQL JUS2ES
BITL #M_FLG!M_PCM,F ;or if end of paragraph or region
BNEQ JUS2ES
TSTL R3 ;or if line wrapped around
BEQL JUS2ES
MOVL SAVEAC+28,R1 ;Get the number of extra spaces to add - any?
BLEQ JUS2ES ;No - nothing to adjust
DECL SAVEAC+8 ;Word count was one too large
BEQL JUS2ES ;Just save it if only one word
MOVL R2,R9 ;Store pointer
CLRL R2
EDIV SAVEAC+8,R1,R1,R2 ;Over number of words, gives spaces per line
PUSHR #^M<R2> ;Get number of words which get extra spaces
MOVL R9,R2
POPR #^M<R9>
TSTL R9 ;Got exactly enough spaces?
BNEQ 30$ ;No
MOVL #^XFFFF,R9 ;Yes - do exactly the same thing for every word
BRB JUS2ES
30$: BBS #V_LFF,F,40$ ;Flip odd/even flag - even?
BISL #M_LFF,F ;Yes
INCL R1 ;Add in the extra space and continue
BRB JUS2ES
40$: BICL #M_LFF,F
MNEGL R9,R9
ADDL SAVEAC+8,R9 ;Get # of words which get normal spacing
JUS2ES: MOVL R1,SAVEAC+8 ;Save number of spaces - 1 between words
JUS2E1: MOVZBL (R6)+,R1 ;Get a character
CMPL R6,R0 ;At the end of the line?
BEQL JUS2E2 ;Yes - finish the line and loop
TSTL R1 ;No - ignore it if null
BEQL JUS2E1
CLRB -1(R6) ;Else null out the source character
CMPB R1,#^A" " ;End of a word?
BNEQ 10$ ;No
BSBW JUS3SP ;Yes - add the right amount of spaces
10$: MOVB R1,(R2)+ ;No - save the character
BRB JUS2E1 ;and get another one
JUS2E2: TSTL R3 ;Did the line wrap around?
BEQL 10$ ;Yes
CLRB -1(R6) ;No - null out the source character
10$: BSBW JUSEOL ;End the line with a CRLF
BBC #V_FLG,F,20$ ;Is this the end of a paragraph?
BSBW JUSEOL ;Yes - throw out another CRLF
20$: MOVL R2,SAVEAC+4 ;Save the storage pointer
TSTL R3 ;If previous line wrapped, don't lose last char
BEQL JUS2E4
BBC #V_PCM,F,JUS2E3 ;Done with entire range?
BRW JUSDPY ;Yes
JUS2E3: CMPL R6,SAVEAC+12 ;See if the region ends here
BNEQ 10$
BRW JUSDPY ;It does - go display
10$: MOVZBL (R6)+,R1 ;Check all the nulls at the end of the line
BEQL JUS2E3
JUS2E4: DECL R6 ;Back up behind real character again
BRW JUSP2S ;Then go do the next line
;Here when end of region is reached - set flag to say so and
;go finish off the last line, then display; done
JUS2ND: BISL #M_PCM,F ;Note that this is the last line
BBS #V_FLG,F,10$ ;Just ended a paragraph?
BRW JUS2EL ;No - finish the last line; done
10$: BRW JUSDPY ;Yes - go display the result
;Here when a space is found during pass 2. Bump count of words
;and save pointer to the space
JUS2SP: INCL SAVEAC+8 ;Bump count of words on this line
MOVL R6,R0 ;Save pointer to the space
MOVL R3,SAVEAC+28 ;Save character count up to this word
BRW JUSP2B ;Count the character and loop
;Here if character is space or less - handle some characters specially
JUS2CK: TSTB R1 ;Ignore nulls
BNEQ 10$
BRW JUSP2A
10$: CMPB R1,#^A" " ;Space?
BEQL JUS2SP ;Yes - count and save pointer
CMPB R1,#13 ;Carriage return?
BEQL 20$ ;Yes
BRW JUSP2B ;No - treat it normally
20$: MOVL R6,R2 ;Yes - check for CRLF - get fraggable pointer
MOVZBL (R2)+,R1 ;See if LF follows the CR
CMPB R1,#10 ;Does it?
BEQL 30$ ;Yes
BRW JUSP2B ;No - treat the CR like a normal character
30$: CLRB -1(R2) ;Null over the linefeed
BBS #V_FLG,F,JU2CK1 ;Just had a CRLF?
MOVL R6,R0 ;No - set pointer to latest space to here
BISL #M_FLG,F ;Note that it's the end of the paragraph
BRW JUS2EL ;Go end it
JU2CK1: CLRB -1(R6) ;Null out the CRL
MOVL R2,R6 ;Skip over the CRLF
BRW JUSP2A ;and continue
;Here when a space if found while copying the line
;Put in the right number of spaces
JUS3SP: MOVL SAVEAC+8,R4 ;Get number of extra spaces to add
BEQL JUS3S1 ;Any? No - don't put any in
10$: MOVB R1,(R2)+ ;Save a space
SOBGTR R4,10$ ;Loop to save all the spaces
JUS3S1: DECL R9 ;Any adjustments needed?
BGTR 30$ ;If not, done
BBC #V_LFF,F,10$ ;Else on an even line?
DECL SAVEAC+8 ;No - de-bump number of spaces to add
BRB 20$
10$: INCL SAVEAC+8 ;Yes - bump number of spaces to add
20$: MOVL #^XFFFF,R9 ;Set word count big now
30$: RSB ;Done
;Here when done - delete old text from display and insert justified text
;SAVEAC+24/ Lines in old text; SAVEAC+20/ Lines in new text
JUSDPY: JSB POSCUR ;Make sure the cursor is in the right place
MOVL #$JUSTI,R9 ;Restore the command name
BISL #M_XPB,F ;Say bottom pointer is bad
BICL #M_FLG!M_PCM!M_LFF,F ;and clear the flags justify used
SUBL3 R7,LPP(R10),R4 ;Get number of lines remaining on screen
CMPL R4,SAVEAC+20 ;Will the re-display fit in the screen?
BLEQ 10$
TSTL CLN(R10) ;Yes - can the terminal clear to end of line?
BNEQ 20$
10$: JMP DISDWN ;Neither - just display to end of screen
20$: CMPL R4,SAVEAC+24 ;Start with more lines than were on the screen?
BLSS 10$ ;Yes - just display to end of screen
SUBL3 SAVEAC+20,SAVEAC+24,R4 ;Find change in number of lines
BNEQ 30$
BRW JUSDP2 ;If no change, don't insert or delete any
30$: BLSS JUSDP1 ;Jump if lines increased
TSTL DLN(R10) ;Else delete lines - can the terminal do it?
BEQL 10$ ;No - just display from here on down
PUSHR #^M<R2> ;Yes - put number of lines in the right place
MOVL R4,R2
POPR #^M<R4>
BBC #V_FNC,F,JUSDP0 ;Is the fence up?
BSBW JUSFNE ;Yes - remove it
JUSDP0: MOVL DLN(R10),R1 ;Get sequence to delete lines
JSB PUTSEQ ;Delete the excess lines
SOBGTR R2,JUSDP0
PUSHR #^M<R4> ;Put R2 and R4 in the right places
MOVL R2,R4
POPR #^M<R2>
BRB JUSDP2 ;Now go clear out and rewrite the screen
JUSDP1: MNEGL R4,R4 ;# lines increased - make count positive
10$: MOVL ILN(R10),R1 ;Insert lines - can the terminal do it?
BNEQ 20$ ;Yes
JMP DISDWN ;No - just display from here on down
20$: JSB PUTSEQ ;Insert the needed line
SOBGTR R4,10$
BBCC #V_FNC,F,30$ ;Was the fence on the screen before?
JSB FIXBLW ;Yes - put it back if it's still there
30$: JSB POSCUR ;Re-position the cursor
JUSDP2: MOVB #13,(R5)+ ;Make sure cursor is at start of line
MOVL SAVEAC+20,R4 ;Get count of lines to clear
JUSDP3: MOVL CLN(R10),R1 ;Get the line-clearing sequence
JSB PUTSEQ ;Clear out a line
JSB CDOWN ;Move down a line
SOBGTR R4,JUSDP3 ;Loop through all the lines
JSB POSCUR ;Position to the start of the region
MOVL SAVEAC+20,R4 ;Get number of lines to display
MOVL LINPTR,R6 ;and pointer to start of first line
JSB DISPLY ;Display the lines
SUBL3 SAVEAC+20,SAVEAC+24,R4 ;Find change in lines before and after
BGTR 10$
JMP DISCUR ;Done, unless lines were deleted
10$: MOVL R4,ROLLS
MNEGL R4,R4
ADDL LPP(R10),R4 ;Get line number of start of rewrite
MOVL R4,SAVEAC
BSBW ROLFW1 ;Repair the bottom of the screen
JMP LOOP ;Done
;Subroutines to erase the fence and to put it back if it's there
JUSFNE: JSB CBOTOM ;Erase the fence from the bottom line
JMP POSCUR ;Re-position the cursor and return
;Subroutine to insert a CRLF in the new text and count another line
JUSEOL: MOVW #^X0A0D,(R2)+ ;End the line with a CRLF
INCL SAVEAC+20 ;Bump count of ending lines
RSB ;Done
;Subroutine to add the header string, if any, to the start of the line.
;It then adds tabs and/or spaces to start the line at the left margin.
;Call with R2/ptr to text; returns R4/0. Uses R1
JUSINS: MOVL JSHCNT,R4 ;Got a header string to insert?
BEQL JUSIN0 ;No - skip this
MOVAB JUSHED,R9 ;Yes - get pointer to the string
JUSINL: MOVB (R9)+,(R2)+ ;Transfer a character
SOBGTR R4,JUSINL ;Loop through all characters
JUSIN0: MOVL SAVEAC+16,R4 ;Find number of spaces to insert
BGTR 10$ ;Any?
RSB ;No - done
10$: CMPL R4,#8 ;Got room for a tab?
BLSS JUSIN2 ;No room - do it all in spaces
TSTB INSTBS ;Want to insert tabs if possible?
BNEQ JUSIN2 ;No - do it all in spaces
JUSIN1: CMPL R4,#8 ;Got room for another tab?
BLSS JUSIN2 ;No - finish off with spaces
MOVB #9,(R2)+ ;Yes - save a tab
SUBL #8,R4 ;Count the tab
BRB JUSIN1 ;and try for one more
JUSIN2: TSTL R4 ;Counted out?
BNEQ 10$ ;No
RSB ;Yes - done
10$: MOVB #^A" ",(R2)+ ;Save spaces
SOBGTR R4,10$ ; until counted out
RSB ;Done
;Here to center the line the cursor is on between /LM: and /RM:
;(The cursor can be anywhere in the line; it ends up at the beginning)
JUSCEN: JSB ERASPM ;Repair the screen from the parameter
BSBW MAKLPT ;Get a good line pointer
MOVL LINPTR,R6 ;Get the pointer to the start of the line
MOVL R6,CHRPTR ;Move the cursor to the start
CLRL R4 ;Clear the counter
CLRL R8 ;Move to column zero
BICL #M_XPC,F ;Say the character pointer is O.K.
BRB JUSC1A
;Now see how long the line is, while nulling out leading and trailing
;spaces and tabs
JUSCN1: CLRB -1(R6) ;Null out the spacer
JUSC1A: MOVZBL (R6)+,R1 ;Get the next character
BEQL JUSC1A ;Ignore nulls
CMPB R1,#^A" " ;Space?
BEQL JUSCN1 ;Yes
CMPB R1,#9 ;or tab?
BEQL JUSCN1 ;Yes - null it out and keep looking
BRB JUSC2A ;No - jump into the counting loop
JUSCN2: MOVZBL (R6)+,R1 ;See how long thfe line is - get a character
BEQL JUSCN2 ;Ignore nulls
JUSC2A: CMPB R1,#9 ;Tab?
BNEQ 10$ ;No
MOVB #^A" ",-1(R6) ;Yes - change it to a space
10$: CMPB R1,#13 ;Carriage return?
BEQL 30$ ;Yes
20$: INCL R4 ;No - count the character
BRB JUSCN2 ; and loop
30$: CMPB (R6),#10 ;Is the next character LF?
BNEQ 20$ ;No - count the CR and continue looking
;Yes - strip trailing spaces/tabs
JUSCN3: MOVZBL -(R6),R1 ;Get the previous character
BEQL JUSCN3 ;Skip it if null
CMPB R1,#^A" " ;Space?
BNEQ JUSCN4 ;No - proceed with centering
CLRB (R6) ;Yes - null it out
DECL R4 ;Un-count it and check the next one
BRB JUSCN3
JUSCN4: SUBL RMARGN,R4 ;See how much space to add
ADDL LMARGN,R4
ASHL #-1,R4,R4 ;Now R4/ negative space to add
BGEQ JUSCN5 ;If line is too long, just re-display it
MNEGL R4,NUMCHR ;Else save (positive) number of spaces to add
BSBW MAKSPC ;Put them in
JUSCN5: JSB DISONL ;Re-display the line
JMP DISCUR ;Re-position the cursor and get a new command
GLOB ;Define the global symbols
.END