// IfsMailCompose.bcpl -- Compose a mail file
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified April 9, 1982  12:38 PM by Taft

get "Ifs.decl"
get "IfsDirs.decl"
get "IfsMail.decl"
get "AltoFileSys.d"
get "IfsRs.decl"

external
[
// outgoing procedures
StartMsg; WriteMNB; FinishMsg

// incoming procedures from other mail modules
AppendRegistry

// incoming procedures from Streams
WriteBlock; SetFilePos; FilePos; FileLength; Closes; Puts

// incoming procedures from Dirs
IFSOpenFile; CloseIFSStream; CloseIFSFile; DeleteFileFromFD
DestroyFD

// incoming procedures - misc
SysAllocateZero; SysFree; MailStat; IFSError; DiskToDisk
DefaultArgs; Zero; MoveBlock; ReadCalendar
DoubleSubtract

// incoming statics
mail; ndbQ; infoVMD; CtxRunning
]

// let msg = StartMsg("firstRecipient", "sender")
// if msg ne 0 then
//    [
//    let stream = msg!0
//    WriteMNB(msg, mbTypeMlbx, "secondRecipient")
//    Wss(stream, "To: firstRecipient, secondRecipient")
//    Wss(stream, "*NFrom: sender")
//    Wss(stream, "*NDate: "); WRITEUDT(stream, 0, true)
//    Wss(stream, "*NSubject: Example*N")
//    Wss(stream, "This is an example of how to compose a message")
//    FinishMsg(msg, true)
//    ]

//----------------------------------------------------------------------------
let StartMsg(mlbx, sndr, lvEc; numargs na) = valof
//----------------------------------------------------------------------------
// Builds an Msg structure, and starts a new version of <Mail>New>Mail.
// If mlbx or sndr is supplied, appends MNBs for them to the file.
// If it fails to open the file, lvEc is the error code.
[
if na ls 1 then mlbx = 0
if na ls 2 then sndr = 0
if na ls 3 then lvEc = lv na

// use mail identity to create the file.
let ui = CtxRunning>>RSCtx.userInfo
CtxRunning>>RSCtx.userInfo = mail>>Mail.ui
let stream = IFSOpenFile("<Mail>New>Mail!n", lvEc, modeAppend)
CtxRunning>>RSCtx.userInfo = ui
if stream eq 0 resultis 0

let msg = SysAllocateZero(lenMsg)
msg>>Msg.stream = stream
WriteBlock(stream, lv msg>>Msg.mh, lenMH)
FilePos(stream, lv msg>>Msg.posBlk)
FilePos(stream, lv msg>>Msg.posTxt)
if mlbx ne 0 then WriteMNB(msg, mbTypeMlbx, mlbx)
if sndr ne 0 then WriteMNB(msg, mbTypeSndr, sndr)
resultis msg
]

//----------------------------------------------------------------------------
and WriteMNB(msg, type, name, ec; numargs na) be
//----------------------------------------------------------------------------
// Appends a name block to 'msg'.  Assumes the stream is positioned
//  at the proper place (i.e. at the end of a previous block or at
//  Msg.posBlk if this is the first one.
[
DefaultArgs(lv na, -3, 0)

// if name is unqualified, then append our registry
let dot = 0
for i = name>>String.length to 1 by -1 do
   if name>>String.char↑i eq $. then [ dot = i; break ]
if dot eq 0 then name = AppendRegistry(name)
let lenName = name>>String.length rshift 1 +1

let mnb = vec lenMNBHdr; Zero(mnb, lenMNBHdr)
mnb>>MNB.type = type
mnb>>MNB.length = lenMNBHdr + lenName
mnb>>MNB.ec = ec

let stream = msg>>Msg.stream
if type eq mbTypeSndr then FilePos(stream, lv msg>>Msg.posSndr)
WriteBlock(stream, mnb, lenMNBHdr)
WriteBlock(stream, name, lenName)
FilePos(stream, lv msg>>Msg.posTxt)

if dot eq 0 then SysFree(name)
unless type eq mbTypeFree % type eq mbTypeSndr do
   msg>>Msg.numActive = msg>>Msg.numActive +1
]

//----------------------------------------------------------------------------
and FinishMsg(msg, ok) = valof
//----------------------------------------------------------------------------
// Finishes off the file described by 'msg', and then destroys msg.
//  If 'ok' is true the header is finished and the stream closed.
//   Assumes the file is positioned at the end of the text area.
//  If 'ok' is false the file is destroyed.
[
let stream = msg>>Msg.stream
test ok
   ifso  //finish off the header and close the file
      [
      let lenTxt = lv msg>>Msg.lenTxt
      if (FilePos(stream, lenTxt) & 1) eq 1 then Puts(stream, 0)  //pad
      DoubleSubtract(lenTxt, lv msg>>Msg.posTxt)
      MailStat(msTypeLen, lenTxt)
      let v = vec 1; v!0 = 0; v!1 = msg>>Msg.numActive
      MailStat(msTypeMlbx, v)
      ReadCalendar(lv msg>>Msg.date)
      FilePos(stream, lv msg>>Msg.posEnd)
      SetFilePos(stream, lv msg>>Msg.posBegin)
      msg>>Msg.version = mhVersion
      msg>>Msg.seal = mhSeal
      WriteBlock(stream, lv msg>>Msg.mh, lenMH)
      FileLength(stream)  //so Closes doesn't truncate
      Closes(stream)
      //wake up mail process
      mail>>Mail.workToDo = true
      ]
   ifnot  //destroy the file
      [
      let fd = CloseIFSStream(stream, true)  // leave file locked
      if DeleteFileFromFD(fd, false, true) ne 0 then CloseIFSFile(fd)
      DestroyFD(fd)
      ]
SysFree(msg)
resultis 0
]