// IfsTelnetDel.bcpl -- IFS server telnet Delete and Rename commands
// Copyright Xerox Corporation 1979, 1980, 1981, 1983

// Last modified September 25, 1983  2:00 PM by Taft

get "Ifs.decl"
get "IfsFiles.decl"
get "IfsDirs.decl"
get "IfsRs.decl"

external
[
// outgoing procedures
ExecDelete; ExecRename

// incoming procedures
CollectFilenames; NextFile; DestroyFGD; Subcommands; SetFGDLC
WhatChanged; CopyFD; PrintSubFilename
InitCmd; Confirm; GetNumber; GetString; EnableCatch; EndCatch; TerminatingChar
CreateKeywordTable; InsertKeyword; DestroyKeywordTable
TelnetCommandLoop; TelnetSubcommandPrompt; TelnetAborting; TelnetConfirm
LookupFD; NextFD; DestroyFD; DeleteFileFromFD
LookupIFSFile; IFSRenameFile
StringCompare; ExtractSubstring; ConcatenateStrings
SysAllocateZero; FreePointer; IFSPrintError; Block; Dismiss
Ws; Wss; Puts; Errors; Closes; Resets
SysFree; Zero; MoveBlock

// incoming statics
dsp; keys; CtxRunning
]

structure Options:
[
autoConfirm word	//automatically confirm each deletion
keep word		//number of versions to keep
			// -1 => delete one version only (usually lowest)
]
manifest lenOptions = size Options/16

//---------------------------------------------------------------------------
let ExecDelete(cs) be
//---------------------------------------------------------------------------
// Delete <file-designators> [, <subcommands> ]
[
Wss(cs, " (files) ")
let fgd = CollectFilenames(cs, lcVLowest+lcMultiple)

let options = vec lenOptions
Zero(options, lenOptions)
options>>Options.keep = -1
if Subcommands(fgd) then
   [
   let kt = CreateKeywordTable(5)
   InsertKeyword(kt, "Confirm")!0 = 1
   InsertKeyword(kt, "Keep")!0 = 2
   TelnetCommandLoop(kt, TelnetSubcommandPrompt(), true, options, 0, 0,
    DeleteSubcommand)
   DestroyKeywordTable(kt)
   ]

if options>>Options.keep ne -1 then
   SetFGDLC(fgd, lcVAll+lcMultiple)  // change default version to "*"

let lastFD, bfd = SysAllocateZero(lenFD), SysAllocateZero(lenFD)
let numVer = 0

until TelnetAborting() do
   [
   let fd = NextFile(fgd)
   if fd eq 0 break
   test options>>Options.keep le 0
      ifso
         DeleteOneFile(fd, lastFD, options)
      ifnot
         [
         if StringCompare(lv fd>>FD.dr>>DR.pathName,
          lv bfd>>FD.dr>>DR.pathName, 1, fd>>FD.lenBodyString,
          1, bfd>>FD.lenBodyString) ne 0 then
            [ CopyFD(bfd, fd); numVer = 0 ]
         numVer = numVer+1
         if numVer gr options>>Options.keep then
            [
            if LookupFD(bfd) eq 0 then DeleteOneFile(bfd, lastFD, options)
            bfd>>FD.template = fd>>FD.template  // so NextFD will work
            NextFD(bfd)
            fd>>FD.template = bfd>>FD.template  // just in case NextFD deleted it
            bfd>>FD.template = 0
            ]
         ]
   Block()
   ]

DestroyFD(lastFD); DestroyFD(bfd)
DestroyFGD(fgd)
]

//---------------------------------------------------------------------------
and DeleteOneFile(fd, lastFD, options) be
//---------------------------------------------------------------------------
// Assumes directory is not locked
[
if WhatChanged(fd, lastFD) eq 0 then
   [ Puts(dsp, $*n); PrintSubFilename(dsp, fd, 1, fd>>FD.lenSubDirString) ]
let cs = options>>Options.autoConfirm? dsp, InitCmd(150, 1)
if cs eq 0 return
Wss(cs, "*n  ")
PrintSubFilename(cs, fd, fd>>FD.lenSubDirString+1)
unless options>>Options.autoConfirm do
   [
   let ok = Confirm(cs)
   Closes(cs)
   unless ok return
   ]

let deleteUndeletable = false

   [ // repeat
   let ec = DeleteFileFromFD(fd, deleteUndeletable)
   if ec ne 0 then
      [ Ws(" -- not deleted:*n   "); IFSPrintError(dsp, ec) ]
   unless ec eq ecFileUndeletable &
    CtxRunning>>RSCtx.userInfo>>UserInfo.capabilities.wheel return

   Ws("*n   But because you are enabled, you may delete it anyway.")
   Ws("*n   Are you really sure you want to do this?")
   Dismiss(50)  // 0.5 second
   Resets(keys)
   unless TelnetConfirm() return
   deleteUndeletable = true
   ] repeat
]

//---------------------------------------------------------------------------
and DeleteSubcommand(cs, entry, options) be
//---------------------------------------------------------------------------
[
switchon entry!0 into
   [
   case 1:
      Wss(cs, " (all deletes automatically)")
      options>>Options.autoConfirm = true
      endcase
   case 2:
      Wss(cs, " (# of versions) ")
      options>>Options.keep = GetNumber(cs)
      endcase
   ]
]

//---------------------------------------------------------------------------
and ExecRename(cs) be
//---------------------------------------------------------------------------
// Rename <existing-file> <new-file>
[
Wss(cs, " (existing file) ")
let oldName, oldNameBody, newName = 0, 0, 0
if EnableCatch(cs) then
   [ FreePointer(lv oldName, lv oldNameBody, lv newName); EndCatch(cs) ]
oldName = GetString(cs, 0, Wss, "filename")
let fd = LookupIFSFile(oldName, lcVHighest)
if fd eq 0 then Errors(cs, 0)
oldNameBody = ExtractSubstring(lv fd>>FD.dr>>DR.pathName,
 fd>>FD.lenSubDirString+1, fd>>FD.lenBodyString-1)
DestroyFD(fd)

Wss(cs, " (to be) ")
newName = GetString(cs, 0, Wss, "filename")
if TerminatingChar(cs) eq 33B then  // ESC -- append body of old name
   [
   Ws(oldNameBody)
   newName = ConcatenateStrings(newName, oldNameBody, true)
   ]
let ec = nil
unless IFSRenameFile(oldName, newName, lv ec) do
   [ Ws("*nFailed: "); IFSPrintError(dsp, ec) ]
FreePointer(lv oldName, lv oldNameBody, lv newName)
]