//		A L T O   E X E C U T I V E
//	User Input Module - ExecInput.bcpl
// Copyright Xerox Corporation 1980

//	last modified by R. Johnsson, May 21, 1980  10:27 PM




get "streams.d"
get "altofilesys.d"
get "COMSTRUCT.BCPL"

static [
	ShouldFlash = false
	]


let Cancel() = LASTONEINKEYS(CONTROLC) ne 0


and EDITCHARS(TOQ, FROMQ, PROMPT, OKFORTIMEOUT,
		Terminators, OverwritePreload;
		numargs na) = valof

	[ if PROMPT ne 0 then InitUserLine(PROMPT)

	if na ls 6 then OverwritePreload = false
	let InPreload = not ISEMPTYQ(FROMQ)

	let C = GNC(FROMQ, 
		(na gr 3? OKFORTIMEOUT, true)&
			ISEMPTYQ(TOQ))

	[ if (na le 4)?
		C eq $*N,
		valof	[ for i=1 to Terminators>>STRING.length do
				if C eq Terminators>>STRING.char↑i then
					resultis true
			resultis false
			]
		then
		[ PUTQR(TOQ, C)
		resultis true
		]

	switchon C into
		[ case NULL:	endcase

		case CONTROLA:
		case BACKSPACE:
			test ISEMPTYQ(TOQ)

			ifso if PROMPT ne 0 then
				[ WRITE($?)
				InitUserLine(PROMPT)
				]

			ifnot	[ let char = GETQR(TOQ)
				if PROMPT ne 0 then
				    unless EraseChar(char) do
					OverType(TOQ, PROMPT)
				]

			endcase

		case CONTROLW:
			DeleteWord(TOQ, PROMPT)
			endcase

		case $↑:
		case $':
			if PROMPT ne 0 then WRITE(C)
			PUTQR(TOQ, C)
			C = GNC(FROMQ, false)
			if PROMPT ne 0 then WRITE(C)
			PUTQR(TOQ, C)
			endcase

		case CONTROLU:
			CALLBRAVO = true
			endcase

		case CONTROLX:
			[ let MYBQ = vec size QS/16
			INITQ(MYBQ)
			APPENDQ(MYBQ, MYBQ, TOQ)
			PUTQR(MYBQ, $*N) // Add CR for EXPAND

			INITQ(TOQ)
			unless EXPAND(TOQ, MYBQ, true) do
				resultis false
			GETQR(TOQ) // Remove added CR
			RETYPE(TOQ, WRITE, PROMPT)
			]
			endcase

		case CONTROLC:
			if PROMPT ne 0 then WRITE(CONTROLC)
			resultis false

		case DELETEKEY:
			EMPTYOUTQ(TOQ)
			CALLBRAVO = false

			if PROMPT ne 0 then
				[ WRITE("*SXXX")
				InitUserLine(PROMPT)
				]

			endcase

		case ESCAPE:
			[ let REMQ = vec size QS/16
			INITQ(REMQ)

			test EXPANDESC(TOQ, REMQ, true) ne 1
			ifso	ShouldFlash = true
			ifnot	PUTQR(REMQ, CONDSP)

			APPENDQ(FROMQ, REMQ, FROMQ)
			]
			endcase

		case CONDSP:
			C = GNC(FROMQ, false)
			if ISFILECHAR(C) & (C ne $!) & (C ne $$) then
				[ if PROMPT ne 0 then
					WRITE($*S)

				PUTQR(TOQ, $*S)
				]
			loop

		case $*T:
		case $?:
			[ if PROMPT ne 0 then
				WRITE($?)

			let MYQ = vec size QS/16
			INITQ(MYQ)
			PUTQR(MYQ, $?)
			let S = vec 20
			let DE = GETSUBSYS(MYQ, S, ";")

			EMPTYOUTQ(MYQ)
			COPYQ(TOQ, MYQ)
			QFToComCm(MYQ)
			CALLIFLOCAL(DE)
			if C eq $*T then
				XFERQWHILE(GETQR, PUTQR,
					TOQ, PUTQF, MYQ,
					IsCommandChar)
			EMPTYOUTQ(MYQ)
			InitUserLine(PROMPT)
			MapQ(TOQ, WRITE)
			]
			endcase

		case $*L:
		case 201b:
		case 202b:
		case 203b:
			[ let filename = nil
			test C eq $*L ifso filename = "Line.cm"
			ifnot
			  [ let num = C - 200b
			  filename = "Key0.cm"
			  filename>>STRING.char↑4 = num + $0
			  ]
			let s = MyOpenFile(filename, ksTypeReadOnly, charItem)
			if s eq 0 then endcase
			until Endofs(s) do
			  [
			  let c = Gets(s)
			  if PROMPT ne 0 then WRITE(c)
			  PUTQR(TOQ, c)
			  ]
			Closes(s)
			endcase
			]

		default:
			if (not InPreload) & OverwritePreload then
				[ EMPTYOUTQ(TOQ)
				if PROMPT ne 0 then
					OverType(TOQ, PROMPT)
				]

			if PROMPT ne 0 then
				WRITE(C)
			PUTQR(TOQ, C)
		]

	unless InPreload do OverwritePreload = false
	InPreload = not ISEMPTYQ(FROMQ)
	C = GNC(FROMQ, OKFORTIMEOUT&ISEMPTYQ(TOQ))
	] repeat

	]


and RemoveUpArrows(Q) be

	[ let DestQ = vec size QS/16
	INITQ(DestQ)

	until ISEMPTYQ(Q) do

		[ let C = GETQF(Q)

		if C eq $↑ then
			[ DIDEXPAND = true
			unless ISEMPTYQ(Q) do C = GETQF(Q)
			loop
			]

		if C eq $' then
			[ DIDEXPAND = true
			unless ISEMPTYQ(Q) do C = GETQF(Q)
			]

		PUTQR(DestQ, C)
		]
	APPENDQ(Q, DestQ, Q)
	]


and GNC(Q, OKFORTIMEOUT) = ISEMPTYQ(Q)? valof

	[ if ShouldFlash then
		[ FlashScreen()
		ShouldFlash = false
		]

	if Endofs(keys) then
		TwiddleThumbs(OKFORTIMEOUT? Q, 0)
	unless ISEMPTYQ(Q) resultis GETQF(Q)
	resultis Gets(keys)
	] , GETQF(Q)


and DeleteWord(Q, PROMPT) be

	[ if ISEMPTYQ(Q) then
		[ if PROMPT ne 0 then
			[ WRITE($?)
			InitUserLine(PROMPT)
			]
		return
		]

	let C = GETQR(Q)
	let erasing = true

	until ISEMPTYQ(Q) % IsCommandChar(C) do
		[ if erasing then erasing = EraseChar(C)
		C = GETQR(Q)
		]
	if ISEMPTYQ(Q) then
		[ if erasing then erasing = EraseChar(C)
		if PROMPT ne 0 & (not erasing) then OverType(Q, PROMPT)
		return
		]

	until ISEMPTYQ(Q) % ISNTFILECHAR(C) do
		[ if erasing then erasing = EraseChar(C)
		C = GETQR(Q)
		]

	test IsCommandChar(C)
	    ifso if erasing then erasing = EraseChar(C)
	    ifnot PUTQR(Q, C)

	if PROMPT ne 0 & (not erasing) then OverType(Q)
	]


and EXPAND(LQ, BQ, FULLBUF; numargs NA) = valof

	[ if NA ls 3 then FULLBUF = false

	if ISEMPTYQ(BQ) then resultis true
	let C = GETQF(BQ)
	let INFILENAME = false
	let HASASTAR = false
	[ if HASASTAR & (not ISITEMCHAR(C)) do
		[ EXPANDSTAR(LQ)
		HASASTAR = false
		DIDEXPAND = true
		]

	switchon C into
		[ case $;:
		case $*N:
			if INFILENAME then
				[ PUTQF(BQ, C)
				PUTQF(BQ, $@)	// Convenience
				endcase
				]

			test FULLBUF

			ifso	[ PUTQR(LQ, C)
				]

			ifnot	[ PUTQR(LQ, $*N)

				until ISEMPTYQ(BQ) do
					[ let NC = GETQF(BQ)
					if (NC ne $*N) & (NC ne $;)
						then
						[ PUTQF(BQ, NC)
						break
						]
					]

				resultis true
				]
			endcase


		case $↑:
		case $':	PUTQR(LQ, C)
				PUTQR(LQ, GETQF(BQ))
				endcase

		case $/:	C = GETQF(BQ)
				test C eq $/
					ifso	[ while (C ne $*N) &
							(C ne $;) do
							C = GETQF(BQ)
						]
					ifnot PUTQR(LQ, $/)
				loop
				endcase

		case $@:
			INFILENAME = not INFILENAME
			test INFILENAME
			ifso PUTQR(LQ, $@)
			ifnot	[ let EXPQ = vec size QS/16
				INITQ(EXPQ)

				unless SUBSTFILE(LQ, EXPQ) do
						resultis 0

				test FULLBUF
				ifso APPENDQ(LQ, LQ, EXPQ)
				ifnot APPENDQ(BQ, EXPQ, BQ)
				]

			endcase

		case $**:
		case $#:	PUTQR(LQ, C)
				HASASTAR = true
				endcase

		default:	PUTQR(LQ, C)
		]

	if ISEMPTYQ(BQ) then
		[ if HASASTAR then
			[ EXPANDSTAR(LQ)
			DIDEXPAND = true
			]
		resultis true
		]

	if ISEMPTYQ(BQ) then resultis true
	C = GETQF(BQ)
	] repeat
	]


and SUBSTFILE(LQ, Q) = valof

	[ if LOOKFORCTLC() then resultis false

	let FNQ = vec size QS/16
	INITQ(FNQ)
	let C = GETQR(LQ)
	while C ne $@ do
		[ PUTQF(FNQ, C)
		C = GETQR(LQ)
		]

	let STR = vec 200

	let MYDE = GETSUBSYS(FNQ, STR, ".CM.;**.CM.;.;**.")

	EMPTYOUTQ(FNQ)

	let V = true
	switchon MYDE into

	[ default: if (MYDE>>MYDE.TYPE eq ISFILE) then
			[ let FILE =
				MyOpenFile(STR, ksTypeReadOnly,
					charItem)

			STREAMTOQR(FILE, FNQ)
			Closes(FILE)
			APPENDQ(Q, FNQ, Q)

			INITQ(FNQ)
			PUTQR(Q, $*N)	// To make EDITCHARS stop
			EDITCHARS(FNQ, Q, 0, false)
			APPENDQ(Q, FNQ, Q)
			GETQR(Q)	// Removes extra CR
			endcase
			]

	case NONAME:
	case NOFILE:
		WRITE(FORMATN(
			"*NFile name *"<S>*" unknown. Type what it would contain.",
				STR))

		V = ASKUSER(FNQ)

		unless ISEMPTYQ(FNQ) do GETQR(FNQ)  // Remove final
							// CR
		APPENDQ(Q, FNQ, Q)
		endcase

	]

	DIDEXPAND = true
	resultis V
	]


and ASKUSER(Q) = valof

	[ Resets(keys)	// FLUSH KBD

	let MYQ = vec size QS/16
	INITQ(MYQ)

	resultis EDITCHARS(Q, MYQ, ">>", false)
	]


and ISNTITEMCHAR(C) = not ISITEMCHAR(C)