;	Compose
;	Used to write all texts in KOM
;
;	Creation			25-Sep-84 20:15:58 /PRN
;	Hacking started			27-Jan-85 17:48:14 /PRN
;	..and the hacking goes on..	05-Mar-85 17:06:26 /JSN
;	I have sent PIPSAV.TXT as mail!	29-Mar-85 20:09:16 /JSN
;	Tab support (almost) added.	09-May-85 17:07:00 /JSN
;	"!" commands implemented	23-May-85 19:44:12 /JSN
;	Job name is now KOM.CO during
;	COMPOSing			25-Nov-85 18:59:55 /JSN
;	Changed Space-break width and
;	made TAB a "break char"		13-Mar-86 08:49:57 /JSN
;	Rehacked "replace" a bit	14-Jun-86 22:41:04 /JSN
;	Added support for new database
;	format				22-Aug-86 20:37:50 /JSN
;
	.title	Compos

	BUFLEN	= 1000			; Size of compos' in-core buffer
	RECLEN	= 200			; Size of one line record

	.nlist

	.inclu	"B:GLOBAL"

	.nlist	sym

	sect	CODE

oXCMP:	jmp	KOMNYI			; forget you ever saw this.
	.list

proc	oCOMPO
	begin
	gos	compxx <#true,#11,>
	ret

proc	oEntFl	<chan,stline>		; Enter file. Start at line stline
	begin
	gos	compxx <, chan(r5), stline(r5)>
	ret

proc	compxx	<iactiv,chan,stline>

var	nolin,	word			; # of lines stored
var	curlin,	word			; # of current line
var	frstln, word			; # of first line in buffer
var	brewid, word			; Width when to break line
var	savech,	char			; Save char
var	fpos,	word
var	fblk,	word
var	CSW,	word			; Compose Status Word, bits as follows
					; 	1 : Header not erasable.
					; 	2 : don't write to tmp file.
					;    	4 : *** reserved ***
					;	!
					;  100000 : *** reserved ***
var	bufptr,	word			; Pointer to buffer
var	buffer,	BUFLEN

	HnE	= 1			; CSW bit 1.
	DWtTF	= 2			; CSW bit 2

	XLEN	= 32.			; Length of 'byt' strings

var	byt.to,	XLEN+2			; String to replace WITH
var	byt.fr,	XLEN+2			; String to search for
var	repcnt, word			; Number of replaces

	BreLen	= 6			; Width-Length of line before break
	BreSpc	= 9.			; Width-BreLen-Width of line before
					; space break

begin
	.nlist
	mov	r5, bufptr(r5)		; Set up the buffer pointer
	add	#buffer, bufptr(r5)
	setnam	#"CO
	mov	#-1., line		; Get rid of all those '(Tryck...'

	call	clrfqb			; Open temporary file
	movb	#crtfq, firqb+fqfun
	movb	#12*2, firqb+fqfil	; File # 12 (10.)
;	mov	#100040, firqb+fqmode	; Make a tentative file

	calfip				; Do it (Thanks, Johannes!)
	call	ioerr			;  (You're welcome!)
	movb	#dlnfq, firqb+fqfun
	calfip				; Immediatelly delete it!
	call	ioerr
	clr	CSW(r5)

again:	;mov	iactiv(r5), r0
;	bpt
	mov	#1, nolin(r5)		; Init some vars.
	mov	#1, curlin(r5)
	mov	#1, frstln(r5)
	bic	#DWtTF, CSW(r5)
	clrb	savech(r5)

	call	clrbuf

	tst	iactiv(r5)		; Interactive mode?
	bne	50$			; If yes - to 50$

	clrb	tmpstr			; 0 length current line
	call	entf			; Read text file for me!
	jmp	cmplai			; Enter it!

50$:	cmpb	tmpstr, #377		; Is there already a header?
	
	beq	100$
	bis	#HnE, CSW(r5)
	call	wrttmp
	call	PCRLF
	call	putlin
	inc	nolin(r5)
	inc	curlin(r5)
	call	adjbuf
	clr	(r0)
	br	120$	
100$:	mov	#arende, r0		; Ask for "[rende"
	mov	bufptr(r5), r1
	call	movstr


120$:	mov	Width, r3		; Max width
	sub	#brelen, r3
	mov	r3, brewid(r5)

140$:	call	linget			; Get curlin in tmp
160$:	call	wrttmp			; Write out line

180$:	;movb	savech(r5), r0		; Get next char or the last
	;beq	200$
	;clrb	savech(r5)
	;br	220$
		
200$:	call	ttyin

220$:	cmp	r0, #177		; Rubout?
	beq	300$

	cmp	r0, #40			; Special char?
	bgt	240$			; No!
	asl	r0
	call	@jmptab(r0)
	br	180$
	
240$:	cmp	r0, #'-			; Hyphenation here?
	bne	245$
	asl	r0
	call	640$
	br	180$

245$:	call	getlen
	cmp	r4, brewid(r5)
	blos	260$

;	push	<r0>
;	movb	tmpstr, r0
;	cmpb	tmpstr(r0), #'-
;	beq	250$
;	mov	#'-, r0
;	call	ttyout
;	call	inschr			; insert r0 in tmpstr
;250$:	pop	<r0>

	call	700$

260$:	call	inschr

280$:	call	ttyout
	br	180$

300$:	tstb	tmpstr			; Rubout (NOT a subroutine)
	bne	360$

	dec	curlin(r5)
	beq	340$
	bit	#HnE, CSW(r5)		; Eraseable header?
	beq	320$
	cmp	curlin(r5), #1
	beq	340$
320$:	dec	nolin(r5)
	br	140$

340$:	inc	curlin(r5)
	call	putlin
	br	140$
	
360$:	tst	TTflag			; Test if it is a hardcopy terminal
	bpl	365$
	movb	tmpstr, r0
	movb	tmpstr(r0), r0
	call	ttyout			; 'cause TECO does this!
	decb	tmpstr
	br	380$

365$:	call	getlen
	mov	r4, r0
	decb	tmpstr
	call	getlen
	sub	r4, r0
	cmp	r0, #1
	bhi	370$
	write	#rubch
	br	380$
370$:	call	putlin
	mov	#10, r1
	call	string
	call	erol
	call	linget

380$:	br	180$

400$:	mov	#7, r0			; ^G (Sound bell)
	call	ttyout
	rts	pc

420$:	tst	TTflag			; Check if hardcopying
	bpl	430$			; To 430$ if so
	write	#ctrlu
430$:	call	eral			; ^U (Erase Line)
	clrb	tmpstr
	rts	pc


440$:	tst	TTflag
	bpl	450$
	write	#ctrlw
450$:	call	getlen			; ^W (Erase Word)
	mov	r4, r0
	movb	tmpstr, r4
	beq	500$
	
460$:	dec	r4
	beq	500$
	cmpb	tmpstr+1(r4), #40
	blos	460$
	
480$:	dec	r4
	beq	500$
	cmpb	tmpstr+1(r4), #40
	bhi	480$
	inc	r4
	
500$:	movb	r4, tmpstr
	call	getlen
	call	putlin
	sub	r4, r0
	mov	#10, r1			; Rub it out!
	call	string
	call	Erol
	call	linget
	rts	pc

520$:					; ^Z (End of message)
	write	#ctrlz
	jmp	cmplai

580$:	tstb	tmpstr			; Escape (Command mode)
	beq	600$
	call	PCRLF

600$:	call	putlin			; Store line
	mov	#CMPLST,r1
	call	GetAdr
	mov	r1, r0
	add	#rStr, r0
	call	MovPro			; Moves prompter to user memory.
	mov	PrsPri, r1		; Priority to PARSER
	bis	#1000, r1		; Priority for all COMPOS commands.
	PARSER	#CMPLST, r1, r0
	call	ccon
	call	UtmOff
	call	linget
	mov	#-1., line		; Get rid of all those '(Tryck...'
610$:	call	PCRLF
	tst	level
	beq	620$
	mov	found, r1
	call	GetAdr
	mov	(r1), r0
	beq	620$			; Continue to write
	bit	#1000, rPri1(r1)
	beq	615$			; Orginal Compos command

	jmp	@r0

615$:	call	pcrlf			; 88.05.03 /AG
	push	<r2, r3, r4, r5>
	clr	line
	bic	#1000, Prios		; Used by ReRead/AG
	call	@r0
	mov	#-1, line
	pop	<r5, r4, r3, r2>
	write	#ateot
	
620$:					; Continue (just CR after ESC)
	cmpfor	== 620$

	tst	(sp)+
	jmp	140$


640$:	mov	brewid(r5), r1		; Space and hyphen (Check for eoln)
	sub	#brespc, r1
	call	getlen			; Get my real position. (count tabs)
	cmp	r4, r1			; Time to break?
	blt	650$			; NO-> Continue
	cmp	r0, #2*'-
	bne	680$
	asr	r0
	call	inschr
	call	ttyout
	br	680$

650$:	asr	r0			; reconvert r0 to char.
	tst	(sp)+
	jmp	260$			; Go and insert it

660$:					; ^R (Rewrite line)
	tst	TTflag			; Check if hardcopying
	bpl	670$			; To 670$ if so
	write	#ctrlr
670$:	call	putlin
	call	eral
	call	linget
	call	wrttmp
	rts	pc

680$:	clr	r0			; ^M and ^J (force eoln)
	bit	#xELIN, MyFlag
	beq	690$
	tstb	tmpstr
	bne	690$
	jmp	520$			; Perform ^Z

690$:	bit	#xEE, MyFlag
	beq	700$
	tstb	tmpstr
	beq	700$
	cmpb	tmpstr+1, #'!		; First char an "!" ?
	bne	700$

;	push	<r0, r1>
;	mov	iactiv(r5), r0
;	mov	#iactiv, r1
;	add	r5, r1
;	bpt
;	pop	<r1, r0>
	push	<r0, r1, r2, r3, r4, r5>
	call	putlin
;	push	r0
;	mov	iactiv(r5), r0
;	bpt
;	pop	r0
	mov	#pstr1, r4
	mov	#tmpstr, r1
	movb	(r1)+, r0
	dec	r0
	beq	693$
	inc	r1
	movb	r0, (r4)+
	mov	r4, strs
691$:	movb	(r1)+, (r4)+
	sob	r0, 691$
	clr	minlvl
	mov	#pstr1+1, minstr
	movb	prspri, prios
	bis	#1000, prios
	mov	#CmpLst, lists
	clr	level
	clr	copyP
	clr	LnkLvl
	movb	#377, Lnks
	call	Find
	call	UnicP
	bcs	693$
	movb	#40, (r4)+
	inc	pstr1
	mov	Ambp, r1
	call	nextl

692$:	tst	(pc)+
693$:	sec
	pop	<r5, r4, r3, r2, r1, r0>
	bcs	695$
	clrb	tmpstr
	call	putlin			; Delete the line
	jmp	610$
695$:	call	linget

700$:	;movb	r0, savech(r5)
	call	PCRLF			; Store current line and start a new.
	call	putlin			; Store line.
710$:	inc	curlin(r5)
	call	adjnol			; Adjust nolin if necessarry
	push	r0
	call	adjbuf
	clrb	(r0)
	pop	r0
	call	linget
	call	wrttmp
	rts	pc

720$:	cmphel	= 720$			; ^L (Blank screen and do "Hela")
	call	putlin

	call	clrcrt
	call	hela
	rts	pc
	
740$:	mov	#11, r0			; ^I (Tab)
	call	inschr
	mov	brewid(r5), r1			; 
	sub	#brespc, r1
	call	getlen			; Get my real position. (count tabs)
	cmp	r4, r1
	bge	770$

	call	ttyout			; Show The Tab too!
760$:	rts	pc

770$:	decb	tmpstr			; Get rid of the obsolete TAB
	jmp	680$			; Go and make an end-of-line


cmplai = .
780$:					; Send the text
	call	putlin
	tstb	tmpstr
	bne	790$
	cmp	nolin(r5), #1
	blos	790$
	dec	nolin(r5)
	dec	curlin(r5)
790$:
	call	laggpa
	tst	(sp)+
	jmp	endit

cmpedi	= .				; Edit using editor
791$:
	call	putlin			; Save the line currently in corcmn
	mov	#JFSYS, xrb
	.set				; Enable privs
	mov	#"MP, -(sp)
	mov	#".T, -(sp)		; Put the extension (.TMP) on stack
	call	clrfqb
	movb	#uu.sys, firqb+fqfun	; Get system info (for this job)
	.uuo
	movb	firqb+fqjob, r2
	asr	r2			; make r2 job #
	movb	r2, corcmn+177		; ..and save it at the end of corcmn
	mov	r2, r1
	clr	r0			; Calculate the two last chars of 
	div	#10., r0		;  the TMP-file's name
	add	#'0, r0
	add	#'0, r1
	swab	r1
	bis	r1, r0
	mov	r0, -(sp)		; ..then push 'em
	mov	#"OM, -(sp)
	mov	#"XK, -(sp)		; Put part1 of file name on stack
	call	clrfqb
	call	clrxrb
	mov	#10., (r1)		; Length of the file name
	mov	(r1)+, (r1)+
	mov	sp, (r1)		; Address of file name
	.fss
	movb	#crefq, firqb+fqfun	; Create the file!
	movb	#7*2, firqb+fqfil
	calfip
	call	ioerr
	mov	#FBU, utmptr		; Enable output to the file we just
	mov	#1, utmblk		;   opened
	clr	utmflg
	bis	#utmon, KSW
	call	hela			; Then retype the whole text
	bic	#utmon, KSW
	call	utmoff			; And turn the output off
	mov	#corcmn, r2		; Fill CORCMN
	mov	#13.+<400*'E>, (r2)+	; size=13. chars
	mov	#"D , (r2)+		; "ED 
	mov	#GRPLST, r1		; Find name of current terminal!
	mov	pterm, r0
	call	findcm
	mov	r0, r1
	clr	r0
	tst	r1
	beq	792$
	cmp	-rStr(r1), #-1
	beq	792$

	dec	r2
	clr	r3
	bisb	(r1)+, r3		; L{ngd byte.
	gos	cvt$$, <r1, r2, r3, #7>
	movb	(r2), r3
	movb	#'/, (r2)+
	add	r3, r2
	movb	#40, (r2)
	inc	r3
	mov	r3, r0
	movb	corcmn, r2
	add	r3, r2
	movb	r2, corcmn

792$:	mov	#10., r2
	mov	sp, r1
	add	#10., r1
	add	r2, r0
	add	#corcmn+4, r0
793$:	movb	-(r1), -(r0)
	sob	r2, 793$
	call	clrfqb
	movb	#uu.job, firqb+fqfun
	movb	#100, firqb+fqfil	; Indicate we want a logged in job
	mov	#400*1+2, firqb+fqppn	; $TAMIS.EXE
	mov	#^rTAM, firqb+fqnam1
	mov	#^rIS , firqb+fqnam1+2
	mov	#^rEXE, firqb+fqext
	mov	#"SY, firqb+fqdev
	mov	#400, firqb+fqdevn
	mov	#4711, firqb+fqclus	; Indicates restricted TAMIS.
	.uuo				; Create it!
	tstb	firqb
	bne	799$
	movb	firqb+fqfil, r2		; Get created job # to r2
	asr	r2
	setnam	#"TA
	call	clrfqb
	movb	#uu.att, firqb+fqfun	; Then swap console with that job
	movb	#1, firqb+fqsizm
	movb	r2, firqb+fqfil
	.uuo
	movb	firqb, r0
	beq	794$
	bpt
	br	799$

794$:	clr	r0			; Write a NUL (to make us HiBernate)
	call	ttyout
	call	clrfqb
	movb	#uu.chu, firqb+fqfun	; Kill that job!
	movb	r2, firqb+fqfil
	movb	#377, firqb+35
	.uuo

	setnam	#"CO			; Were back!
	mov	#1, curlin(r5)
	mov	#1, nolin(r5)
	clrb	tmpstr
	call	clrfqb
	call	clrxrb
	mov	#12, (r1)
	mov	(r1)+, (r1)+
	mov	sp, (r1)
	call	edinfi

799$:	add	#12, sp
	mov	#JFSYS, xrb
	.clear
	rts	pc

800$:	.word	760$, 760$, 760$, 760$, 760$	; 0 - 4		^@ ^A ^B ^C ^D
	.word	760$, 760$, 400$, 300$, 740$	; 5 - 11	^E ^F ^G ^H ^I
	.word	680$, 760$, 720$, 680$, 760$	; 12 - 16	^J ^K ^L ^M ^N
	.word	760$, 760$, 760$, 660$, 760$	; 17 - 23 	^O ^P ^Q ^R ^S
	.word	760$, 420$, 760$, 440$, 760$	; 24 - 30       ^T ^U ^V ^W ^X
	.word	760$, 520$, 580$, 760$, 760$	; 31 - 35	^Y ^Z ^[ ^\ ^]
	.word	760$, 760$, 640$		; 36 - 41	^^ ^_    

jmptab	= 800$

endit:	push	<r0, r1>
	mov	#ERASTR, r0
	mov	bufptr(r5), r1
	mov	#BUFLEN, r2
100$:	tstb	(r0)
	bne	120$
	mov	#ERASTR, r0
120$:	movb	(r0)+, (r1)+
	sob	r2, 100$
	
;	movb	#uu.fcb, firqb+fqfun
;	movb	#12, firqb+fqfil	; Get file size
;	movb	#1, firqb+fqsizm
;	.uuo

;	mov	firqb+fqnam1, r1
	mov	Nolin(r5), r1
	add	#BUFLEN/RECLEN-1, r1
	clr	r0
	div	#BUFLEN/RECLEN, r0
	beq	160$			; Why bother if filesize=0?
	
	mov	#1, r2
	
140$:	mov	#xrb, r1		; Erase the file (using a funny text)
	mov	#BUFLEN, (r1)
	mov	(r1)+, (r1)+
	mov	bufptr(r5), (r1)+
	mov	#12*2, (r1)+
	mov	r2, (r1)
	.write
	clr	r2
	sob	r0, 140$
	
160$:	movb	#clsfq, firqb+fqfun
	movb	#12*2, firqb+fqfil
	calfip	
	pop	<r1, r0>
	ret				; At return r0 points to BLK and r1
					; to pos. in BLK. If r0 = 0 then there
					; is no text.

wrttmp:	; Write out TMPSTR without a curlif
	; Destroyes: None

	push	r1
	write	#tmpstr
	pop	r1
	rts	pc

clrbuf:	push	<r0, r1>
	mov	bufptr(r5), r0		; Zero buffer (FB1,FB2)
	mov	#BUFLEN/2, r1
100$:	clr	(r0)+
	sob	r1, 100$
	pop	<r1, r0>
	rts	pc

linget:	; Get line curlin from buffer or file to TMPSTR. Zero length if curlin
	; is greater than nolin.
	; Destroyes: nothing

	push	<r0, r1, r2>
	call	adjbuf			; Get line location in r0

	tst	r0
	bne	100$			; Everything Ok
	clrb	tmpstr			; If r0 = 0 then something is wrong
	br	120$	

100$:	mov	#tmpstr, r1
	call	movstr
	tst	(pc)+
120$:	sec
	pop	<r2, r1, r0>
	rts	pc

putlin:	; Put line in TMPSTR to buffer or file at position curlin.
	; Destroyes: nothing

	push	<r0, r1, r2>
	call	adjbuf
	mov	r0, r1
	bne	10$
	mov	curlin(r5), r0
	mov	nolin(r5), r1
	bpt

10$:	mov	#tmpstr, r0
	call	movstr

	pop	<r2, r1, r0>
	rts	pc

hela:	; Write out the whole text
	; Destroyes: r0, r1, r2

	push	curlin(r5)

	mov	#1, curlin(r5)

100$:	cmp	curlin(r5), nolin(r5)
	bhi	140$
	call	linget
	call	wrttmp
	cmp	curlin(r5), nolin(r5)
	beq	120$			; Last line don't write CRLF

	call	PCRLF

120$:	inc	curlin(r5)
	br	100$

140$:	pop	curlin(r5)
	rts	pc


adjbuf:	; Adjust file buffer (FB1-FB2) according to curlin and frstln
	; Put and get from TMP file if necessary.
	; Return with r0 pointing to line in buffer.
	; Return with r0 set to zero if something is wrong
	; Destroyes: None

	cmp	curlin(r5), nolin(r5)	; Test if we have that many lines
	blos	100$			; Yes, we have
	clr	r0
	br	240$

100$:	mov	frstln(r5), r0		; Test if TMP file should be used
	cmp	curlin(r5), r0
	bhis	140$			; Yes, we're before buffer
	
120$:	sub	#BUFLEN/RECLEN, r0
	cmp	curlin(r5), r0
	blo	120$
	br	160$
	
140$:	add	#BUFLEN/RECLEN, r0
	cmp	curlin(r5), r0
	blo	220$			; Yes, we're in the buffer

160$:	push	<r1, r0>		; Get from file buffer adjust frstln.
	bit	#DWtTF, CSW(r5)		; Shall we put?
	bne	200$
	mov	frstln(r5), r0		; But put this block first
	add	#3, r0
	ash	#-2, r0			; Block number is now in r0!
	bit	#xDEB, MyFlag
	beq	180$
	push	r0
	mov	#'W, r0
	call	ttyout
	pop	r0
	bpt
180$:	mov	#xrb, r1
	mov	#BUFLEN, (r1)
	mov	(r1)+, (r1)+
	mov	bufptr(r5), (r1)+
	mov	#12*2, (r1)+
	mov	r0, (r1)
	.write
	call	ioerr
	call	clrbuf

200$:	pop	r0
	mov	r0, frstln(r5)
	add	#3, r0
	ash	#-2, r0

	gos	get <#-12, r0, bufptr(r5), #BUFLEN/1000,>
	pop	r1

220$:	mov	curlin(r5), r0		; Ok, now we have the right buffer
	sub	frstln(r5), r0
	ash	#7, r0			; Adjust for a length of 200 (128.)
	add	bufptr(r5), r0		; Add the offset!

240$:	rts	pc

adjnol:	; Adjust nolin(r5) if curlin(r5) > nolin(r5)
	; Destroyes: None

	cmp	curlin(r5), nolin(r5)
	blos	100$
	mov	curlin(r5), nolin(r5)

100$:	rts	pc

laggpa:	; Put the text in the data base

	push	<r2, r3, r4>
	call	Get1st
	mov	r3, fblk(r5)		; Block/Anders
	mov	r4, fpos(r5)		; Pos.
	
100$:	add	r1, r4			; r1 contains address of buffer.

	mov	#-1, r0			;+ 19-Mar-89 11:07:56 /AGN
	call	PutChr			; (New database format)
	call	PutChr			;
	neg	r0			; Texts begin with -1, 1. 
	call	PutChr			; 
	clr	r0			; 
	call	PutChr			;-	

	mov	nolin(r5), r3
	clr	curlin(r5)
	tst	iactiv(r5)		; interactive mode?
	bne	119$
	mov	stline(r5), curlin(r5)	; If not - start saving at line # 
					;   'stline'
	dec	curlin(r5)
119$:
	mov	r3, r0			; Save # of lines
	call	PutChr
	swab	r0
	call	PutChr
	
120$:	inc	curlin(r5)
	call	AdjBuf
	bis	#DWtTF, CSW(r5)		; Don't put from now on
	mov	r0, r1
	movb	(r1)+, r0
	call	PutChr
	mov	r0, r2
	beq	160$
140$:	movb	(r1)+, r0
	call	PutChr
	sob	r2, 140$
160$:	sob	r3, 120$		
	call	PutLst

	mov	fblk(r5), r0
	mov	fpos(r5), r1	
	pop	<r4, r3, r2>
	rts	pc

cmpbyt:	; "Byt (ut text)" Find and substitute text (within a line)
	; Destroys: r0, r1, r2

	push	curlin(r5)
	clr	repcnt(r5)		; Make replace count == 0

1$:	REPARS	#2, #byttxx		; Get 1st part (from: part)
	mov	#-1, line	
	bcs	40$
	mov	strs+2, r0
	mov	strs+4, r2
	sub	r0, r2
	cmp	r2, #XLEN
	blos	7$

5$:	write	#byttol			; String too long (>20 chars)
	br	1$

7$:	mov	#byt.fr, r1		; This ought to work better...
	add	r5, r1			; (It didn't - But THIS will!)
	movb	r2, (r1)+		; Make it a standard KOM string
	beq	40$			; Skip it if zero length

10$:	movb	(r0)+, (r1)+
	sob	r2, 10$	
	clrb	(r1)

	mov	#byt.fr, r1
	add	r5, r1
	call	discsp			; discard trailing spaces

	PARSER	#CMPMOT, #377, #BYTPRM	; Get 2nd part (with: part)
	mov	#-1, line
	call	PCRLF
	tst	level
	bne	20$

	clrb	PStr1
	
20$:	cmpb	PStr1, #XLEN
	bhi	5$			; String too long (>20 chars)

	mov	#PStr1, r1
	call	discsp
	push	r5
	add	#byt.to, r5
	movb	PStr1, r0
	clrb	PStr1+1(r0)
	mov	#PStr1, r0
25$:	movb	(r0)+, (r5)+
	bne	25$
	pop	r5
	mov	#1, curlin(r5)		; Line count
	clr	repcnt(r5)		; No replaces so far

30$:	cmp	curlin(r5), nolin(r5)
	bhi	40$
	call	linget
	call	100$			; Check for substitute
	bcc	35$

	call	putlin			; C set => line changed => save it

35$:	inc	curlin(r5)
	br	30$

40$:	mov	repcnt(r5), r1
	clr	r0
	call	deco16
	write	#replcd
	pop	curlin(r5)
	rts	pc

100$:	; Check for substitute
	push	r3
	clr	r3
	clr	r0
	bisb	tmpstr, r0		; Get current line length to r0
	clrb	tmpstr+1(r0)		; NUL-terminate it!
	mov	#tmpstr+1, r0		; make r0 point at the line

105$:	mov	#byt.fr+1, r1		; Make r1 point to the string to
	add	r5, r1			; search for

110$:	tstb	(r0)			; Null length line?
	beq	300$			; If so - exit with C clear
	call	match			; Check for match.
	bcs	120$			; C set indicates match!
	inc	r0			; Try match beginning at the next char
	br	110$

120$:	mov	r0, r2			; Here if match!

200$:	call	wrttmp			; Ask if we're going to substitute
	call	PCRLF
	push	tmpstr			; Save tmpstr's length 
	mov	r2, r4			; Kludge to make 'getlen' count
	sub	#tmpstr+1, r4		;   TABs etc for us
	beq	202$
	movb	r4, tmpstr
	call	getlen			; Set up r4 to width_on_screen of
	mov	#40, r0			;   line up to the point where r0 point
201$:	call	ttyout
	sob	r4, 201$		; Note: DO NOT use SPCOUT! It causes
202$:					;   TmpStr to be destroyed!
	pop	tmpstr
	mov	#'^, r0
	call	ttyout
	call	PCRLF
	call	putlin			; PARSER is fond of destroying TmpStr
	PARSER	#JANEJL, #1, #bytque
	call	PCRLF
	mov	#-1, line
	call	linget
	tst	level
	beq	210$			; Just CR means "Ja"
	mov	found, r1
	call	getadr
	tst	(r1)			; 
	bne	210$			; "Ja"

205$:	inc	r2
	mov	r2, r0
	br	105$			; Continue the search

210$:					; Here if OK to replace 
	mov	#1, r3			; Do it!  r2 ptr to str in tmpstr
	mov	r2, r0
	movb	byt.fr(r5), r1		; Get length of search string to r1
	add	r0, r1			; Make r1 point past end of found str

220$:	movb	(r1)+, (r0)+		; Remove the old string
;	tstb	(r1)
	bne	220$

;	mov	r2, r0
;230$:	tstb	(r0)+
;	bne	230$

	movb	byt.to(r5), r1		; Fetch length of string to 
					;   replace with
	add	r0, r1

240$:	movb	-(r0), -(r1)		; Make room for the new string
	cmp	r0, r2
	bne	240$

	mov	#byt.to+1, r1		; Get adress of string to replace
	add	r5, r1			;   with

250$:	tstb	(r1)			; Move in the new string
	beq	260$
	movb	(r1)+, (r0)+
	br	250$

260$:	push	r2
	movb	byt.to(r5), r1
	movb	byt.fr(r5), r2
	sub	r2, r1
	movb	tmpstr, r2
	add	r1, r2
	movb	r2, tmpstr
	clrb	tmpstr+1(r2)
	pop	r2
	inc	repcnt(r5)		; Yet another replace..
	br	105$

300$:	ror	r3			; Set or clear Carry
	pop	r3	
	rts	pc			; Done!


;+	MATCH - Check if the string pointed to by r1 matches 
; the one pointed to by r0.
; Both strings are stored in ASCIZ format.
;-
match:
	push	<r0, r1, r2, r3>
.rem %	
	push	<r1, r0>
	movb	#'|, r0
	call	ttyout
1$:	movb	(r1)+, r0
	beq	2$
	call	ttyout
	br	1$
2$:	movb	#'|, r0
	call	ttyout
	mov	(sp), r1
3$:	movb	(r1)+, r0
	beq	4$
	call	ttyout
	br	3$
4$:	mov	#'|, r0
	call	ttyout
	call	pcrlf
	pop	<r0, r1>	
%
10$:	tstb	(r1)
	beq	20$
	movb	(r0)+, r2
	movb	(r1)+, r3
	xor	r3, r2
	bic	#40, r2
;	bpt
;	cmpb	(r0)+, (r1)+
	beq	10$
	tst	(pc)+
20$:	sec
	pop	<r3, r2, r1, r0>
	rts	pc

discsp:	push	r0
	movb	(r1)+, r0
	add	r1, r0
10$:	cmp	r0, r1
	beq	30$
	cmpb	-(r0), #40
	blos	10$
	inc	r0
30$:	clrb	(r0)
	sub	r1, r0
;	bpt
	movb	r0, -(r1)
	pop	r0
	rts	pc

.rem	&
debug:	push	<r0, r1>
	mov	(r2)+, r1
	add	r5, r1
	call	strout
	call	pcrlf
	pop	<r1, r0>
	rts	r2

&
cmpbor:	; "(Ta) Bort (inl{gget)" Return from Compose without text

	tst	(sp)+
	clr	r0
	call	PCRLF
	jmp	endit

cmpsta:	; "B|rja om" Start all over again.

	tst	(sp)+
	bit	#HnE, CSW(r5)
	beq	80$
	mov	#1, curlin(r5)
	call	adjbuf
	mov	#tmpstr, r1
	call	movstr			; Get Header to tmpstr.
	br	100$
80$:	movb	#-1, tmpstr
100$:	jmp	again

cmpfil:	; "(L{gg in) fil" Read from a file
	call	putlin
	repars	#2, #WhtFil
	call	linget
	mov	#-1, line
	cmp	Level, #1
	beq	180$			; Just CR!
	call	clrfqb
	call	clrxrb
	mov	#^rTXT, firqb+fqext	; Default extension.
	mov	Strs+4, (r1)
	sub	Strs+2, (r1)
	mov	(r1)+, (r1)+
	mov	Strs+2, (r1)
edinfi	= .
	.fss
	call	Filerr			; Check for file errors and print
	bcs	180$
	movb	#opnfq, firqb+fqfun
	movb	chan(r5), firqb+fqfil
	aslb	firqb+fqfil
;	movb	#11*2, firqb+fqfil	; use channel 11 (9)
	calfip
	call	Filerr
	bcs	180$

; Entry for 'enter file'

entf	= .

	mov	#FB4+1000, r1
	clr	FB4-2

100$:	call	getchr
	bcs	160$			; EOF reached?
	tst	r0
	beq	100$			; Discard all nulls.
	cmp	r0, #cr	
	bne	120$
	call	getchr
	bcs	160$
	call	200$			; New line here!
	br	100$
	
120$:
;	cmpb	tmpstr, brewid(r5)	; Remove these comments to enable
;	blos	140$			; KOM to cut too long lines (insert
					; hyphens and so on)
;	call	200$			; New line
	
140$:	call	inschr
	br	100$

160$:	tst	iactiv(r5)		; interactive?
	beq	161$
	write	#atEOF
161$:	call	putlin
	clrb	firqb+fqfun
	movb	chan(r5), firqb+fqfil
	aslb	firqb+fqfil
;	movb	#11*2, firqb+fqfil
	calfip				; Close.
	call	linget
	call	wrttmp
180$:	rts	pc


200$:	call	putlin			; New line.
	inc	curlin(r5)
	call	adjnol
	clrb	tmpstr
	rts	pc

inschr:	movb	tmpstr, r4
	movb	r0, tmpstr+1(r4)
	incb	tmpstr
	rts	pc
	
getlen:	push	<r0, r1, r2>
	clr	r4
	mov	#tmpstr, r1
	movb	(r1)+, r0
	beq	40$
10$:	movb	(r1)+, r2
	cmp	r2, #11			; Tab?
	bne	20$
	add	#10, r4
	bic	#7, r4
	br	30$
20$:	inc	r4
30$:	sob	r0, 10$
40$:	pop	<r2, r1, r0>
	rts	pc

getchr:	cmp	r1, #FB4+1000
	blo	100$
	mov	#FB4-2, r1
	inc	(r1)
	mov	chan(r5), r0
	neg	r0			; Calculate negative channel # to use
	gos	get <r0, (r1)+, r1, #1,>	; C set if EOF
	bcs	120$
100$:	clr	r0
	bisb	(r1)+, r0
120$:	rts	pc


;+
; PutTxt Put header-fields in a special EXTERN node in File 3.
; Call:		r1 => Pointer to Text buffer to save.
; Return	r0 => Blk
;		r1 => Pos
;-

oPtTxt:	push	<r5, r4, r3, r2>
	mov	r1, r5

	call	Get1st
	mov	r3, -(sp)
	mov	r4, -(sp)
	add	r1, r4

	mov	#ExtHdr, r2
	mov	#6, r3
10$:	mov	(r2)+, r0
	call	PutChr
	swab	r0
	call	PutChr
	sob	r3, 10$
	mov	#4, r3
	mov	#OrgTxt, r2
20$:	movb	(r2)+, r0		; Save Text-number (long)
	call	PutChr
	sob	r3, 20$

	mov	(r5)+, r2		; Number of lines.
	mov	r2, r0
	call	PutChr
	swab	r0
	call	PutChr
30$:	clr	r3
	bisb	(r5)+, r3
	mov	r3, r0
	call	PutChr
40$:	movb	(r5)+, r0
	call	PutChr
	sob	r3, 40$
	inc	r5
	bic	#1, r5
	sob	r2, 30$
	call	putlst

	pop	<r1, r0>		; Position, Block #
	pop	<r2,r3,r4,r5>
	rts	pc	

	sect	texts,d

arende:	.str	<"[rende: ">
rubch:	.str	<<10>" "<10>>
ctrlz:	.str	<"^Z"<cr><lf>>
ctrlr:	.str	<"^R">
ctrlu:	.str	<"^U">
ctrlw:	.str	<"^W"<10><10>>
WhtFil:	.str	<"Filnamn ">
atEOF:	.str	<"Filen inlagd."<cr><lf>>
ERASTR:	.asciz	" **Fiske F|rbjudet** "
bytprm:	.str	<"Mot ">
byttxx:	.str	<"Vad skall bytas? ">	
bytque:	.str	<"Skall str{ngen bytas h{r? ">
byttol:	.str	<"Str{ngen {r f|r l}ng">
replcd:	.str	<" str{ngar utbytta"<cr><lf>>
ateot:	.str	<"Du st}r i slutet av texten."<cr><lf><lf>>

	.even

ExtHdr:	.word	-1
	.word	2
	.blkw0	4


	.even

	.end