//		A L T O   E X E C U T I V E
//	Internal Exec Commands (2) - Rename.bcpl
// Copyright Xerox Corporation 1979

//	This program is loaded with the command
//	processor and implements some of the various internal
//	functions of the command processor.

//	E. McCreight
//	last edited by R. Johnsson, September 21, 1979  12:11 PM


get "sysdefs.d"
get "altofilesys.d"
get "disks.d"
get "streams.d"
get "time.d"
get "COMSTRUCT.bcpl"

external
	[
	Rename
	RenameFile
	LogIn
	QUERY
	]


let QUERY(ISTREAM, DSTREAM) be

	[ static [ FNCount ]

	let CiteName(MYDE, Y) = valof

		[ FNCount = FNCount+1
		resultis PRETTYWRITE(lv (MYDE>>MYDE.S))
		]

	let LQ = vec size QS/16
	let FNQ = vec size QS/16
	INITQ(LQ)
	INITQ(FNQ)

	STREAMTOQR(ISTREAM, LQ)
	XFERQWHILE(GETQR, PUTQR, LQ, PUTQF, FNQ, IsCommandChar)

	FNCount = 0

	INITDIRBLK(SORTED)
	MAPDIR(FNQ, CiteName, true)

	unless FNCount gr 0 do WRITE("No files.")

	WRITE($*N)
	EMPTYOUTQ(LQ)
	EMPTYOUTQ(FNQ)
	]


and ReadDN(Q) = valof

	[ let D = 0

	if ISEMPTYQ(Q) then resultis D
	let TermChar = GETQF(Q)

	until (TermChar ge $0 & TermChar le $9)
		do
		[ if ISEMPTYQ(Q) then resultis D
		TermChar = GETQF(Q)
		]

	while (TermChar ge $0 & TermChar le $9)
		do
		[ D = 10*D+TermChar-$0
		if ISEMPTYQ(Q) then resultis D
		TermChar = GETQF(Q)
		]

	PUTQF(Q, TermChar)
	resultis D
	]


and LogIn(IStream, DStream) be

	[ static
		[ IDStream
		PSB
		]


	let SToOs(S, OSString) be

		[ let MaxChars = 2*(OSString!(-1))-1
		if S>>STRING.length gr MaxChars then
			S>>STRING.length = MaxChars
		CONCATENATE(OSString, S)
		]

	let PutAStar(S, char) be

		[ Puts(IDStream, (ISFILECHAR(char)?
			$**, char))
		SetupFstream(S, PSB, 0, 0)
		]

	let S = vec 200

	GetStringFromKbd(S, UserName, "User Name: ", false)

	SToOs(S, UserName)

	let PStream = vec lFS
	let PSBuf = vec 2
	PSB = PSBuf
	InitializeFstream(PStream, charItem, PutAStar)
	SetupFstream(PStream, PSB, 0, 0)
	IDStream = DStream

	let UPS = vec 200
	WRITE("*NPassword: ")
	ReadString(UPS, "*N ", keys, PStream)
	if UPS!0 gr 0 then
		[ EvalParam(UPS, $P, -1, S)
		SToOs(S, UserPassword)
		]

	WRITE($*N)
	]


and GetStringFromKbd(String, Preload, Prompt, RemoveBlanks) be

	[ let TQ = vec size QS/16
	INITQ(TQ)
	GetQFromKbd(TQ, Preload, Prompt, RemoveBlanks)
	QFTOSTRING(TQ, String)
	EMPTYOUTQ(TQ)
	]


and GetQFromKbd(TQ, Preload, Prompt, RemoveBlanks) be

	[ let FQ = vec size QS/16
	INITQ(FQ)
	STRINGTOQR(Preload, FQ)

	EMPTYOUTQ(TQ)
	unless EDITCHARS(TQ, FQ, Prompt, true, "*N ", true) do
		[ WRITE($*N)
		return
		]

	WRITE($*N)
	GETQR(TQ)	// Remove carriage return

	if RemoveBlanks then
		until ISEMPTYQ(TQ) do
			[ let C = GETQR(TQ)
			if C ne $*S then
				[ PUTQR(TQ, C)
				break
				]
			]
	]


and Rename(IStream, DStream) be

	[ let FN = vec 200
	let Sw = vec 100

	SetupReadParam(FN, 0, IStream, Sw)

	let OldFN = vec 129
	let NewFN = vec 129
	GetTwoFileNames(OldFN, NewFN)
	let didit = false

	test EqualStrings(OldFN,NewFN)
	  ifso
		[
		let fn = vec size LD.name/16; Zero(fn,size LD.name/16)
		let dirname = vec 129
		SplitFileName(NewFN, dirname, fn)
		let dirS =  MyOpenFile(
			(dirname>>STRING.length eq 0? "SysDir", dirname),
			ksTypeReadWrite, wordItem, verLatest)
		if dirS ne 0 then
		    [
		    let pos = FindFdEntry(dirS,fn)
		    if pos ne -1 then
			[
			pos = pos + lDV
			let posH = pos ls 0 ? 1, 0
			SetFilePos(dirS,posH,pos lshift 1)
			for i = 0 to (fn>>STRING.length-1)/2 do
			    Puts(dirS,fn!i)
			didit = true
			let file = MyOpenFile(OldFN, ksTypeReadOnly)
			if file ne 0 then
			    [
			    let buf = vec 256
			    ReadLeaderPage(file,buf)
			    MoveBlock(lv buf>>LD.name,fn,size LD.name/16)
			    WriteLeaderPage(file,buf)
			    Closes(file)
			    ]
			]
		    Closes(dirS)
		    ]
 		]
	  ifnot
		[
		didit = RenameFile(OldFN,NewFN,verLatest,@lvSysErr,CZ)
		]
	WRITE(FORMATN("*300<S>*301 <S>renamed to *300<S>*301*n",
		OldFN,
		didit? "", "could not be ",
		NewFN))
	if didit then WIPEDIRBLK()
	]


and EqualStrings(S1, S2) = valof

	[ let lS1 = S1>>STRING.length
	let lS2 = S2>>STRING.length
	if lS1 ne lS2 then resultis false

	for i=1 to lS1 do
		[
		let c1 = Capitalize(S1>>STRING.char↑i)
		let c2 = Capitalize(S2>>STRING.char↑i)
		if c1 ne c2 then resultis false
		]
	resultis true
	]


and CopyString(ToString, FromString) be

	[ MoveBlock(ToString, FromString,
		(FromString>>STRING.length rshift 1)+1)
	]


and GetTwoFileNames(FromName, ToName) be

	[ GetName(FromName, "from: ")

	GetName(ToName, "to: ")

	if ToName!0 eq "←"!0 then
		[ CopyString(ToName, FromName)
		GetName(FromName, "from: ")
		]
	]


and GetName(Name, Prompt) be

	[ Name>>STRING.length = 0

	ReadParam($P, -1, Name)

	if Name>>STRING.length eq 0 then
		 GetStringFromKbd(Name, "", Prompt, true)
	]