// 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 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("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 ]