#-h- msgcbl          4355 asc 21-oct-80 16:14:41
#-h- msgsym          1591 asc 21-oct-80 16:11:32
 define(ANSWERCOM,LETA)
 define(BACKUPCOM,LETB)
 define(CURRENTCOM,LETC)
 define(DELETECOM,LETD)
 define(EXITCOM,LETE)
 define(FORWARDCOM,LETF)
 define(GOTOCOM,LETG)
 define(HEADERCOM,LETH)
 define(INFOCOM,LETI)
 define(JUMPCOM,LETJ)
 define(LISTCOM,LETL)
 define(MOVECOM,LETM)
 define(NEXTCOM,LETN)
 define(OVERCOM,LETO)
 define(PUTCOM,LETP)
 define(QUITCOM,LETQ)
 define(READCOM,LETR)
 define(SNDMSGCOM,LETS)
 define(TYPECOM,LETT)
 define(UNDELETECOM,LETU)
 define(WRITECOM,LETW)
 define(NEWSCOM,SHARP)
 define(HELPCOM,QMARK)
 define(INTROCOM,PERCENT)
 define(DELETE,LETD)
 define(SAVE,LETS)
 define(MAXHEADERS,40)
 define(MSGNUMBERS,DIG0)
 define(FROMSEARCH,LETF)
 define(SUBJECTSEARCH,LETS)
 define(SEPARATOR,COLON)
 define(ALLPAT,LETA)
 define(CTRLM,13)
 define(NOCONFIRM,LETN)
 define(CTRLJ,10)
 define(CTRLX,24)			# flush message sequence
 define(MAXFROMSIZE,20)
 define(MAXSUBJSIZE,30)
 define(MAXDATESIZE,12)
 define(PATSIZE,20)
 define(MSGNUMBWIDTH,4)
 define(MSGSIZEWIDTH,6)
 define(MSGDATEWIDTH,14)
 define(MSGFROMWIDTH,20)
 define(EOT,26)
 define(BACKSPACE,8)
 define(RUBOUT,127)
 define(LINEDELETE,21)			# CTRLU
 define(RETYPELINE,18)			# CTRLR
 define(FIRSTMSG,LETF)
 define(LASTMSG,LETL)
 define(MSGNOCHAR,SHARP)
 define(MSGSIZECHAR,STAR)
 define(SCRATCHSIZE,75)
 define(FORMFEED,12)
 define(NOTIFY,YES)
 define(NONOTIFY,NO)
 define(HLPPTRSIZE,30)
 define(PAGESIZE,22)
 define(NOPAGING,-1)
 define(LISTHEADERS,YES)
 define(NOLISTHEADERS,NO)
 define(NULLCHAR,8%200)		# null with high bit set, so != EOS
 define(MAXPAD,7)
 define(MINPAD,0)
 define(DEFPAD,5)
 define(ESCAPE,27)
#-h- msgscr           144 asc 08-may-80 12:47:28
 common / msgscr / buf(MAXLINE), scrfil(FILENAMESIZE)

 character buf		# scratch buffer for io
 character scrfil	# scratch array for file names
#-h- chdrs            527 asc 08-may-80 12:47:28
 common / chdrs / hsize(MAXHEADERS),
		  haddr(MAXHEADERS),
		  rdate(MAXHEADERS),
		  hdate(MAXDATESIZE, MAXHEADERS),
		  hfrom(MAXFROMSIZE, MAXHEADERS),
		  hsubj(MAXSUBJSIZE, MAXHEADERS),
		  hdele(MAXHEADERS)

 integer hsize		# size of message in characters
 linepointer haddr	# address of header line for message
 real rdate		# real number representing date for sorting
 character hdate	# date string
 character hfrom	# from string
 character hsubj	# subject string
 character hdele	# if message has been deleted; init=NO
#-h- chelp            215 asc 08-may-80 12:47:29
 common / chelp / size, name(FILENAMESIZE), buf(MAXLINE)

 integer size		# return size of entry from gethdr
 character name		# return name of entry from gethdr
 character buf		# buffer for reading help archive file
#-h- cmhelp           239 asc 08-may-80 12:47:30
 common / cmhelp / hlpint, hlpptr(HLPPTRSIZE), hlpscr(HLPPTRSIZE)

 integer hlpint		# unit for help file; init = ERR
 linepointer hlpptr	# pointers into help file for headers
 linepointer hlpscr	# scratch array of line pointers for dohelp
#-h- cmline           101 asc 08-may-80 12:47:31
 common / cmline / linara(MAXHEADERS)

 integer linara		# array of messages used by various commands
#-h- cmsg            1055 asc 08-may-80 12:47:32
 common / cmsg / nmsgs, curmsg, unit, defalt, rawin, rawout, pagesz, tdate,
		 home(FILENAMESIZE), file(FILENAMESIZE),
		 scrat(FILENAMESIZE), hdrpat(4),
		 frompt(PATSIZE), subjpt(PATSIZE),
		 datept(PATSIZE)

 integer nmsgs		# number of messages found in file
 integer curmsg		# current message number - set to 1 on read
 integer unit		# rat4 unit number of input file
 integer defalt		# YES if reading mymail, NO otherwise
 integer rawin		# result of rawmod call for STDIN
 integer rawout		# result of rawmod call for STDOUT
 integer pagesz		# set to screen size; PAGESIZE if rawin==rawout==RAW
			# used by dohead, dotype, dogoto, goback, donext
			# set by msgint
 real tdate		# real expression for current date
 character home		# home directory string
 character file		# name of current file
 character scrat	# scratch file to use on E/O commands
 character hdrpat	# string for pattern starting each message (^A^A^J)
 character frompt	# pattern to match from:
 character subjpt	# pattern to match subject:
 character datept	# pattern to match date:
#-h- ccrlf             91 asc 20-oct-80 17:28:37
 common / crlf / crlf(10)

 character crlf		# array to map NEWLINES into including padding
#-h- msgdrv.q          61 asc 07-may-80 12:25:06
 include msgsym

# call initr4
# call msg
# call endr4
# end
#-h- msgs.q           603 asc 07-may-80 12:25:08
# subroutine msg
 subroutine main

 integer rawmod, status, msgcmd
 character c, clower, getch

 include chdrs
 include cmsg

 string pstr "<- "

 rawin = rawmod(STDIN, RAW)
 rawout = rawmod(STDOUT, RAW)
 call msgint
 repeat
    {
    call mputch(NEWLINE, STDOUT)
    call ptmlin(pstr, STDOUT)
    repeat
        {
        c = getch(c, STDIN)
        if (c == EOT | c == EOF)
            break
        if (c == CTRLM)
	    c = NEXTCOM
        }
    until (c != NEWLINE)
    if (c == EOT | c == EOF)
	break
    c = clower(c)
    status = msgcmd(c)
    }
 until (status == EOF)
 call msgend

 return
 end
#-h- banner.q         217 asc 11-apr-80 14:29:09
 subroutine banner

 integer mrkhlp
 external ptmlin

 include cmhelp

 string bannst "banner"

 if (mrkhlp(hlpint, hlpptr, bannst, hlpscr) == OK)
    call puthlp(hlpint, hlpscr, bannst, STDOUT, ptmlin)

 return
 end
#-h- curfil.q         156 asc 20-oct-80 22:47:52
 subroutine curfil(int)

 include cmsg

 string filstr " file '"

 call ptmlin(filstr, int)
 call ptmlin(file, int)
 call mputch(SQUOTE, int)

 return
 end
#-h- delemf.q         193 asc 11-apr-80 14:29:12
 subroutine delemf(linara)

 integer linara(MAXHEADERS), i, n

 include chdrs

 for (i=1; i < MAXHEADERS & linara(i) != 0; i=i+1)
    {
    n = linara(i)
    hdele(n) = YES
    }

 return
 end
#-h- doansw.q        1237 asc 21-oct-80 16:36:59
 integer function doansw(x)

 character x, tfile(FILENAMESIZE)
 integer n, out, i
 integer gmsgno, create, getlin, match, index

 include chdrs
 include cmsg
 include msgscr

 string str "answer"
 string ans "ans"
 string sndmsg "sndmsg"
 string minust " -t"
 string minuss ' "-sRe: '
 string minusr ' "-rYour message of '
 string spnerr "  Error spawning sndmsg  "

 call ptmlin(str, STDOUT)
 if (gmsgno(n) == ERR)
    doansw = ERR
 else
    {
    call scratf(ans, tfile)
    out = create(tfile, WRITE)
    if (out != ERR)
	{
	call seek(haddr(n), unit)
	for (i=getlin(buf,unit); i > 1 & i != EOF; i=getlin(buf,unit))
	    {
	    call fold(buf)
	    if (match(buf, frompt) == YES)
		break
	    }
	i = index(buf, BLANK) + 1
	call skipbl(buf, i)
	call scopy(buf, i, buf, 1)
	call putlin(buf, out)
	call close(out)
	i = 1
	call stcopy(sndmsg, 1, buf, i)
	call stcopy(minust, 1, buf, i)
	call stcopy(tfile, 1, buf, i)
	call stcopy(minuss, 1, buf, i)
	call stcopy(hsubj(1,n), 1, buf, i)
	call chcopy(DQUOTE, buf, i)
	call stcopy(minusr, 1, buf, i)
	call stcopy(hdate(1,n), 1, buf, i)
	call chcopy(DQUOTE, buf, i)
	if (spwnit(buf) == ERR)
	    call ptmlin(spnerr)
	call remove(tfile)
	doansw = OK
	}
    else
	doansw = ERR
    }

 return
 end
#-h- doback.q         373 asc 11-apr-80 14:29:15
 integer function doback(linara)

 integer linara(MAXHEADERS)

 include cmsg

 string str "backing up - previous message is:"
 string errmsg "cannot backup past message 1"

 call ptmlin(str, STDOUT)
 if (curmsg > 1)
    {
    curmsg = curmsg - 1
    call onemsg(curmsg)
    doback = OK
    }
 else
    {
    call ptmlin(errmsg, STDOUT)
    doback = ERR
    }

 return
 end
#-h- docurr.q         444 asc 11-apr-80 14:29:16
 integer function docurr(x)

 character x, temp(5)
 integer itoc
 integer junk

 include cmsg

 string ofs " of"
 string msgs " messages in"
 string str "current message is"

 data temp(1) /BLANK/

 call ptmlin(str, STDOUT)
 junk = itoc(curmsg, temp(2), 4)
 call ptmlin(temp, STDOUT)
 call ptmlin(ofs, STDOUT)
 junk = itoc(nmsgs, temp(2), 4)
 call ptmlin(temp, STDOUT)
 call ptmlin(msgs, STDOUT)
 call curfil(STDOUT)
 docurr = OK

 return
 end
#-h- dodele.q         244 asc 11-apr-80 14:29:18
 integer function dodele(linara)

 integer linara(MAXHEADERS)
 integer msgseq

 string str "delete"

 call ptmlin(str, STDOUT)
 if (msgseq(linara) == ERR)
    dodele = ERR
 else
    {
    call delemf(linara)
    dodele = OK
    }

 return
 end
#-h- doexit.q         397 asc 20-oct-80 22:47:54
 integer function doexit(linara)

 integer linara(MAXHEADERS), status
 integer savemf, gtconf

 string str "exit and update old"
 string errmsg "@n? Can't update mail file."

 call ptmlin(str, STDOUT)
 call curfil(STDOUT)
 if (gtconf(status) == NO)
    doexit = ERR
 else if (savemf(linara) == ERR)
    {
    call ptmlin(errmsg, STDOUT)
    doexit = ERR
    }
 else
    doexit = EOF

 return
 end
#-h- doforw.q         932 asc 20-oct-80 13:53:36
 integer function doforw(x)

 character x, file(FILENAMESIZE)
 integer linara(2), i, int
 integer gmsgno, create, spwnit

 include msgscr

 string str "forward"
 string fwd "fwd"
 string start "----- Start of forwarded message -----"
 string null ""
 string stop "------ End of forwarded message ------"
 string sndmsg "sndmsg"
 string minusm " -m"
 string spnerr "  Error spawning sndmsg!"

 data linara(2) /0/

 call ptmlin(str, STDOUT)
 if (gmsgno(i) == ERR)
    doforw = ERR
 else
    {
    linara(1) = i
    call scratf(fwd, file)
    int = create(file, WRITE)
    if (int != ERR)
	{
	call ptmlin(start, int)
	call putmf(null, linara, int, NOPAGING)
	call ptmlin(stop, int)
	call close(int)
	i = 1
	call stcopy(sndmsg, 1, buf, i)
	call stcopy(minusm, 1, buf, i)
	call scopy(file, 1, buf, i)
	if (spwnit(buf) == ERR)
	    call ptmlin(spnerr, STDOUT)
	call remove(file)
	doforw = OK
	}
    else
	doforw = ERR
    }

 return
 end
#-h- dogoto.q         259 asc 11-apr-80 14:29:21
 integer function dogoto(x)

 character x
 integer gmsgno
 integer n

 include cmsg

 string str "go to"

 call ptmlin(str, STDOUT)
 if (gmsgno(n) == ERR)
    dogoto = ERR
 else
    {
    curmsg = n
    call onemsg(curmsg)
    dogoto = OK
    }

 return
 end
#-h- dohead.q         285 asc 11-apr-80 14:29:23
 integer function dohead(linara)

 integer linara(MAXHEADERS)
 integer msgseq

 include cmsg

 string str "headers"

 call ptmlin(str, STDOUT)
 if (msgseq(linara) == ERR)
    dohead = ERR
 else
    {
    call headmf(NEWLINE, linara, STDOUT, pagesz)
    dohead = OK
    }

 return
 end
#-h- dohelp.q         769 asc 21-oct-80 16:37:03
 integer function dohelp(x)

 linepointer hlptmp(2)
 character x
 integer mrkhlp, gtcont, eqlptr
 integer j, i

 include cmhelp
 include cmsg

 external ptmlin

 string hlpstr "? MSG Help"
 string summar "%"
 string errmsg "  No help available."

 call ptmlin(hlpstr, STDOUT)
 if (mrkhlp(hlpint, hlpptr, summar, hlpscr) == ERR)
    {
    call ptmlin(errmsg, STDOUT)
    dohelp = ERR
    }
 else
    {
    call cpyptr(NULLPOINTER, hlptmp(2))
    call mputch(NEWLINE, STDOUT)
    j = 0
    for (i=1; eqlptr(hlpscr(i), NULLPOINTER) == NO; i=i+1)
	{
	if (pagesz > 0 & j >= pagesz)
	    if (gtcont(EOS) == NO)
		break
	    else
		j = 0
	call cpyptr(hlpscr(i), hlptmp(1))
	call puthlp(hlpint, hlptmp, summar, STDOUT, ptmlin)
	j = j + 1
	}
    dohelp = OK
    }

 return
 end
#-h- doinfo.q         851 asc 20-oct-80 23:22:49
 integer function doinfo(x)

 character x, c
 character clower, getch
 integer mrkhlp

 external ptmlin

 include cmhelp
 include msgscr

 string str "information - type command character: "
 string news "news"
 string intr "intr"
 string help "help"
 string errmsg "  No information available!"

 call ptmlin(str, STDOUT)
 c = clower(getch(c,STDIN))
 call mputch(c, STDOUT)
 call mputch(NEWLINE, STDOUT)
 if (c == HELPCOM)
    call scopy(help, 1, scrfil, 1)
 else if (c == NEWSCOM)
    call scopy(news, 1, scrfil, 1)
 else if (c == INTROCOM)
    call scopy(intr, 1, scrfil, 1)
 else
    {
    scrfil(1) = c
    scrfil(2) = EOS
    }
 if (mrkhlp(hlpint, hlpptr, scrfil, hlpscr) == ERR)
    {
    call ptmlin(errmsg, STDOUT)
    doinfo = ERR
    }
 else
    {
    call puthlp(hlpint, hlpscr, scrfil, STDOUT, ptmlin)
    doinfo = OK
    }

 return
 end
#-h- dojump.q         383 asc 20-oct-80 13:40:24
 integer function dojump(x)

 character x
 integer gtconf, spwnit
 integer i

 include msgscr

 string str "jump into shell"
 string sh "sh"
 string spnerr " Error spawning shell!"

 call ptmlin(str, STDOUT)
 if (gtconf(i) == YES)
    {
    call scopy(sh, 1, buf, 1)
    if (spwnit(buf) == ERR)
	call ptmlin(spnerr, STDOUT)
    dojump = OK
    }
 else
    dojump = ERR

 return
 end
#-h- dolist.q         828 asc 11-apr-80 14:29:29
 integer function dolist(linara)

 integer linara(MAXHEADERS), int
 integer msgseq, getmf, create

 include msgscr
 include cmsg
 include chdrs

 string str "list"
 string ons "on"
 string lispat " --- message #, * characters ---"
 string errmsg "  Error listing mail on "

 call ptmlin(str, STDOUT)
 if (msgseq(linara) == ERR)
    dolist = ERR
 else
    {
    call mputch(NEWLINE, STDOUT)
    call ptmlin(ons, STDOUT)
    if (getmf(scrfil) <= 0)
	dolist = ERR
    else
	{
	int = create(scrfil, WRITE)
	if (int != ERR)
	    {
	    call headmf(FORMFEED, linara, int, NOPAGING)
	    lispat(1) = FORMFEED
	    call putmf(lispat, linara, int, NOPAGING)
	    call close(int)
	    dolist = OK
	    }
	else
	    dolist = ERR
	}
    if (dolist == ERR)
	{
	call ptmlin(errmsg, STDOUT)
	call ptmlin(scrfil, STDOUT)
	}
    }

 return
 end
#-h- domove.q         735 asc 11-apr-80 14:29:30
 integer function domove(linara)

 integer linara(MAXHEADERS), int
 integer msgseq, create, getmf

 include chdrs
 include cmsg
 include msgscr

 string str "move"
 string intos "into"
 string errmsg "  Error moving mail into "

 call ptmlin(str, STDOUT)
 if (msgseq(linara) == ERR)
    domove = ERR
 else
    {
    call mputch(NEWLINE, STDOUT)
    call ptmlin(intos, STDOUT)
    if (getmf(scrfil) <= 0)
	domove = ERR
    else
	{
	int = create(scrfil, APPEND)
	if (int != ERR)
	    {
	    call putmf(hdrpat, linara, int, NOPAGING)
	    call close(int)
	    call delemf(linara)
	    domove = OK
	    }
	else
	    domove = ERR
	}
    if (domove == ERR)
	{
	call ptmlin(errmsg, STDOUT)
	call ptmlin(scrfil, STDOUT)
	}
    }

 return
 end
#-h- donews.q         456 asc 21-oct-80 16:37:05
 integer function donews(x)

 character x
 integer mrkhlp

 include cmhelp

 external ptmlin

 string nwsstr "# MSG News"
 string news "news"
 string errmsg "  No news available."

 call ptmlin(nwsstr, STDOUT)
 if (mrkhlp(hlpint, hlpptr, news, hlpscr) == ERR)
    {
    call ptmlin(errmsg, STDOUT)
    donews = ERR
    }
 else
    {
    call mputch(NEWLINE, STDOUT)
    call puthlp(hlpint, hlpscr, news, STDOUT, ptmlin)
    donews = OK
    }

 return
 end
#-h- donext.q         350 asc 11-apr-80 14:29:51
 integer function donext(linara)

 integer linara(MAXHEADERS)

 include cmsg

 string str "next message is:"
 string errmsg " no more messages!"

 call ptmlin(str, STDOUT)
 if (curmsg < nmsgs)
    {
    curmsg = curmsg + 1
    call onemsg(curmsg)
    donext = OK
    }
 else
    {
    call ptmlin(errmsg, STDOUT)
    donext = ERR
    }

 return
 end
#-h- doover.q         491 asc 11-apr-80 14:29:52
 integer function doover(linara)

 integer linara(ARB), status
 integer savemf, readmf, gtconf

 include cmsg

 string str "overwrite old"
 string errmsg "  Error overwriting file!"

 call ptmlin(str, STDOUT)
 call curfil(STDOUT)
 if (gtconf(status) == NO)
    doover = ERR
 else if (savemf(linara) == ERR)
    doover = ERR
 else if (readmf(file, NONOTIFY, LISTHEADERS, linara) == ERR)
    doover = ERR
 else
    doover = OK
 if (doover == ERR)
    call ptmlin(errmsg, STDOUT)

 return
 end
#-h- doput.q          704 asc 11-apr-80 14:29:54
 integer function doput(linara)

 integer linara(MAXHEADERS), int
 integer msgseq, create, getmf

 include chdrs
 include cmsg
 include msgscr

 string str "put"
 string intos "into"
 string errmsg "  Error putting mail into "

 call ptmlin(str, STDOUT)
 if (msgseq(linara) == ERR)
    doput = ERR
 else
    {
    call mputch(NEWLINE, STDOUT)
    call ptmlin(intos, STDOUT)
    if (getmf(scrfil) <= 0)
	doput = ERR
    else
	{
	int = create(scrfil, APPEND)
	if (int != ERR)
	    {
	    call putmf(hdrpat, linara, int, NOPAGING)
	    call close(int)
	    doput = OK
	    }
	else
	    doput = ERR
	}
    if (doput == ERR)
	{
	call ptmlin(errmsg, STDOUT)
	call ptmlin(scrfil, STDOUT)
	}
    }

 return
 end
#-h- doquit.q         203 asc 11-apr-80 14:29:55
 integer function doquit(x)

 character x
 integer gtconf
 integer status

 string str "quit"

 call ptmlin(str, STDOUT)
 if (gtconf(status) == YES)
    doquit = EOF
 else
    doquit = ERR

 return
 end
#-h- doread.q         348 asc 11-apr-80 14:29:56
 integer function doread(linara)

 integer linara(MAXHEADERS)
 integer readmf, getmf

 include msgscr
 include cmsg

 string str "read"

 call ptmlin(str, STDOUT)
 if (getmf(scrfil) <= 0)
    doread = ERR
 else if (readmf(scrfil, NOTIFY, LISTHEADERS, linara) == ERR)
    doread = ERR
 else
    {
    defalt = NO
    doread = OK
    }

 return
 end
#-h- dosndm.q         360 asc 20-oct-80 13:40:27
 integer function dosndm(x)

 character x
 integer gtconf, spwnit
 integer i

 include msgscr

 string str "sndmsg"
 string spnerr " Error spawning sndmsg!"

 call ptmlin(str, STDOUT)
 if (gtconf(i) == YES)
    {
    call scopy(str, 1, buf, 1)
    if (spwnit(buf) == ERR)
	call ptmlin(spnerr, STDOUT)
    dosndm = OK
    }
 else
    dosndm = ERR

 return
 end
#-h- dotype.q         381 asc 11-apr-80 14:29:59
 integer function dotype(linara)

 integer linara(MAXHEADERS)
 integer msgseq

 include cmsg

 string str "type"
 string typhdr " (message #, * characters)"

 call ptmlin(str, STDOUT)
 if (msgseq(linara) == ERR)
    dotype = ERR
 else
    {
    call mputch(NEWLINE, STDOUT)
    typhdr(1) = NEWLINE
    call putmf(typhdr, linara, STDOUT, pagesz)
    dotype = OK
    }

 return
 end
#-h- dounde.q         331 asc 11-apr-80 14:30:00
 integer function dounde(linara)

 integer linara(MAXHEADERS), i
 integer msgseq

 include chdrs

 string str "undelete"

 call ptmlin(str, STDOUT)
 if (msgseq(linara) == ERR)
    dounde = ERR
 else
    {
    for (i=1; i < MAXHEADERS & linara(i) != 0; i=i+1)
	{
	j = linara(i)
	hdele(j) = NO
	}
    dounde = OK
    }

 return
 end
#-h- dowrit.q         131 asc 11-apr-80 14:30:01
 integer function dowrit(x)

 character x

 string str "write"

 call ptmlin(str, STDOUT)
 call notimp
 dowrit = ERR

 return
 end
#-h- getfld.q         293 asc 11-apr-80 14:30:03
 subroutine getfld(buf, i, limit, array)

 character buf(ARB), array(ARB)
 integer i, limit, j, k

 j = i
 call skipbl(buf, j)		# skip leading blanks
 for (k=1; buf(j) != NEWLINE & buf(j) != EOS & k < limit; k=k+1)
    {
    array(k) = buf(j)
    j = j + 1
    }
 array(k) = EOS

 return
 end
#-h- gethdr.q         437 asc 11-apr-80 14:30:04
 integer function gethdr(fd, buf, name, size)

 character buf(MAXLINE), c, name(FILENAMESIZE)
 integer ctoi, equal, getlin, getwrd
 integer fd, i, len, size

 string hdr "#-h-"

 if (getlin(buf, fd) == EOF)
    {
    gethdr =  EOF
    return
    }
 i = 1
 len = getwrd(buf, i, name)
 if (equal(name, hdr) == NO)
    call error("Bad archive.")
 gethdr = YES
 len = getwrd(buf, i, name)
 size = ctoi(buf, i)
 call fold(name)

 return
 end
#-h- getmf.q          400 asc 21-oct-80 16:14:49
 integer function getmf(file)

 character file(ARB), trmara(4)
 character getrln
 integer length
 integer i

 string str " file name: "

 data trmara/CTRLM, CTRLJ, ESCAPE, EOS/

 call ptmlin(str, STDOUT)
 if (getrln(file, 1, STDIN, STDOUT, trmara) == ESCAPE)
    file(1) = EOS
 call mputch(BLANK, STDOUT)
 i = 1
 call skipbl(file, i)
 call scopy(file, i, file, 1)
 getmf = length(file)

 return
 end
#-h- getrln.q         823 asc 20-oct-80 22:48:00
 character function getrln(buf, start, in, out, trmara)

 integer in, out, i, start
 integer index
 character buf(ARB), trmara(ARB), c, bsblbs(4), notstr(5)
 character getch

 data bsblbs/BACKSPACE, BLANK, BACKSPACE, EOS/
 data notstr/CARET, BIGR, CTRLM, CTRLJ, EOS/

 i = start
 repeat
    {
    c = getch(c, in)
    if (index(trmara, c) > 0)
	break
    if (c == BACKSPACE | c == RUBOUT)
	{
	if (i > start)
	    {
	    call putlin(bsblbs, out)
	    i = i - 1
	    }
	else
	    {
	    c = RUBOUT
	    break
	    }
	}
    else if (c == LINEDELETE)
	for ( ; i > start; i = i - 1)
	    call putlin(bsblbs, out)
    else if (c == RETYPELINE & i > start)
	{
	call putlin(notstr, out)
	buf(i) = EOS
	call putlin(buf, out)
	}
    else
	{
	buf(i) = c
	i = i + 1
	call putch(c, out)
	}
    }
 buf(i) = EOS
 getrln = c

 return
 end
#-h- gmsgno.q        1021 asc 21-oct-80 16:14:51
 integer function gmsgno(n)

 integer n, i
 integer ctoi
 character c, trmara(3)
 character clower, getch, type, getrln

 include cmsg
 include msgscr

 string str " message number: "
 string first "first"
 string last "last"
 string currnt "current"
 string errmsg "  invalid message number!"

 data trmara /CTRLM, CTRLJ, EOS/

 call ptmlin(str, STDOUT)
 c = clower(getch(c, STDIN))
 if (c == FIRSTMSG)
    {
    call ptmlin(first, STDOUT)
    n = 1
    }
 else if (c == LASTMSG)
    {
    call ptmlin(last, STDOUT)
    n = nmsgs
    }
 else if (c == CTRLM | c == CTRLJ)
    {
    call ptmlin(currnt, STDOUT)
    n = curmsg
    }
 else if (type(c) == DIGIT)
    {
    scrfil(1) = c
    call mputch(c, STDOUT)
    c = getrln(scrfil, 2, STDIN, STDOUT, trmara)
    i = 1
    n = ctoi(scrfil, i)
    if (n <= 0 | n > nmsgs)
	{
	call ptmlin(errmsg, STDOUT)
	n = ERR
	}
    }
 else if (c == ESCAPE)
    n = ERR
 else
    {
    call mputch(c, STDOUT)
    call ptmlin(errmsg, STDOUT)
    n = ERR
    }
 gmsgno = n

 return
 end
#-h- gseqno.q        2114 asc 20-oct-80 23:51:46
 integer function gseqno(c, linara)

 character c, text(SCRATCHSIZE), trmn8r, trmara(5), sepr8r(3), skpstr(8),
	   bsblbs(4)
 character getrln, getch
 integer i, j, linara(MAXHEADERS), start, stop, dif, k, status, ctr
 integer ctoi, index, type

 include cmsg

 string ctrxst "^X"

 data trmara/CTRLM, CTRLJ, CTRLX, COMMA, EOS/
 data sepr8r/COLON, MINUS, EOS/
 data skpstr/CTRLM, CTRLJ, BLANK, TAB, COMMA, BACKSPACE, RUBOUT, EOS/
 data bsblbs/BACKSPACE, BLANK, BACKSPACE, EOS/

 j = 1
 status = OK
 repeat
    {
    text(1) = c
    call mputch(c, STDOUT)
    trmn8r = getrln(text, 2, STDIN, STDOUT, trmara)
    if (trmn8r == RUBOUT)
	call ptmlin(bsblbs, STDOUT)
    while (trmn8r == RUBOUT)
	trmn8r = getrln(text, 1, STDIN, STDOUT, trmara)
    if (trmn8r == COMMA)
        call mputch(COMMA, STDOUT)
    else if (trmn8r == CTRLX)
	{
	call ptmlin(ctrxst, STDOUT)
	status = ERR
	break
	}
    i = 1
    start = ctoi(text, i)
    if (start <= 0 | start > nmsgs)
	{
	status = ERR
	break
	}
    call skipbl(text, i)
    if (text(i) == EOS)
        {
        linara(j) = start
        j = j + 1
        }
    else if (index(sepr8r, text(i)) > 0)
        {
        i = i + 1
        stop = ctoi(text, i)
	if (stop <= 0 | stop > nmsgs)
	    {
	    status = ERR
	    break
	    }
        if (stop >= start)
            dif = 1
        else
            dif = -1
        stop = stop + dif
        for (k=start; k != stop; k=k+dif)
            {
            linara(j) = k
            j = j + 1
            }
        }
    else
        {
        status = ERR
        break
        }
    if (trmn8r == COMMA)
	{
	ctr = 1
        for (c=getch(c,STDIN); index(skpstr,c) > 0; c=getch(c,STDIN))
	    if (c == BACKSPACE | c == RUBOUT)
		{
		if (ctr > 1)
		    {
		    call ptmlin(bsblbs, STDOUT)
		    ctr = ctr - 1
		    }
		}
	    else
		{
		call mputch(c, STDOUT)
		if (c == CTRLM | c == CTRLJ)
		    ctr = 1
		else
		    ctr = ctr + 1
		}
	}
    if (type(c) != DIGIT)
        {
        status = ERR
        break
        }
    }
 until (trmn8r != COMMA)
 if (status == ERR)
    j = 1
 linara(j) = 0
 gseqno = status

 return
 end
#-h- gtconf.q         335 asc 20-oct-80 22:48:05
 integer function gtconf(status)

 integer status
 character c
 character clower, getch

 string confst " [type SPACE to confirm] "

 call ptmlin(confst, STDOUT)
 c = clower(getch(c, STDIN))
 if (c != CTRLM & c != CTRLJ)
    call mputch(c, STDOUT)
 if (c == BLANK)
    status = YES
 else
    status = NO
 gtconf = status

 return
 end
#-h- gtcont.q         384 asc 20-oct-80 22:48:06
 integer function gtcont(strng)

 integer index
 character c, strng(ARB)
 character getch

 string str "[type SPACE to continue]"
 string constr " "

 if (strng(1) == EOS)
    call ptmlin(str, STDOUT)
 else
    call ptmlin(strng, STDOUT)
 c = getch(c, STDIN)
 if (index(constr, c) > 0)
    {
    call mputch(NEWLINE, STDOUT)
    gtcont = YES
    }
 else
    gtcont = NO

 return
 end
#-h- gthptr.q        1424 asc 11-apr-80 15:31:01
 subroutine gthptr(in)

 real jdate
 integer i, getlin, match, equal, n, j, index, in
 linepointer temp

 include chdrs
 include cmsg
 include msgscr

 string errstr "Too many messages!"

 i = 1
 repeat
    {
    call markl(in, temp)
    call markl(unit, haddr(i))
    if (getlin(buf, in) == EOF)
	break
    call putlin(buf, unit)
    if (equal(buf, hdrpat) == YES)
	{
	if (i >= MAXHEADERS)
	    {
	    call mputch(NEWLINE, STDOUT)
	    call ptmlin(errstr, STDOUT)
	    call msgend
	    }
	hfrom(1,i) = EOS
	hsubj(1,i) = EOS
	hdate(1,i) = EOS
	rdate(i) = 0.
	for (n=getlin(buf,in); n > 1 & n != EOF; n=getlin(buf,in))
	    {
	    call fold(buf)
	    if (match(buf, frompt) == YES)
		call getfld(buf, 6, MAXFROMSIZE, hfrom(1,i))
	    else if (match(buf, subjpt) == YES)
		call getfld(buf, 9, MAXSUBJSIZE, hsubj(1,i))
	    else if (match(buf, datept) == YES)
		{
		call getfld(buf, 6, MAXDATESIZE, hdate(1,i))
		if (index(hdate(1,i), MINUS) > 0)
		    {
		    j = index(hdate(1,i), BLANK)
		    if (j > 0)
			hdate(j,i) = EOS
		    }
		rdate(i) = jdate(buf(6))
		}
	    }
	call seek(temp, in)
	n = getlin(buf, in)
	call markl(in, temp)
	for (m=getlin(buf,in); m != EOF; m=getlin(buf,in))
	    {
	    if (equal(buf, hdrpat) == YES)
		break
	    else
		{
		n = n + m
		call putlin(buf, unit)
		}
	    call markl(in, temp)
	    }
	hsize(i) = n
	call seek(temp, in)
	hdele(i) = NO
	i = i + 1
	}
    }
 nmsgs = i - 1

 return
 end
#-h- headmf.q         372 asc 11-apr-80 14:30:17
 subroutine headmf(ch, linara, int, page)

 character ch
 integer linara(MAXHEADERS), int, i, page, j
 integer gtcont

 if (ch != EOS)
    call mputch(ch, int)
 j = 0
 for (i=1; i < MAXHEADERS & linara(i) != 0; i=i+1)
    {
    if (page > 0 & j >= page)
	if (gtcont(EOS) == NO)
	    break
	else
	    j = 0
    call puthdr(linara(i), int)
    j = j + 1
    }

 return
 end
#-h- inihlp.q         522 asc 08-may-80 12:48:25
 integer function inihlp(file, ptrara, ptrsiz, unit)

 integer ptrsiz, unit, i
 linepointer ptrara(ptrsiz)
 character file(FILENAMESIZE)
 integer open, gethdr

 include chelp

 call close(unit)			# close it if previously opened
 unit = open(file, READ)
 if (unit != ERR)
    {
    for (i=1; i < ptrsiz; i=i+1)
	{
	call markl(unit, ptrara(i))
	if (gethdr(unit, buf, name, size) != YES)
	    break
	call fskip(unit, size)
	}
    call cpyptr(NULLPOINTER, ptrara(i))
    inihlp = OK
    }
 else
    inihlp = ERR

 return
 end
#-h- inimsh.q         248 asc 12-oct-80 17:34:32
 subroutine inimsh

 integer i
 integer inihlp

 include cmhelp
 include msgscr

 string msghlp "msghlp"

 call getdir(MAILDIRECTORY, LOCAL, scrfil)
 call concat(scrfil, msghlp, scrfil)
 i = inihlp(scrfil, hlpptr, HLPPTRSIZE, hlpint)

 return
 end
#-h- jdate.q           74 asc 11-apr-80 14:30:48
 real function jdate(buf)

 character buf(ARB)

 jdate = 0.

 return
 end
#-h- mfsave.q         647 asc 11-apr-80 14:30:49
 integer function mfsave(outfil, access, linara, ifnot)

 character outfil(FILENAMESIZE)
 integer access, linara(MAXHEADERS), ifnot, int, j, i
 integer create

 include cmsg
 include chdrs

 string savstr "updating..."

 int = create(outfil, access)
 if (int != ERR)
    {
    if (ifnot == NOTIFY)
	{
	call mputch(NEWLINE, STDOUT)
	call ptmlin(savstr, STDOUT)
	}
    j = 1
    for (i=1; i <= nmsgs; i=i+1)
	if (hdele(i) == NO)
	    {
	    linara(j) = i
	    j = j + 1
	    }
    linara(j) = 0
    call putch(NEWLINE, int)
    call putmf(hdrpat, linara, int, NOPAGING)
    call close(int)
    mfsave = OK
    }
 else
    mfsave = ERR

 return
 end
#-h- mputch.q         224 asc 20-oct-80 17:31:26
 subroutine mputch(c, int)

 integer int, raw
 character c

 include cmsg
 include ccrlf

 if (int == STDOUT & rawout == RAW & (c == CTRLM | c == CTRLJ))
    call putlin(crlf, int)
 else
    call putch(c, int)

 return
 end
#-h- mrkhlp.q         707 asc 08-may-80 12:48:27
 integer function mrkhlp(unit, ptrara, key, outara)

 linepointer ptrara(ARB), outara(ARB)
 integer unit, j, i, junk, doall
 integer equal, gethdr, eqlptr
 character key(ARB)

 include chelp

 string summar "%"
 string all "?"

 if (equal(key, summar) == YES | equal(key, all) == YES)
    doall = YES
 else
    doall = NO
 j = 1
 for (i=1; eqlptr(ptrara(i), NULLPOINTER) == NO; i=i+1)
    {
    call seek(ptrara(i), unit)
    junk = gethdr(unit, buf, name, size)
    if (doall == YES | equal(name, key) == YES)
	{
	call cpyptr(ptrara(i), outara(j))
	j = j + 1
	}
    if (j > 1 & doall == NO)
	break
    }
 call cpyptr(NULLPOINTER, outara(j))
 if (j > 1)
    mrkhlp = OK
 else
    mrkhlp = ERR

 return
 end
#-h- msgcmd.q        1635 asc 20-oct-80 22:48:09
 integer function msgcmd(c)

 character c
 integer doansw, doback, docurr, dodele, doexit, doforw, doinfo,
	 dogoto, dohead, dojump, dolist, domove, donext, doover, doput,
	 doquit, doread, dosndm, dotype, dounde, dowrit, donews, dohelp,
	 dointr

 include cmline

 string estr " ? No such command. [Type '?' for help]"

 if (c == ANSWERCOM)
    msgcmd = doansw(c)
 else if (c == BACKUPCOM)
    msgcmd = doback(linara)
 else if (c == CURRENTCOM)
    msgcmd = docurr(c)
 else if (c == DELETECOM)
    msgcmd = dodele(linara)
 else if (c == EXITCOM)
    msgcmd = doexit(linara)
 else if (c == FORWARDCOM)
    msgcmd = doforw(c)
 else if (c == GOTOCOM)
    msgcmd = dogoto(c)
 else if (c == HEADERCOM)
    msgcmd = dohead(linara)
 else if (c == INFOCOM)
    msgcmd = doinfo(x)
 else if (c == JUMPCOM)
    msgcmd = dojump(c)
 else if (c == LISTCOM)
    msgcmd = dolist(linara)
 else if (c == MOVECOM)
    msgcmd = domove(linara)
 else if (c == NEXTCOM)
    msgcmd = donext(linara)
 else if (c == OVERCOM)
    msgcmd = doover(linara)
 else if (c == PUTCOM)
    msgcmd = doput(linara)
 else if (c == QUITCOM)
    msgcmd = doquit(c)
 else if (c == READCOM)
    msgcmd = doread(linara)
 else if (c == SNDMSGCOM)
    msgcmd = dosndm(c)
 else if (c == TYPECOM)
    msgcmd = dotype(linara)
 else if (c == UNDELETECOM)
    msgcmd = dounde(linara)
 else if (c == WRITECOM)
    msgcmd = dowrit(linara)
 else if (c == NEWSCOM)
    msgcmd = donews(c)
 else if (c == HELPCOM)
    msgcmd = dohelp(c)
 else if (c == INTROCOM)
    msgcmd = dointr(c)
 else
    {
    call mputch(c, STDOUT)
    call ptmlin(estr, STDOUT)
    msgcmd = ERR
    }

 return
 end
#-h- msgend.q         129 asc 20-oct-80 22:48:11
 subroutine msgend

 include cmsg

 call mputch(NEWLINE, STDOUT)
 call close(unit)
 call remove(scrat)
 call endr4

 return
 end
#-h- msgint.q        1750 asc 21-oct-80 16:14:56
 subroutine msgint

 character clower
 integer getpat, i, open, getarg, readmf, j, ctoi, pad
 real jdate

 include chdrs
 include cmsg
 include ccrlf
 include cmhelp
 include msgscr
 include cmline

 string mymail "mymail"
 string msg "msg"
 string froms "%from:"
 string subjs "%subject:"
 string dates "%date:"
 string patrns "Error in generating pattern."
 string blnk " "

 if (rawin == RAW & rawout == RAW)
    pagesz = PAGESIZE
 else
    pagesz = NOPAGING
 hdrpat(1) = 1
 hdrpat(2) = 1
 hdrpat(3) = NEWLINE
 hdrpat(4) = EOS
 call inimsh
 call gdate(scrfil)
 call concat(scrfil, blnk, scrfil)
 call gtime(buf)
 call concat(scrfil, buf, scrfil)
 tdate = jdate(scrfil)
 if (getpat(froms, frompt) == ERR)
    call error(patrns)
 if (getpat(subjs, subjpt) == ERR)
    call error(patrns)
 if (getpat(dates, datept) == ERR)
    call error(patrns)
 call mailid(scrat, home)
 call scratf(msg, scrat)
 unit = ERR
 call concat(home, mymail, scrfil)
 defalt = YES
 pad = DEFPAD
 for (i=1; getarg(i, buf, FILENAMESIZE) != EOF; i=i+1)
    if (buf(1) == QMARK)
	call error("usage:  msg [-fn] [-p[n]] [file].")
    else if (buf(1) == MINUS)
	switch (clower(buf(2)))
	    {
	    case LETF:	{ j = 3
			pad = ctoi(buf, j)
			pad = min(pad, MAXPAD)
			pad = max(pad, MINPAD)
			}
	    case LETP:	if (rawin == RAW & rawout == RAW)
			    {
	    		    j = 3
			    pagesz = ctoi(buf, j)
			    if (pagesz <= 0)
				pagesz = NOPAGING
			    }
	    default:	;
	    }
    else
	{
	call scopy(buf, 1, scrfil, 1)
	defalt = NO
	}
 crlf(1) = CTRLM
 crlf(2) = CTRLJ
 j = 3
 call pchar(NULLCHAR, pad, crlf, j)
 crlf(j) = EOS
 call banner
 if (readmf(scrfil, NONOTIFY, LISTHEADERS, linara) == ERR)
    call error("Error opening input file.")
 call close(ERROUT)

 return
 end
#-h- msgseq.q        2148 asc 21-oct-80 17:55:42
 integer function msgseq(linara)

 integer linara(MAXHEADERS), i, j, value
 integer getpat, match, length, dosequ
 character getch, clower, getrln, type, gseqno
 character c, text(FILENAMESIZE), pat(FILENAMESIZE), trmara(4)

 include cmsg
 include chdrs

 string msgstr " (message sequence) "
 string allstr "all messages"
 string frmstr "from string: "
 string subst "subject string: "
 string delstr "deleted messages"
 string undstr "un"
 string seqerr " ? Invalid message sequence!"

 data trmara/CTRLM, CTRLJ, ESCAPE, EOS/

 repeat
    {
    call ptmlin(msgstr, STDOUT)
    c = clower(getch(c, STDIN))
    if (c == QMARK)
	j = dosequ(c)
    }
 until (c != QMARK)
 if (c == FROMSEARCH)
    {
    call ptmlin(frmstr, STDOUT)
    c = getrln(text, 1, STDIN, STDOUT, trmara)
    call fold(text)
    j = 1
    if (getpat(text, pat) != ERR & length(text) > 0)
	{
	for (i=1; i <= nmsgs; i=i+1)
	    if (match(hfrom(1,i), pat) == YES)
		{
		linara(j) = i
		j = j + 1
		}
	linara(j) = 0
	msgseq = OK
	}
    else
	msgseq = ERR
    }
 else if (c == SUBJECTSEARCH)
    {
    call ptmlin(subst, STDOUT)
    c = getrln(text, 1, STDIN, STDOUT, trmara)
    call fold(text)
    j = 1
    if (getpat(text, pat) != ERR & length(text) > 0)
	{
	for (i=1; i <= nmsgs; i=i+1)
	    if (match(hsubj(1,i), pat) == YES)
		{
		linara(j) = i
		j = j + 1
		}
	linara(j) = 0
	msgseq = OK
	}
    else
	msgseq = ERR
    }
 else if (c == ALLPAT)
    {
    call ptmlin(allstr, STDOUT)
    for (i=1; i <= nmsgs; i=i+1)
	linara(i) = i
    linara(i) = 0
    msgseq = OK
    }
 else if (c == DELETECOM | c == UNDELETECOM)
    {
    if (c == DELETECOM)
	value = YES
    else
	{
	value = NO
	call ptmlin(undstr, STDOUT)
	}
    call ptmlin(delstr, STDOUT)
    j = 1
    for (i=1; i <= nmsgs; i=i+1)
	if (hdele(i) == value)
	    {
	    linara(j) = i
	    j = j + 1
	    }
    linara(j) = 0
    }
 else if (c == CTRLM | c == CTRLJ)
    {
    linara(1) = curmsg
    linara(2) = 0
    msgseq = OK
    }
 else if (type(c) == DIGIT)
    if (gseqno(c, linara) == ERR)
	msgseq = ERR
    else
	msgseq = OK
 else
    msgseq = ERR
 if (msgseq == ERR)
    call ptmlin(seqerr, STDOUT)

 return
 end
#-h- notimp.q          97 asc 11-apr-80 14:31:02
 subroutine notimp

 string impstr "  UNIMPLEMENTED"

 call ptmlin(impstr, STDOUT)

 return
 end
#-h- onemsg.q         221 asc 11-apr-80 14:31:03
 subroutine onemsg(n)

 integer n, linara(2)

 include cmsg

 string msghdr " (message #, * characters)"

 data linara(2) /0/

 linara(1) = n
 msghdr(1) = NEWLINE
 call putmf(msghdr, linara, STDOUT, pagesz)

 return
 end
#-h- pchar.q          155 asc 11-apr-80 14:31:04
 subroutine pchar(c, n, lin, j)

 character c, lin(ARB)
 integer n, i, j

 for (i=1; i <= n; i=i+1)
    {
    lin(j) = c
    j = j + 1
    }

 return
 end
#-h- ptmlin.q         263 asc 20-oct-80 17:31:31
 subroutine ptmlin(lin, int)

 character lin(ARB), buf(200)
 integer int

 include cmsg
 include ccrlf

 if (int == STDOUT & rawout == RAW)
    {
    call sbst(lin, NEWLINE, buf, crlf)
    call putlin(buf, int)
    }
 else
    call putlin(lin, int)

 return
 end
#-h- puthdr.q         871 asc 11-apr-80 14:31:07
 subroutine puthdr(n, int)

 integer n, int, m, itoc, length, i
 character temp(10), buf(100)

 include chdrs
 include cmsg

 if (n >= 1 & n <= nmsgs)
    {
    i = 1
    m = MSGNUMBWIDTH - itoc(n, temp, 10)
    call pchar(BLANK, m, buf, i)
    call stcopy(temp, 1, buf, i)
    if (hdele(n) == YES)
	call chcopy(STAR, buf, i)
    else
	call chcopy(BLANK, buf, i)
    m = MSGSIZEWIDTH - itoc(hsize(n), temp, 10)
    call pchar(BLANK, m, buf, i)
    call stcopy(temp, 1, buf, i)
    call chcopy(BLANK, buf, i)
    m = MSGDATEWIDTH - length(hdate(1,n))
    call stcopy(hdate(1,n), 1, buf, i)
    call pchar(BLANK, m, buf, i)
    m = MSGFROMWIDTH - length(hfrom(1,n))
    call stcopy(hfrom(1,n), 1, buf, i)
    call pchar(BLANK, m, buf, i)
    call stcopy(hsubj(1,n), 1, buf, i)
    call chcopy(NEWLINE, buf, i)
    buf(i) = EOS
    call ptmlin(buf, int)
    }

 return
 end
#-h- puthlp.q         668 asc 08-may-80 12:48:33
 subroutine puthlp(unit, outara, key, out, putout)

 linepointer outara(ARB)
 integer unit, out, i, dosumm, junk
 integer gethdr, getlin, equal, eqlptr
 character key(ARB)
 external putout

 include chelp

 string summar "%"

 dosumm = equal(key, summar)
 for (i=1; eqlptr(outara(i), NULLPOINTER) == NO; i=i+1)
    {
    call seek(outara(i), unit)
    junk = gethdr(unit, buf, name, size)
    if (dosumm == YES)
	{
	junk = getlin(buf, unit)
	call putout(buf, out)
	}
    else
	{
	size = size - getlin(buf, unit)
	for (junk = getlin(buf, unit); size > 0; junk = getlin(buf, unit))
	    {
	    call putout(buf, out)
	    size = size - junk
	    }
	}
    }

 return
 end
#-h- putmf.q          707 asc 20-oct-80 22:48:16
 subroutine putmf(hdrstr, linara, int, page)

 character hdrstr(ARB), temp(SCRATCHSIZE)
 integer linara(MAXHEADERS), int, i, n, junk, page
 integer itoc, length, gtcont

 include msgscr
 include chdrs

 string constr "[type SPACE for next message]"

 for (i=1; i < MAXHEADERS & linara(i) != 0; i=i+1)
    {
    if (i > 1 & page > 0)
	if (gtcont(constr) == NO)
	    break
    n = linara(i)
    junk = itoc(n, scrfil, 10)
    call sbst(hdrstr, MSGNOCHAR, temp, scrfil)
    junk = itoc(hsize(n), scrfil, 10)
    call sbst(temp, MSGSIZECHAR, buf, scrfil)
    call ptmlin(buf, int)
    junk = length(buf)
    if (buf(junk) != NEWLINE)
	call mputch(NEWLINE, int)
    call putmsg(n, int, page)
    }

 return
 end
#-h- putmsg.q         449 asc 11-apr-80 14:31:11
 subroutine putmsg(n, int, page)

 integer n, int, i, m, j, page
 integer getlin, gtcont

 include chdrs
 include cmsg
 include msgscr

 if (n >= 1 & n <= nmsgs)
    {
    call seek(haddr(n), unit)
    i = getlin(buf, unit)
    j = 0
    for (m=getlin(buf,unit); i < hsize(n); m=getlin(buf,unit))
	{
	if (page > 0 & j >= page)
	    if (gtcont(EOS) == NO)
		break
	    else
		j = 0
	call ptmlin(buf, int)
	j = j + 1
	i = i + m
	}
    }

 return
 end
#-h- readmf.q         704 asc 11-apr-80 15:49:54
 integer function readmf(tfile, ifnot, iflist, linara)

 character tfile(ARB)
 integer open, create
 integer ifnot, in, iflist, i, linara(MAXHEADERS)

 include cmsg

 string redstr "reading..."

 if (unit != ERR)
    call close(unit)
 in = open(tfile, READ)
 if (in == ERR)
    {
    readmf = ERR
    return
    }
 unit = create(scrat, READWRITE)
 if (unit != ERR)
    {
    call scopy(tfile, 1, file, 1)
    if (ifnot == NOTIFY)
	call ptmlin(redstr, STDOUT)
    call gthptr(in)
    curmsg = min(1, nmsgs)
    if (iflist == LISTHEADERS)
	{
	for (i=1; i <= nmsgs; i=i+1)
	    linara(i) = i
	linara(i) = 0
	call headmf(NEWLINE, linara, STDOUT, pagesz)
	}
    }
 call close(in)
 readmf = unit

 return
 end
#-h- savemf.q         754 asc 11-apr-80 14:31:14
 integer function savemf(linara)

 integer linara(MAXHEADERS), i, access, mmsgs
 integer create, mfsave, readmf

 include cmsg
 include chdrs
 include msgscr

 string mbox "mbox"
 string mymail "mymail"

 if (defalt == YES)
    {
    call concat(home, mbox, file)
    access = APPEND
    }
 else
    access = WRITE
 if (mfsave(file, access, linara, NOTIFY) == ERR)
    savemf = ERR
 else if (defalt == YES)
    {
    mmsgs = nmsgs
    call concat(home, mymail, scrfil)
    if (readmf(scrfil, NONOTIFY, NOLISTHEADERS, linara) == ERR)
	savemf = ERR
    else
	{
	for (i=1; i <= mmsgs; i=i+1)
	    hdele(i) = YES
	savemf = mfsave(scrfil, WRITE, linara, NONOTIFY)
	}
    call concat(home, mbox, file)
    defalt = NO
    }
 else
    savemf = OK

 return
 end
#-h- sbst.q           433 asc 11-apr-80 14:31:16
   #--------------------------------------------------------------------
 ## sbst  - substitutes a string for a specified character
    subroutine sbst (in,char,out,subara)

    character in(ARB), char, out(ARB), subara(ARB)
    integer i, j

    j = 1
    for (i=1; in(i) != EOS; i=i+1)
        if (in(i) == char)
	    call stcopy(subara, 1, out, j)
        else
	    call chcopy(in(i), out, j)
    out(j) = EOS

    return
    end
#-h- cpyptr.q         129 asc 02-oct-80 09:10:28
 subroutine cpyptr(in, out)

 integer in(2), out(2)

 out(1) = in(1)
 if (in(1) != NULLPOINTER)
    out(2) = in(2)

 return
 end
#-h- eqlptr.q         210 asc 02-oct-80 09:10:28
 integer function eqlptr(ptr1, ptr2)

 integer ptr1(2), ptr2(2)

 eqlptr = NO
 if (ptr1(1) == ptr2(1))
    if (ptr1(1) == NULLPOINTER)
	eqlptr = YES
    else if (ptr1(2) == ptr2(2))
	eqlptr = YES

 return
 end
#-h- spwnit.q         306 asc 20-oct-80 17:42:51
 integer function spwnit(buf)

 character buf(ARB), image(FILENAMESIZE), path(80)
 integer i, junk
 integer getwrd, loccom, spawn

 i = 1
 junk = getwrd(buf, i, image)
 call impath(path)
 junk = loccom(image, path, image)
 call mputch(NEWLINE, STDOUT)
 spwnit = spawn(image, buf, path, WAIT)

 return
 end
#-h- dosequ.q         507 asc 20-oct-80 22:48:19
 integer function dosequ(x)

 character x
 integer mrkhlp

 include cmhelp

 external ptmlin

 string intstr "? may be any of the following:"
 string sequ "sequ"
 string errmsg "? Sorry, no help available; consult the MSG primer."

 call ptmlin(intstr, STDOUT)
 if (mrkhlp(hlpint, hlpptr, sequ, hlpscr) == ERR)
    {
    call ptmlin(errmsg, STDOUT)
    dosequ = ERR
    }
 else
    {
    call mputch(NEWLINE, STDOUT)
    call puthlp(hlpint, hlpscr, sequ, STDOUT, ptmlin)
    dosequ = OK
    }

 return
 end
#-h- dointr.q         506 asc 21-oct-80 16:37:17
 integer function dointr(x)

 character x
 integer mrkhlp

 include cmhelp

 external ptmlin

 string intstr "% Introduction to MSG"
 string intr "intr"
 string errmsg "? Sorry, no introduction available; consult the MSG primer."

 call ptmlin(intstr, STDOUT)
 if (mrkhlp(hlpint, hlpptr, intr, hlpscr) == ERR)
    {
    call ptmlin(errmsg, STDOUT)
    dointr = ERR
    }
 else
    {
    call mputch(NEWLINE, STDOUT)
    call puthlp(hlpint, hlpscr, intr, STDOUT, ptmlin)
    dointr = OK
    }

 return
 end