Google
 

Trailing-Edge - PDP-10 Archives - BB-KL11M-BM_1990 - t20src/ms.mac
There are 19 other files named ms.mac in the archive. Click here to see a list.
;This software is furnished under a license and may only be used
;  or copied in accordance with the terms of such license.
;
;Copyright (C) 1979,1980,1981,1982 by Digital Equipment Corporation
;	       1983,1984,1985,1986    Maynard, Massachusetts, USA


	TITLE MS - Message System for TOPS10 and TOPS20

	SEARCH GLXMAC,MSUNV,MACSYM
TOPS20<	SEARCH MONSYM>
	PROLOG (MS)

	CPYRYT
	MSINIT

	.DIRECTIVE FLBLST
	SALL

IFNDEF MHACK,<MHACK==0>		; BLISS hack switch

;Define globals

	GLOBS			; Storage
	GLOBRS			; Routines

;Globals

	INTERNAL CKEXIT, CKXIT0, CKXRTN, CMDRES, GO, GO1, SUBJEC
	INTERNAL CHECKT,CHKDEL
TOPS20<	INTERNAL CHECKM>
	INTERNAL DELMSG,FNDCC,FNDDAT,FNDFRM,FNDMID,FNDREF,FNDRRR,FNDSDT
;**;[3096] Change 1 line at INTERNAL FNDSND,...		Ned	12-Aug-87
	INTERNAL FNDSND,FNDSUB,FNDTO,RECEN0,FSCPKL

	INTERNAL CRFPRT,ENQBLK,FILPGM,FILPGS,FILSIZ,FILWRT,FLAGS2,NETFLG
	INTERNAL HLPTXT,IDXNUM,IDXSAV,LASTRD,MBOT,MSGFAD,MSGIFJ,MSGJF2
	INTERNAL MSGPAG,MSGSSQ,MTOP,OUTFOB,WBOT,WTOP,WWIDH
	INTERNAL MINWSZ,SCRLFL,BLKTIM
	INTERNAL ABREL,ADRLST,AUTCMT,AUTEXP,BLKTIM
	INTERNAL CMDTAB,CRFDEV
	INTERNAL CRFDIR,CRFPRT,DEFCC,DFCMTB,EXPRNC,F%NO,FILPGS,FILSIZ
	INTERNAL FLAGS2,GTFLAG,HD%KWD,HDITAB,HDTNAM,HLPTAB,HLPTXT
	INTERNAL INIFOB,INIIFN,KWDLST,LIBVER
	INTERNAL MOVDSP,MOVHDO,MVALST,NDELET,NFLAGD,OHSNMX,PERSON,RCMDTB
	INTERNAL REDNOV,REDPTR,REPADD
	INTERNAL SCMDTB,SCRBTM,SCRLFL,SCRREG,SCRRGR,SENNOV,SENPTR,SETNOV
	INTERNAL SETPTR,SHCMTB,STCMT0,STCMTB,STRBSZ,SVMFOB,TOPNOV,TOPPTR
	INTERNAL TYPE1,UNSEEN,V52FLG
	INTERNAL AUTEXP,CHECKS,CMDLUP,CRFPRT,FLAGS2,HDITAB
	INTERNAL IB,INIRET,LINEW,OKTINT,PDL,PIDBLK,PIDMS
	INTERNAL SAVMOD,TAKPDL,TAKPTR,ZEREND,ZERMEM
	INTERNAL CRFDEV, CRFDIR, INIP, INIRET, LFCNT, INIPDL
	INTERNAL MYDIR, MYDIRS, PERSON, MSGSSQ, MSGSQE
	INTERNAL RPRHNP,FRMLCL,TTXTIB,FSJFN,MYHSPT,MYHDPT,CRFDTB

TOPS10<	INTERNAL MYPPN, FILBLK, SENBLK,CRFFDH
	INTERNAL OBUF,INTBLK,INTF,MYPPN,SAVPSZ,SENBLK,TTYUDX
	INTERNAL FILCRV,FILOPB,LKB,MSGA1,MSGSTR,MSIOWD,PBLOCK,MSGFD
	INTERNAL ATTBLK,LOKAPP >

TOPS20<	INTERNAL CHNSIZ,CHNTAB,GTJFN2,IDXFIL,INTP,INTPDL,JF2BUF >

;Global routines defined elsewhere

;MSFIL.MAC
	EXTERNAL CHECK0,CLOSEF,EXPUNG,GET1,GETFIL,GETHLP,GETLPT
TOPS20< EXTERNAL CLSJF2,GETJF2,SIZFIL>
	EXTERNAL GETNEW,GETOUT,GETPRS,LPTMSG,MOVMSG,PARSEF,PUTMSG
	EXTERNAL REMAP,SETREF,SETSFL,SHRAGN
TOPS20<	EXTERNAL UNMAPF>
	EXTERNAL UPDBIT,XCLENQ

;MSMCMD.MAC
	EXTERNAL BLANK0,.BBORD,.BLANK,.CREAT,.ECHO,.FINIS,.HELP
TOPS20<	EXTERNAL .LOGOU,.MAILR>
	EXTERNAL .PUSH,.QUINI,.QUIT,.SET,.SHADL,.SHDEF,.SHHDI
	EXTERNAL .SHINT,.SHOW,.SHSYN,.STATU,.STAUF,.STAUT,.STBFD
	EXTERNAL .STCDI,.STCLZ,.STCNC,.STCND,.DAYTI
	EXTERNAL .STCPR,.STDCC,.STDFT,.STDLC,.STEXP
	EXTERNAL .STFDI
	EXTERNAL .STHLP,.STHPR
	EXTERNAL .STINC,.STLGD,.STNO,.STOHS,.STPNM,.STRAD,.STRPA,.STRPS
	EXTERNAL .STSPH,.STSUM,.STVID,.STWSZ,.TAKE,.VERSI,MSGOD0,.MSGOD

;MSCNFG.MAC
TOPS20<	EXTERNAL CTLCIN,TMRINT>
	EXTERNAL CTCLOK,CTCOK,KWDREL,MSINI
	EXTERNAL SUMMRY,TTINI

;MSDLVR.MAC
	EXTERNAL DELIVR, SAVMSG, SAVDRF

;MSDSPL.MAC
	EXTERNAL TYPBOD, TYPHDR, TYPLIT, TYPMHD

;MSGUSR.MAC
TOPS20<	EXTERNAL CHKPBX>

;MSHTAB.MAC
	EXTERNAL NAMINI, HOSTAB, HSTINI
;MSTXT.MAC
TOPS10< EXTERNAL CTX >
TOPS20<	EXTERNAL .EDITO >
	EXTERNAL GETTXT, .ERST0, .EDTXT
	EXTERNAL TXTCHR, TXTCPT, TXTPUT

;MSUTL.MAC
	EXTERNAL ALCFOB, ALCSB, CFIELD, CLRCTO, CLRFIB, CMDERR, CMDER1
	EXTERNAL CMDINI, COMPAC, COUNTS, CPYATM, CRIF, CRLF, DPROMP
TOPS10<	EXTERNAL ECHOON >
;**;[3096] Change 1 line at EXTERNAL EXPAND,...		Ned	12-Aug-87
	EXTERNAL EXPAND, FSCOPY, FSPEC, FSPEC0, GETUSR, UNGGNU, FENTRM
	EXTERNAL MOVST0, MOVST1, MOVST2, MOVSTR
	EXTERNAL RELFOB, RELSB, REPARS
	EXTERNAL RFIELD, RFLDE, RSTPSZ
TOPS20<	EXTERNAL RUNFIL, RUNFL0, RUNFL2 >
	EXTERNAL SETIOJ, SETPSZ, SSEARC, TBADDS, TBOUT, TNOUT, TSOUT
	EXTERNAL TXTOUT, UPDTOR
	EXTERNAL RDELAY
TOPS10<	EXTERNAL XDATI >

;MSUUO.MAC
	EXTERNAL UUOH

;Global data items defined elsewhere

;MSGUSR.MAC
TOPS10<	EXTERNAL KILLST >

;MSHTAB.MAC
	EXTERNAL VALID8

;MSUTL.MAC
	EXTERNAL ATMBUF, CJFNBK, CMDBUF, CMDACS
	EXTERNAL LSCERR, REPAR0, REPARA, SBK
;MSCNFG
	EXTERNAL RJ.FLG, RJ.VMA, RJ.AMA
 SUBTTL Impure storage

	IMPUR0

ZERMEM:				; Begin clear here
MSQBOT:	BLOCK 1			; Sequence frame bottom
MSQTOP:	BLOCK 1			; And Top
MMPPG:	BLOCK 1			; Index file page number
INIP:	BLOCK 1			; Saved P during init file
INIRET:	BLOCK 1			; Where to go when init file exhausted
INIPDL:	BLOCK 40		; Saved stack during init file
OKTINT:	BLOCK 1			; Is it ok for timer to interrupt now?
V52FLG:	BLOCK 1			; We are on a vt52
GTFLAG:	BLOCK 1			; "No messages in file" message flag
LSTCHR:	BLOCK 1			; Place to stash last char typed
CPYJFN:	BLOCK 1			; JFN for MAIL.CPY
FSJFN::	BLOCK 1			; Temporary JFN storage
FLAGS2:	BLOCK 1			; Second flags word
;**;[3096] Delete (move) one line at FLAGS2: + 1	Ned	12-Aug-87
TOPS20<
MSGJF2:	EXP 0 			; JFN to open for write
GTJFN2:	EXP 0			; READ/WRITE JFN for GET command
CHNSIZ:	EXP 0>			; File has changed size flag
;**;[3096] Delete (move) 2 lines at CHNSIZ: + 1		Ned	12-Aug-87
MSGIDP:	BLOCK 1			; Its size in pages
MSGSQL:	BLOCK 1			; Sequence buffer size in pages

   TOPS10<
MSGSTR:	BLOCK 1			; Structure for message file
LKB:	BLOCK .RBTIM+1		; Extended LOOKUP/ENTER block
PBLOCK:	BLOCK 10		; Path block
FILOPB:	BLOCK .FOPPN+1		; FILOP. block
SAVPSZ:	BLOCK 1			; Saved TTY page size
MYPPN:	BLOCK 1
OBUF:	BLOCK 3			; Output buffer headers
FILBLK:	BLOCK .FOPPN+1		; FILOP block for queued network mail
SENBLK:	BLOCK 10		;
ASCNOD:	BLOCK 5			; Storage for ASCII8 node name
LOKAPP:	BLOCK	1		;Level counter for getting append lock
   >;End TOPS10

OUTIFN:	BLOCK 1			; Output file IFN
OUTFOB:	BLOCK 2			; Output file FOB size and length
SAVMOD:	BLOCK 5			; Normal tty modes
LASTM:	BLOCK 1			; Number of messages in current file
FILPGM:	BLOCK 1			; Number of mapped pages for reading
FILPGS:	BLOCK 1			; Size of the file in pages
FILSIZ:	BLOCK 1			; Size of the file (bytes)
FILCRV:	BLOCK 1			; Creation date
FILWRT:	BLOCK 1			; Write date
LASTRD:	BLOCK 1			; Last read date of file
UNSEEN:	BLOCK 1			; Number of unseen messages
NDELET:	BLOCK 1			; Number of deleted messages
NFLAGD:	BLOCK 1			; Number of flagged messages
LASTN:	BLOCK 1			; Saved last number for pluralizing
DOMSG:	BLOCK 2			; Dispatch to process next message
HLPTXT:	BLOCK 1			; Pointer to text from help file
PSIPC:	BLOCK 1			; Saved pc from psi routine (level 3)
ILIPC:	BLOCK 1			; Saved pc from psi routine (level 2)
CTLCPC:	BLOCK 1			; Saved pc from psi routine (level 1)
TOPTRS:	BLOCK 1			; CC,,TO list pointers
RPRHNP:	BLOCK 1			; REPAIR flag
TRYSND:	BLOCK 1			; Use SENDER in REPLY (no FROM/REPLY-TO)
FRMLCL:	BLOCK 1			; From MSLCL or from SAVE OUTGOING-MESSAGES
DEFCC:	BLOCK 1			; Ptr to default cc list
NAMTAB:	BLOCK 1			; (Pointer to) name table
FRENAM:	BLOCK 1			; Pointer to free space for names
SV.TOP:	BLOCK 1			; Saved TOPTRS (for reparsing address lists)
SV.FNM:	BLOCK 1			; Saved FRENAM (ditto)
SV.NTB:	BLOCK 1			; Saved NAMTAB (ditto)
MOVDSP:	BLOCK 1			; Dispatch for typing or setting to, etc
REPLIN:	BLOCK ^D50		; Reply lines (In-reply-to and Reference)
SAVEL:	BLOCK 1			; Saved L (msg sequence pointer)
TTYUDX:	BLOCK 1			; Terminal UDX
LINEW:	BLOCK 1			; Terminal line width
REDLVL:	BLOCK 1			; Recursive read level depth
FILCOL:	BLOCK 1			; Fill column for auto-fill mode
TAKPDL:	BLOCK TAKPTN		; Stack for take file IFNs and FOBs
TAKPTR:	BLOCK 1			; Stack pointer
SVMFOB:	BLOCK 2			; Saved messages FOB size and address
SVMIFN:	BLOCK 1			; Saved messages IFN
INIIFN:	BLOCK 1			; IFN of init file being created
INIFOB:	BLOCK 2			; FOB size and addr of init file being created
SUBJEC:	BLOCK 1			; Subject field
AUTEXP:	BLOCK 1			; Magic number which controls auto-expunges
SVABLK:	BLOCK 1			; Saved A-block for GETUSR
UPDPTR:	BLOCK 1			; Updated byte pointer returned by TORs
UPDX:	BLOCK 1			; Updated X (horizontal position) for TORs
OBPTR:	BLOCK 1			; Output byte pointer (partly replaces AC O)
MSGID0:	BLOCK 1			; Date/time to compose msg id with
MSGID1:	BLOCK 1			; Job number for same
MSGID2:	BLOCK 1			; PPN or usernumber for same
MSGID3:	BLOCK 1			; Runtime in msec. for same
LDEPTH:	BLOCK 1			; Address list depth
WTOP::	BLOCK 1			; File window top address
WBOT::	BLOCK 1			; File window bottom address
MSGPGS:	BLOCK 1			; Pages allocated for message file
CNCLHD:	BLOCK 1			; Pointer to TBLUK table of suppressed headers
SCRREG:	BLOCK 1			; Ptr to routine to set scroll region
SCRBTM:	BLOCK 1			; Ptr to routine to undo scroll region and
				;  go to bottom line of screen
SCRRGR:	BLOCK 1			; Ptr to routine to do the reverse
BLKTIM:	BLOCK 1			; Universal date/time before which clear-screen
				;  not allowed (error message would vanish)
LFCNT:	BLOCK 1			; Line feed counter
MINWSZ:	BLOCK 1			; Minimum text window size
SCRLFL:	BLOCK 1			; Screen parameters need resetting flag
ABLHED:	BLOCK 1			; OWN storage for ADRLST reparse code
LCNT:	BLOCK 1			; Number of msgs in current message sequence
TOPPTR:	BLOCK 1			; Pointer to command table, top level
REDPTR:	BLOCK 1			; Pointer to command table, read level
SENPTR:	BLOCK 1			; Pointer to command table, send level
SETPTR:	BLOCK 1			; Pointer to command table, set commands
EXPRNC:	BLOCK 1			; Experience level, controls preceding 4 vars

   TOPS10<
MSIOWD:	BLOCK 2			; IOWD command list
MSGFD:	BLOCK FDXSIZ		; FD for message file
   >;End TOPS10
HLPTAB:	BLOCK 1			; Pointer to help topic table
HDITAB:	BLOCK 1			; Pointer to header-item table
KWDTBL:	BLOCK 1			; Pointer to alias/address list table
REPADD:	BLOCK 1			; Pointer to A-block list for reply-address
PERSON:	BLOCK 1			; Ptr to personal-name string
CLZTXT:	BLOCK 1			; Ptr to S-block for closing text

FLG:	BLOCK 1			; Headers Flags
HDIO:	BLOCK 1			;
HDI1:	BLOCK	1
FLAGS:	BLOCK	1
TENT1:	BLOCK 1
HBLKP:	BLOCK 1

OHSNMX==^D32			; Max no. headers to exclusively show
OHSN:	BLOCK 1			; Number of only-shown headers
OHSPTR:	BLOCK OHSNMX		; length of hdr name,,word addr of name string

;.JBINT block for trapping ctrl-C on TOPS10

   TOPS10<
INTF:	BLOCK 1			; -1 means interrupts not in progress
INTBLK:	BLOCK 3
   >;End TOPS10

CRFDEV:	BLOCK 2			; Created-files device
TOPS10<
CRFFDH:	BLOCK	FDMSIZ-1	;DUMMY HEADER FOR TOPS-10 PATH TYPEOUT
				;MUST BE JUST BEFORE CRFDIR
>
CRFDIR:	BLOCK 10		; Created-files directory
CRFPRT:	BLOCK 2			; Created-files protection
ZEREND:	0			; End of clear
UUOACS:	BLOCK 20		; Ac's during LUUO call
INTACS:	BLOCK 20		; During timer interrupt routines

PDL:	BLOCK NPDL		; Pushdown list

TOPS20<
INTP:	BLOCK 1			; Saved P during interrupt
INTPDL:	BLOCK NPDL		; Interrupt pushdown list
>;END TOPS20

STRBSZ==40
SAVF:	BLOCK 1
;**;[3096] Delete (move) 2 lines at SAVF: + 1	Ned	12-Aug-87

TOPS20<
IDXFIL: BLOCK ^D40		; Place to keep index file name
>;END TOPS20

IDXNUM:	BLOCK	1		; TEMP for GTMIND
IDXSAV:	BLOCK	3		; TEMP for GTMIND
;**;[3096] Delete (move) 3 lines at IDXSAV: + 1		Ned	12-Aug-87
STRBUF:	BLOCK STRBSZ		; Temporary string space
TOPS20<
JF2BUF:	BLOCK STRBSZ		; Temporary string space for GET command
MYSTR::	BLOCK 2			; Keep STR: here
>
MYDIR:	BLOCK 1			; Login directory
MYDIRS:	BLOCK 10		; ASCII of login directory
LIBVER:	BLOCK 1			; Place to keep GLXLIB Version number
TRANFG:	BLOCK 1			; Flags from last nodename done by TRANSH

;**;[3096] Delete (move) 13 lines at ATTBLK: - 1	Ned	12-Aug-87

SAB::	BLOCK 5			; SEND ARGUMENT BLOCK

Z.DRFB:!			;BEGINING OF BLOCK TO ZERO
DRFFOB:	BLOCK	FOB.MZ		;FOB OF DRF FILE
DRFFD:	BLOCK	FDXSIZ		;FD BLOCK OF DRF FILE
Z.DRFE:!			;END OF BLOCK TO ZERO
SUBTTL Impure storage inited nonzero

   TOPS10<
	IMPUR0
	..NZLO==:.		; Lowseg origin of nonzero-inited stuff
	PURE			; Make pure copy
	..NZHO==:.		; At this address
	PHASE ..NZLO		; But make like in low seg
	..NZT==:.		; For computing length of this stuff
   >;End TOPS10

CPYRIT::ASCIZ /COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1982,1983,1984/

;**;[3096] Insert (move to) 31 lines at CPYRIT:		Ned	12-Aug-87
TOPS10	<
ATTBLK:	EXP	3		;[3096][CJA] GALAXY file attributes (3 words total)
	XWD	1,.FIPRO	;[3096][CJA] Might specify protection
	EXP	CRFPRT		;[3096][CJA] Address of default file protection
>

NETFLG:	EXP	RJ.FLG		;[3096]
PIDBLK::PB.MNS,,0		;[3096] LENGTH OF THE PID BLOCK
	EXP 0			;[3096] PID (FILLED IN BY GLXLIB)
	IP.RSE			;[3096] RETURN TO CALLER IF SEND FAILS
	EXP 0			;[3096] NO INTERRUPT FOR IPCF
	EXP 0			;[3096] DON'T SET IPCF RECEIVE/SEND QUOTAS

MSGIFJ:	EXP -1			;[3096]
MSGFAD::EXP MSGA1               ;[3096] Address of beginning of message file
MSGPAG:	EXP MSGA1/1000		;[3096] Page of beginning of message file

MBOT:	EXP 0			;[3096] First message number in index section
MTOP:	EXP 777			;[3096] Last message number in index section
MSGJFN:	EXP -1 			;[3096] JFN for current message file
IPCTIM::^D300			;[3110] Wait time for IPCF response (patchable)

TOPS10<
MSGJF2: EXP -1 >		;[3096] JFN to open for write

FSCPKL:	0			;[3096] a LSHC A,<n> for SHIFT-IN goes here
	LSH A,1			;[3096]
	MOVEM A,(C)		;[3096] Address of dest stored in RH here
	0			;[3096] a LSHC A,<n> for SHIFT-OUT goes here
	MOVE B,(C)		;[3096] Address of source stored in RH here
	AOBJN C,FSCPKL		;[3096]
	JRST @FENTRM(D)		;[3096]

;PIDS THAT ARE NEEDED

PIDMS::	0			; PID of MS
PIDMX::	0			; PID of MX

MYHSPT:	POINT 7,MYHNAM,6
MYHNAM:	ASCIZ /@/
	BLOCK 17		; ARPANET host name

MYHDPT:	POINT 7,MYHDEC,6
MYHDEC:	ASCIZ /@/
	BLOCK 17		; DECNET host name

;TEXTI argument block

TTXTIB:	7			; .RDCWB - count
	RD%JFN			; .RDFLG - flags
	.PRIIN,,.PRIOU		; .RDIOJ - JFNs
TXTPTR:	0			; .RDDBP - destination byte pointer
TXTCNT:	0			; .RDDBC - destination byte count
	0			; .RDBFP - buffer pointer
	0			; .RDRTY - prompt string pointer
	TXTMS2			; .RDBRK - break table for text

; Texti break mask for user input

TXTMS2:
	110100001400		; ^B, ^E, ^K, ^Z, ESC
	000000000000
	000000000000
	000000000000

   TOPS20<
EDTGJB:	EXP GJ%OLD		; GTJFN block to default editor type to .EXE
	XWD .NULIO,.NULIO
	-1,,[ASCIZ /SYS:/]
	0
	-1,,[ASCIZ /EDIT/]
	-1,,[ASCIZ /EXE/]
	EXP 0
	EXP 0
	EXP 0

;**;[3074][3075] Add 9 lines at EMXGJB:+0L	MDR	14-AUG-86
EMXGJB:	EXP GJ%OLD		;[3074][3075] GTJFN to use the right EMACS.EXE
	XWD .NULIO,.NULIO	;[3074][3075]
	-1,,[ASCIZ /SYS:/]	;[3074][3075]
	0			;[3074][3075]
	-1,,[ASCIZ /EMACS/]	;[3074][3075]
	-1,,[ASCIZ /EXE/]	;[3074][3075]
	EXP 0			;[3074][3075]
	EXP 0			;[3074][3075]
	EXP 0			;[3074][3075]
   >;End TOPS20

;ENQ block for expunge interlock
; CAUTION -- offsets assumed to be the same on TOPS10 and TOPS20

ENQBLK:	1,,6			; Number of locks,,length of block
	NQID			; Magic number
	0			; Bits,,JFN
	POINT 7,[ASCIZ /Mail expunge interlock/]	; Name of lock
	0			; Unused fields
	0

   TOPS10<
;ENQ block for append interlock -- TOPS10 only
; Needed since TOPS10 screws up if two simultaneous appenders

APPQID==23456			; Magic number defined
APPBLK:	1,,6			; Number of locks,,length of block
	APPQID			; Magic number
	0			; Bits, channel number
	POINT 7,[ASCIZ /Mail append interlock/]
	0
	0			; Unused fields
   >;End TOPS10


;Trailer added to end of queued mail and saved mail

TRAILR:	ASCIZ /   --------
/

; Interrupt storage

   TOPS20<
LEVTAB:	CTLCPC
	ILIPC
	PSIPC


CHNTAB:	1,,CTLCIN		; 0 - ctrl-C
	EXP 0			; 1
	EXP 0			; 2
	EXP 0			; 3
	EXP 0			; 4
	3,,TMRINT		; 5 - timer interrupt
	XLIST			; Nothing else
	REPEAT ^D30,<EXP 0>	;  ..
	LIST

   >;End TOPS20

   TOPS10<
	..NZT==.-..NZT		; Compute number of words in nonzero lowseg
	DEPHASE			; Back to normality please
	IMPUR0			; Allocate space for this stuff
	BLOCK ..NZT		;  ..
   >;End TOPS10
SUBTTL High segment -- sharable data

	PURE

;GLXLIB initialization block

IB:	EXP 0			; Default everything except interrupt vectors
TOPS10<	EXP IT.OCT!IB.NPF >	; Open controlling terminal, no pfh
TOPS20<	EXP 0 >
TOPS20<	LEVTAB,,CHNTAB >
TOPS10<	EXP 0 >
	EXP PIDBLK		; Address of the PID Block
	EXP 0
	SIXBIT /MS/		; Program name


;Help message for host name parsing

HSTHLP:	ASCIZ /host name/
SUBTTL Page allocation


DEFPAG HDRPAG,10		; Header of msg currently being composed
DEFPAG TCPAG,NTCPAG		; TO/CC lists
DEFPAG NAMTXT,10		; Name strings for above lists

TOPS10<WWIDHN=^D10>		; Default to ten pages for mail file window
TOPS20<WWIDHN=^D100>		; Or one hundred on TOPS-20

WWIDH: EXP WWIDHN		; Number of pages for the mail window
DEFPAG MSGA1,WWIDHN		; Window into the mail file
DEFPAG MSGIDX,MSGIDN		; Window into the index file (if needed)
MSGSQN==^D10			; Buffer for sequences
DEFPAG MSGSSQ,MSGSQN		; ...
MSGSQE==MSGSSQ+MSGSQN*1000-1
 SUBTTL Main program

GO:	MOVX F,F%FDIR		; Clear flags, but light Force-directory-look
GO0:	MOVE P,[IOWD NPDL,PDL]
	RESET
   TOPS20<
	MOVEI A,<<TOPPAG+777>/1000>*1000
	MOVEM A,.JBFF##		; Protect our pages from GLXMEM
   >
	CALL MSINI 		; Initialize everything
	TXNE F,F%AMOD		; Auto mod feature?
	JRST MSGOD0		; Yes - enuf init for now

GO3:				;See if command on line which invoked us
   TOPS20<
	SETZ A,
	RSCAN			; check for command
	 ERJMP GO2		; None
	JUMPE A,GO2		; If char count zero, no cmd
   >;End TOPS20
   TOPS10<
	RESCAN 1		; See if anything there
	 SKIPA			; Could be...
	  JRST GO2		; Nothing, skip all this
	MOVX A,.NULIO		; Turn off GLXLIB echoing so users
	HRRM A,SBK+.CMIOJ	;  don't see command twice
   >;End TOPS10
	HRROI A,[0]		; Dummy ^R pointer
	MOVEM A,SBK+.CMRTY
	MOVEI A,GO4+1		; For reparse on error
	MOVEM A,REPARA		;  fake out return addrs.
	MOVEI A,[FLDDB. .CMINI]	; Init COMND
	CALL RFIELD
	MOVEI A,[FLDDB. (.CMKEY,,<[2,,2
				     [ASCIZ /MAIL/],,0
				     [ASCIZ /MS/],,0]>)]
	CALL RFLDE		; See if program name
	 JRST GO2		; Clean up and try normal case
	MOVEI A,[FLDDB. .CMCFM]	; Maybe just MS<CR>
	CALL RFLDE
	 JRST [	TXO F,F%RSCN		;  mark as exec command
		PUSH P,[CMDRES]		; Dummy return in case EOF on cmd input
		MOVEM P,CMDACS+P	;  insure stack doesn't disappear
		JRST CMDLLP]		;  and try command parse

	; ..
	; ..

GO2:
   TOPS20<
	HRROI A,[0]		; Clear rescan
	RSCAN
	 ERJMP .+1
   >;End TOPS20
   TOPS10<
	MOVX A,.PRIOU		; Turn echoing back on
	HRRM A,SBK+.CMIOJ	;  ..
   >;End TOPS10
	SKIPG MSGJFN		; Already have message file?
	CALL GETFIL		; No, get and parse one
	SKIPG MSGJFN		; Have we found something?
	JRST CMDRES		; No - message already printed
	CALL RECENT		; Show data on recent messages
	TXNN F,F%NSUM		; "Set no type-initial-summary"?
	CALL SUMMRY		; No, type summary of the files contents
	JRST CMDRES		; Enter main loop

; Auto message of the day hack

GO1:	MOVX F,F%AMOD		; Set CONgs
	JRST GO0		;  and join common code

;Handle initial command error

GO4:	CALL CLRFIB		; Clear typeahead
	JRST CKEXIT		; Just quit
CMDRES::MOVE P,[IOWD NPDL,PDL]
	PUSH P,[CMDRES]		; Dummy return in case EOF on .PRIOU
	CALL CMDINI		; Init command parser
CMDLUP:	MOVE T,TAKPTR		; See if inside command file
	HRRZ A,(T)		; Get current COMND input IFN
	CAIE A,.PRIIN		; Command file or TTY?
	JRST CMDLP0		;  file...
	TXZE F,F%RSCN		; Exec command?
	JRST [	MOVE A,AUTEXP		; Yes, auto-expunge always?
		CAIE A,1		;  ..
		JRST .EXIT1		; No, just close file and quit
		SKIPLE MSGJFN		; If we have a message file,
		CALL EXPUNG		; Expunge it
		JRST .EXIT1]		; Now close file and quit
CMDLP0:	SKIPE INIIFN		; Creating init file?
	JRST [	PROMPT (MS Create-init>>)
		JRST CMDLLP]		; Yes, different prompt
	PROMPT (MS>)
	MOVX A,F2%NSV		; Reset "suppress save" bit
	ANDCAM A,FLAGS2		;  ..
	HRRZ A,(T)		; Get current COMND input IFN
	CAIE A,.PRIIN		; File or TTY?
	JRST CMDLLP		; File, DON'T call slow routines like CHECK0!
	CALL CHECK0		; Check for new messages
	 JRST CMDLLP		; None - go on
	CALL CHECKS		; Got some - print headers
	JRST CMDLUP		; Re-prompt
	; ..
	; ..

CMDLLP:	MOVE A,TOPPTR		; Get pointer to command table
	SKIPE INIIFN		; Creating defaults file (init file)?
	MOVEI A,[FLDDB. (.CMKEY,,CINTAB)]	; Yes, choose cmd subset
	SETOM OKTINT		; OK for timer interrupt here
	TXZ F,F%VBTY		; Default is not verbose-type
	CALL RFIELD		; Read command
	SETZM OKTINT		; No more though
	HRRZ B,(B)		; Get entry
	MOVE B,(B)		; addr of routine
	PUSH P,B		; Save it
	SKIPG MSGJFN		; Have message file?
	TXNN B,C%GETF		; No - need to get message file?
	 SKIPA			;  Already have it or dont't need it
	CALL GETFIL		; Yes - get it
	HRRZ A,0(P)		; Command dispatch address
	CALL (A)		; Do the command
	POP P,A			; Restore dispatch word
	HRRZS A			; Only check significant part
	CAIE A,.TAKE		; Take command?
	CAIN A,.CREAT		;  or create-init command?
	JRST CMDLUP		; Yes, don't put it into init file!
	CAIN A,.HELP		; Also don't put help into init file
	JRST CMDLUP		;  ..
	MOVE C,[POINT 7,CMDBUF]	; Point to cmd in case it needs writing
	SKIPE A,INIIFN		; Creating init file?
	JRST [	ILDB B,C		; Yes, get next byte
		JUMPE B,CMDLUP		; Done, fetch next cmd
		$CALL F%OBYT		; Write to init file
		JRST .-1]		; Repeat for all bytes in cmd
	TXZN F,F%ESND		; Want to send something?
	JRST CMDLUP		; No - keep going
	SETZM LSTCHR		; Yes - invoke sender
	CALL ERSAL1		; Erase all but text
	CALL SEND0
	JRST CMDLUP		; And return to command loop
 SUBTTL Command tables

;Caution -- the CMD1 macro generates a reference to a label formed by
; preceding the command name with a dot.  This does not work, however, for
; command names containing hyphens.  For these commands, the CMDT macro,
; which requires an explicit label, must be used.

; Top level commands

TOPNOV:	NOVN,,NOVN		; Novice-mode commands
TOPS10<	CMDT (\"32,.EXIT0,CM%INV) >;Blue toads like ctrl-Z
	CMDT (BBoard,.BBORD,CM%INV)
	CMDT (Delete,,,C%GETF)
	CMDT (Directory,.HEADE,,C%GETF)
	CMD1 (Ex,ENTXXT,CM%ABR!CM%INV)
ENTXXT:	CMDT (Exit)
	CMDT (Expunge,,,C%GETF)
	CMDT (File,,,C%GETF)
	CMDT (Headers,.HEADE,,C%GETF)
	CMDT (Help)
TOPS20<	CMDT (Net-mail,.MAILR,CM%INV) >
	CMDT (Print,.LIST,,C%GETF)
	CMDT (Read,,,C%GETF)
	CMDT (Send,,,C%GETF)
	CMDT (Set)
	CMDT (Summarize,.HEADE,CM%INV,C%GETF)
	CMDT (System-messages,.MSGOD)
	CMDT (Undelete,,,C%GETF)
NOVN==.-TOPNOV-1

CMDTAB:	NCMDS,,NCMDS
TOPS10<	CMDT (\"32,.EXIT0,CM%INV) >;Blue toads again
	CMDT (Answer,.REPLY,CM%INV,C%GETF)	; Synonym for Reply
;**;[3094]  Replace 2 lines with 3 at CMDTAB+3.		NED	12 May 87
	CMD1 (B,ENTBLK,CM%ABR!CM%INV)		;[3094] Blank not BBoard
	CMDT (BBoard,.BBORD,CM%INV)
ENTBLK:	CMDT (Blank)				;[3094]
	CMDT (Check,,,C%GETF)
	CMDT (Copy,.PUT,,C%GETF)
	CMDT (Create-init-file,.CREAT)
	CMD1 (D,ENTDEL,CM%ABR!CM%INV)
	CMDT (Daytime)
	CMDT (Define)
ENTDEL:	CMDT (Delete,,,C%GETF)
	CMDT (Directory,.HEADE,,C%GETF)
	CMDT (Echo,,CM%INV)
TOPS20<	CMDT (EMACS,.EDITO,CM%INV) >
	CMD1 (Ex,ENTXIT,CM%ABR!CM%INV)
ENTXIT:	CMDT (Exit)
	CMDT (Expunge,,,C%GETF)
	CMDT (File,,,C%GETF)
	CMDT (Flag,,,C%GETF)
	CMDT (Forward,,,C%GETF)
	CMDT (Get)
	CMD1 (H,ENTHDR,CM%ABR!CM%INV)
ENTHDR:	CMDT (Headers,.HEADE,,C%GETF)
	CMDT (Help)
	CMDT (List,,CM%INV,C%GETF)
	CMDT (Mark,,,C%GETF)
	CMDT (Move,,,C%GETF)
	CMD1 (N,ENTNXT,CM%ABR!CM%INV)
TOPS20<	CMDT (Net-mail,.MAILR,CM%INV) >
ENTNXT:	CMDT (Next,,,C%GETF)
	CMDT (Print,.LIST,,C%GETF)
	CMDT (Push)
	CMDT (Quit)
	CMD1 (R,ENTRED,CM%ABR!CM%INV)
ENTRED:	CMDT (Read,,,C%GETF)
	CMDT (Redistribute,,CM%INV,C%GETF)
	CMD1 (Rep,ENTRP1,CM%ABR!CM%INV)
	CMDT (Repair)
ENTRP1:	CMDT (Reply,,,C%GETF)
	CMDT (Retrieve)
	CMD1 (S,ENTSND,CM%ABR!CM%INV)
	CMD1 (Sa,ENTSAV,CM%ABR!CM%INV)
	CMD1 (Sav,ENTSAV,CM%ABR!CM%INV)
ENTSAV:	CMDT (Save,.SAVTL)	; Top-level save command
	CMDT (Save-outgoing-messages,.SAVMS,CM%INV)
ENTSND:	CMDT (Send)
	CMDT (Set)
	CMDT (Show)
	CMDT (Skim)
	CMDT (SSend,.XSEND,CM%INV)
	CMDT (Status,.STATU,CM%INV,C%GETF)
	CMDT (Summarize,.HEADE,CM%INV,C%GETF)
	CMDT (System-messages,.MSGOD)
	CMD1 (T,ENTTYP,CM%ABR!CM%INV)
	CMDT (Take)
ENTTYP:	CMDT (Type,,,C%GETF)
	CMDT (Undelete,,,C%GETF)
	CMDT (Unflag,,,C%GETF)
	CMDT (Unmark,,,C%GETF)
	CMDT (Verbose-type,,,C%GETF)
	CMDT (ZSend,.ZSEND,CM%INV)
NCMDS==.-CMDTAB-1
;Commands available in create-init mode

CINTAB:	NINCMD,,NINCMD
	CMDT (Blank)
	CMDT (Check,,,C%GETF)
	CMD1 (D,ENIDEL,CM%ABR!CM%INV)
	CMDT (Daytime)
	CMDT (Define)
ENIDEL:	CMDT (Delete,,,C%GETF)
	CMDT (Directory,.HEADE,,C%GETF)
	CMDT (Echo,,CM%INV)
TOPS20<	CMDT (EMACS,.EDITO,CM%INV) >
	CMDT (Expunge,,,C%GETF)
	CMDT (Finish)
	CMDT (Flag,,,C%GETF)
	CMDT (Get)
	CMDT (Headers,.HEADE,,C%GETF)
	CMDT (Mark,,,C%GETF)
	CMD1 (N,ENINXT,CM%ABR!CM%INV)
TOPS20<	CMDT (Net-mail,.MAILR,CM%INV) >
ENINXT:	CMDT (Next,,,C%GETF)
	CMDT (Print,.LIST,,C%GETF)
	CMDT (Push)
	CMDT (Quit,.QUINI)
	CMD1 (R,ENIRED,CM%ABR!CM%INV)
ENIRED:	CMDT (Read,,,C%GETF)
	CMD1 (Rep,ENIRP1,CM%ABR!CM%INV)
ENIRP1:	CMDT (Reply,,,C%GETF)
	CMDT (Save,.SAVTL)
	CMDT (Set)
	CMDT (Show)
	CMDT (Skim)
	CMDT (Status,.STATU,CM%INV,C%GETF)
	CMDT (Summarize,.HEADE,CM%INV,C%GETF)
	CMDT (System-messages,.MSGOD)
	CMD1 (T,ENITYP,CM%ABR!CM%INV)
	CMDT (Take)
ENITYP:	CMDT (Type,,,C%GETF)
	CMDT (Undelete,,,C%GETF)
	CMDT (Unflag,,,C%GETF)
	CMDT (Unmark,,,C%GETF)
	CMDT (Verbose-type,,,C%GETF)
NINCMD==.-CINTAB-1
; Read commands

REDNOV:	NRNOV,,NRNOV		; Novice-mode read-level commands
	CMD (Answer,.RRPL1,CM%INV)
	CMD (Delete)
	CMD (File)
	CMD (Flag)
	CMD (Forward)
	CMD (Help)
	CMD (Next,.RDNXT)
	CMD (Print,.LIST)
	CMD (Quit,.RQUIT)
	CMD (Reply,.RREPL)
	CMD (Set)
	CMD (Type,.RTYPE)
	CMD (Undelete)
	CMD (Unflag)
NRNOV==.-REDNOV-1

RCMDTB:	NRCMDS,,NRCMDS
TOPS10<	CMD (\"32,.REXIZ,CM%INV) > 	; Blue Demons again
	CMD (Answer,.RRPL1,CM%INV)
	CMD (Backup,.RBACK)		; Synonym for "previous"
	CMD (Blank)
	CMD (Copy,.PUT)
	CMD1 (D,ENTRDL,CM%ABR!CM%INV)
	CMD (Daytime)
	CMD (Define)
ENTRDL:	CMD (Delete)
	CMD (Directory,.RHEAD)
	CMD (Echo,,CM%INV)
TOPS20<	CMD (EMACS,.EDITO,CM%INV) >
	CMD (Exit,.REXIT)
	CMD (File)
	CMD (Flag)
	CMD (Forward)
	CMD1 (H,ENTRHD,CM%ABR!CM%INV)
ENTRHD:	CMD (Headers,.RHEAD)
	CMD (Help)
	CMD (List,,CM%INV)
	CMD (Mark)
	CMD (Move)
TOPS20<	CMD (Net-mail,.MAILR,CM%INV) >
	CMD (Next,.RDNXT)
	CMD (Previous,.RPREV,CM%INV)
	CMD (Print,.LIST)
	CMD (Push)
	CMD (Quit,.RQUIT)
	CMD1 (R,ENTRD0,CM%ABR!CM%INV) ; Abbreviation for READ
ENTRD0:	CMD (Read)
	CMD (Redistribute,,CM%INV)
	CMD1 (Rep,ENTREP,CM%ABR!CM%INV)
	CMD (Repair)
ENTREP:	CMD1 (Reply,.RREPL)
	CMD (Retrieve)
	CMD1 (S,ENTSNX,CM%ABR!CM%INV)
entsnx:	CMD (Send)
	CMD (Set)
	CMD (Show)
	CMD (Skim)
	CMD (SSend,.XSEND,CM%INV)
	CMD (Status,.STATU,CM%INV)
	CMD (Summarize,.RHEAD,CM%INV)
	CMD (Take)
	CMD (Type,.RTYPE)
	CMD (Undelete)
	CMD (Unflag)
	CMD (Unmark)
	CMD (Verbose-type,.RVBTY)
NRCMDS==.-RCMDTB-1
; Send (and reply) commands

SENNOV:	NSNOV,,NSNOV		; Novice-mode send-level commands
	CMD (cc)
	CMD (Display)
	CMD (Edit,.SEDIT)
	CMD (Erase)
	CMD (Help)
	CMD (Insert)
	CMD (Quit,.SQUIT)
	CMD (Remove,.UNTO)
	CMD (Return-receipt-requested,.RETUR) ;
	CMD (Send,.SSEND)
	CMD (Set)
	CMD (Subject)
	CMD (Text)
	CMD (To)
NSNOV==.-SENNOV-1

SCMDTB:	NSCMDS,,NSCMDS
;**;[3106] Delete 1 line at SCMDTB+1		Ned 	9-Sep-88
	CMD (Blank)
	CMD (cc)
	CMD1 (D,ENTSDI,CM%ABR!CM%INV)
	CMD (Daytime)
	CMD (Define)
ENTSDI:	CMD (Display)
	CMD (Echo,,CM%INV)
	CMD (Edit,.SEDIT)
	CMD (Erase)
	CMD (Exit)
	CMD (Help)
	CMD (Include)
	CMD (Insert)
	CMD (Push)
	CMD (Quit,.SQUIT)
	CMD (Remove,.UNTO)
	CMD (Return-receipt-requested,.RETUR)
	CMD1 (S,ENTSSN,CM%ABR!CM%INV)
	CMD (Save,.SAVE)
ENTSSN:	CMD (Send,.SSEND)
	CMD (Set)
	CMD (Show)
	CMD (Status,.STATU,CM%INV)
	CMD (Subject)
	CMD (Take)
	CMD (Text)
	CMD (To)
	CMD (Type,.STYPE)
	CMD (Verbose-type,.VSTYP)
	CMD (ZSend,.ZSSND,CM%INV)
NSCMDS==.-SCMDTB-1

ECMDTB:	NECMDS,,NECMDS
	CMD All,.ERSAL
	CMD Cc,.ERSCC
	CMD Header-item,.ERSHD
	CMD Reply-information,.ERSDT
	CMD Subject,.ERSSB
	CMD Text,.ERSTX
	CMD To,.ERSTO
NECMDS==.-ECMDTB-1
DCMDTB:	NDCMDS,,NDCMDS
	CMD All,.DSALL
	CMD Cc,.DSCC
	CMD Subject,.DSSUB
	CMD Text,.DSTXT
	CMD To,.DSTO
NDCMDS==.-DCMDTB-1

EDCMTB:	NEDCMS,,NEDCMS
;	CMD All,.EDALL
;	CMD Cc,.EDCC
;	CMD Subject,.EDSUB
	CMD Text,.EDTXT
;	CMD To,.EDTO
NEDCMS==.-EDCMTB-1


RPCMTB:	NRPCMS,,NRPCMS		; REPLY commands
	CMD All,.REPAL
	CMD Sender-only,.REPTO
NRPCMS==.-RPCMTB-1


;Show commands

SHCMTB:	NSHCMT,,NSHCMT
	CMD (Address-lists,.SHADL)
	CMD (Aliases,.SHSYN)
	CMD (Daytime)
	CMD (Defaults,.SHDEF)
	CMD (Header-items,.SHHDI)
	CMD (Internal-information,.SHINT,CM%INV)
	CMD (Status,.STATU)
	CMD (Version)
NSHCMT==.-SHCMTB-1
;SET commands

SETNOV: 1,,1			; Novice-mode SET commands
	CMD (Experience-level,.STEXP)

STCMTB:	NSTCMD,,NSTCMD
	CMD (Auto-expunge,.STAUT)
	CMD (Auto-fill,.STAUF)
	CMD (Brief-address-list-display,.STBFD)
	CMD (Closing-text,.STCLZ)
	CMD (Concise-mode,.STCNC)
	CMD (Default,.STDFT)
	CMD (Directory-lookup-confirmation,.STDLC,cm%inv)
	CMD (Experience-level,.STEXP)
	CMD (Force-directory-lookup,.STFDI)
	CMD (Headers-on-printer-output,.STHLP,CM%INV)
	CMD (Headers-personal-name-only,.STHPR,CM%INV)
	CMD (Include-me-in-replies,.STINC)
TOPS20<	CMD (Logout-on-exit,.LOGOU) >
	CMD (No,.STNO)
	CMD (Only-headers-shown,.STOHS)
	CMD (Personal-name,.STPNM)
	CMD (Reply-address,.STRAD,CM%INV)
	CMD (Reply-to,.STRAD)	; Synonym
	CMD (Summary-on-printer-output,.STHLP)
	CMD (Summary-personal-name-only,.STHPR)
	CMD (Suppressed-headers,.STSPH)
	CMD (Text-scroll-region,.STWSZ)
	CMD (Type-initial-summary,.STSUM)
	CMD (Video-mode,.STVID)
NSTCMD==.-STCMTB-1

STCMT0:	NSTCM0,,NSTCM0		; SET commands which can be negated
	CMD (Auto-fill,.STAUF)
	CMD (Brief-address-list-display,.STBFD)
	CMD (Concise-mode,.STCNC)
	CMD (Directory-lookup-confirmation,.STDLC,cm%inv)
	CMD (Force-directory-lookup,.STFDI)
	CMD (Headers-on-printer-output,.STHLP,CM%INV)
	CMD (Headers-personal-name-only,.STHPR,CM%INV)
	CMD (Include-me-in-replies,.STINC)
	CMD (Personal-name,.STPNM)
	CMD (Reply-address,.STRAD,CM%INV)
	CMD (Reply-to,.STRAD)	; Synonym
	CMD (Summary-on-printer-output,.STHLP)
	CMD (Summary-personal-name-only,.STHPR)
	CMD (Suppressed-headers,.STSPH)
	CMD (Text-scroll-region,.STWSZ)
	CMD (Type-initial-summary,.STSUM)
	CMD (Video-mode,.STVID)
NSTCM0==.-STCMT0-1


;Set default

DFCMTB:	NDFCM0,,NDFCM0
	CMD Cc-list,.STDCC
	CMD Directory,.STCDI
	CMD Protection,.STCPR
	CMD Reply-to-all,.STRPA
	CMD Reply-to-sender-only,.STRPS
NDFCM0==.-DFCMTB-1
;Keyword table for set default directory

CRFDTB:	CRFDT0,,CRFDT0
	CMD Connected-directory,.STCND
	CMD Logged-in-directory,.STLGD
CRFDT0==.-CRFDTB-1

;Keyword table for set auto-expunge (on)

AUTCMT:	AUTCM0,,AUTCM0
	CMD Any-exit,1		; Magic numbers
	CMD Exit-command-only,2	; Default
	CMD Never,3
AUTCM0==.-AUTCMT-1


;Keyword table for define commands

DFNCTB:	DFNCT0,,DFNCT0
	CMD Address-list,.DEFSS
	CMD Alias,.DEFAS
	CMD Header-item,.DFHDI
DFNCT0==.-DFNCTB-1


;Keyword table for define header-item

HTYP0T:	HTYP00,,HTYP00
	CMD Optional,HD%OPT
	CMD Predefined,HD%PDF
	CMD Required,HD%RQD
HTYP00==.-HTYP0T-1

;Save command, top level

SVTLTB:	SVTLT0,,SVTLT0
	CMD (Outgoing-messages,.SAVMS)
SVTLT0==.-SVTLTB-1

;Save command, send level

SVCMTB:	SVCMT0,,SVCMT0
	CMD (Draft,.SAVDF)
	CMD (Outgoing-messages,.SAVMS)
SVCMT0==.-SVCMTB-1

;Retrieve commands

RETRCM:	RETRC0,,RETRC0
	CMD (Draft,.RESDF)
	CMD (Last-message,.RECOV)
RETRC0==.-RETRCM-1

;Insert commands

INSCTB:	INSCT0,,INSCT0
	CMD (File,.INSFI)
	CMD (Message,.INSMS)
INSCT0==.-INSCTB-1
; Headers of messages (SUMMARIZE command)

.RHEAD:	MOVEM F,SAVF
	JSP F,SAVMSQ		; Save message sequence context
	MOVE F,SAVF
	CALL DFSQTH		; Default to current
	CALL .HEAD0		; Call ordinary routine
	MOVEM F,SAVF
	JSP F,RESMSQ			; Restore context
	MOVE F,SAVF
	RET


.HEADE:	SAVMSX			; Save context if necessary
TOPS20<	SKIPG A,MSGJFN		; Does the mail file exist?
	JRST .HEAD2		; No, so do not check if file size changed
	CALL SIZFIL		; Yes, get latest infomation on file size
	SETOM CHNSIZ		; Error, assume file size has changed
	SKIPE CHNSIZ		; Has file size changed?
	CALL PARSEF		; Yes, do a total reparse
.HEAD2: >
	CALL DFSQNW		; Get sequence, default to new
	CALL .HEAD0		; Do the work
	RESMSX			; Restore context
	CALL SETREF		; Update last time mail file was read
	RET

.HEAD0:	SKIPN LCNT		; Any message at all?
	JRST [	WARN <No messages match this specification>
		RET]
HEADR1:	CALL NXTSEQ		; Get the next message in sequence
	 RET			; No more to do
	CALL TYPHDR		; Type its header
	JRST HEADR1


; Type messages

.VERBO:	TXO F,F%VBTY		; Set "verbose type" flag
.TYPE:	CALL DFSQTH
	SKIPN LCNT		; Any messages at all?
	JRST [	WARN <No messages match this specification>
		CALL SETREF	; Update the last time file was read
		RET]
TYPE1:	CALL NXTSEQ
	 JRST [	TXZ F,F%VBTY
		CALL SETREF	; Update the last time file was read
		RET]
	CALL CHKDEL		; See if deleted and type out warning
	 JFCL			; Unlike READ, type the message anyway.
	CALL TYPMSG
	JRST TYPE1
SUBTTL Routines to diddle various message flags

.FLAG:	SAVMSX			; Save context maybe
	MOVEI A,FLGMSG		; Flag messages
	MOVEI B,[ASCIZ / Flagged: /]
.FLAGX:	CALL SEQUEN
	RESMSX			; Restore context maybe
	RET

.UNFLA:	SAVMSX			; Save context maybe
	MOVEI A,UFLMSG		; Unflag messages
	MOVEI B,[ASCIZ / Unflagged: /]
	CALLRET .FLAGX		; Common exit

.UNMAR:	SAVMSX			; Save context maybe
	MOVEI A,UMKMSG		; Unmark message (make unseen)
	MOVEI B,[ASCIZ / Unmarked: /]
	CALLRET .FLAGX		; Common exit

.UNDEL:	SAVMSX			; Save context maybe
	MOVEI A,UNDMSG		; Undelete message
	MOVEI B,[ASCIZ / Undeleted: /]
	CALLRET .FLAGX		; Common exit

.MARK:	SAVMSX			; Save context maybe
	MOVEI A,MRKMSG		; Mark message (as seen)
	MOVEI B,[ASCIZ / Marked: /]
	CALLRET .FLAGX		; Common exit
.DELET:	SAVMSX			; Save context maybe
	MOVEI A,DELMSG		; Delete message
	MOVEI B,[ASCIZ / Deleted: /]
	CALLRET .FLAGX		; Common exit

FLGMSG:	MOVX A,M%ATTN		; Mark as attention needed
	MOVE C,[AOS NFLAGD]	; And increment number flagged
	JRST SETBIT

UFLMSG:	MOVX A,M%ATTN		; Mark as unflagged
	MOVE C,[SOS NFLAGD]	; Decrement number of messages flagged
	JRST CLRBIT

DELMSG:	MOVX A,M%DELE		; Mark as deleted
	MOVE C,[PUSHJ P,DELMS1]	; We will also mark as read
	JRST SETBIT
DELMS1:	AOS NDELET		; Keep counts up to date
	MOVX A,M%SEEN		; Was this message unread?
	TRNE A,(D)		;  before we deleted it?
	 JRST DELMS2		; No, do normal things.
	IORM A,MSGBTS(B)	; Mark it as read now.
	SOS UNSEEN		; One less unread message.
DELMS2:	MOVX A,M%DELE		; Restore our own bit
	RET			;  and return.

UNDMSG:	MOVX A,M%DELE		; Mark as undeleted
	MOVE C,[SOS NDELET]	; Keep counts up-to-date
	JRST CLRBIT

MRKMSG:	MOVX A,M%SEEN		; Mark as seen
	MOVE C,[SOS UNSEEN]	; One less new message
SETBIT:	GTMBL (M,B)		; Get ptr to message block
	MOVE D,MSGBTS(B)	; Get the message bits handy
	TRNE A,(D)		; Did we already have this bit set?
	 RET			; Yes, well we don't have much to do then
	XCT C			; Keep counts accurate
	IORM A,MSGBTS(B)	; Set it
	JRST UPDBIT		; Go update the message bits

UMKMSG:	MOVX A,M%SEEN		; Mark as unseen
	MOVE C,[AOS UNSEEN]	; One more new message
CLRBIT:	GTMBL (M,B)		; Get ptr to message block
	MOVE D,MSGBTS(B)	; Get the message bits handy
	TRNN A,(D)		; Did we already have this bit unset?
	 RET			; Yes, well we don't have much to do then
	XCT C			; Keep counts accurate
	ANDCAM A,MSGBTS(B)	; Unset the bit
	JRST UPDBIT		; Go update the message bits
;Here to perform some action on a sequence of messages
;Call:
;	A/ address of routine to munch message
;	B/ address of ASCIZ reassurance string

SEQUEN:	DMOVEM A,DOMSG		; Set up handler
	CALL DFSQTH		; Get sequence, default to current
SEQUE0:	MOVE A,LCNT		; Get count of msgs in this sequence
	CAIN A,1		; Is there only one?
	SKIPG REDLVL		;  and is this a READ or SKIM mode command?
	SKIPA			; No to either
	JRST SEQUE2		; Yes, no confirmations then
	CALL CRIF		; In case random error messages have happened
	MOVE A,DOMSG+1		; Type reassurance string
	HRLI A,(POINT 7,)
	$CALL KBFTOR		; Flush buffers, this might be slow
SEQUE1:	CALL NXTSEQ		; Next message spec'd
	 CALLRET PRTSQS		; No more, type end of them
	CALL @DOMSG		; Process the message
	CALL PRTSEQ		; Print out the numbers
	JRST SEQUE1
SEQUE2:	MOVX A,F2%NSQ		; No sequence flag
	IORM A,FLAGS2		;  ..
	CALL NXTSEQ		; Get next (only) message
	 JRST [	WARN <MS internal error:  SEQUE2>
		JRST SEQUE3]
	CALL @DOMSG		; Call handler
	CALL NXTSEQ		; Bug filter
	 JRST SEQUE3
	WARN <MS internal error:  LCNT and NXTSEQ don't agree>
SEQUE3:	MOVX A,F2%NSQ		; Clear no sequence flag
	ANDCAM A,FLAGS2
	RET
SUBTTL GET command - Get another message file

.GET:	NOISE (messages from file)
	TXZ F,F%F2		; Allow printing of file status
	TXZ F,F%RSCN		; Don't return to EXEC after reading file
   TOPS20<
	MOVX A,GJ%OLD		; Must exist
	MOVEM A,CJFNBK+.GJGEN
	HRROI A,[ASCIZ /POBOX:/]	; Default to PS:<logged-in-directory>
	MOVEM A,CJFNBK+.GJDEV
	HRROI A,MYDIRS
	MOVEM A,CJFNBK+.GJDIR
	HRROI A,[ASCIZ /MAIL/]
	MOVEM A,CJFNBK+.GJNAM
	HRROI A,[ASCIZ /TXT/]
	MOVEM A,CJFNBK+.GJEXT
   >;End TOPS20
   TOPS10<
	SETZM CJFNBK		; First zero the block
	MOVE A,[CJFNBK,,CJFNBK+1]
	BLT A,CJFNBK+CJFNLN-1
	MOVE A,[SIXBIT /MAIL/]
	MOVEM A,CJFNBK+.FDNAM
	MOVSI A,(SIXBIT /TXT/)
	MOVEM A,CJFNBK+.FDEXT
   >;End TOPS10
	MOVEI A,[FLDDB. .CMFIL]
	CALL CFIELD
	TXZ F,F%AMOD!F%MOD
	SETZM GTFLAG
 	JRST GET1		;GO DO THE WORK
.NEXT:	NOISE (message)
	CONFRM			; Confirm first
	SKIPG MSGJFN
	 JRST [	WARN (No current mail file)
		RET]
	CAME M,LASTM		; At last message?
	 AOJA M, [ CALL SETREF	  ; Update the last read of mail file
		   JRST TYPMSG ]   ; No, type the next one then
	CIETYP < Currently at end, message %M.
>
	RET
.EXIT:	NOISE (and update message file)
	CONFRM			; Confirm first
.EXIT0:	CALL CHECK0		; Any newly arrived mail?
	 SKIPA			; No, continue
	  JRST [CALL CLRFIB		; Clear typeahead - this is unexpected
		CALL CHECKS		; Type message
		JRST .+1]		; Go on
	MOVE A,AUTEXP		; Get auto-expunge magic number
	TXNN F,F%MOD		; SYSTEM messages?
	CAIN A,3		;  or never do auto-expunge?
	JRST .EXIT1		; Yes to either, don't try then
	SKIPLE MSGJFN		; If file exists,
	 CALL EXPUNG		;  then expunge first
.EXIT1:	SKIPG MSGJFN		; Still have file?
	JRST CKEXIT		; No, just quit
TOPS20<	CALL UNMAPF >		; Yes - unmap message file
	CALL CLOSEF		;  and flush JFN

CKEXIT:	CALL CKXRTN		; Exit and return if continued
	MOVE P,[IOWD NPDL,PDL]	; If continued, reset stack
	JRST GO3		;  and try a rescan (so KEEP CONTINUE wins)

CKXRTN:	TXNE F,F%MOD		; Never do implied EXPUNGE for system mail
	JRST CKXIT0		;  ..
	MOVE A,AUTEXP		; Get auto-expunge magic number
	CAIN A,1		; Do for any exit?
	JRST [	SKIPLE MSGJFN		; Yes, have a message file?
		CALL EXPUNG		; Yes, do it then
		JRST .+1]
CKXIT0:	SKIPE SCRLFL		; If scroll region in effect,
	JRST [	CALL @SCRRGR		; Undo scroll region stuff
		CALL @SCRBTM		; Get to bottom of screen
		SETZM SCRLFL		; Reset flag
		JRST .+1]
	$CALL K%FLSH		; Make sure user sees everything we've typed
   TOPS20<
	TXNN F,F%LOGO
	JRST CKXIT1
	MOVNI A,1
	LGOUT
	 JRETER <Failed to logout job>
CKXIT1:	HALTF
   >;End TOPS20

   TOPS10<
;**;[3095] Insert 2 lines at ckxit0: + 16	Ned	5-Aug-87
	SKIPLE MSGJFN		; [3095]Do we still have the file open?
	CALL CLOSEF		; [3095]Yes, don't leave the file sitting around
	MONRT.
	MOVX A,.PRIOU		; In case continued
	HRRM A,SBK+.CMIOJ	;  turn echoing back on
   >;End TOPS10
;**;[3087] Change 1 line at .DEFAS:-8L	MDR	 7-APR-87
;**;[3086] Add 1 line at .DEFAS:-8L	MDR	20-MAR-87
	SETOM MSGSSQ		;[3086][3087] Reset the message sequence
	CALL TTINI		; See if user changed terminal types
	RET
SUBTTL Define commands - define alias and define address-list

;Define alias

.DEFAS:	MOVX B,AB%INV		; This flavor is invisible to recipient
	MOVEI A,[FLDDB. (.CMTOK,,<POINT 7,[ASCIZ /*/]>,,,[FLDDB. (.CMQST,,,,,[FLDBK. (.CMFLD,,,<name of alias>,,[BRMSK.(USRB0.,USRB1.,USRB2.,USRB3.)])])])] ;[3108] Alias parse
	JRST .DEFS1


;Define address-list

.DEFSS:	SETZ B,			; This kind will be visible to recipient
	MOVEI A,[FLDDB. (.CMTOK,,<POINT 7,[ASCIZ /*/]>,,,[FLDDB. (.CMQST,,,,,[FLDBK. (.CMFLD,,,<name of address list>,,[BRMSK.(USRB0.,USRB1.,USRB2.,USRB3.)])])])] ;[3108] Address list parse
;	JRST .DEFS1
;Common code to define address lists or aliases

.DEFS1:	STKVAR <SYN0,ADRL,TBENT0,FLGS,FCNB>	; Synonym ptr, addr list ptr, table entry addr, fcn blk addr
	MOVEM A,FCNB		; Save function block address
	MOVEM B,FLGS		; Save flags
	NOISE (name)
	MOVE A,FCNB		; Restore function block address
	CALL RFIELD		; Parse the synonym
	MOVE A,CR.COD(A)	; Get fcn parsed
	CAIN A,.CMTOK		; * (all)?
	JRST .DEFA8		; Yes, go delete all aliases/address-lists
	SETZM SYN0		; No string yet
	CALL CPYATM		; No, allocate string blk and copy atom to it
	 JRST .DEFAE		; No space
	MOVEM A,SYN0		; Save address of string
	HRLI A,(POINT 7)	; Scan string, allow only reasonable things
	CALL SCNASN		;..
	JUMPN B,[
		WARN <Illegal character in Alias name>
		MOVE A,SYN0
		CALL RELSB
		RET
	]
	NOISE (to be)
	SETZM ADRL		; No address list
	CALL ADRLST		; Parse addresses and form list
	 JRST .DEFAE		; Error
	MOVEM A,ADRL		; Save ptr to head of addr list
	MOVE B,FLGS		; Get flags for this synonym
	MOVEM B,AB.FLG(A)	; Stuff into A-block
	MOVE A,KWDTBL		; See if this one already exists
	MOVE B,SYN0		; Point to synonym string
	HRLI B,(POINT 7,)	;  ..
	$CALL S%TBLK		;  ..
	TXNN B,TL%EXM		; Exact match?
	JRST .DEFA1		; No, just add to table then
	MOVEM A,TBENT0		; Yes, save address of entry
	HRRZ B,(A)		; Get code or pointer to A-block
	CAIN B,SYSCOD		; Code?
	JRST [	WARN (Can't redefine or delete definition of SYSTEM)
		MOVE A,SYN0		;  ..
		CALL RELSB		; Release string block no longer needed
		RET]
	CALL ABREL		; Delete or supersede - release all A-blocks
	MOVE A,SYN0		; So release that as well
	CALL RELSB		;  ..
	SKIPE ADRL		; Any address list returned?
	JRST .DEFA2		; Yes, superseding
	MOVE B,TBENT0		; No, deleting - release synonym name also
	HLRZ A,(B)		;  ..
	CALL RELSB
	MOVE A,KWDTBL		; Remove entry from table
	MOVE B,TBENT0		;  ..
	$CALL S%TBDL		;  ..
	RET			; All done!
;Here to supersede an existing alias

.DEFA2:	MOVE A,ADRL		; Point to address list
	MOVE B,TBENT0		; Address of table entry
	HRRM A,(B)		; Point existing table entry at new expansion
	RET			; All done

;Here to add an entirely new alias

.DEFA1:	SKIPN B,ADRL		; Insure that we got an address
	JRST [	WARN (No address specified)
		RET]
	MOVEI A,KWDTBL		; Where to add table entry
	HRL B,SYN0		; Address of synonym string
	CALL TBADDS		; Add to table, expand if necessary
	JUMPF [	CMERR (Can't add synonym to table)
		RET]
	RET

;Here if no room

.DEFAE:	WARN (Can't get memory)
	SKIPE A,SYN0		; If string block got allocated,
	CALL RELSB		;  release it
	RET


;Here to delete all address-lists/aliases (define alias *)

.DEFA8:	CONFRM
	HLLZ E,@KWDTBL		; Count of entries in table
	JUMPE E,R		; Quit if none
	MOVN E,E		; Form AOBJN ptr to table
	HRR E,KWDTBL		;  ..
	ADDI E,1		; Skip header word
.DEFA9:	HRRZ B,(E)		; Get next entry
	CAIN B,SYSCOD		; SYSTEM?
	JRST .DEFA7		; Yes, skip it
	MOVE A,AB.FLG(B)	; Get flags for this entry
	XOR A,FLGS		; See if the kind we want
	TXNE A,AB%INV		; Does this bit match?
	JRST .DEFA7		; No, skip this entry then
	CALL ABREL		; Delete A-block
	HLRZ A,(E)		; Get address of name string
	CALL RELSB		; Release space
	MOVE A,KWDTBL		; Remove from TBLUK table
	MOVEI B,(E)		; Point to entry to remove
	$CALL S%TBDL		; Delete it
	SUBI E,1		; Account for shortening of table
.DEFA7:	AOBJN E,.DEFA9		; Loop through table
	MOVE A,KWDTBL		; Shorten the table
	CALLRET COMPAC		;  and return

;Scan alias string (BP in A), checking for reasonable characters. Mostly,
; we don't want Comma in an alias name, but A..Z a..z 0..9 .-%&_$ and space
; are sufficient. Return B/0 if it looks OK, B/ nonzero otherwise.
SCNASN:	SETZ C,
SCNALN:	ILDB B,A		; Get character
	JUMPE B,[
		CAIN C,0	;No real characters in?
		MOVEI B," "	; Return failing
		RET]
	CAIN B," "
	JRST	[
		JUMPN C,SCNALN	;Leading space?
		RET]		;Yes; return failing
	CAIL B,"A"
	CAILE B,"Z"
	CAIN B,"-"
	AOJA C,SCNALN
	CAIL B,"a"
	CAILE B,"z"
	CAIN B,"."
	AOJA C,SCNALN
	CAIL B,"0"
	CAILE B,"9"
	CAIN B,"_"
	AOJA C,SCNALN
	CAIE B,"%"
	CAIN B,"$"
	AOJA C,SCNALN
	CAIN B,"&"
	AOJA C,SCNALN
	RET
SUBTTL Define commands - ADRLST - parse an address list

;Parse an address list and form linked list of A-blocks
;
;Return	+1: Failure, no room or bad syntax
;	+2: Success, A points to head of list

ADRLST:	TRVAR <AB0,AB1,<ADRS,SB.LEN>>	; Head, current
	MOVEI A,AB.LEN		; Size of an A-block
	$CALL M%GMEM		; Allocate a chunk
	JUMPF R			; Failure
	MOVEM B,AB0		; Save head pointer
	CALL ADRLSV		; Save state and set up for reparse
ADRLS0:	MOVEM B,AB1		; Make this current
	MOVEI U,ADRS		; Point to string space on stack
	CALL GETUSR		; Parse an address
	 JRST ADRLSX		; CRLF -- all done
	MOVE C,AB1		; Point to current A-block
	HRRZM B,AB.COD(C)	; Store user number or code
	MOVEI A,ADRS		; Point to address we got
	HRLI A,(POINT 7,)	; Form byte pointer
	CALL COUNTS		; Size it up
	CALL ALCSB		; Allocate a string block for it
	 JRST [	WARN <Can't parse address list, insufficient memory>
		RET]
	MOVE C,AB1		; Point to current A-block
	MOVEM B,AB.ADR(C)	; Set up pointer to address string
	HRLI B,(POINT 7,)	; Form byte pointer
	MOVE A,B		; Set up dest for MOVST0
	MOVEI B,ADRS		; Point to stack copy of address
	CALL MOVST0		; Copy to string block
	TXZE F,F%CMA		; More addresses to come?
	JRST [	MOVEI A,AB.LEN		; Yes, get another chunk
		$CALL M%GMEM		;  ..
		JUMPF ADRLSE		; Sigh...  fail
		MOVE A,AB1		; Point to current block
		MOVEM B,AB.LNK(A)	; Chain
		JRST ADRLS0]		; Go fetch next address
ADRLSX:	MOVE A,AB0		; Point to head
	SKIPN AB.COD(A)		; Any addresses typed at all?
	JRST [	MOVE B,A		; For ABREL
		CALL ABREL		; No, release all chunks
		SETZ A,			; Signal null address spec
		RETSKP]
	RETSKP			; Yes, all done

ADRLSE:	MOVE B,AB0		; Failure, release chunks
	CALLRET ABREL		;  and give bad return
;Routine to prepare for reparse -- calls remainder of ADRLST as coroutine

ADRLSV:	MOVEM B,ABLHED		; Save head of list in OWN storage
	MOVEI A,ADRLS2		; Where to go in case reparse needed
	HRRM A,SBK+.CMFLG	; Inform S%CMND
	EXCH A,REPARA		; Inform CMDERR, get what it wanted before this
	MOVEM A,REPAR0		; Save what was originally there
	MOVEI A,ADRLS1		; Where to go to restore world
	EXCH A,(P)		; Set up so coroutine exit restores world
	JRST (A)		; Call remainder of ADRLST as coroutine


;This routine called by reparse code at CMDERR or from S%CMND via .CMFLG word
; First instruction is in case of SOSing reparse address because reprompt needed

	SOS REPAR0		; Decrement saved reparse addr to force reprompt
ADRLS2:	MOVEI A,REPARS		; Original reparse address
	HRRM A,SBK+.CMFLG	; Restore
	MOVE A,REPAR0		; Original reparse routine
	MOVEM A,REPARA		; Restore
	SKIPE B,ABLHED		; Deallocate A-block chain
	CALL ABREL		;  ..
	JRST REPARS		; Now go do fancy reparse stuff


;Routine called when coroutine finally exits (ADRLST finishes or bombs)

ADRLS1:	TDZA B,B		; Watch out for skip/nonskip returns
	MOVEI B,1		; B gets offset (A returns ADRLST's result)
	ADDM B,(P)		; Correct return address
	MOVEI B,REPARS		; Restore default reparse stuff
	HRRM B,SBK+.CMFLG	;  ..
	MOVE B,REPAR0		;  ..
	MOVEM B,REPARA		;  ..
	RET			;  and return

;Here to release chain of A-blocks, B points to first block

ABREL:	STKVAR <AHED>
	MOVEM B,AHED		; Save pointer
	SKIPE A,AB.ADR(B)	; If there is an string block pointed to,
	CALL RELSB		;  release it
	MOVE B,AHED		; Restore pointer to A-block list
	MOVE D,AB.LNK(B)	; Get link
	MOVEI A,AB.LEN		; Length of an A-block
	$CALL M%RMEM		; Release chunk
	JUMPE D,R		; If no link, done
	MOVE B,D		; Link, do next
	JRST ABREL		;  ..
SUBTTL Define commands - MVALST - move an address list

;Move an address list, handling line wrap and XMAILR-style quoting
;Call:	A/ ptr to head of address list
;	X/ Horizontal position

MVALST:	STKVAR <ABLK,BRAKF>	; Ptr to current A-block
	MOVEM A,ABLK
	SETZM BRAKF		; No brackets needed yet
MVALS0:	MOVE A,ABLK
	MOVE B,AB.ADR(A)	; Get address of string block for address text
	HRLI B,(POINT 7,)
	HRRZ C,AB.COD(A)	; Get user number or code
	CAIN C,PFXCOD		; Is this an address list prefix?
	JRST [	CALL MOVTU0		; Yes, type it
		MOVEI A,":"		; Punctuate
		XCT MOVDSP		;  ..
		MOVE A,ABLK		; Restore current A-block ptr
		MOVE A,AB.LNK(A)	; Get ptr to next
		MOVEM A,ABLK		; Make current
		AOJA X,MVALS2]		; Go check for line wrap
	CAIN C,PRNCOD		; Personal name?
	JRST [	CALL MOVTU0		; Yes, type it
		SETOM BRAKF		; Flag punctuation needed for address
		MOVE A,ABLK		; Point to current
		MOVE A,AB.LNK(A)	; Get next
		MOVEM A,ABLK		; Make current
		AOJA X,MVALS2]		; Continue
	MOVEI A,"<"		; Just in case...
	SKIPE BRAKF		; Brackets needed?
	XCT MOVDSP		; Yes, type one
	CALL MOVADR		; Normal address, just type it
	MOVEI A,">"		; Closing bracket if needed
	SKIPE BRAKF		;  ..
	XCT MOVDSP		; Close it up
	SETZM BRAKF		; Clear flag
MVALS1:	MOVE A,ABLK		; Restore A-block pointer
	SKIPN B,AB.LNK(A)	; Any more entries?
	RET			; No, return
	MOVEM B,ABLK		; Yes, make this one current
	MOVE C,AB.COD(B)	; Get usernum or code of this entry
	CAIN C,SFXCOD		; Suffix?
	JRST [	MOVEI A,";"		; Yes, type it
		XCT MOVDSP		;  ..
		AOJA X,MVALS1]		; Check for more suffixes or addresses
	MOVEI A,","		; Type comma, there's more coming
	XCT MOVDSP		;  ..
MVALS2:	CAIL X,ADRWTH		; Or too close to right margin?
	JRST [	MOVEI B,[ASCIZ /
    /]
		CALL MOVSB2		; Move CRLF and indentation
		MOVEI X,4		; Init horizontal position
		JRST MVALS0]		; Type next address
	MOVEI A," "		; Same line, type space
	XCT MOVDSP		;  ..
	ADDI X,2		; Update column position
	JRST MVALS0
SUBTTL Define commands - Define header-item

.DFHDI:	NOISE (name)
	TXZ F,F%F1		; Assume not supersede or delete
	setz	e,			;not rrr
	MOVEI A,[FLDDB. (.CMTOK,,<POINT 7,[ASCIZ /*/]>,,,[FLDDB. (.CMQST,,,,,[FLDDB. (.CMFLD,,,<name of header item>)])])]
	CALL RFIELD		; Get the name
	MOVE A,CR.COD(A)	; Get function parsed
	CAIN A,.CMTOK		; Token? (asterisk)
	JRST .DFHD6		; Yes, confirm and delete all header-items
	MOVE B,[POINT 7,ATMBUF]
	SKIPN A,HDITAB		; See if name already exists
	JRST .DFHD1		; Table empty, this header item is new
	$CALL S%TBLK		; Table nonempty, look up this entry
	TXNE B,TL%EXM		; Exact match?
	JRST [	TXO F,F%F1	; Yes, flag supersede/delete
		MOVEM A,TENT1	; Save addr of existing table entry
		JRST .DFHD0]	; Don't make new name block
.DFHD1:	CALL CPYATM		; New hdr-item, copy name to string block
	 RET			; Failure
	MOVEM A,HDIO		; Save address of string block
;	JRST .DFHD0
;define header-item (cont'd.)

.DFHD0:	NOISE (type)
	MOVEI A,[FLDDB. (.CMKEY,,HTYP0T,,,[FLDDB. (.CMCFM)])]
	CALL RFIELD		; Get name or CR
	MOVE A,CR.COD(A)	; Get function parsed
	CAIN A,.CMCFM		; Confirm?
	JRST .DFHD8		; Yes, delete this entry then
	HRRZ B,(B)		; Get flags for this keyword
	MOVEM B,FLG		; Save
	MOVEI A,[FLDDB. (.CMKEY,,HTYP1T)]
	CALL RFIELD		; Parse type
	HRRZ B,(B)		; Get flags for this keyword
	IORB B,FLG		; Set more bits
	ANDI B,HD%TYP		; ***Should use LOAD
.DFHDA:	HLRZ A,GETHDA(B)	; Get size of chunk for this type H-block
	$CALL M%GMEM		; Get the chunk
	JUMPF .DFHD9		; No room
	MOVEM B,HDI1		; Remember this address
	MOVEM A,HD.SIZ(B)	; Put size into chunk
	MOVE A,HDI1		; Addr of H-block
	MOVE B,FLG		; Get flags and type
	MOVEM B,HD.FLG(A)	; Store in H-block
	ANDI B,HD%TYP		; Get just type
	CAIN B,HD%KWD		; Keyword?
	JRST [	NOISE (list)
		MOVE B,FLG		; Insure not predefined
		TXNE B,HD%PDF		;  ..
		CWARN (Keyword header-item cannot be predefined)
		MOVEI A,^D100		; Allocate table space
		$CALL M%GMEM
		MOVE A,HDI1		; Point to H-block
		MOVEM B,HD.DAT+1(A)	; Point H-block to table
		MOVEI A,^D99		; Number of entries
		MOVEM A,(B)		; Init table header word
		MOVE A,B		; For KWDLST
		PUSH P,A		; Save table address
		CALL KWDLST		; Parse list
		POP P,A			; Restore table address
		HLRZ B,(A)		; Get count of entries presented
		JUMPE B,[MOVE B,A		; None, error - release
			MOVEI A,^D100		;  storage for table
			$CALL M%RMEM		;  ..
			WARN <No keywords specified>
			RET]			; Error return
		CALL COMPAC		; Compact the table
		JRST .DFHD3]		; Can't be predefined
	MOVE B,FLG			;
	TXNN B,HD%PDF		; Predefined header-item?
	JRST .DFHD2		; No, don't parse one now then
	CALL GETHDI		; Parse the header-item
	 RET			; Error, msg already typed
	JRST .DFHD3		; GETHDI got the confirmation
.DFHD2:	JUMPN E,.DFHD3		; If a rrr commmand don't need to confirm
	CONFRM
.DFHD3:	TXZE F,F%F1		; Superseding existing entry?
	JRST [	MOVE D,TENT1		; Yes, get its addr
		HRRZ A,(D)		; Get old H-block addr
		CALL HBREL		; Release
		MOVE A,HDI1		; Addr of new block
		MOVE D,TENT1		; recover address to store to!
		HRRM A,(D)		; Replace
		RET]			; All done
	MOVEI A,HDITAB		; Header-item table
	HRLZ B,HDIO		; String address (name of header-item)
	HRR B,HDI1		; Address of header-item block
	CALL TBADDS		; Add to table
	JUMPF [	WARN (Couldn't add header-item to table)
		RET]
	RET


;Here to delete all header-items (define header-item *)

.DFHD6:	CONFRM
	SKIPN A,HDITAB		; If a table exists
	RET			;  ..
	HLRZ E,(A)		; Get number of header-items
	JUMPE E,R		; If none, done
.DFHD7:	MOVE A,HDITAB		; Entry to be removed is always first
	ADDI A,1		;  ..
	CALL HDIDEL		;  since HDIDEL moves 'em all down one
	SOJG E,.DFHD7		; Loop through all entries
	RET			;  and return


;Here to delete header-item definition

.DFHD8:	TXNN F,F%F1		; Insure that we found a match
	JRST [	HRRO A,HDIO		; Point to name
		WARN <Header-item "%1S" does not exist>
		MOVE A,HDIO		; Get pointer to string block again
		CALL RELSB		; Release storage
		RET]
	HRRZ A,TENT1		; Address of entry to delete
	CALLRET HDIDEL		; Delete it and return


.DFHD9:	CMERR (No room)
	RET
SUBTTL Define commands - HDIDEL - delete a header-item

;Delete an entry from HDITAB and associated storage
;A/ address of entry to delete

HDIDEL:	STKVAR <T0>
	MOVEM A,T0		; Save address of table entry
	HLRZ A,(A)		; Get ptr to name block
	CALL RELSB		; Release it
	MOVE A,T0		; Recover address of table entry
	HRRZ A,(A)		; Addr of H-block
	CALL HBREL		; Release H-block
	MOVE A,HDITAB		; Header-item table
	MOVE B,T0		; Addr of entry to remove
	$CALL S%TBDL		; Do it
	RET
SUBTTL Define commands - HBREL - release H-block storage

;Release H-block storage - must release associated blocks too
;Call:	A/ Addr of H-block

HBREL:	STKVAR <HBADD>
	MOVEM A,HBADD		; Remember address for a bit
	MOVE A,HD.FLG(A)	; Get flags
	ANDI A,HD%TYP		; *** Get type (should use LOAD)
;	LOAD A,HDTYP(A)
	CAIN A,HD%ADR		; Address spec?
	JRST [	MOVE A,HBADD		; Yes, point to H-block
		SKIPE B,HD.DAT(A)	; Point to address list
		CALL ABREL		; Release it if present
		JRST HBREL0]
	CAIN A,HD%KWD		; Keyword?
	JRST [	MOVE A,HBADD		; Yes, point to H-block
		SKIPE A,HD.DAT+1(A)	; If keyword table present,
		CALL KWDREL		; Release it
		JRST HBREL0]
	CAIN A,HD%TXT		; Text?
	JRST [	MOVE A,HBADD		; Yes, point to H-block
		SKIPE A,HD.DAT(A)	; Get pointer to text block
		CALL RELSB		; Release it if present
		JRST HBREL0]
HBREL0:	MOVE B,HBADD		; Point to H-block again
	MOVE A,HD.SIZ(B)	; Size
	$CALL M%RMEM		; Release chunks
	RET
SUBTTL Define commands - KWDLST - parse keyword list

;Parse keyword list and enter into TBLUK-style table
;Call:	A/ address of table

KWDLST:	STKVAR <STRB,HDBLK,IDX>	; String block address, table address, index
	MOVEM A,HDBLK		; Save H-block ptr
	SETZM IDX		; Init index for ordering of keywords
KWDLS0:	MOVEI A,[FLDDB. (.CMFLD,CM%SDH,,<
Enter keywords, separated by commas
>)]
	CALL RFIELD		; Get next word
	LDB A,[POINT 7,ATMBUF,6]
	JUMPE A,KWDLS1		; Insure something typed
	CAIE A,15		;  ..
	CAIN A,12
	JRST KWDLS1
	CALL CPYATM		; Allocate string blk, copy atom to it
	 RET			; Failure, give up now
	MOVEM A,STRB		; Save address of the string
	MOVE A,HDBLK		; Table address
	AOS B,IDX		; Count items as they go in
	HRL B,STRB		; String pointer,,index
	$CALL S%TBAD		; Add to it
	JUMPF [	CALL CRIF
		HRRZ A,STRB
		HRLI A,(POINT 7,)
		$TEXT (KBFTOR,<Can't add keyword ^Q/A/ to table because: ^E/[-1]/>)
		RET]
KWDLS1:	MOVEI A,[FLDDB. .CMCFM,,,,,[FLDDB. .CMCMA]]
	CALL RFIELD
	MOVE A,CR.COD(A)	; Get function parsed
	CAIN A,.CMCMA		; Comma typed?
	JRST KWDLS0		; Yes, go for next keyword
	RET
SUBTTL HDTYPS - Header-item definitions

;Parse header-item and store
;Call:	A/ Address of H-block
;Returns +1: failure, error msg already printed
;	 +2: success, H-block updated

GETHDI:	MOVEM A,HBLKP		; Save H-block pointer and result pointer
	MOVE B,HD.FLG(A)	; Should use LOAD for this
	ANDI B,HD%TYP		; Isolate type field
;	LOAD B,HDTYP(A)		; Get type of H-block
	HRRZ B,GETHDA(B)	; Get routine address
	CALLRET (B)		; Dispatch to appropriate routine


;Define types of header-items, names, and size of H-blocks

DEFINE HDTYPS,<
X	ADR,address,HD.LEN
X	DAT,date,HD.LEN
X	DTI,<date-and-time>,HD.LEN
X	KWD,keyword,<HD.LEN+1>
X	TXT,<text-string>,HD.LEN
X	TIM,time,HD.LEN
>
SUBTTL Routines to parse header-items

;Build command table

DEFINE X(COD,STRNG,SIZ),<
	CMD (<STRNG>,HD%'COD)
>

HTYP1T:	HTYP10,,HTYP10
	HDTYPS
HTYP10==.-HTYP1T-1


;Define type codes and build dispatch table

	%%%ZZZ==0
DEFINE X(COD,STRNG,SIZ),<
	HD%'COD==%%%ZZZ		;; Define type code
	XWD SIZ,GTH'COD		;; Address of routine to parse header-item
	%%%ZZZ==%%%ZZZ+1	;;  and size of H-block
>

GETHDA:	HDTYPS

;Define name strings

DEFINE X(COD,STRNG,SIZ),<
	EXP POINT 7,[ASCIZ /STRNG/]
>

HDTNAM:	HDTYPS
;Parse address header-item

GTHADR:	MOVE B,HBLKP		; Point to H-block
	SKIPE B,HD.DAT(B)	; Any address list already there?
	CALL ABREL		; Yes, release it first
	CALL ADRLST		; Parse an address list
	 RET			; Error
	MOVE C,HBLKP		; Point to H-block
	MOVEM A,HD.DAT(C)	; Store pointer to address list
	JUMPE A,GTHEX0		; Null list typed -- mark not present
GTHEX1:	MOVX A,HD%PRS		; Non-null list -- mark item present
	IORM A,HD.FLG(C)	;  ..
	RETSKP			; Give good return

GTHEX0:	MOVX A,HD%PRS		; Mark header-item not present
	ANDCAM A,HD.FLG(C)	;
	RETSKP

;Parse date

GTHDAT:	MOVEI A,[FLDDB. .CMCFM,,,,,[FLDDB. (.CMTAD,,CM%IDA)]]
GTHDT0:	CALL RFIELD
	MOVE A,CR.COD(A)	; Get function parsed
	MOVE C,HBLKP		; Point to H-block
	CAIN A,.CMCFM		; Just CR typed?
	JRST GTHEX0		; Yes, mark item not present
	PUSH P,B		; Save date/time over CONFRM
	CONFRM
	POP P,HD.DAT(C)		; Store datum
	JRST GTHEX1		; Mark present

;Parse date/time

GTHDTI:	MOVEI A,[FLDDB. .CMCFM,,,,,[FLDDB. (.CMTAD,,CM%IDA!CM%ITM)]]
	JRST GTHDT0		; Join common code

;Parse time

GTHTIM:	MOVEI A,[FLDDB. .CMCFM,,,,,[FLDDB. (.CMTAD,CM%SDH,CM%ITM,<
Time in hours, or hh:mm for hours and minutes
>)]]
	JRST GTHDT0		; Join common code
;Parse text header-item

GTHTXT:	MOVEI A,[FLDDB. .CMCFM,,,,,[FLDDB. (.CMTXT)]]
	CALL RFIELD		; Get field
	MOVE A,CR.COD(A)	; Get function parsed
	MOVE C,HBLKP		; Point to H-block
	CAIN A,.CMCFM		; Just CR?
	JRST GTHEX0		; Yes, mark as not present
	CONFRM
GTHTX1:	MOVE A,[POINT 7,ATMBUF]	; Count chars in string
	CALL COUNTS		;  ..
	ADDI A,2		; Add 2 in case quotes required
	CALL ALCSB		; Allocate a string block
	 JRST [	MOVE A,[POINT 7,ATMBUF]
		WARN <Can't add header-item, insufficient memory>
		RET]
	MOVE C,HBLKP		; Point to H-block
	MOVEM B,HD.DAT(C)	; Save pointer to string block
	MOVE B,[POINT 7,ATMBUF]	; Check to insure special chars are quoted
	SETZ D,			; Assume no quotes required
	CALL SPCCHK		;  ..
	 MOVEI D,42		; Quotes required, supply 'em
	MOVE A,HD.DAT(C)	; Point to text space
	HRLI A,(POINT 7,)	; Form byte pointer
	SKIPE D			; If quoting,
	IDPB D,A		;  move the quote
	CALL MOVST1		; Move 'em on out!
	SKIPE D			; If quoting,
	IDPB D,A		;  move close quote
	SETZ B,			; ASCIZ pleaze
	IDPB B,A		;  ..
	MOVE C,HBLKP		; Restore H-block pointer
	JRST GTHEX1		; Mark present and return

;Parse keyword

GTHKWD:	STKVAR <<FLDB0,10>>	; Two writeable FLDDB. blocks
	HRLI A,[FLDDB. (.CMCFM)]
	HRRI A,FLDB0		; Copy templates to writeable storage
	BLT A,3+FLDB0		;  ..
	HRLI A,[FLDDB. (.CMKEY)]
	HRRI A,4+FLDB0		; Stupid MACRO can't put both macros inside
	BLT A,7+FLDB0		;  one literal so we need two BLTs
	MOVEI A,4+FLDB0		; Pointer to second block (.CMKEY)
	HRRM A,FLDB0		; Chain to first block (.CMCFM)
	MOVE B,HBLKP		; Point to H-block
	MOVE B,HD.DAT+1(B)	; Point to keyword table
	MOVEM B,.CMDAT+4+FLDB0	; Store in 2nd function block
	MOVEI A,FLDB0		; Point to COMND arg block
	CALL RFIELD		; Parse keyword or CR
	MOVE A,CR.COD(A)	; Find out which
	MOVE C,HBLKP		; Point to H-block
	CAIN A,.CMCFM		; CR?
	JRST GTHEX0		; Yes, mark not present and return
	PUSH P,B		; Save datum returned from S%CMND
	CONFRM
	POP P,HD.DAT(C)		; Store in H-block
	JRST GTHEX1		; Mark present and return
SUBTTL Define, Retrieve, and Save command dispatchers

F%NO==F%F1			; local flag indicating "no" typed

.DEFIN:	SKIPN INIP		; If not from init file,
	TXZ F,F%RSCN		;  don't uselessly return to exec
	MOVEI A,[FLDDB. (.CMKEY,,DFNCTB)]
	CALL RFIELD
	HRRZ A,(B)		; Get routine address
	CALL (A)
	RET

;Retrieve commands

.RETRI:	MOVEI A,[FLDDB. (.CMKEY,,RETRCM)]
	CALL RFIELD
	HRRZ A,(B)
	CALL (A)
	RET


.SAVTL:	MOVEI A,[FLDDB. (.CMKEY,,SVTLTB,,<outgoing-messages>)]
	CALL RFIELD		; Parse keyword
	HRRZ A,(B)		; Get routine address
	CALLRET (A)		; Go to it
SUBTTL Save-outgoing-messages (in file)

.SAVMS:	NOISE (in file)
   TOPS20<
	HRROI A,[ASCIZ /txt/]	; Default extension
	MOVEM A,CJFNBK+.GJEXT	;  ..
   >;End TOPS20
   TOPS10<
	SETZM CJFNBK		; Zero previous fields
	MOVE A,[CJFNBK,,CJFNBK+1]
	BLT A,CJFNBK+CJFNLN-1
	MOVSI A,(SIXBIT /TXT/)
	MOVEM A,CJFNBK+.FDEXT	; Default extension
	MOVE A,MYPPN		; Put outgoing mail into my PPN
	MOVEM A,CJFNBK+.FDPPN	;  ..
   >;End TOPS10
	CALL GETPRS		; Parse filespec, don't open
	 JRST [	DMOVE A,SVMFOB		; No filespec given, just release this
		SKIPE A			;  if one to release
		CALL RELFOB		;  ..
		SETZM SVMFOB		;  ..
		SETZM SVMFOB+1		;  ..
		RET]
	DMOVE A,SVMFOB		; Release previous FOB
	SKIPE A			;  if any
	CALL RELFOB		;  ..
	DMOVE A,OUTFOB		; Save this away in a safe place
	DMOVEM A,SVMFOB		;  ..
   TOPS10<
	MOVE A,FOB.FD(B)	; Point to FD
	MOVE B,MYPPN		; Get my PPN in case needed
	SKIPN .FDPPN(A)		; PPN supplied by user?
	MOVEM B,.FDPPN(A)	; No, default to logged-in PPN then
   >;End TOPS10
	MOVX A,F2%NSV
	ANDCAM A,FLAGS2		; Reset "suppress save" bit
	RET
SUBTTL Expunge command


.EXPUN:	NOISE (deleted messages)
	CONFRM			; Confirm first
	SKIPG MSGJFN
	 JRST [	WARN (No current mail file)
		RET]
	JRST EXPUNG
SUBTTL Read mode commands

.SKIM:	SAVMSX			; Save context if necessary
	STKVAR <<RPROMP,3>,RHNDLR> ; Prompt string, handler routine address
	MOVEI A,RPROMP		; Built byte pointer
	HRLI A,(POINT 7,)	;  ..
	MOVEM A,UPDPTR		; Set pointer up for $TEXT
	$TEXT (UPDTOR,<MS skim^A>)
	MOVEI A,TYPHDR		; Handler for skim mode (type header line)
	MOVEM A,RHNDLR		; Set up for common code
	CALLRET .READ0		; Join common code

.READ:	SAVMSX			; Save context if necessary
	STKVAR <<RPROMP,3>,RHNDLR> ; Prompt string, handler routine address
	MOVEI A,RPROMP		; Build byte pointer
	HRLI A,(POINT 7,)	;  ..
	MOVEM A,UPDPTR		;  ..
	$TEXT (UPDTOR,<MS read^A>)
	MOVEI A,.RTYP0		; Handler routine which types message
	MOVEM A,RHNDLR		; Set up for common code

.READ0:	CALL CHECKT		; Check for recently arrived mail
	SKIPE REDLVL		; Recursive read level?
	JRST [	CALL DFSQTH		; Yes, default to current, not new
		JRST .READ1]
	CALL DFSQNW		; Get sequence, default to new
.READ1:	AOS REDLVL		; Count depth of recursion
	MOVE A,MSGSEQ
	ADD A,[POINT 18,0,17]
	LDB A,A
	CAIN A,777777		; Any messages selected?
	JRST [	WARN <No messages match this specification>
		JRST RQUIT0]
	MOVE A,REDLVL		; Get depth of this read level
	SOJLE A,.READ2		; If first level, no recursion level nonsense
	$TEXT (UPDTOR,<(^D/A/) ^A>) ; Type recursion level
.READ2:	MOVE A,UPDPTR		; Add the two wedgie brackets
	MOVEI B,">"		;  ..
	IDPB B,A		;  ..
	IDPB B,A		;  ..
	SETZ B,			; ASCIZ pleaze
	IDPB B,A
READ0:	CALL NXTSEQ		; Get next message
	 JRST [ CALL SETREF	  ; None, update last time file was read
		JRST RQUIT0 ]	  ; All done
	MOVEM L,SAVEL		; Save current msg sequence pointer
	CALL CHKDEL		; Dont if deleted msg
	 JRST REDRET
	CALL @RHNDLR		; Call read/skim handler routine

REDRET:	MOVE L,SAVEL		; Restore msg sequence pointer
	CALL CMDINI		; Init this level
REDCLP:	HRROI A,RPROMP		; Point to prompt string
	CALL DPROMP		; Prompt user
	MOVE A,REDPTR		; Point to command table
	TXZ F,F%VBTY		; Default is not verbose-type
	CALL RFIELD		; Parse a command
	HRRZ A,(B)		; Dispatch
	CALL (A)
	TXZN F,F%ESND		; Want to send something
	JRST REDCLP		; Keep going
	SETZM LSTCHR		; Setup for send
	CALL ERSAL1		; Erase all but text
	CALL SEND0
	JRST REDCLP		; Continue
;Read level commands

.RQUIT:	NOISE (read mode)
	CONFRM			; Confirm first
	CALL UPDBIT		; Update this message
	POP P,A			; Dump return address in read level loop
RQUIT0:	SOS REDLVL		; Count levels of read level
	RESMSX			; Restore context if still in a read level
	CALL @SCRRGR		; Undo fancy scroll-region stuff
	CALL @SCRBTM		; Get to bottom of screen if need be
	SETZM SCRLFL		; Reset scroll-region flag
	CALL CHECK0		; Any new messages?
	 RET			; No, quit now
	CALL CHECKS		; Yes, print the message
	TXZ F,F%RSCN		; Don't quit, user probably wants to read 'em
TOPS10<	CALL ECHOON >		; In case monitor command
	RET			; Return to caller (top level)

.RDNXT:	NOISE (message in sequence)
.RNEX0:	CONFRM
	CALL UPDBIT		; Update message bits
	POP P,A			; Flush unused return address
	JRST READ0		; Step to next message

.RBACK:	NOISE (to previous message in sequence)
	JRST .RPRV0
.RPREV:	NOISE (message in sequence)
.RPRV0:	CONFRM
	CALL UPDBIT		; Update message bits
	MOVNI A,2		; Back byte pointer up one msg
	ADJBP A,L		;  ..
	MOVE B,MSGSEQ		;**
	SUBI B,1
	ADD B,[POINT 18,0,17]
	CAMN A,B
	JRST [	WARN (There are no messages prior to this one in this sequence)
		RET]
	MOVE L,A
	POP P,A			; Flush unused return address
	JRST READ0		; Step to next message

.REXIT:	NOISE (and update message file)
	CONFRM
.REXIZ:	CALL UPDBIT		; Update this message
.REXI0:	CALL RQUIT0		; Unwind
	SKIPE REDLVL		; Completely unwound yet?
	JRST .REXI0		; No, keep unwinding
	CALLRET .EXIT0		; Exit
SUBTTL Send mode commands

;SSEND command -- do a send without entering text mode

.XSEND:	NOISE <message -- going directly to send level>
	CONFRM
	CALL SNDINI		; Initialize buffers, etc.
	JRST SEND1

; ZSEND - Send but suppress saving of outgoing message

.ZSEND:	MOVX A,F2%NSV
	IORM A,FLAGS2
	CALL .SEND
	RET

;Normal SEND command

.SEND:	NOISE (message)
	CALL SNDINI		; Reset fields
	MOVEI A,[FLDDB. .CMCFM]	; Either CR or addresses must follow
	CALL RFLDE		; See which it is
	 JRST [	CALL GETMS0		; Addresses - parse message
		JRST SEND0]		;  and go handle
	CALL GETMSG		; Prompt for message
SEND0:	MOVE A,LSTCHR		; Get last character
	CAIN A,32		; ESC - wants more stuff
	 CALL SSEND0		; ^Z - just send if off then
SEND1:	TXZ F,F%ESND		; Clear this
SNDRET:	TXZE F,F%ESND		; Want auto send?
	JRST [	CALL SSEND0		; Yes - do it
		JRST SEND1]		; Failed, stay at send level
	CALL CMDINI		; Init this level
SNDLUP:	PROMPT (MS send>>)
	TXZ F,F%VBTY		; Default is not verbose-type
	MOVE A,SENPTR		; Point to command set
	CALL RFIELD		; Parse a command
	HRRZ A,(B)		; Dispatch
	CALL (A)		;  ..
	TXZN F,F%ESND		; Want to send it now?
	JRST SNDLUP		; Nope
	CALL SSEND0		; Yes - off it goes
	JRST SEND1		; Failure, stay at send level (success
				;  returns to next level, not here)
.ZSSND:	NOISE (message without saving in outgoing mail file)
	CONFRM
	MOVX A,F2%NSV
	IORM A,FLAGS2
	JRST SSEND0

.SSEND:	NOISE (message)
	CONFRM			; Make sure if just null command
SSEND0:	TXZ F,F%ESND		; Clear this here in case its set
	CALL SNDMSG		; Send it off and fall thru
	 RET			; Failed, enter (or remain in) send level
	JRST SQUIT0

.SQUIT:	NOISE (send mode)
	CONFRM			; Confirm first
	SKIPG MSGJFN		; Do we have a message file?
	 JRST SQUIT0		; No, then this cann't be a reply, move on
	GTMBL (M,B)		; Get ptr to message block
	MOVX A,M%RPLY		; Check if reply being done for
	TDNN A,MSGBTS(B)	;  this message
	 JRST SQUIT0		; No - go on
	LDB C,[POINT 12,MSGBTS(B),17]	; Yes
	TXNN C,M%RPLY		; See if previous reply in file bits
	 ANDCAM A,MSGBTS(B)	; No - clear this reply then
SQUIT0:	POP P,A			; Dump useless return address
	TXZ F,F%ESND		; Not in send command any more
	RET			; Return to caller of send level
.VSTYP:	TXO F,F%VBTY		; Set "verbose type" flag
.STYPE:	SKIPG MSGJFN		; Have a message file?
	JRST [	WARN (No current mail file)
		TXZ F,F%VBTY
		RET]
	MOVEM F,SAVF
	JSP F,SAVMSQ		; Save message sequence context
	MOVE F,SAVF
	CALL .TYPE		; Call type routine
	MOVEM F,SAVF
	JSP F,RESMSQ			; Restore context
	MOVE F,SAVF
	TXZ F,F%VBTY
	RET			; And return

.SEDIT:	NOISE (field)
	MOVEI A,[FLDDB. (.CMKEY,,EDCMTB,,<text>)]
	JRST .ERAS2		; Get field to edit

.ERASE:	NOISE (field)
;**;[3106] Change 1 line at .ERASE+1		Ned 	9-Sep-88
	MOVEI A,[FLDDB. (.CMKEY,,ECMDTB)]
	CALL RFIELD
	SKIPA
.ERAS2:	CALL CFIELD		; Parse keyword and confirm
	HRRZ A,(B)
	CALLRET (A)

.DISPL:	NOISE (field)
	MOVEI A,[FLDDB. (.CMKEY,,DCMDTB,,<all>)]
	JRST .ERAS2

.RETUR:	NOISE (for this message)
	CONFRM
	SETO E,
	MOVEI	B,[asciz/Return-receipt-requested-to/]
	MOVEM	B,HDIO		; store name for .DFHDA
	HRLI	B,(POINT 7,)	; byte pointer to asciz string
	SKIPN	A,HDITAB	; see if name already exists
	 JRST	.RR1		; table is empty - this header is new
	$CALL	S%TBLK		; table is nonempty - look up this entry
	TXNE	B,TL%EXM	;exact match?
	TXOA	F,F%F1		; yes - we need to replace old block
.RR1:	TXZA	F,F%F1		;no - don't try to replace nonexistant block
	MOVEM	A,TENT1		; yes - address of old block entry is here
	MOVX	B,HD%OPT!HD%ADR	;set optional bit and ADDRESS bit
	MOVEM	B,FLG		;save the flags
	ANDI	B,HD%TYP	;get header type
	SETZM	HDI1		;so we know if .DFHDA fails
	CALL	.DFHDA		;go to define code to build header block
	SKIPN	HDI1		;make it?
	RET			;.DFHDA didn't have room for it
	PROMPT	(Return-receipt-requested-to: )
	MOVE	A,HDI1		;go ask for the argument now
	CALL	GETHDI		;..
	 RET			;GETHDI already complained
	RET			;all set
SUBTTL Send level commands - include (header-item)

.INCLU:	STKVAR <<.INCL0,2>>
	NOISE (header-item)
	DMOVE A,[FLDDB. (.CMKEY)]
	DMOVEM A,.INCL0		; Build writeable FLDDB block on stack
	SKIPN A,HDITAB		; Pointer to header-item table
	 CERR (No header-items defined)
	MOVEM A,.CMDAT+.INCL0	; Stuff into FLDDB block
	MOVEI A,.INCL0		; Set up for COMND
	CALL CFIELD		; Parse keyword and confirm
	MOVE E,B		; Put in right AC for later
	HRRZ A,(E)		; Address of H-block for item
	MOVE B,HD.FLG(A)	; Get flags
	TXNN B,HD%PDF		; Predefined?
	CALLRET INCLUD		; No, go on ahead then
	WARN <Header-item is predefined, use "define" command to change>
	RET


;Include user-defined header-item.  Prompts user for it and stores data.
;Call:	E/ Address of entry in HDITAB for item
;Returns +1: always

INCLUD:	MOVE A,[POINT 7,STRBUF]	; Where to form name and colon
	HLRZ B,(E)		; Get address of header-item's name
	HRLI B,(POINT 7,)	; Form byte pointer
	CALL MOVSTR		; Move name
	MOVEI B,":"		; Colon space (for prompt)
	IDPB B,A		;  ..
	MOVEI B," "		;  ..
	IDPB B,A		;  ..
	SETZ B,			; Insure ASCIZ
	IDPB B,A		;  ..
	MOVE A,[POINT 7,STRBUF]	; Point to prompt string
	CALL DPROMP		; Prompt
	HRRZ A,(E)		; Address of H-block
	CALL GETHDI		; Parse it
	 JFCL			; Error msg already printed
	RET			; Return
;Insert file or message

.INSER:	MOVEI A,[FLDDB. (.CMKEY,,INSCTB,,<file>)]
	CALL RFIELD
	HRRZ A,(B)		; Get routine address
	CALLRET (A)		;  and dispatch to it


.INSFI:
   TOPS20<
	SETZM CJFNBK+.GJEXT	; [ESM] No default extension
   >;End TOPS20
   TOPS10<
	SETZM CJFNBK		; Zap previous defaults
	MOVE A,[CJFNBK,,CJFNBK+1]
	BLT A,CJFNBK+CJFNLN-1
	SETZM CJFNBK+.FDEXT	; [ESM] No default extension
   >;End TOPS10
	CALL FSPEC		; Get a file spec
	 RET			; Just CR - ignore
	CALL RDTEXT		; Get contents of file
	 RET			; Error - just return
	RET
;Insert message into message

.INSMS:	SAVMSX			; Save context maybe
	MOVEI A,INSMSG		; Action routine address
	MOVEI B,[ASCIZ / Inserted: /]
	CALLRET .FLAGX		; Clean up and return

;Insert one message into current message

INSMSG:	GTMBL (M,B)		; Get ptr to message block
	MOVE V,MSGBOD(B)	; Get char pointer to message body
	CALL REMAP
	PUSH P,V
	SUB V,WBOT
	MOVE A,MSGFAD
	IMULI A,5
	ADD V,A
	CHR2BP			; Form byte pointer in A
	POP P,V
	MOVE B,MSGBON(B)	; Get size of msg body
	CALLRET TXTCPT		; Insert counted string to text buff and return
SUBTTL Send level commands - save-draft

.SAVE:	MOVEI A,[FLDDB. (.CMKEY,,SVCMTB,,<draft>)]
	CALL RFIELD		; Parse keyword
	HRRZ A,(B)		; Get routine address
	CALLRET (A)		; Go to it


.SAVDF:	NOISE (in file)
   TOPS20<
	HRROI A,[ASCIZ /draft/]	; Default extension
	MOVEM A,CJFNBK+.GJEXT	;  ..
   >;End TOPS20
   TOPS10<
	SETZM CJFNBK		; Zap previous defaults
	MOVE A,[CJFNBK,,CJFNBK+1]
	BLT A,CJFNBK+CJFNLN-1
	MOVSI A,(SIXBIT /DRF/)	; Default extension
	MOVEM A,CJFNBK+.FDEXT
   >;End TOPS10
	CALL GETNEW		; Get file, open for write (not append)
	 JRST [	WARN (No file specified)
		RET]
 	MOVE A,[POINT 7,HDRPAG]	; First must build header text
	MOVEM A,OBPTR
	CALL MOVTO		; Just need to, cc, and subject
	CALL MOVCC
	TXO F,F%F1		; Want CRLF first
	CALL MOVSUB
	MOVEI B,[BYTE (7) 15, 12, 0]	; Separate hdrs from text
	CALL MOVSB2		;  ..
	SETZ A,			; Tie this off with null
	IDPB A,OBPTR		;  ..
	MOVE A,OUTIFN		; IFN of draft file
	TXO F,F%F3		; Don't put the trailing dashes in
	CALL SAVDRF		; Write headers and text
	 JFCL			; Don't care (msg already typed)
	DMOVE A,OUTFOB		; Release chunks
	CALL RELFOB		;  ..
	SETZM OUTIFN
	RET
SUBTTL Reply command

.REPLY:	CALL DFSQTH		; Get range arg
REPRET:	CALL NXTSEQ		; Next message in list
	 RET			; Done
	CALL CHKDEL		; Deleted?
	 JRST REPRET		; Yes - skip it
	CALL CMDINI		; Init this level
	MOVE A,[POINT 7,STRBUF]	; Setup prompt string in strbuf
	MOVEM A,UPDPTR		; Put byte ptr where TOR can get to it
	MOVEI B,1(M)		; Message #
	$TEXT (REPRE0,< Reply message number ^D/B/ to: ^A>)
	SETZ A,			; Insure ASCIZ
	IDPB A,UPDPTR		;  ..
	HRROI A,STRBUF		; Point to prompt string
	CALL DPROMPT
	CALL .RRPL1		; Used common reply code
	JRST REPRET		; Loop over all in list


;Here by $TEXT macro above to stuff bytes

REPRE0:	IDPB A,UPDPTR
	RET
.RREPL:	NOISE (to)
.RRPL1:	TXNE F,F%RPAL		; Want default of all?
	JRST [	MOVEI A,[FLDDB. (.CMKEY,,RPCMTB,,<all>)]
		JRST .ERAS2]
	MOVEI A,[FLDDB. (.CMKEY,,RPCMTB,,<sender-only>)]
	JRST .ERAS2

.REPAL:	TXOA F,F%F3		; Say reply to everyone
.REPTO:	 TXZ F,F%F3		; Say just reply to sender
	TXZ F,F%CC!F%AT		; Clear some bits
	SETOM TRYSND		; Only try sender once
	CALL SNDINI		; Erase drafts
	GTMBL (M,MX)		; Pointer to message block
	CALL CONREP		; Construct reply lines (In-reply-to,Regarding)
	CALL REPSUB		; Construct the subject
;	SKIPE V,MSGSND(MX)	; Use "sender" field if there
;	JRST .REPLX		;   ..
	MOVE V,MSGFRM(MX)	; Find "from" field (for hostname defaulting,
	JUMPE V,.REPL3		;  even if reply-to field present)
.REPLX:	CALL SETSFL
	PUSH P,V
	SUB V,WBOT
	MOVE A,MSGFAD
	IMULI A,5
	ADD V,A
	CHR2BP
	POP P,V
	MOVEI W,TCPAG-1		; Where to build address list
	SETZ E,			; No host name defaulting
	CALL PRADDR		; Get the guy
;**;[3097] Add 2 lines at .REPLX+11L	MDR	18-NOV-87
	CAMN B,[-1]		;[3097] Did we get something?
	JRST .REPLQ		;[3097] No, get it by hand
	HRRM W,TOPTRS		; Starting to pointer
	SETZ E,			; assume default
	TXNN F,F%AT		; Was there an @ in the main name?
	 JRST .REPL3		; No, leave default at null
	MOVE E,FRENAM		; Yes, point to first name
.REPL6:	ILDB B,E
	JUMPE B,[SETZ E,	; If node name removed (because local node),
		JRST .REPL3]	;  then don't default node name
	CAIE B,"@"		; Start it just after the @
	 JRST .REPL6

.REPL3:	MOVEI T,[ASCIZ /
Reply-to: /]
	PUSH P,E		; Clobbered by FNDHDR
	CALL FNDHDR		; Reply-to field present?
	 JRST [	POP P,E			; No, use from field then
		JRST .REPL0]		;  ..
	POP P,E
	HRRZ W,TOPTRS		; Yes, add to list (reply to all)
	SKIPN W			; Valid starting pointer there?
	MOVEI W,TCPAG-1		; No, make one up then
	TXNE F,F%F3		;  or only use this one?
	JRST .REPL5		; Reply-to-all -- skip deletions
	PUSH P,A		; Save pointer to "Reply-to" field
	HRRZ A,@NAMTAB		; Release name table
	ADDI A,1		; Length
	SKIPE B,NAMTAB		; Address
	CALL M%RMEM		; ZAP
	SETZM NAMTAB		;  ..
	POP P,A			; Restore string pointer
	MOVEI W,TCPAG-1		; Reset addr list (but keep "from"
;	JRST .REPL5		;  string in name space for host defaulting)
;Reply (cont'd.)

.REPL5:	PUSH P,F		; Save state of hostname flag
	CALL PRADDR		;  so hostname defaulting (at PRTOCC) works
	POP P,F			; Restore flags
	HRRM W,TOPTRS		; Save this address
.REPL0:	HRRZ A,TOPTRS		; See if any names found ("from" or "reply-to")
	JUMPE A,.REPL2		; No, go ask user then
.REPL4:	TXZN F,F%F3		; Wants reply to all addresses?
	 JRST .REPL1		; No, have enuf now
	MOVE V,MSGTO(MX)	; Yes, point to "To:" list
	CALL SETSFL
	PUSH P,V
	SUB V,WBOT
	MOVE A,MSGFAD
	IMULI A,5
	ADD V,A
	CHR2BP			; Form byte pointer
	POP P,V
	CALL PRTOCC		; Get to and cc lists
	TXNE F,F%RPIN		; Including me in replies?
	JRST .REPL1		; Yes, don't remove myself
	MOVEI U,MYDIRS		; Remove me from the list
	SETZ A,			; Not removing list, just single name
	CALL DOUNTO
.REPL1:	MOVE M,MSGNUM(MX)	; Restore M as msg number
	CALL GETUHD		; Prompt for required header-items
	CALL GETTXT		; Get text of reply
	GTMBL (M,B)		; Get ptr to message block
	MOVX A,M%RPLY		; Mark message as replied to
	IORM A,MSGBTS(B)	; Careful about updating bits
	CALLRET SEND0		; And go get more or send it off

.REPL2:	SKIPE	V,MSGSND(MX)	; Is there at least a SENDER?
	AOSE	TRYSND		; Yes, did we attempt this stunt once?
	JRST	.REPLQ		; None, or tried and failed, just ask
	WARN (No FROM or REPLY address in message - trying SENDER)
	JRST	.REPLX		; We can at least try this...
.REPLQ:	WARN (Cannot tell who message is from) ;Pretty odd message!
	CALL GETTO		; Ask him who it's to then...
	HRRZ A,TOPTRS		; Anything supplied?
	JUMPE A,.REPL4		; No, don't loop...
	JRST .REPL0
SUBTTL CONREP - Construct reply lines (In-reply-to and Reference)

;Must be called with MX set up, not M

CONREP:	STKVAR <REPDAT,REPPTR>
	MOVE A,MSGDAT(MX)	; Get date message was sent
	MOVEM A,REPDAT		; Save for a bit
	MOVE A,[POINT 7,REPLIN]	; Point to where this junk will go
	MOVEI B,[ASCIZ /References: /]
	CALL MOVSTR
	SKIPN V,MSGFRM(MX)	; Sender known?
	JRST [	MOVEI B,[ASCIZ /Your message of /]
		JRST CONRP1]		; No, just mumble then...
	MOVEI B,[ASCIZ /Message from /]
	CALL MOVSTR		; Yes, say something intelligent
	MOVEM A,REPPTR		; Preserve pointer for a bit
	CALL SETSFL
	PUSH P,V
	SUB V,WBOT
	MOVE A,MSGFAD
	IMULI A,5
	ADD V,A
	CHR2BP			; Get ptr to name
	POP P,V
	MOVE C,A
	MOVE B,MSGFRN(MX)	; Get msg's length
CONRP0:	ILDB A,C		; Next byte of name
	IDPB A,REPPTR		; Stuff it
	SOJG B,CONRP0		; Until done
	MOVE A,REPPTR		; Set up for MOVSTx again
	MOVEI B,[ASCIZ / of /]	; Make grammatical
	MOVE C,MSGFRN(MX)	; Get length of "from"
	CAIL C,^D24		; Will continuing on this line exceed 72 chars?
	MOVEI B,[ASCIZ /
              of /]		; Yes, make a continuation line then
CONRP1:	CALL MOVSTR
	MOVE B,REPDAT
   TOPS20<
	MOVX C,<OT%NSC!OT%NCO!OT%TMZ!OT%SCL>
	ODTIM			; Must use ODTIM because GLXLIB doesn't
   >;End TOPS20			;  do time zones
   TOPS10<
	MOVEM A,UPDPTR		; Stash PTR or IFN for TOR
	$TEXT (UPDTOR,<^H/B/^A>)
	MOVE A,UPDPTR		; Get updated byte pointer
   >;End TOPS10
	SKIPN V,MSGMID(MX)	; Message-ID exist for this message?
	JRST CONRP3		; No, all done then
	MOVEI B,[ASCIZ /
In-reply-to: /]			; Yes, include in reply then
	CALL MOVSTR
	MOVEM A,REPPTR		; Save pointer for a bit
	CALL SETSFL
	PUSH P,V
	SUB V,WBOT
	MOVE A,MSGFAD
	IMULI A,5
	ADD V,A
	CHR2BP			; Form BP to message-ID
	POP P,V
	MOVE C,A		; Copy
	MOVE B,MSGMIN(MX)	; Length of message-ID
CONRP2:	ILDB A,C		; Get next byte of message-ID
	IDPB A,REPPTR		; Stuff it
	SOJG B,CONRP2
	MOVE A,REPPTR
CONRP3:	MOVEI B,[BYTE (7) 15, 12, 0]	; Tie everything off
	CALLRET MOVST0
SUBTTL REPSUB - Construct subject for reply from subject of msg being answered

;Call with MX, not M, set up

REPSUB:	SKIPN A,MSGSUB(MX)
	 RET			; No subject
	MOVE C,MSGSUN(MX)	; Size of subject field
	CAILE C,<STRBSZ*5>-1	; [ESM] Don't overflow buffer!
	 MOVEI C,<STRBSZ*5>-1
	MOVE B,[POINT 7,STRBUF]
	CALL FORMSS		; Move it to temp space
	SETZ D,
	IDPB D,B		; And a null
	MOVE A,[POINT 7,ATMBUF]	; Where to build string
	MOVE B,STRBUF		; Get start of original subject string
	ANDCM B,[<BYTE (7) 40,40,0,0,177>+1] ; Uppercase and clear last byte
	CAMN B,[ASCIZ /RE: /]	; Already a response?
	 JRST REPSB1		; Yes, dont propogate Re: 's
	MOVEI B,[ASCIZ /Re: /]	; No, make a Re:
	CALL MOVSTR
REPSB1:	MOVEI B,STRBUF		; From here
	CALL MOVST0		; Move remainder of subject and a null
	SKIPE A,SUBJEC		; Release old subject, if any
	CALL RELSB		;  ..
	SETZM SUBJEC
	CALL CPYATM		; Copy string we built into new block
	 JRST [	WARN <Can't set subject, insufficient memory>
		RET]
	MOVEM A,SUBJEC
	RET
SUBTTL Repair undeliverable mail
.REPAI:	TRVAR <<DFOB,2>,DIFN,DBUF,DPGS,DSIZ>
	NOISE (undeliverable mail in .RPR file)
	MOVEI A,[FLDDB1 (.CMNUM,CM%SDH,^D10,<-1,,HPTEXT>)]
	CALL RFIELD		; Read the file number
	MOVE E,B		; Save the integer
	CONFRM
	CAIL E,0		;Must be a valid number
	CAIL E,^D10000
	JRST [WARN <Number must be between 0 and 9999>
              RET]

	MOVE A,[Z.DRFB,,Z.DRFB+1] ;Set up BLT to zero FOB and FD
	SETZM Z.DRFB		;Clear first word
	BLT A,Z.DRFE		;Zero DRF file's FOB and FD
	MOVEI A,DRFFD		;Point to FD
	MOVEM A,DRFFOB+FOB.FD	;Save in the FOB
	MOVEI A,7		;Byte size of the DRF file
	MOVEM A,DRFFOB+FOB.CW	;Save in the control word
	MOVEI A,FDXSIZ		;Get size of FD
	HRLZM A,DRFFD		;And save it in the FD
	CALL CHNSIX		;Change integer to SIXBIT file name
TOPS10	<
	MOVEM C,DRFFD+.FDNAM	;SAVE NAME ON -10
	MOVSI A,'DSK'		;Device
	MOVEM A,DRFFD+.FDSTR	;Place in the FD
	MOVSI A,'RPR'		;Extension
	MOVEM A,DRFFD+.FDEXT	;Place in the FD
	MOVE A,MYPPN		;PPN
	MOVEM A,DRFFD+.FDPPN	;Place in the FD
>
TOPS20	<$TEXT (<-1,,DRFFD+.FDFIL>,<^T/MYSTR/[^T/MYDIRS/]^W/C/.RPR.1;P777700^0>)>
	MOVEI A,FOB.MZ		;FOB size
	MOVEI B,DRFFOB		;FOB address
	DMOVEM A,DFOB		;Save for RETRIEVE processing routine
	$CALL F%IOPN		;Open file for output
	JUMPF [CAIN A,ERFNF$	  ;File does not exist?
	       WARN <No such dead letter>
	       CAIE A,ERFNF$	  ;File does not exist?
	       WARN (Could not open dead letter)
	       RET]
	MOVEM A,DIFN		;Save IFN for retrieval
	MOVX B,FI.SIZ		;Get the size of the file
	CALL F%INFO
	JUMPE A,[WARN <Dead letter is empty>
		 MOVE A,DIFN 	  ;Get the IFN
		 CALL F%REL	  ;Close the file
	         RET]

	SETZM DSIZ		; Init size in bytes of draft
	SETZM DBUF		; No buffer pages yet
	PUSH P,A		; Save file size
	CALL SNDINI		; Init draft
	POP P,A			; Restore file size
	SETOM RPRHNP		; At SEND level we'll know it's a REPAIR
	CALL .RESD		; RETRIEVE DRAFT and then repair
	SKIPE RPRHNP		; Was the message sent?
	RET			; No, so return now
	DMOVE A,DFOB		; Yes, so delete it
	CALL F%DEL
	RET

CHNSIX:	MOVE C,[SIXBIT/MS0000/]	;Init result
	MOVE D,[POINT 6,C,35]	;Get pointer to end of the SIXBIT file spec

CHNSI2:	IDIVI E,^D10		;Peel off a digit
	ADDI T,20		;Convert integer to SIXBIT
	DPB T,D 		;Store into C
	ADD D,[6B5]		;Back up byte pointer
	JUMPN E,CHNSI2		;Loop if more to do
	RET			;Return to next higher level

HPTEXT:	ASCIZ/Type in the four digits from the POSTMASTER
message Repair (RPR) file
/
SUBTTL Retrieve commands - retrieve last-message

;Recover-last-message -- puts user back into send level after having
; sent something and belatedly realizing that, say, an address was
; missing

.RECOV:	NOISE (and enter send level)
	CONFRM
	SKIPE TOPTRS		; See if address lists empty
	JRST .RESD2		; No, go ahead with it then
	SKIPN A,TXTPTR		; No addresses, is there any text?
	JRST .RECV2		; Nope, this is silly then
	SKIPN B,TXTFPG		; Are there any text pages in the list?
	 JRST .RECV2		; No, complain
	ADD B,[POINT 7,TB.TXT]	; Form virgin ptr for comparison
	CAME A,B		; Is TXTPTR virgin?
	JRST .RESD2		; No, OK
.RECV2:	WARN (There is no previous message draft)
	RET
SUBTTL Retrieve commands - retrieve saved-draft

;Retrieve saved-draft -- parses saved draft and enters send mode

.RESDF:	TRVAR <<DFOB,2>,DIFN,DBUF,DPGS,DSIZ>
				; FOB, IFN, bfr addr, pages, size (bytes)
	NOISE (from file)
	SETZM DSIZ		; Init size in bytes of draft
	SETZM DBUF		; No buffer pages yet
	CALL SNDINI		; Init draft
   TOPS20<
	HRROI A,[ASCIZ /draft/]	; Default extension
	MOVEM A,CJFNBK+.GJEXT	;  ..
   >;End TOPS20
   TOPS10<
	SETZM CJFNBK
	MOVE A,[CJFNBK,,CJFNBK+1]
	BLT A,CJFNBK+CJFNLN-1	; Zap previous fields
	MOVSI A,(SIXBIT /DRF/)	; Default extension
	MOVEM A,CJFNBK+.FDEXT
   >;End TOPS10
	CALL FSPEC		; Get a IFN
	 JRST [	WARN (No file specified)
		RET]
	DMOVEM A,DFOB		; Save FOB info
	$CALL F%IOPN		; Open for read
	JUMPF [	WARN (Can't read draft)
		DMOVE A,DFOB
		CALLRET RELFOB]
	MOVEM A,DIFN		; Save IFN
	MOVX B,FI.SIZ		; Get size of file in bytes
	$CALL F%INFO		;  ..
.RESD:	IDIVI A,5*1000		;  ..
	ADDI A,1		; Round up
	MOVEM A,DPGS		; Remember how many we take
	$CALL M%AQNP		; Get the pages
	JUMPF [	WARN (Can't read draft file -- insufficient memory)
		JRST .RESD1]		; Release file blocks and return
	LSH A,^D9		; Compute address of buffer
	MOVEM A,DBUF
	HRLI A,(POINT 7,)	; Point to it
	MOVE C,A		; Safer AC
;	JRST .RESD0
.RESD0:	MOVE A,DIFN
	$CALL F%IBYT		; Get a byte
	JUMPF [	CAIE A,EREOF$		; EOF?
		WARN (Error reading draft)
		JRST .RESD1]		; Release file blocks
	JUMPE B,.RESD0		; Ignore nulls
	AOS DSIZ		; Count bytes in draft
	IDPB B,C		; Stuff into text pag
	JRST .RESD0		; Keep going
.RESD1:	SETZ A,			; Insure ASCIZ
	IDPB A,C		;  ..
	MOVE A,DIFN
	$CALL F%REL		; Close file
	DMOVE A,DFOB		; Release file info blocks
	SKIPN RPRHNP		; No FOB to release if from REPAIR
	CALL RELFOB
	MOVE A,DBUF		; Address of buffer
	HRLI A,(POINT 7,)	; Point to draft
	SKIPE B,DSIZ		; Size of draft, in bytes
	CALL PRSDRF		; Parse the draft
	 CALLRET .RESDX		; Error - release pages and return now
	CALL .RESDX		; Release buffer pages
.RESD2:	CALL .DSALL		; Type current draft
	SETZM LSTCHR		; No special action
	JRST SEND0		; Enter send mode

;Release buffer pages, if any, used by .RESDF

.RESDX:	SKIPN B,DBUF		; Any buffer allocated?
	RET			; No
	LSH B,-^D9		; Yes, form page number
	MOVE A,DPGS		; Number of pages
	$CALL M%RLNP		; Release 'em
	RET
SUBTTL Retrieve commands - retrieve saved-draft - PRSDRF - parse draft

;Here to parse a draft and insert good info into send buffer
;Call:
;	A/ Byte pointer to draft
;	B/ Byte count
;	CALL PRSDRF
;Return	+1: failure, probably bad syntax in draft
;	+2: OK, send buffers all set up

PRSDRF:	STKVAR <DRFSIZ,DRFPTR>	; Size of draft, pointer to it
	MOVEM A,DRFPTR		; Save pointer
	MOVEM B,DRFSIZ		;  and size
	MOVEI A,TCPAG-1		; Init to list pointer
	MOVEM A,TOPTRS		;  ..
	MOVE A,DRFPTR		; Get pointer to draft again
	BP2CHR			; Form character pointer
	MOVEM V,DRFPTR		; Remember for later
	MOVE W,DRFSIZ		; Length of draft
	MOVEI T,[ASCIZ /
To: /]				; Look for addressee lists
	CALL SSEARC		;  ..
	 JRST [	WARN (Can't find To field in draft)
		JRST PRSDR0]
	SETZ E,			; No hostname defaulting
	CALL PRTOCC		; Fetch to and cc lists into new draft
	MOVE B,TOPTRS		; Did PRTOCC find anybody?
	CAIN B,TCPAG-1		;  ..
PRSDR0:	SETZM TOPTRS		; No, don't confuse MOVTO then
	MOVE V,DRFPTR		; Point at start again
	MOVE W,DRFSIZ		;  ..
	MOVEI T,[ASCIZ /
Subject: /]			; Find subject
	CALL SSEARC		;  ..
	 JRST PRSDR1		; Not there
	MOVE B,[POINT 7,ATMBUF]	; Make temp copy in ATMBUF
PRSDR2:	ILDB C,A		; Next byte
	CAIN C,15		; Stop at CR
	JRST PRSDR3		;  ..
	IDPB C,B
	JRST PRSDR2
PRSDR3:	SETZ A,			; Put null at end
	IDPB A,B		;  ..
	SKIPE A,SUBJEC		; First release old subject
	CALL RELSB		;  ..
	SETZM SUBJEC		;  ..
	CALL CPYATM		; Now set new one from ATMBUF
	 JRST [	WARN <Can't set subject, insufficient storage>
		JRST PRSDR1]
	MOVEM A,SUBJEC
;	JRST PRSDR1
	; ..

PRSDR1:	MOVE V,DRFPTR		; Search through entire msg
	MOVE W,DRFSIZ		;  ..
	MOVEI T,[ASCIZ /

/]				; For end of header area (two CRLFs)
	CALL SSEARC		;  ..
	 JRST RSKP		; No text, I guess
	CALL TXTPUT		; Ok, move everything up to null to text area
	RETSKP			; Give good return
SUBTTL COPY, FILE, and MOVE commands - Move messages into files

;COPY just sopies the message
;MOVE copies and then deletes
;FILE copies and then asks the user if deletion is desired (a la EMS)

.FILE:	DMOVE A,[PUTMSG
		 [ASCIZ / Filed: /]]
	CALL .MOVE0		; Call common code
	CALL CMDINI		; Init this level
	SKIPE REDLVL		; Read level?
	JRST .FILE0		; Yes, be a little cleverer about the prompt
	PROMPT < Delete this message from current message file? >
	JRST .FILE1
.FILE0:	PROMPT < Delete from current message file the message(s) just filed? >
.FILE1:	CALL YESNO		; Get a yes or no
	 RET			; No, just return
	SKIPE REDLVL		; Read level?
	CALLRET DELMSG		; Yes, this is easy
	DMOVE A,[DELMSG		; No, set up for SEQUEN
		 [ASCIZ / Deleted: /]]
	DMOVEM A,DOMSG		; Save dispatch
	SETOM LSTMSG		; Re-init message sequencer states
	MOVE L,MSGSEQ		;**
	ADD L,[POINT 18,0]
	CALLRET SEQUE0		; Delete 'em and return


YESNO:	MOVEI A,[FLDDB. (.CMKEY,,<[2,,2
				   [ASCIZ /no/],,0
				   [ASCIZ /yes/],,1]>,,<no>)]
	CALL CFIELD		; Get the answer
	HRRZ A,(B)		; Get the code
	JUMPE A,R		; 'no' -- nonskip
	RETSKP

;Just like YESNO only default (CR) is yes.
NOYES:	MOVEI A,[FLDDB. (.CMKEY,,<[2,,2
				   [ASCIZ /no/],,0
				   [ASCIZ /yes/],,1]>,,<yes>)]
	CALL CFIELD		; Get the answer
	HRRZ A,(B)		; Get the code
	JUMPE A,R		; 'no' -- nonskip
	RETSKP
.PUT:	DMOVE A,[PUTMSG
		 [ASCIZ / Copied: /]]
	SKIPA
.MOVE:	DMOVE A,[MOVMSG
		 [ASCIZ / Moved: /]]
.MOVE0:	DMOVEM A,DOMSG
	SKIPE REDLVL		; Read level?
	 JRST .RPUT1		; Yes
	CALL DFSQTH		; Get message sequence
	CALL CMDINI		; Init this level
	PROMPT (  Into file: )
   TOPS20<
	HRROI A,[ASCIZ /txt/]	; Default extension
	MOVEM A,CJFNBK+.GJEXT	;  ..
	HRROI A,[ASCIZ /DSK/]	; Default device
	MOVEM A,CJFNBK+.GJDEV	;  ..
	SETZM CJFNBK+.GJDIR	; No default for directory
   >;End TOPS20
   TOPS10<
	SETZM CJFNBK		; Zap previous defaults
	MOVE A,[CJFNBK,,CJFNBK+1]
	BLT A,CJFNBK+CJFNLN-1
	MOVSI A,(SIXBIT /TXT/)
	MOVEM A,CJFNBK+.FDEXT
   >;End TOPS10
	CALL GETOUT		; Get output file
	 JRST [	WARN (No output file specified)
		RET]
.PUT1:	CALL SEQUE0		; go handle the sequence
.PUT2:	SKIPE A,OUTIFN		; If still open,
	$CALL F%REL		;  close file
	SETZM OUTIFN
	DMOVE A,OUTFOB		; Release chunks
	CALL RELFOB		;  ..
	RET
.RPUT1:	NOISE (into file)
   TOPS20<
	HRROI A,[ASCIZ /txt/]	; Default extension
	MOVEM A,CJFNBK+.GJEXT	;  ..
  >;End TOPS20
   TOPS10<
	SETZM CJFNBK		; Zap previous fields
	MOVE A,[CJFNBK,,CJFNBK+1]
	BLT A,CJFNBK+CJFNLN-1
	MOVSI A,(SIXBIT /TXT/)
	MOVEM A,CJFNBK+.FDEXT	; Default extension
   >;End TOPS10
	CALL GETOUT		; Get output file
	 JRST [	CMERR (No output file specified)
		RET]
.RPUT2:	CALL @DOMSG		; Process it
	JRST .PUT2		; And go close it up

.LIST:	MOVEI A,LPTMSG
	MOVEI B,[ASCIZ / Listed: /]
	DMOVEM A,DOMSG
	SKIPE REDLVL		; Read level
	 JRST .RLIS1		; Yes
	CALL DFSQTH		; Get sequence
	CALL GETLPT		; Open LPT for output
	 RET			; Failure, return
	TXNN F,F%HLPT		; Headers wanted on LPT output?
	JRST .PUT1		; No, skip this then
	PUSH P,L		; Yes, save initial msg pointer
.LIST0:	CALL NXTSEQ		; Get next msg in sequence
	 JRST [	POP P,L			; Done, restore original sequence
		MOVE A,OUTIFN		; Put headers on separate page
		MOVEI B,14		;  ..
		$CALL F%OBYT		;  ..
		CALLRET .PUT1]		; Go print the messages and return
	CALL TYPHDR		; Type header for this message
	JRST .LIST0		; Go through 'em all

.RLIS1:	NOISE (on line-printer)
	CONFRM
	CALL GETLPT
	 RET			; Failure, just quit
	JRST .RPUT2
SUBTTL FORWARD and REDISTRIBUTE commands

.FORWA:	SAVMSX			; Save message sequence context, maybe
	CALL DFSQTH		; Get message sequence, default to this
.FORW0:	CALL SNDINI		; Reset message drafts
	CALL GETTO		; Get recipients
	CALL GETCC		;  ..
	CALL GETUHD		; Get required header-items
	CALL GETTXT		; Get initial comments
	MOVE A,TXTPTR		; Get pointer to text field
	MOVE B,TXTFPG		; Address of first text page
	ADD B,[POINT 7,TB.TXT]	; Form virgin text pointer
	CAMN A,B		; Is buffer empty?
	 JRST .FORW2		; Yes, no need to check crlf
	LDB C,A			; Get last char
	MOVEI A,[BYTE (7) 15, 12, 0]
	CAIN C,12		; Unless have crlf
	JRST .FORW2
	CALL TXTPUT		; Put one in
.FORW2:	CALL NXTSEQ		; Get next guy in list
	 JRST .FORW3		; Maybe send if off or get more
	CALL CHKDEL		; Dont forward deleted msgs
	 JRST .FORW2
	CALL .FORWD		; Include original message
	JRST .FORW2		; Then look for more
.FORW3:	CALL SEND0		; Send it off
	RESMSX			; Restore message sequence, maybe
	RET
;Here to move forwarded message into text buffer

.FORWD:	MOVEI A,[ASCIZ /- - - - - - - Begin message from: /]
	CALL TXTPUT
	GTMBL (M,B)		; Get ptr to message block
	SKIPN V,MSGFRM(B)	; Original sender
	 JRST [	MOVEI A,[ASCIZ /(Unknown)/]
		CALL TXTPUT
		JRST .FRWD1]
	CALL SETSFL
	PUSH P,V
	SUB V,WBOT
	MOVE A,MSGFAD
	IMULI A,5
	ADD V,A
	CHR2BP			; Form byte pointer to sender
	POP P,V
	GTMBL (M,B)		; Get ptr to message block
	MOVE B,MSGFRN(B)	; Length of from field
	CALL TXTCPT		; Move counted string to text
.FRWD1:	MOVEI A,[ASCIZ /
/]				; add a CRLF
	CALL TXTPUT		;  ..
	CALL FORMSG		; Include text
	MOVEI A,[ASCIZ /- - - - - - - End forwarded message
/]
	CALL TXTPUT		; Move this out
	RET			; And return
FORMSG:	GTMBL (M,B)		; Get ptr to message block
	SKIPN D,MSGFRM(B)	; Has an author?
	 JRST FORMS2		; No
	SKIPE A,SUBJEC		; Release existing subject string
	CALL RELSB		;  ..
	SETZM SUBJEC
	MOVE B,[POINT 7,ATMBUF]	; Make temp copy of this stuff in ATMBUF
	MOVEI C,"["
	IDPB C,B
	GTMBL (M,C)		; Get ptr to message block
	MOVE C,MSGFRN(C)	; Get length of from field
	MOVE A,D		; Get pointer back
	CALL FORMSS
	MOVEI C,":"
	IDPB C,B
	GTMBL (M,A)		; Get ptr to message block
	SKIPN A,MSGSUB(A)	; Subject field present?
	 JRST FORMS1		; No
	MOVEI C," "
	IDPB C,B
	GTMBL (M,C)		; Get ptr to message block
	MOVE C,MSGSUN(C)	; Size of subject field
	CALL FORMSS
FORMS1:	MOVEI C,"]"
	IDPB C,B
	SETZ C,
	IDPB C,B
	CALL CPYATM		; Copy this string to a newly allocated block
	 JRST [	WARN <Can't set subject, insufficient storage>
		JRST FORMS2]
	MOVEM A,SUBJEC		; Set subject string
FORMS2:	GTMBL (M,B)		; Get ptr to message block
	MOVE V,MSGBOD(B)	; body of the message
	MOVE C,MSGBON(B)	; Length
	JUMPE C,R		; No body? return
	MOVE D,V		; Start of message body in scratch AC
	ADD D,C			; Add to it the number of chars to move
	SOS D			; Last character to me moved
	CAMG D,WTOP		; Is the whole message in core?
	  JRST FORM28		; Yes, we can take the easy way out
FORM25:	CALL REMAP		; Remap to get as much in core as possible
	CAMG D,WTOP		; Is rest of the message in core?
	  JRST FORM28		; Yes, the simple ending
	MOVE C,D		; Last char to move
	SUB C,WTOP		; How many we'll have left
	PUSH P,C		; Remember for later
	MOVE C,WTOP		; Compute how many chars we will
	SUB C,V			; move this time
	AOS C			; around
	SKIPA
FORM28:	PUSH P,[0]		; This indicates that we'll be done soon
	PUSH P,V		; Save the begining of the message body
	SUB V,WBOT		; Offset into message window
	MOVE A,MSGFAD		; Beginning of message window
	IMULI A,5		; Change into a character count
	ADD V,A			; Message body starts this far into memory
	CHR2BP			; Form byte pointer to it
	POP P,V			; Restore the beginning of the message body
	MOVE D,A		; Better AC
FORMS3:	ILDB A,D		; Move all nonnull chars
	JUMPE A,FORMS4		;  ..
	CALL TXTCHR		;  to text area
FORMS4:	SOJG C,FORMS3		;  and repeat as necessary

	POP P,C			; Restore the number of bytes left
	SKIPN C			; Anything to do?
	  RET			; Nope, quit
	MOVE V,WTOP		; This is where we left off
	MOVE D,V		; Start of message body in scratch AC
	AOS V			; This is where we'll continue
	ADD D,C			; Last character to me moved
	JRST FORM25
;
;
FORMSS:	JUMPE C,R		; None to do
	MOVE V,A
	CALL SETSFL
	PUSH P,V
	SUB V,WBOT
	MOVE A,MSGFAD
	IMULI A,5
	ADD V,A
	CHR2BP			; Get byte pointer to it
	POP P,V
FRMSS1:	ILDB D,A		; Get char
	JUMPE D,FRMSS2		; Skip nulls
	IDPB D,B
FRMSS2:	SOJG C,FRMSS1
	RET
;Redistribute

.REDIS:	SAVMSX			; Maybe save context
	CALL DFSQTH		; Get sequence, default to current
	CALL SNDINI		; Init drafts
	CALL GETTO
	CALL GETCC
.REDI0:	CALL NXTSEQ		; Next message in sequence
	 JRST .REDIX		; Go send it
	CALL CHKDEL		; Don't do deleted messages
	 JRST .REDI0
	GTMBL (M,B)		; Get ptr to message block
	MOVE V,MSGBOD(B)	; Point to message body
	CALL REMAP
	PUSH P,V
	SUB V,WBOT
	MOVE A,MSGFAD
	IMULI A,5
	ADD V,A
	CHR2BP			; Form kosher byte pointer
	POP P,V
	MOVE C,A		; Better AC
	MOVE D,MSGBON(B)	; Get total length of message
.REDI1:	ILDB A,C		; Next byte of message text
	JUMPE A,.REDI2		; Don't move nulls
	CALL TXTCHR		; Move to text of this message
.REDI2:	SOJG D,.REDI1		; Count through text of redistributed message
	MOVEI A,[BYTE (7) 15, 12, 0]
	CALL TXTPUT		; Put one in
	JRST .REDI0		; Repeat for all msgs in sequence

.REDIX:	SETZM LSTCHR		; Enter send level rather than sending
	TXO F,F%ESND		; Auto send this
	TXO F,F%REDI		; Flag redistribute in progress
	CALL SNDRET		; Send the message
	TXZ F,F%REDI		; Clear redistribute flag
	RESMSX
	RET
SUBTTL CHECK command - Check for new mail

.CHECK:	NOISE (for new messages)
	CONFRM
;	CALLRET CHECKT		; Check and type stuff if new msgs

CHECKT:	CALL CHECK0		; Check for new messages
	 RET			; None
;	CALLRET CHECKS		; There are some, announce them

; Print message when there are new guys

CHECKS:
TOPS20<	CALL GETJF2		; Lock the file with a READ/WRITE JFN
	RET			; File in use
	MOVE A,MSGJFN		; Set JFN
	CALL SETREF >		; Update read date-time
TOPS10<	MOVE A,MSGJFN >		; Get JFN
	PUSH P,M		; Save current message
	MOVE M,LASTM		; Start at current end or
	PUSH P,M		;  from beginning if new file
	AOJ M,			; From that one on,
	CALL PARSEF		; Parse these new ones
TOPS20<	CALL CLSJF2> 		; Release the READ/WRITE lock
CHECK1:	POP P,A			; Get old number
	MOVEI M,1(A)		; For headers (TYPHDR)
	SUB A,LASTM		; Get number of new guys
	JUMPGE A,[POP P,A		; Clean up stack
		RET]			; None - someone's mucking the file
	MOVM A,A
	MOVEI B,[ASCIZ /are/]
	CAIN A,1
	 MOVEI B,[ASCIZ /is/]
	CIETYP < There %2S %1D additional message%P:
>
	MOVEI E,(A)		; Get number of new messages
CHECK2:	PUSH P,E		; TYPHDR is hairy and clobbers most ACs
	CALL TYPHDR		; Announce each new message
	ADDI M,1		;  ..
	POP P,E
	SOJG E,CHECK2		;   ..
	POP P,M			; Restore current message
	CIETYP < Currently at message %M.
>
	MOVEI A,^D5		; Five seconds
	CALLRET RDELAY		; Delay if read mode and exit


; Already have a READ/WRITE JFN
TOPS20<
CHECKM:	CALL CHECK0		; Check for new messages
	RET			; None
	MOVE A,MSGJFN		; Set JFN
	CALL SETREF 		; Update read date-time
	PUSH P,M		; Save current message
	MOVE M,LASTM		; Start at current end or
	PUSH P,M		; From beginning if new file
	AOJ M,			; From that one on,
	CALL PARSEF		; Parse these new ones
	JRST CHECK1 >		; Continue in common code

;Check to insure a message isn't deleted, or if return receipt was
; requested, that it's sent.
;Call:	CALL CHKDEL
;Return	+1: deleted or acknowledged refused, don't allow user access
;	+2: All OK, access allowed

CHKDEL:	MOVX A,M%DELE
	GTMBL (M,B)		; Get ptr to message block
	TDNN A,MSGBTS(B)	; Deleted?
	JRST CHKDL0
	CIETYP < Message %M is deleted.
>
	RET
CHKDL0:	CALL RRECPT		; Return receipt OK?
	 JRST [	CIETYP < Message %M has return receipt requested, but not yet sent.>
		RET]
	RETSKP


;Check to see if return receipt needs to be sent and send it if so.
;Call:	CALL RRECPT
;Return	+1: receipt requested but user refused, don't display the message,
;	    or we were unable to send the receipt
;	+2: receipt not requested, or requested and sent OK

RRECPT:	GTMBL (M,B)		; Get ptr to message block
	MOVX A,M%RSNT		; Has return receipt already been sent?
	TDNE A,MSGBTS(B)	;  ..
	RETSKP			; Yes, quit now then
	SKIPN V,MSGRRR(B)	; Is receipt requested?
	RETSKP			; No, quit then
	MOVE W,MSGRRN(B)	; Yes, get length of reply field then
	$CALL K%FLSH		; Flush output buffer
	CALL CLRFIB		; Clear typeahead, this is unexpected
	CALL TYPHDR		;
	MOVEI A,1(M)		; Get 1-origin message number
	$TEXT (KBFTOR,< Sender of message ^D/A/ has requested return receipt.>)
	CALL CMDINI
	PROMPT ( Send it ? )
	CALL NOYES
 	 JRST [ GTMBL (M,MX)
		JRST RRECP1]		;

	CALL SNDINI		; User said OK, init draft
	GTMBL (M,MX)		; Get ptr to message block
	CALL CONREP		; Construct default header like REPLY
	CALL REPSUB		; Subject too
	HRROI A,[ASCIZ / This is a RETURN RECEIPT for your message./]
	CALL TXTPUT		; Text of message
	MOVE V,MSGRRR(MX)	; Get char pointer to return receipt address
	CALL SETSFL
	PUSH P,V
	SUB V,WBOT
	MOVE A,MSGFAD
	IMULI A,5
	ADD V,A
	CHR2BP			; Form byte pointer to return receipt field
	POP P,V
	MOVEI W,TCPAG-1		; Where to store address entries
	SETZ E,			; shouldn't have to do this but...
	CALL PRADDR		; Parse the address
	HRRM W,TOPTRS		; Stuff it
	CALL SNDMSG		; Now send the receipt
	 WARN <Could not send return receipt> ;
	MOVX A,4		; Give user 4 seconds to watch this
	$CALL I%SLP		; ..
	MOVX A,M%RSNT		; Set flag saying receipt was sent
	IORM A,MSGBTS(MX)	;  ..
RRECP1:	MOVE M,MSGNUM(MX)	; Restore M
	CALL UPDBIT		; Update message bits please
	RETSKP			; Give good return
; Find the subject of the message.
; All header search routines must be called with MX, not M, set up.

FNDSUB:	MOVEI T,[ASCIZ /
Subject: /]
	CALL FNDHDR		; Try to find this header
	 JRST FNDSB3		; Not there
FNDSB1:	SETZ W,			; Count size of field in w
FNDSB2:	ILDB T,A		; Get char
	CAIE T,15		; Until the CR
	 AOJA W,FNDSB2
	RET
FNDSB3:	MOVEI T,[ASCIZ /
Re: /]				; Try this then
FNDSB4:	CALL FNDHDR
	 JRST FNDSB5		; Not there either
	JRST FNDSB1		; Found it then
FNDSB5:	SETZB V,W		; Say we didnt find it anywhere
	RET

   IFE MHACK,<

; Find the "From" field a message

FNDFRM:	MOVEI T,[ASCIZ /
From: /]
	JRST FNDSB4


; Find "Sender" field

FNDSND:	MOVEI T,[ASCIZ /
Sender: /]
	JRST FNDSB4


; Find the message-ID

FNDMID:	MOVEI T,[ASCIZ /
Message-ID: /]
	JRST FNDTO0		; Use common code

;Find reference field

FNDREF:	MOVEI T,[ASCIZ /
In-reply-to: /]
	JRST FNDTO0		; Use common code

   >;End IFE MHACK
; Find "to" field.  Returns position in V, length of first line in
; W (for headers command), length of entire field in X

FNDTO:	MOVEI T,[ASCIZ /
To: /]
FNDTO0:	CALL FNDHDR		; Find it
	 JRST [	SETZB V,W		; say didn't find it
		SETZ X,
		RET]
	SETZ W,			; Count size of first line in W
FNDTO1:	ILDB T,A		; Look for EOL
	CAIE T,15		;  ..
	AOJA W,FNDTO1		;  ..
	MOVE D,W		; OK, W has length of first line...
FNDTO2:	MOVE X,D		; Save candidate for end of field
	ADDI D,1		; Count CR in case next line is continuation
FNDTO4:	ILDB T,A		; See if next line is continuation
	SKIPE T			; Ignore nulls
	CAIN T,12		; Ignore LF
	AOJA D,FNDTO4		;  ..
	CAIE T,40		; Is first char of line Linear White Space?
	CAIN T,11		; ie., space or tab?
	AOJA D,FNDTO3		; Yes, keep counting
	RET			; Not continuation, return size of whole field
FNDTO3:	ILDB T,A		; Get next char of this line
	CAIN T,15		; Until CR
	JRST FNDTO2		; CR found, see if continuation
	AOJA D,FNDTO3		; Still in this line... count away

   IFE MHACK,<

;Find cc field, similar to FNDTO

FNDCC:	MOVEI T,[ASCIZ /
cc: /]
	JRST FNDTO0		; Join common code

;Find return-receipt, similar to FNDTO and FNDCC

FNDRRR:	MOVEI T,[ASCIZ /
Return-receipt-requested-to: /]
	JRST FNDTO0		; Common code

; (Still inside IFE MHACK)
; (Still inside IFE MHACK)

; Find the date field

FNDDAT:	MOVE V,MSGALL(MX)	; First thing in header is recv date
	CALL SETSFL		;SET STUFF FOR FILE SEARCHING
	PUSH P,V
	MOVE A,MSGFAD
	IMULI A,5
	SUB V,WBOT
	ADD V,A
	CHR2BP
	POP P,V
	SETZB B,C
TOPS20<	IDTIM
	 ERJMP [MOVE A,MSGNUM(MX)
		ADDI A,1		; Message number for error msg
		CMERR (File has bad format - message %1D has no receive date)
		SETO B,			; supply a random one (now)
		RET]
>;End TOPS20
TOPS10<
;	CHR2BP
	CALL XDATI		; *** Call date/time crock
	JUMPF [	MOVE A,MSGNUM(MX)
		ADDI A,1
		CMERR (File has bad format - message %1D has no receive date)
		SETO B,
		RET]
>;End TOPS10
	RET


FNDSDT:	MOVEI T,[ASCIZ /
Date: /]
	CALL FNDHDR
	 JRST FNDDT1		; Not there
TOPS20<	SETZB B,C
	IDTIM >			; Try to parse it, will skip on success

TOPS10<	CALL XDATI		; *** Call date/time crock
	JUMPF FNDDT1		; Failure, use receive date
	RET >			; Success, keep date just parsed

FNDDT1: MOVE B,MSGDAT(MX)	; Bad format, use recv date
	RET

>;End IFE MHACK
SUBTTL File parsing subroutines - SEARCH - fast string search

; Try to find a header in the message body

FNDHDR:	SETZ W,			; Clear counter in case message is unparseable
	SKIPN V,MSGBOD(MX)	; Start of msg body, if any
	 RET			; None, so skip it.
	MOVE W,MSGHDN(MX)	; Look in header area only
	SUBI V,2		; Include CRLF before 1st item in search
	ADDI W,2		;  because headers must begin with CRLF
	CALL SETSFL		;SET STUFF FOR FILE SEARCHING
	MOVE A,MSGFAD
	IMULI A,5
	SUB V,WBOT
	ADD V,A
	CALL SSEARC
	 RET			; No good
	AOS (P)
	BP2CHR			; Form char pointer
	ADD V,WBOT
	MOVE B,MSGFAD		;TO CHAR POINTER
	IMULI B,5		;FROM THE BEGINNING
	SUB V,B			;OF THE FILE
	RET			;  and return
SUBTTL PRADDR - Parse address lists in received mail

;Parse the rest of this line as addresses, inserting default host
; name pointed to by E, using free space from FRENAM and into list in W

PRADDR:	TRVAR <SAVB,HSTBEG,NAMBEG,<TEMP,10>,SRC>
	MOVE U,FRENAM
	MOVEM A,SRC		; Stash source string ptr
PRADD0:	TXZ F,F%AT		; No @ seen yet
	MOVEI T,(U)		; Save pointer for later
PRADD1:	ILDB B,SRC		; Get char
	CAIE B,","
	 CAIN B,15
	 JRST NXTAD1
	CAIN B," "
	 JRST PRADD1		; flush leading spaces
	HRLI U,(<POINT 7,0>)	; Make byte pointer
	MOVEM U,NAMBEG		; Save start of name string
PRADD2:	CAIN B,42		; Start of quoted string?
	 JRST PRADD9		; Yes, eat to matching quote
	CAIN B,":"
	 JRST PRADDL		; This is start of list of addresses
	CAIN B,"("		; ( - search for matching )
	 JRST PRADD4
	CAIE B,","
	 CAIN B,15		; End of line or this address
	 JRST PRADD5
	CAIN B,";"		; End of named address-list?
	 JRST PRADD5		; Yes, that ends this name as well
	CAIN B,"<"		; Opening bracket?
	 JRST PRNET6		; Yes - flush what we've got
	CAIN B,">"		; Terminating bracket?
	 JRST PRNET3		; Yes - flush remainder of address
	CAIN B,"@"		; Allow @ in net address
	 JRST PRNETB
	CAIN B," "		; Non-initial spaces
	 JRST PRNETA		; Terminate this part of it
PRADD3:	IDPB B,U		; Stick it in
	ILDB B,SRC		; Get next
	JRST PRADD2
;We've parsed the name of a list of addresses - increment list depth
; and store name

PRADDL:	MOVEI A,(T)		; Point to string
	AOS LDEPTH		; Increment depth
	TXO A,AD%PFX		; Flag this as prefix to list
PRADL0:	AOS W			; Step to next table entry location
	MOVEM A,(W)		; Store this entry
	SETZ A,			; Insure ASCIZ
	IDPB A,U		;  ..
	MOVEI U,1(U)		; Step to next free string space location
	MOVEI B,","		; Pretend comma so coming address gets scanned
	JRST NXTAD1		; Continue parsing

;Here if open wedge seen.  Store personal name and keep scanning.

PRNET6:	TXZ F,F%AT		; Forget "@" seen
	MOVEI A,(T)		; Get address of start of string
	TXO A,AD%PRN		; Light personal name flag
PRNT6A:	LDB B,U			; Get character before open wedge
	CAIE B,11		; Space or tab?
	CAIN B,40		;  ..
	JRST [	MOVNI B,1		; Yes, back up over it
		ADJBP B,U		;  ..
		MOVEM B,U		;  so we can stomp on it with a null
		JRST PRNT6A]
	JRST PRADL0		; Store and keep scanning

; Skip to ")"

PRADD4:	IDPB B,U
	ILDB B,SRC
	CAIE B,")"
	 JRST PRADD4
	JRST PRADD3
;**;[3111] Replace PRADD9			GAS	23-Mar-89
;[3111] Here to skip to close quote.  After the ending quote can be only linear
;whitespace followed by a semicolon, comma, or open angle bracket.  Note the
;code marked as edit 3097 can be removed if MX is fixed to not pass badly
;constructed personal names (multiple quote characters) from foreign hosts.

PRADD9:	IDPB B,U		;[3111] Store previously read character
	ILDB B,SRC		;[3111] Get next character
	CAIE B,.CHCRT		;[3097] CR seen before end quote?
	IFSKP.			;[3097] If so,
	  SETO B,		;[3097] See we have none
	  RET			;[3097] And return to caller
	ENDIF.			;[3097]
	CAIE B,""""		;[3111] Is it a closing quote?
	JRST PRADD9		;[3111] Nope, loop
	IDPB B,U		;[3111] Store the quote character 
	MOVE A,SRC		;[3111] Save source pointer

;[3111] Now we want to eat until a non-space character seen.  

	DO.			;[3111] Loop through characters after quote
	  ILDB B,SRC		;[3111] Load the next character
	  CAIE B,.CHCRT		;[3111] Is it a return?
	  CAIN B,.CHLFD		;[3111]  or is it a linefeed?
	  LOOP.			;[3111] Yes, eat it
	  CAIE B," "		;[3111] It is a space
	  CAIN B,.CHTAB		;[3111]  or a tab?
	  LOOP.			;[3111] Yes, loop
	OD.			;[3111] So it isn't space to us
	CAIE B,","		;[3111] Is it a comma
	CAIN B,";"		;[3111]  or a semicolon?
	JRST PRADD2		;[3111] Yes, handle parse of that stuff
	CAIN B,"<"		;[3111] Start of name>?
	JRST PRADD2		;[3111] Yes, continue parse

;[3111] Character after quoted string was not open angle, semicolon, or comma.

	MOVEM A,SRC		;[3111] Restore source pointer
	ILDB B,SRC		;[3111] Get the character after quote
	JRST PRADD2		;[3111]  and start parsing again
;Here when address terminator is seen (comma, semicolon, or EOL)
; Default hostname if none given and defaulting requested
; B/ terminating character
; E/ byte pointer to default hostname

PRADD5:	TXNN F,F%AT		; "at" seen?
	CALL NETDEF		; No, default the hostname then
PRADD6:	MOVEM B,SAVB		; Save terminating character
	SETZ B,
	IDPB B,U		; End with null
	TXNN F,F%AT		; Net address?
	JRST PRADD8		; No, validate local username then
	CALL CHKHNM		; Yes, parse and validate hostname
	 JRST FLSADR		; No such name and user wants to flush
	JUMPL C,ADDAD0		; If C <> 0, net address
PRADD8:	HRRO B,T		; Local user, point to name string
   TOPS20<
	MOVX A,RC%EMO		; Exact match only
	RCUSR
	 ERJMP PRADD7		; Not a user, go see if SYSTEM
	TXNN A,RC%NOM		; Match?
	JRST ADDAD0		; Yes - add to list
   >;End TOPS20
   TOPS10<
	HRLI B,(POINT 7,)	; Form byte pointer to name
;
;  Ask me NO questions and I'll tell you NO lies!
;  We won't even talk about what a crock this is.
;  We need to verify the local user here - we ain't.
;
;	MOVE A,USRTAB		; See if known local user
;	$CALL S%TBLK		;  ..
;	TXNE B,TL%EXM		; Exact match?
	MOVEI C,1
;	JRST [	HRRZ C,(A)		; Yes, get ptr to PPN
		JRST ADDAD0		; Go add to table
;]
   >;End TOPS10
PRADD7:	HRRO A,T		; See if special
	HRROI B,[ASCIZ "SYSTEM"]
	$CALL S%SCMP		; See if strings match
TOPS20<	JUMPN A,PRADDE		; Jump if no match (no user on PS:)>
TOPS10<	JUMPN A,[CALL NOUSER	; TOPS-10 does the old thing because
		 JRST FLSADR]	; it doesn't use POBOX:
>;End TOPS10
	MOVEI C,SYSCOD		; Match, supply code
	JRST ADDAD0		;  and proceed
TOPS20<
PRADDE:	HRRO A,T		; Now check to see if on POBOX:
	SETZ B,			; Flag we have just username
	CALL CHKPBX
	IFNSK.
	 CALL NOUSER		; Not on POBOX:, definitely no user!
	 JRST FLSADR		; Complain, and flush the address
	ELSE.
	 JRST ADDAD0		; User is there on POBOX:, fine.
	ENDIF.
>; End TOPS20
;Routine to insert the default hostname, pointed to by E

NETDEF:	SKIPN D,E		; Is there a default hostname?
	RET			; No, return
	MOVEI C,"@"		; Yes, do the atsign
	IDPB C,U		;  ..
	MOVEM U,HSTBEG		; Save pointer to hostname for later
	TXO F,F%AT		; Flag that we have a net address
NETDF1:	ILDB C,D		; Move hostname now
	JUMPE C,[RET]		; If null, return
	IDPB C,U
	JRST NETDF1


;No such user name - issue warning

NOUSER:	CITYPE <% No such user: >
	MOVE A,NAMBEG		; Print name parsed
	$CALL KBFTOR
	$TEXT (KBFTOR,< - ignored^M>)
	RET
;CHKHNM - Check for valid host name
;Call: HSTBEG/ pointer to host name
;Return	+1: no such name and user decided to flush the address, or no network
;	+2: OK, C = 0 if local host name, C = -1 if remote host name

CHKHNM:	STKVAR <<CHKHN0,6>>	; Temp space for FLDDBs
	TXNN F,F%ARPA!F%DECN!F%ANFX	; Have a net here?
	JRST [	CALL NOUSER		; No, complain about the address
		RET]			;  and flush the address
;	SKIPN HOSTAB		; Have host table?
;	CALL HSTINI		; No - get one now
;	MOVE A,HOSTAB		; Point to table
;	MOVE B,HSTBEG		; Host name to lookup
;	$CALL S%TBLK		; See if in table
;	TXNN B,TL%EXM		; Exact match only!
	MOVE A,HSTBEG		; Get the pointer to the host name
	CALL VALID8		; Check it out
	 JRST CHKHN2		; Oops - ask user for help
	HRRZ A,(B)		; Get node block pointer
   Repeat 0,<
	TXNE F,F%XMLR		; XMAILR/HOSTS2 type host table?
	JRST [	MOVE A,N.SITE(A)	; Yes, get ptr to site table entry
		CAMN A,LSITE		; Is this the local host?
		JRST CHKLCL		; Yes, treat differently
		SETO C,			; Nope - set net flag
		RETSKP]
   >;End Repeat 0
	MOVE A,N.FLGS(A)	; Non-XMAILR -- get host flags
	TXNN A,NT%LCL		; Local host?
	JRST [	SETO C,			; No, set net flag
		RETSKP]
CHKLCL:	SETZ C,			; Local host - zap host name with leading null
	DPB C,HSTBEG		;  ..
	RETSKP			; Good return

CHKHN2:	$TEXT (KBFTOR,<% No such host: ^Q/NAMBEG/>)
CHKHN3:	WARN < Enter new host name or CR to ignore.
>
	PROMPT <Host: >
;**;[3099] Change 1 line at CHKHN3:+2L	MDR	20-NOV-87
	MOVEI A,[FLDBK. (.CMFLD,,,<-1,,HSTHLP>,,[BRMSK.(FLDB0.,FLDB1.,FLDB2.,FLDB3.,<-#.>)])] ;[3099] Parse host (maybe ARPA)
	SKIPN HOSTAB		; Is there anything in the host cache?
	IFSKP.			; Yes, so point to it
	 DMOVE B,[FLDDB. (.CMCFM)]
	 DMOVEM B,CHKHN0		; Build writeable FLDDB blocks on stack
	 HRRZI B,2+CHKHN0	; 2nd FLDDB goes here
	 HRRM B,.CMFNP+CHKHN0	; Link to 1st
	 HRLI B,[FLDDB1 (.CMKEY,,,<-1,,HSTHLP>)]
	 BLT B,5+CHKHN0		;  ..
	 MOVEI B,2+CHKHN0	; Point to the chain
	 MOVE C,HOSTAB		; Address of host table
	 MOVEM C,.CMDAT(B)	; Set into FLDDB block
	 MOVEI B,CHKHN0		; Get head of chain
	 HRRM A,.CMFNP(B)	; Chain .CMFLD function onto it
	 EXCH A,B		; Add it onto the list
	ENDIF.			; and rejoin...
	CALL RFIELD		; Read the host name
	MOVE C,CR.COD(A)	; Get the function code
	CAIN C,.CMCFM		; Skip if it wasn't a Confirm
	 RET			; It was, so flush the address
	CAIE C,.CMFLD		; Skip if it was a .CMFLD
	IFSKP.			; It was, so...
	 HRROI A,ATMBUF		; Node name is here
	 CALL VALID8		; And check it out
	 IFNSK.			; Invalid host again?
	  $TEXT(KBFTOR,<% Invalid host name: ^T/ATMBUF/.>)
	  JRST CHKHN3		; Try again
	 ENDIF.			; Invalid host name
	ENDIF.			; .CMFLD validation
	HRRZ A,(B)		; Get pointer to node block
	MOVE A,N.FLGS(A)	; Get flags for this node
	TXNE A,NT%LCL		; Local node?
	JRST CHKLCL		; Yes, throw away node name then
	HLR B,(B)		; No, get address of node name string
	MOVE A,(B)		; Get potential flags word
	TLNN A,(177B6)		; First byte empty?
	TXNN A,CM%FW		; And flags bit lit?
	SKIPA			; No, must be text
	ADDI B,1		; Yes, skip to text word then
	HRLI B,(POINT 7,)	; Form byte pointer
	MOVE A,HSTBEG		; Where old (bad) hostname begins
	CALL MOVST0		; Overwrite with good name
	MOVE U,A		; Update new free pointer
	CONFRM			; Get CRLF
	SETO C,			; Flag as net address
	RETSKP			; Give good return
; Add address to list c(C) := user number or code
;	-1 := net address
;	-2 := SYSTEM
;	 0 := no known address
; c(T) := pointer to name string

ADDAD0:	HRRZ B,C		; User number or code
	HRL B,T			; Pointer to string
	MOVEI A,NAMTAB		; Name string table
	CALL TBADDS		; Attempt to add
	 JUMPF FLSADR		; Reclaim space (dupl entry)
	AOS W			; Step to next entry
	HRRZM T,(W)		; Save pointer to string
	MOVEI U,1(U)
ADDAD1:	MOVE B,SAVB		; Restore terminator character
ADDAD2:	CAIE B,";"		; End of named list?
	JRST NXTADR		; No, check for comma
	SOSGE LDEPTH		; Watch nesting level
	JRST [	WARN (Too many terminators in named address list)
		SETZM LDEPTH
		JRST .+1]
	AOS W			; Make room for next entry
	MOVX C,AD%SFX		; Stuff the suffix into the list
	MOVEM C,(W)		;  ..
	ILDB B,SRC		; Get char after semicolon
	MOVEM B,SAVB		; For NXTADR
	JRST ADDAD2		; Check for nested lists

;Flush current address because of some bogosity and keep parsing

FLSADR:	MOVEI U,(T)		; Reclaim unused string
;**;[3099] Change 1 line at FLSADR:+1L	MDR	30-NOV-87
	CAILE W,TCPAG		;[3099] Watch those boundary conditions!
	CAIN W,TCPAG+NTCENT-1	;   ..
	JRST ADDAD1		; Nothing special to do here if list empty
	MOVX A,AD%PRN		; Get personal-name bit
	TDNN A,(W)		; Is previous entry a personal-name field?
	JRST ADDAD1		; No, skip this
	SOJA W,ADDAD1		; Yes, flush the personal name too

;Go on to next address in the list

NXTADR:	MOVE B,SAVB		; Restore break character
NXTAD1:	CAIN B,","		; more names?
	 JRST NXTAD2		; Yes - check for ,<crlf>
NXTAD4:	HRRZ T,FRENAM		; No - end of line then
	MOVEM U,FRENAM		; Update free space
	CAIE T,(U)		; If no names gotten,
	 JRST NXTAD3
	TXNN F,F%CC		; Must undo update to pointer
	 HRRZ W,TOPTRS
	TXNE F,F%CC
	 HLRZ W,TOPTRS
NXTAD3:	MOVE A,SRC		; Return updated source pointer to caller
	SKIPN LDEPTH		; Insure all named lists terminated
	RET			; OK, return to caller
	WARN <Message has bad format:  unterminated named address list>
	MOVX C,AD%SFX		; Generate all terminators required
NXTAD5:	AOS W			; Next loc in list please
	MOVEM C,(W)		; Hallucinate a terminator
	SOSE LDEPTH		; In case nested lists, do all levels
	JRST NXTAD5		;  ..
	RET


;Comma seen - check line continuation

NXTAD2:	MOVE A,SRC		; Get temp source pointer for lookahead
NXTADS:	ILDB B,A		; Peek ahead to next char
	CAIE B," "		; Allow space, tab after comma
	CAIN B,.CHTAB
	JRST NXTADS
	CAIE B,15		; Maybe <CR>?
	JRST PRADD0		; No, just parse next address then
	ILDB B,A		; Yes, skip <LF> also
	MOVEM A,SRC		; Update source pointer
	ILDB B,A		; See if next line starts with LWSP
	CAIE B,40		; Does it start with space or tab?
	CAIN B,11		;  ..
	JRST PRADD0		; OK, this is continuation - get next address
	JRST NXTAD4		; Nope -- this line has spurious comma then
;Check possible net address

PRNETA:	ILDB B,SRC
	CAIN B," "
	 JRST PRNETA
	CAIN B,"@"		; Allow space-atsign-space host delimiter
	 JRST PRNETB		;  ..
	CALL ATP		; Is this the word "at"?
	 JRST [	MOVEI B," "		; No, assume multi-word username.
		IDPB B,U		; Insert the space...
		LDB B,SRC	; Re-prime the pump with next nonspace
		JRST PRADD2]		;  character and keep scanning.
	MOVEI B,"@"
PRNETB:	IDPB B,U		; Got the at, start it out
	TXO F,F%AT
	MOVEM U,HSTBEG		; Save start of host name
PRNET1:	ILDB B,SRC
	CAIN B," "
	 JRST PRNET1		; Flush any intermediate spaces
PRNET2:	IDPB B,U
	ILDB B,SRC
	CAIN B,">"		; Terminating bracket?
	 JRST PRNET3		; Yes - skip to end
	CAIN B,";"		; End of address list?
	 JRST PRADD6		; Yes, add this addr and check for next
	CAIE B,","		; End of single address?
	 CAIN B,15		;  ..
	 JRST PRADD6		; Yes, tie off string and validate
	CAIE B," "		; Eat trailing spaces
	 JRST PRNET2
	CALL ATP		; Is this the word "at"?
	 JRST PRNET3		; No, assume trailing whitespace
PRNET0:	SETZ B,			; Yes, tie off the string so far (ASCIZ)
	IDPB B,U		;  ..
	EXCH U,HSTBEG		; Save this host ptr, restore preceding
PRNT0A:	MOVEI A,TEMP		; Copy the preceding hostname to TEMP
	HRLI A,(POINT 7,)	;  ..
	MOVEI B,[ASCIZ /@/]	;  only 1st replace " at " with "@"
	CALL MOVSTR		;  ..
	MOVE B,U		; Point to beginning of preceding hostname
	CALL MOVST2		; Move preceding hostname to TEMP, with null
	MOVNI A,1		; Form byte pointer to preceding hostname - 1
	ADJBP A,U		;  so we will stomp on the @
	MOVEI B,TEMP		; Move " at <preceding-host-name>" on top
	HRLI B,(POINT 7,)	;  of "@<preceding-host-name>"
	CALL MOVST1		;  ..
	MOVE U,A		; Point to end of preceding hostname
	MOVEI B,"@"		; Fetch real hostname marker
	JRST PRNETB		; Go do the hostname bit again

PRNET3:	ILDB B,SRC
	CAIN B,"("		; Handle comment
	 JRST SKPCOM
	CAIE B,","		; Flush the rest of this address
	 CAIN B,15
	 JRST PRADD6		; Tie off string and validate
	JRST PRNET3
;Try to parse the word "at", followed by a space.  Call with B already
; containing the suspect for the letter "a", or leading whitespace
; before the suspect, and SRC pointing to it.
;
;Return	+1: failure, SRC not changed
;	+2: success, SRC moved over the word and the trailing space

ATP:	CAIE B," "		; Do we have leading whitespace to skip?
	JRST ATP0		; No
	ILDB B,SRC		; Yes, gobble it upt
	JRST ATP		;  ..
ATP0:	CAIE B,"a"
	CAIN B,"A"		; Allow either case
	SKIPA A,SRC		; Is an "a", fetch the source pointer
	RET			; Oops, failure
	ILDB B,A		; Get candidate for "t"
	CAIE B,"t"
	CAIN B,"T"
	SKIPA
	RET
	ILDB B,A		; Now check for space
	CAIE B," "
	RET
	MOVEM A,SRC		; Winnage, update SRC
	RETSKP			;  and give skip return


;Flush this field

SKPADR:	MOVEI U,(T)
SKPAD1:	ILDB B,SRC
	CAIE B,","
	 CAIN B,15
	 JRST NXTAD1
	JRST SKPAD1


;Here on open paren (personal name)

SKPCOM:	PUSH P,T		; Save current start of real address
	SETZ B,			; Insure ASCIZ
	IDPB B,U		;  ..
	MOVEI U,1(U)		; Step to next free string space location
	HRLI U,(POINT 7,)	; Form byte pointer
	HRRZ T,U		; Save start address of this string
SKPCM0:	ILDB B,SRC		; Get next character of personal name
	CAIN B,")"		; End?
	JRST SKPCM1		; Yes
	IDPB B,U		; No, keep storing
	JRST SKPCM0		;  ..
SKPCM1:	MOVEI A,(T)		; Get start address of string
	TXO A,AD%PRN		; Light personal-name flag
	AOS W			; Store entry in address list
	MOVEM A,(W)		;  ..
	POP P,T			; Restore start of actual address
	JRST PRNET3
; Get to and cc lists from message

PRTOCC:	HRRZ W,TOPTRS		; Where to store more of list
	TXZ F,F%CC		; Not in CC yet
PRTO11:	CALL PRADDR		; Parse this line
	IBP A			; Move over the LF too
	ILDB B,A		; Get next char
	CAIE B,"T"		; More to maybe
	 CAIN B,"t"
	 JRST PRTO20
	CAIE B,"C"		; Or maybe start of cc
	 CAIN B,"c"
	 JRST PRTO30
PRTO12:	TXNN F,F%CC		; If doing to still
	 HRRM W,TOPTRS		; Update to list
	TXZE F,F%CC
	 HRLM W,TOPTRS		; Else cc
	RET			; And done
PRTO20:	ILDB B,A
	CAIE B,"O"
	 CAIN B,"O"
	 CAIA
	 JRST PRTO12
	ILDB B,A
	CAIE B,":"
	 JRST PRTO12		; No good I guess
	JRST PRTO11		; Get rest of this line then
PRTO30:	ILDB B,A
	CAIE B,"C"
	 CAIN B,"c"
	 CAIA
	 JRST PRTO12
	ILDB B,A
	CAIE B,":"
	 JRST PRTO12
	TXOE F,F%CC		; Now doing cc
	 JRST PRTO11		; Already was
	HRRM W,TOPTRS		; Update list of to's
	HLRZ W,TOPTRS		; Get list of cc
	JUMPN W,PRTO11		; Already a list started
	MOVEI W,TCPAG+NTCENT-1	; No, start it now
	JRST PRTO11		; And go get more
SUBTTL .RTYPE and .RVBTY - Read-level type (verbose-type) commands

.RVBTY:	TXO F,F%VBTY
.RTYPE:	MOVEI A,[FLDDB. (.CMKEY,,RTYPKW,<
Name of the part of this message you want displayed,>,<everything>)]
	CALL RFIELD		; Get keyword
	HRRZ A,(B)		; Get routine address
	CALL (A)		; Dispatch to it
	TXZ F,F%VBTY		; Clear verbose flag
	RET

;Type everything

.RTYPA:	CONFRM
	CALL CHKDEL		; Can we do this?
;**;[3089] Change 1 line at .RTYPA:+2L	MDR	8-APR-87
	 JFCL			;[3089] Deleted messages are always TYPEable
.RTYP0:	CALL BLANK0		; Clear screen
	CALL TOPLIN		; Type top (summary) line of screen
	MOVEI A,1		; Init line counter
	MOVEM A,LFCNT		;  ..
	SETZ A,			; We're not selecting any particular headers
	CALL TYPMHD		; Type message headers, if distinguishable
	 JRST [	CALL TYPLIT		; Lossage, type message literally then
		RET]			;  and return
	CALL @SCRREG		; Init scrolling region if desired
	CALL TYPBOD		; Type message body
	CALL MRKMSG		; Mark message as having been seen
	CALL SETREF		; Update the last time message file was read
	RET			;  and return

;Type text

.RTYPT:	CONFRM
	CALL CHKDEL		; Can we do this?
	 RET			; No, msg already printed
	CALLRET TYPBOD		; This is the easiest

;Command table for read-level TYPE command

RTYPKW:	RTYPK0,,RTYPK0
	CMD (Everything,.RTYPA)
	CMD (Header-items,.RTYPH)
	CMD (Text,.RTYPT)
RTYPK0==.-RTYPKW-1
;Type header-items

.RTYPH:	STKVAR <TBL0,IDX,PTR>	; Ptr to table of headers, index, string ptr
	MOVEI A,^D100		; Space for TBLUK table of header-names
	$CALL M%GMEM		; Get a chunk
	MOVEM B,TBL0		; Remember its address
	MOVEI A,^D99		; Init table count
	MOVEM A,(B)		;  ..
	MOVE A,B		; Pass table address to KWDLST
	CALL KWDLST		; Parse a list of keywords
	MOVE A,TBL0		; Compact the table now
	CALL COMPAC		; Waste not, want not!
	CALL CHKDEL		; Can we do this?
	 JRST [	MOVE A,TBL0		; No, release storage
		CALLRET KWDREL]		;  and quit
	MOVE B,TBL0		; Point to table header
	HLRZ A,(B)		; Get count of header-items requested
	JUMPE A,[CALL TYPMHD		; None, type all of headers
		  JFCL			; Can't distinguish them, ignore this
		 RET]			; Return
	SETZM IDX		; Init current index
.RTYP2:	CALL CRIF		; Insure we're at left margin
	AOS C,IDX		; Count header-items
	MOVE B,TBL0		; Point to table
	HLRZ B,(B)		; Get count of table entries
	CAILE C,(B)		; Is current index greater than entry count?
	JRST [	MOVE A,TBL0		; Yes, all done, release storage
		CALLRET KWDREL]		;  for keyword table and return
	MOVNS B			; No, negate count
	HRL B,B			; Form AOBJN pointer
	HRR B,TBL0		;  ..
	ADDI B,1		; Skip header word
.RTYP3:	HRRZ A,(B)		; Get this entry's index
	CAIN A,(C)		; The one we want this pass?
	JRST .RTYP4		; Yes, go handle it then
	AOBJN B,.RTYP3		; Loop through table
	FATAL <Badly-formed keyword table at .RTYP3>

.RTYP4:	HLRZ A,(B)		; Get pointer to this header-item's name
	HRLI A,(POINT 7,)	; Form kosher byte pointer
	MOVEM A,PTR		; Save for possible later use
	CALL TYPMHD		; Type this header-item
	 JRST [	MOVE A,PTR	; Point to losing name
		WARN <Header-item "%1S" not found in message>
		JRST .RTYP2]	; Continue through list
	JRST .RTYP2		; Continue through list
SUBTTL .TYPMS and .VBTYP - Top- and send-level type (verbose-type) commands

.VBTYP:	TXO F,F%VBTY		; Set verbose flag
.TYPMS:	CONFRM			; Confirm first
TYPMSG:	CALL TOPLIN		; Type first summary line
	SETZ A,			; Don't select particular header-item
	CALL TYPMHD		; Type message headers
	 JRST [	CALL TYPLIT	; Headers not distinguished, type literally
		RET]		;  and return
	CALL TYPBOD		; Type message body
	CALL MRKMSG		; Mark message as seen
	RET			;  And return
SUBTTL Message typeout and display routines

;Type top (summary) line

TOPLIN:	GTMBL (M,B)		; Get ptr to message block
	MOVX A,M%VALI		; Have we parsed this message yet?
	TDNN A,MSGBTS(B)	;  ..
	CALL PRSMS0		; No, do so then
	GTMBL (M,A)		; Get ptr to message block
	MOVE C,MSGBON(A)	; Get length of message
	MOVEI B,1(M)		; Make external msg number to type
	$TEXT (KBFTOR,< Message ^D/B/ (^D/C/ chars), received ^A>)
   TOPS10<
	$TEXT (KBFTOR,<^H/MSGDAT(A)/>)
   >;End TOPS10
   TOPS20<
	$CALL K%FLSH		; Fancy date/time output please
	GTMBL (M,B)		; Get ptr to message block
	MOVE B,MSGDAT(B)	; Date/time
	MOVX A,.PRIOU		; Output to terminal
	MOVX C,OT%DAY!OT%FDY!OT%FMN!OT%4YR!OT%DAM!OT%SPA!OT%NSC!OT%TMZ!OT%SCL
	ODTIM			; Fancy date/time output
	CALL CRLF
   >;End TOPS20
	RET
SUBTTL RECENT - type out headers of recent messages

RECENT:	TXO F,F%F2		; Want headers
RECEN0:	STKVAR <PRIORM>
	SETZB M,NFLAGD		; Init counts
	SETZM NDELET
	SETZM UNSEEN		; ...
	SETOM PRIORM		; No new messages yet
	CALL CRIF		; Get fresh line if needed
RECEN1:	GTMBL (M,B)		; Get ptr to message block
	TXNE F,F%MOD		; Mod hack?
	 CALL RECMOD		; Yes - special test for new msgs
	MOVE A,MSGBTS(B)	; Get flags
	TXNE A,M%DELE		; Deleted?
	 AOS NDELET		; Count deleted ones
	TXNE A,M%ATTN		; Flagged?
	 AOS NFLAGD		; Count 'em
	TXNE A,M%SEEN		; Seen this one?
	 JRST RECEN2		; Yes - skip it
	AOS UNSEEN		; Count unseen messages
	SKIPGE PRIORM		; If this is our first unseen
	MOVEM M,PRIORM		; Save first unseen
	TXNE F,F%F2		; Header?
	CALL TYPHDR		; Yes - tell him what it's about
RECEN2:	CAMGE M,LASTM		; Thru with all msgs?
	 AOJA M,RECEN1		; No
	SKIPGE M,PRIORM		; Set current message to first unseen
	SETZB M,PRIORM		;  Else use first message
	TXZ F,F%F2		; Don't leave stray bits lying around
	RET

; Special routine to update M%SEEN for system-messages

RECMOD:	MOVX W,M%SEEN		; Bit to twiddle
	SKIPLE A,MSGDAT(B)	; Get recv date of message
	CAMG A,LASTRD		; Check against last read date
	 JRST [	IORM W,MSGBTS(B)	; Mark as seen (ie not new)
		RET]
	ANDCAM W,MSGBTS(B)	; Not seen - assume new
	RET
SUBTTL SNDMSG - send the current message off

SNDMSG:	SKIPN A,TOPTRS		; Must have some addresses
	JRST [	WARN (No addresses specified)
		RET]
	TRNN A,-1		; Must have some To people too
	JRST [	WARN <No TO, only CC>
		RET]
	SKIPG B,TXTPTR		; Get ptr to terminator
	JRST [	HRLI B,(POINT 7,,34)	; If funny (nonexistent byte),
		SUBI B,1		;  correct
		JRST .+1]
	MOVEI A,[BYTE (7) 15, 12, 0]
	LDB C,B
	CAIE C,12		; Unless ended with CRLF
	CALL TXTPUT		;  tack one on
	TXZ F,F%QDEC!F%QARP	; Note no queued mail yet
	CITYPE <Processing mail...>
	$CALL K%FLSH
	$CALL I%NOW		; Get current date/time
	MOVEM A,MSGID0		; Save for construction of message-ID
	SETO A,			; This job
	MOVX B,JI.JNO		; Job number for message-ID
	$CALL I%JINF		;  ..
	MOVEM B,MSGID1		;  ..
	MOVX B,JI.USR		; PPN or usernumber
	$CALL I%JINF		;  ..
	HRRZM B,MSGID2		; Only less significant half
	MOVX B,JI.RTM		; Also runtime in msec
	$CALL I%JINF		;  ..
	HRRZM B,MSGID3		; Only need low-order part, really
;	..			;  continued on next page
;	..			; continued from previous page
	SKIPE A,SVMFOB		; Saving outgoing mail?
	JRST [	MOVX B,F2%NSV		; Suppress this one?
		TDZE B,FLAGS2		;  ..
		JRST .+1		; Yes, skip it
		MOVE B,SVMFOB+1		; Yes, do it up
		CALL CRIF		; Left margin, please
		MOVE C,FOB.FD(B)	;  now to FD for message
		$TEXT (KBFTOR,<Message filed in ^F/(C)/ ^A>)
		PUSH P,B
		$CALL K%FLSH
		POP P,B
		SKIPE RPRHNP		; From REPAIR?
		SOS RPRHNP		; Yes
		CALL SAVMSG		;  ..
		 JRST [	DMOVE A,SVMFOB		; Failure, release chunks
			CALL RELFOB		; ..
			SETZM SVMFOB		; Stop saving messages
			WARN (No more messages will be saved)
			JRST .+1]
		$TEXT (KBFTOR,<- OK>)
		JRST .+1]
	$CALL K%FLSH		; This might take a while, so speak to the user
	CALL DELIVR		; Go deliver the mail
	 RET			; Failure, give nonskip
	RETSKP

; Get user number from table , string pntr c(u)

GETUNM:	MOVE A,NAMTAB		; Table header
	HRRZ B,(U)		; String pointer
	$CALL S%TBLK		; Lookup entry
	HRRE B,(A)		; Get code or user number
	RET
 SUBTTL Message draft editing and display routines

ERSAL1:	SKIPE A,SUBJEC		; Release block if one exists
	CALL RELSB		;  ..
	SETZM SUBJEC		; Reset subject
	SETZM TOPTRS		; Reset to and cc pointers
	SETZM REPLIN		; No reply lines
	SETZM SVABLK		; No saved A-block
	MOVE A,[POINT 7,NAMTXT]
	MOVEM A,FRENAM		; Reset free string pointers
	HRRZ A,@NAMTAB		; Release name table
	ADDI A,1
	SKIPE B,NAMTAB
	CALL M%RMEM
	SETZM NAMTAB
	SKIPN E,DEFCC		; Any default cc-list?
	JRST ERSAL4		; No, skip this
ERSAL0:	MOVEI W,TCPAG+NTCENT-1	; Yes, init cc list pointer
ERSL0B:	HRL B,AB.ADR(E)		; Address of string to LH
	HRR B,AB.COD(E)		; Code to RH
	MOVEI A,NAMTAB		; Enter in NAMTAB
	CALL TBADDS		;  ..
	HRRZ A,AB.COD(E)	; Get code again
	CAIN A,SFXCOD		; Suffix?
	JRST [	MOVX B,AD%SFX		; Yes, get appropriate magic bit
		JRST ERSL0A]
	MOVE B,AB.ADR(E)	; Get address of string
	CAIN A,PFXCOD		; Is this a prefix?
	TXO B,AD%PFX		; Yes, light the bit
ERSL0A:	AOS W			; Step through list
	MOVEM B,(W)		; Stuff into list
	SKIPE E,AB.LNK(E)	; Any more entries?
	JRST ERSL0B		; Yes, keep going
	HRLM W,TOPTRS		; Set cc list pointer
ERSAL4:	SKIPN A,HDITAB		; Header-item table exist?
	JRST ERSAL2		; No, skip this
	HLLZ E,(A)		; Point to user-defined header-items
	JUMPE E,ERSAL2		; None exist
	MOVN E,E		; Form AOBJN pointer
	HRR E,HDITAB		;  ..
	ADDI E,1		; Account for header word
	MOVX B,HD%PRS		; "Present" flag
	MOVX C,HD%PDF		; "Predefined" flag
ERSAL3:	HRRZ A,(E)		; Get addr of H-block for this one
	TDNN C,HD.FLG(A)	; Predefined?
	ANDCAM B,HD.FLG(A)	; No, clear "present" flag
	TDNE C,HD.FLG(A)	; Predefined?
	IORM B,HD.FLG(A)	; Yes, set "present" flag
	AOBJN E,ERSAL3		; Do for all
ERSAL2:	RET

.ERSAL:	CONFRM
SNDINI:	CALL ERSAL1
	SETZM RPRHNP		; Clear REPAIR flag
	JRST .ERST0
.ERSTX:	CONFRM
	TXNE F,F%REDI		; REDISTRIBUTE in progress?
	JRST [	WARN <Erasing the text of a REDISTRIBUTEed message is not allowed.>
		RET]
	CALLRET .ERST0		; Go call erase-text routine
.ERSDT:	CONFRM
	SETZM REPLIN
	RET

.ERSSB:	CONFRM
.ERSB0:	SKIPE A,SUBJEC		; Release string if one exists
	CALL RELSB		;  ..
	SETZM SUBJEC
	RET

.ERSCC:	CONFRM
	HLRZ T,TOPTRS		; get end of cc list
	JUMPE T,R		; if list empty, quit now
	MOVEI V,TCPAG+NTCENT	; and start
.ERSC2:	MOVX A,AD%SFX!AD%PRN	; Don't delete nonexistent strings
	TDNN A,(T)		;  ..
	CALL NAMDEL		; delete this name string
	CAME T,V		; done yet?
	SOJA T,.ERSC2		; no, keep going
	HRRZS A,TOPTRS		; yes, erase cc pointer
.ERSC3:	JUMPN A,R		; if names left in to list, done
	MOVE A,[POINT 7,NAMTXT]
	MOVEM A,FRENAM		; Reset free pointer
	HRRZ A,@NAMTAB		; Release name table
	ADDI A,1
	SKIPE B,NAMTAB
	CALL M%RMEM
	SETZM NAMTAB
	RET
; Erase to field

.ERSTO:	CONFRM
	HRRZ T,TOPTRS		; end of to list
	JUMPE T,R		; if list empty, quit now
	MOVEI V,TCPAG		; and start
.ERST9:	MOVE A,(T)		; Get this entry
	TXNN A,AD%SFX!AD%PRN	; Funny entry?
	CALL NAMDEL		; No, delete this name
	CAME T,V		; done?
	SOJA T,.ERST9		; no, keep going
	HLLZS A,TOPTRS		; yes, reset to pointer
	JRST .ERSC3		; clean up and return

.DSALL:	MOVE A,[$CALL KBFTOR]	; Set up to type it out to tty
	TXO F,F%LCL		; Treat local names w/o net addrs
	CALL MOVTO0
	CALL MOVCC1
	TXO F,F%F1		; want crlf before
	CALL MOVOP1		; Type header options
	CALL MOVSB1		; Type subject
	TXZ F,F%LCL
	SKIPN REPLIN		; Have reply lines?
	JRST .DSTXT		; No, skip this
	MOVEI B,REPLIN		; Yes, type them
	CALL MOVSB2
.DSTXT:	CALL CRLF
	MOVX A,.PRIOU		; Where to put text
	CALL TXTOUT		; Type it and return
	CALLRET CRIF		; CRLF if needed

.DSSUB:	TXO F,F%F1		; Want crlf before
	MOVEI B,MOVSB0
	JRST .DSCC1

.DSTO:	SKIPA B,[MOVTO0]
.DSCC:	 MOVEI B,MOVCC0
	TXO F,F%LCL		; Treat local names w/o net addrs
.DSCC1:	MOVE A,[$CALL KBFTOR]
	JRST (B)


;Erase header-item

.ERSHD:	STKVAR <<.ERSH0,2>>
	NOISE (name)
	DMOVE A,[FLDDB. (.CMKEY)]
	DMOVEM A,.ERSH0		; Build writeable FLDDB block on stack
	SKIPN A,HDITAB		; Pointer to header-item table
	IFNSK.			; No skip means no headers defined
	 WARN (There are no header items defined)
	 RET
	ENDIF.			; Say so, and exit this command
	MOVEM A,.CMDAT+.ERSH0	; Stuff into FLDDB block
	MOVEI A,.ERSH0		; Point to FLDDB block
	CALL CFIELD		; Parse header-item name and confirm
	HRRZ A,(B)		; Point to H-block
	MOVX B,HD%PRS		; Bit to clear
	ANDCAM B,HD.FLG(A)	; Clear "present" bit
	RET
MOVSUB:	MOVE A,[IDPB A,OBPTR]
MOVSB0:	MOVEM A,MOVDSP		; Set up to move into memory
MOVSB1:	SKIPN SUBJEC
	RET			; No subject, return now
	MOVEI B,[ASCII /
/]
	TXZE F,F%F1		; Want crlf
	CALL MOVSB2		; Yes
	MOVEI B,[ASCIZ /Subject: /]
	CALL MOVSB2		; Print header part
	MOVE B,SUBJEC		; Start of actual string
	CALL MOVSB2
	MOVEI B,[BYTE (7) 15, 12, 0]
MOVSB2:	HRLI B,(<POINT 7,0>)
MOVSB3:	ILDB A,B		; Get char
	JUMPE A,R		; Done
	XCT MOVDSP		; Handle it
	JRST MOVSB3


MOVCC:	MOVE A,[IDPB A,OBPTR]
MOVCC0:	MOVEM A,MOVDSP		; Set up to move into memory
MOVCC1:	MOVEI T,[ASCIZ /
cc: /]
	TXNE F,F%REDI		; REDISTRIBUTE command?
	MOVEI T,[ASCIZ /
Resent-cc: /]
	HLRZ C,TOPTRS		; Head of list
	MOVEI E,TCPAG+NTCENT
	JRST MOVTO2


;Construct and insert message-ID

MOVMID:	MOVE A,[IDPB A,OBPTR]
	MOVEM A,MOVDSP
	$TEXT (MVODSP,<Message-ID: ^A>)
	MOVEI A,"<"		; Stupid MACRO can't handle wedgies in args
	XCT MVODSP
	MOVE T,MYHSPT
	TXNE F,F%DNNM		; Are we using the DECnet host name?
	 MOVE T,MYHDPT		; Yes, change pointer to DECnet name
	$TEXT (MVODSP,<"MS^V/VERSN./+GLXLIB^V/libver/" ^D/MSGID0/.^D/MSGID1/.^D/MSGID2/.^D/MSGID3/ at ^Q/T/^A>)
	MOVEI B,[BYTE (7) ">", 15, 12, 0]
	CALLRET MOVSB2
MOVTO:	MOVE A,[IDPB A,OBPTR]
MOVTO0:	MOVEM A,MOVDSP
	MOVEI T,[ASCIZ /
To: /]
	TXNE F,F%REDI		; Redistribute command in progress?
	MOVEI T,[ASCIZ /
Resent-to: /]
	HRRZ C,TOPTRS
	MOVEI E,TCPAG

;Common code for moving address elements to draft

MOVTO2:	$SAVE <X>		; Save possible TRVAR pointer
	STKVAR <BRKF>		; Flag for wedgy brackets needed
	SETZM BRKF		; None needed yet
	JUMPE C,R		; None here, forget it
	TXZ F,F%AT		; Init flag
	SKIPA B,T		; header supplied
MOVTO3:	MOVEI B,[ASCIZ /
    /]				; List continuation
	SETZ X,			; Init horizontal position
	CALL MOVTOU		; Print header
MOVTO4:	MOVE B,(E)		; Get entry
	TXNE B,AD%PFX		; Prefix of list?
	JRST [	HRLI B,(POINT 7,)	; Yes, point to string
		CALL MOVTOU		; Move it
		MOVEI A,":"		; Prefix separator
		XCT MOVDSP		; Move it also
		AOS LDEPTH		; Count levels of list nesting
		JRST MOVTO6]		; OK, finish this and go to next
	TXNE B,AD%SFX		; Is this a suffix entry?
	JRST MOVTO7		; Yes, decrement depth counter, etc.
	TXNE B,AD%PRN		; Is this a personal name?
	JRST [	HRLI B,(POINT 7,)	; Yes, form byte pointer
		CALL MOVTOU		; Move it on out
		SETOM BRKF		; Flag brackets needed
		JRST MOVTO6]		; Continue
	HRLI B,(<POINT 7, 0>)	; No, must be address element, form byte ptr
	MOVEI A,74		; Open bracket
	SKIPE BRKF		; Brackets needed to delimit from pers. name?
	XCT MOVDSP		; Yes, type one then
	CALL MOVADR		; Move address fancily
	MOVEI A,76		; Yes, close them then
	SKIPE BRKF		; Are we enclosing address in brackets?
	XCT MOVDSP		; Yes, move the closing bracket
	SETZM BRKF		; Reset brocket flag
	CAIL E,(C)		; At the end yet?
	RET			; Yes, return then
	MOVE B,1(E)		; See if next entry is a suffix entry
	TXNE B,AD%SFX		;  ..
	JRST MOVTO7		; End of list, this can be tricky
MOVTO5:	MOVEI A,","		; More addresses to come - move comma
	XCT MOVDSP
MOVTO6:	CAIL X,ADRWTH		; near end?
	 AOJA E,MOVTO3		; Yes, get new line for more then
	MOVEI A," "
	XCT MOVDSP
	ADDI X,2
	AOJA E,MOVTO4
;Here to close a named address list

MOVTO7:	MOVEI A,";"		; First close it with semicolon
	XCT MOVDSP		;  ..
	SOSGE A,LDEPTH		; Keep track of nesting level
	JRST [	WARN (Bad named address list nesting found at MOVTO7)
		SETZM LDEPTH
		JRST .+1]
	ADDI E,1		; Move past suffix entry
	CAIE E,1(C)		; Done with list?  (I know this looks funny
	CAIN E,(C)		;  but there is a reason for it)
	RET			; Yes, quit
	ADDI X,1		; Account for semicolon
	MOVE B,1(E)		; See if another suffix (list closure)
	TXNE B,AD%SFX		;  ..
	JRST MOVTO7		; Yes, another semicolon then
	JRST MOVTO5		; No, type comma and do next address
;MOVADR - Move address fancily, handling XMAILR-style address
;	  lists and host translation
;Call:
;	B/ Byte pointer to address string
;	X/ Horizontal position (updated)
;  MOVDSP/ Instruction to execute with character in A

MOVADR:	ILDB A,B		; Get next char of address
	JUMPE A,MOVAD6		; Done - maybe supply hostname, and return
	CAIN A,42		; Quoted string?
	JRST MOVADQ		; Yes, go handle
	CAIN A,"@"		; Start of hostname?
	 JRST MOVAD7		; Yes, handle nodename
	XCT MOVDSP		; No, just move character
	AOJA X,MOVADR		; Count columns

MOVADQ:	XCT MOVDSP		; Move opening quote
	AOS X			; Count columns
MOVAQ0:	ILDB A,B		; Move contents literally
	XCT MOVDSP		;  ..
	LDB A,B			; In case clobbered by MOVDSP
	CAIE A,42		; Close quote?
	AOJA X,MOVAQ0		; No, count columns and continue
	JRST MOVADR		; Yes, finish remainder of text

MOVAD6:	TXZE F,F%AT		; Host name seen?
MOVADX:	RET			; All done
	;JRST	MOVAD8

MOVAD8:	TXNN F,F%ARPA!F%DECN!F%ANFX	; Networks?
	JRST MOVADX		; No - done with name
	MOVE B,MYHSPT		 ; Yes -- add local host name
	TXNE F,F%DNNM		; Use DECNET names?
	MOVE B,MYHDPT		 ; Yes -- use it instead
MOVAD7:	PUSH P,B
	MOVEI B,[ASCIZ /@/]
	CALL MOVTOU
	POP P,B
	TXO F,F%F1		; Don't always translate
	CALL TRANSH		; Translate host name, maybe
	MOVE	A,TRANFG	; Get flags from that nodename block
	TXNE	A,NT%LCL	;Is it local?
	TXNE	F,F%DNNM	;Yes, do we want ARPA name?
	JRST	MOVADN		;No to something
	MOVE	B,MYHSPT	;Yes, fill in local ARPA nodename
MOVADN:	TXZ F,F%F1
	TXO F,F%AT		; Remember that we've done this
MOVAD1:	ILDB A,B		; Translated -- move translated name
	JUMPE A,MOVAD6
	XCT MOVDSP
	AOJA X,MOVAD1		; Do for all chars in string
;Utility routine to move string out via MOVDSP -- updates horizontal
; position in X.  Call with string address in B.

MOVTOU:	HRLI B,(POINT 7,)
MOVTU0:	ILDB A,B
	JUMPE A,R
	XCT MOVDSP
	AOJA X,MOVTU0
;Translate host name if necessary
;Call: 	B/ Pointer to host name
;	F%F1 = Don't translate hostnames with NT%NXL bit (no translate)
;	CALL TRANSH
;Returns +1: B points to translated name -- preserves all other ACs

TRANSH:	TXNE F,F%DECN!F%ARPA	; Have a net?
	TXNE F,F%XMLR		; XMAILR support?
	RET			; No nets, or XMAILR -- don't translate
	$SAVE <C>
	STKVAR <ORIG>		; Original name
	MOVEM B,ORIG		; Save ptr to original name
;	SKIPN HOSTAB		; Have a host table?
;	 CALL HSTINI		; No, get one
	MOVE A,ORIG		; Point to original name
TRANS1:	CALL VALID8		; Check it out
	 JRST [	MOVE A,ORIG		; Point to name being translated
		CMERR (Can't translate host name %1S)
		MOVE B,ORIG
		RET]
	HRRZ A,(B)		; Get ptr to node block
TRANS2:	MOVE B,N.FLGS(A)	; Get flag bits
	TXNN B,NT%SYN		; Synonym?
	JRST TRANSX		; No, just quit
	TXNE F,F%F1		; Suppress translations maybe?
	TXNN B,NT%NXL		; Suppress this one?
	SKIPA
	JRST TRANSX		; Yes, just quit
	SKIPN A,N.REAL(A)	; No, get ptr to real name's N-block
	FATAL (Host name table messed up)
	JRST TRANS2		; Unwind next name
TRANSX:	MOVEM B,TRANFG		; Keep flags for caller
	MOVE B,N.NAME(A)	; Get pointer to name string for host
	MOVE A,(B)		; Get possible flags word
	TLNN A,(177B6)		; Flags present?
	TXNN A,CM%FW		;  ..
	SKIPA
	ADDI B,1		; Yes, skip to text part
	HRLI B,(POINT 7,)
	RET
;Move header options - "Reply-to" and user-defined header-items

MOVOPT:	MOVE A,[IDPB A,OBPTR]
	MOVEM A,MOVDSP
MOVOP1:	SKIPN REPADD		; Any "Reply-to" addresses?
	JRST MOVHDI		; No, do user-defined header-items
	MOVEI B,[BYTE (7) 15, 12, 0]	; CRLF
	TXZE F,F%F1		; If needed
	CALL MOVSB2
	MOVEI B,[ASCIZ /Reply-to: /]
	CALL MOVSB2
	MOVEI X,^D10		; Init horizontal position
	MOVE A,REPADD		; First A-block
	CALL MVALST		; Move this address list
MOVOP3:	MOVEI B,[BYTE (7) 15, 12, 0]	; Move the CRLF
	CALL MOVSB2		;  ..
;	JRST MOVHDI
;Move user-defined header-items out

MOVHDI:	TXNE F,F%REDI		; Redistributing ?
	RET			; Yes, don't do headers
	MOVEI B,[BYTE (7) 15, 12, 0]	; CRLF needed first?
	TXZE F,F%F1		; We're told this by caller lighting F%F1
	CALL MOVSB2		; Yes, move it out
	SKIPN A,HDITAB		; Any header-items?
	RET			; No, return
	HLLZ E,(A)		; Any user-defined header-items?
	JUMPE E,R		; No, return now
	MOVN E,E		; Yes, form AOBJN pointer
	HRRI E,1(A)		;  accounting for header word
MOVHD0:	SETZ X,			; Init horizontal position
	HRRZ A,(E)		; Get ptr to H-block for this one
	MOVE B,HD.FLG(A)	; Get flags
	TXNN B,HD%PRS		; Present?
	JRST MOVHD1		; No, skip it then
	HLRZ B,(E)		; Yes, get name
	HRLI B,(POINT 7,)	; Form ptr
	SETZ C,			; Assume no quoting needed
	CALL SPCCHK		; Qutoing required?
	 MOVEI C,42		; Yes, get the quote char
	SKIPE A,C		; If quoting required,
	XCT MOVDSP		;  move the quote char
	CALL MOVTOU		; Move it out
	SKIPE A,C		; If quoting,
	XCT MOVDSP		;  move closing quote
	MOVEI B,[ASCIZ /: /]	; Colon space
	CALL MOVTOU
	HRRZ A,(E)		; Point to H-block again
	MOVE B,HD.FLG(A)	; Get type code
	ANDI B,HD%TYP		;  *** should use load
;	LOAD B,HDTYP(A)
	CALL @MOVHDO(B)		; Call appropriate routine to move data
	MOVEI B,[BYTE (7) 15, 12, 0]	; CRLF
	CALL MOVSB2		;  ..
MOVHD1:	AOBJN E,MOVHD0		; Go on to next one
	RET


;Table of routines indexed by type to move data of header-item out

DEFINE X(COD,STRNG,SIZ),<
	EXP MVO'COD
>

MOVHDO:	HDTYPS			; Generate the dispatch table
;Move address

MVOADR:	MOVE A,HD.DAT(A)	; Address of address list
	CALLRET MVALST		; Move fancily

;Move text string

MVOTXT:	MOVE B,HD.DAT(A)	; Address of text for this field
	CALLRET MOVSB2		; Move 'em on out

;Move date

MVODAT:	MOVE A,HD.DAT(A)	; Get universal date/time
	$TEXT (MVODSP,<^H9/A/^A>)	; Type only first 9 columns
	RET

;Move date/time

MVODTI:	MOVE A,HD.DAT(A)	; Get universal format date/time
	$TEXT (MVODSP,<^H/A/^A>)	; Use GLXLIB routine
	RET

;Move time

MVOTIM:	MOVE A,HD.DAT(A)	; Get universal date/time
	$TEXT (MVODSP,<^C5/A/^A>)	; Only do minutes and seconds
	RET

;Called by $TEXT macro above with char in A

MVODSP:	XCT MOVDSP
	$RET

;Move keyword

MVOKWD:	MOVE B,HD.DAT(A)	; Get keyword index
	HLRZ B,(B)		; Get string address
	CALLRET MOVSB2		; Move it
; Get some more text

.TEXT:	CONFRM			; Confirm command
	TXNE F,F%REDI		; REDISTRIBUTE in progress?
	JRST [	WARN <Adding text to a REDISTRIBUTEed message is not allowed.>
		RET]
	CALL GETTXT		; Resume text
	MOVE A,LSTCHR		; See if want to send
	CAIN A,32		;  by ^Z term.
	JRST SSEND0
	RET			; Nope
; Get a new subject

.SUBJE:	CONFRM			; Confirm command
GETSUB:	PROMPT (Subject: )
	MOVEI A,[FLDDB. (.CMCFM,CM%SDH,,<
Type a single line terminated with a <CR> which summarizes
the subject of the message you are sending.
>,,[FLDDB. (.CMTXT,CM%SDH)])]
	CALL RFIELD		; Read subject line or crlf
	MOVE A,CR.COD(A)	; See which
	CAIN A,.CMCFM		; Just CR?
	 JRST .ERSB0		;  No subject
	CONFRM
	SKIPE A,SUBJEC		; Release existing block
	CALL RELSB
	CALL CPYATM		; Allocate block and copy string to it
	 JRST [	WARN <Can't set subject, insufficient storage>
		RET]
	MOVEM A,SUBJEC
	RET
.CC:	MOVEI A,[FLDDB. .CMCFM]	; Try confirmation
	CALL RFLDE		;  ..
	 JRST GETCC0		; Non, maybe addresses to parse then
GETCC:	PROMPT (cc: )
GETCC0:	TXO F,F%CC		; Say in cc command
	CALL SVSTAT		; Save state of address lists in case reparse
	HLRZ W,TOPTRS		; Pointer to cc links
	JUMPN W,.TO2
	 MOVEI W,TCPAG+NTCENT-1	; Init for start
	JRST .TO2		; Go join common code


;Save state of address lists in case reparse occurs

SVSTAT:	MOVE A,FRENAM		; String space pointer
	MOVEM A,SV.FNM
	MOVE A,TOPTRS		; Address list pointers
	MOVEM A,SV.TOP
	SKIPE B,SV.NTB		; Any old saved table to release?
	JRST [	HRRZ A,(B)		; Yes, get its size
		ADDI A,1		;  ..
		CALL M%RMEM		; Release it
		JRST .+1]
	SKIPN A,NAMTAB		; Any name table to save?
	JRST [	SETZM SV.NTB		; No, skip this then
		JRST SVSTT0]		;  ..
	HRRZ A,(A)		; Get size of name table
	ADDI A,1		;  ..
	CALL M%GMEM		; Allocate new block for it
	MOVEM B,SV.NTB		; Save address of saved name table
	HRL B,NAMTAB		; From
	HLRZ A,@NAMTAB		; Get number of actual entries
	ADDI A,(B)		; Compute last address BLT'ed
	BLT B,(A)		; Copy the table
SVSTT0:	MOVEI A,SVSTA0		; Where to go to restore all this stuff
	HRRM A,SBK+.CMFLG	; Fake out COMND routines
	EXCH A,REPARA		; Fake out CMDERR also
	MOVEM A,REPAR0		;  but remember what it wanted to do
	MOVEI A,SVSTA1		; Dummy return to reset default reparse addr
	EXCH A,(P)		; Push on stack
	JRST (A)		; Return to caller

;Here if no reparse needed -- reset default reparse address

SVSTA1:	MOVEI A,REPARS
	HRRM A,SBK+.CMFLG
	MOVE A,REPAR0		; Restore original reparse address
	MOVEM A,REPARA
	RET

;Here from COMND JSYS to restore things because reparse needed

	SOS REPAR0		; *** Note that this will only be called
				;     because CMDER1 SOS's REPARA, which
				;     points to SVSTA0.  This remembers that.
SVSTA0:	MOVE A,SV.FNM
	MOVEM A,FRENAM
	MOVE A,SV.TOP
	MOVEM A,TOPTRS
	SKIPE B,NAMTAB		; Any old name table to release?
	JRST [	HRRZ A,(B)		; Yes, get its size
		ADDI A,1		;  ..
		CALL M%RMEM		; Release it
		JRST .+1]
	SKIPN A,SV.NTB		; Any saved table to restore?
	JRST [	SETZM NAMTAB		; No, skip this
		JRST SVSTA2]		;  ..
	HRRZ A,(A)		; Get size of saved name table
	ADDI A,1		;  ..
	CALL M%GMEM		; Allocate new block for it
	MOVEM B,NAMTAB		; Save address of restored name table
	HRL B,SV.NTB		; From
	HLRZ A,@SV.NTB		; Get number of actual entries
	ADDI A,(B)		; Compute last address BLT'ed
	BLT B,(A)		; Copy the table
SVSTA2:
TOPS10<	CALL KILLST >		; Clean up lists built by MSGUSR
	MOVEI A,REPARS		; Restore normal reparse address
	HRRM A,SBK+.CMFLG	;  ..
	MOVE A,REPAR0		; Restore original REPARA
	MOVEM A,REPARA		;  ..
	JRST REPARS		; Go do default reparse things
.TO:	MOVEI A,[FLDDB. .CMCFM]	; Try confirmation
	CALL RFLDE		;  ..
	 JRST GETTO0		; None, maybe addresses to parse
GETTO:	PROMPT (To: )
GETTO0:	TXZ F,F%CC
	CALL SVSTAT		; Save state in case reparse
	HRRZ W,TOPTRS
	JUMPN W,.TO2
	 MOVEI W,TCPAG-1
.TO2:	MOVE U,FRENAM		; Get free space pointer
.TO3:	CALL GETUSR		; Get the user entry in (b)
	 JRST .TO6		; Empty field, finish up and return
	HRRZ A,B		; See if funny code returned
	CAIN A,SFXCOD		; Suffix entry?
	JRST [	MOVE B,(W)		; Yes, was last entry prefix?
		TXNE B,AD%PFX		;  if so, this list is empty
		JRST [	HRRZ T,W		; Empty list -- get ptr to name
			CALL NAMDEL		; Delete the name
			SETZM (W)		; Zap!
			SUBI W,1		;  ..
			JRST .TO5]		; Keep on truckin'
		AOS W			; Yes, stuff into table
		MOVX A,AD%SFX		;  ..
		JRST .TO4]
	MOVE C,B		; Preserve over call to S%TBAD
	CAIN A,PRNCOD		; Personal name?
	JRST .TO1		; Yes, don't stick into name table
	MOVEI A,NAMTAB		; Regular name, add to table
	CALL TBADDS		; Duplicate?
	 JUMPF .TO7		; Could be, go complain maybe
.TO1:	MOVEM U,FRENAM		; Update free pointer
	AOS W			; Add to address
	HLRZ A,C		; Get ptr to string
	HRRZ B,C		; Get user number or code
	CAIN B,PFXCOD		; Prefix of named address-list?
	TXO A,AD%PFX		; Yes, light appropriate flag
	CAIN B,PRNCOD		; Personal name?
	TXO A,AD%PRN		; Yes, light flag
.TO4:	MOVEM A,(W)		; Stuff entry into list
.TO5:	TXNE F,F%CMA		; More wanted
	JRST .TO3		; Yes - get some
.TO6:	TXNN F,F%CC		; In the cc field?
	 JRST [	CAIE W,TCPAG-1		; Check null to list
		HRRM W,TOPTRS
		RET]
	CAIE W,TCPAG+NTCENT-1	; Check null cc list
	HRLM W,TOPTRS
	RET
;Here if failure return from TBADD, either internal error, or
; duplicate name of some sort.  Analyze and inform the user.

.TO7:	CAIE A,EREIT$		; Duplicate entry?
	JRST [	CMERR <Name table full>
		RET]
	HLRZ B,C		; point to string
	HRRZ A,C		; Are we purging an entire address list?
	CAIE A,PFXCOD		;  ..
	JRST [	CALL .TO9		; No, purge one name
		JRST .TO5]		; Go continue eating addresses
	MOVEI E,1		; Yes, init depth counter
	CIETYP <%% Duplicate address list purged - %2S
>
.TO8:	CALL GETUSR		; Eat addresses until list closure
	 JRST [	WARN <Internal error at .TO8, 1>
		JRST .TO6]		; This can't happen
	HRRZ A,B		; Get code for this guy
	CAIN A,PFXCOD		; Prefix?
	ADDI E,1		; Yes, count levels of nesting
	CAIN A,SFXCOD		; Suffix?
	SOJL E,[WARN <Internal error at .TO8, 2>
		JRST .TO6]
	JUMPE E,.TO5		; Back to original level -- all done purging
	TXNN F,F%CMA		; There'd better always be more to parse
	JRST [	WARN <Internal error at .TO8, 3>
		JRST .TO6]
	JRST .TO8		; List to be purged still has elements left


;Here to purge one duplicate name.  Purge associated personal name(s) too.

;**;[3091] Replace one line at .TO9		NED  12 May 87
.TO9:	$TEXT (KBFTOR,<% Duplicate name purged - ^T/(B)/>)
	MOVEI T,TCPAG-1		; Fence for personal name alimentation
	TXNE F,F%CC		; To or CC?
	MOVEI T,TCPAG+NTCENT-1	; CC, different fence
.TO10:	CAIN T,(W)		; Empty list yet?
	RET			; Yes, done
	MOVE A,(W)		; Get entry
	TXNE A,AD%PRN		; Associated personal name?
	SOJA W,.TO10		; Yes, flush it
	RET			; No, return then
;Prompt for and get user-defined header-items which are required

GETUHD:	SKIPN A,HDITAB		; Any header-items defined?
	RET			; No, return
	HLLZ E,(A)		; Count of all header-items
	JUMPE E,R		; None, just quit
	MOVN E,E		; Form AOBJN pointer
	HRRI E,1(A)		;  accounting for header word
GETUH0:	HRRZ A,(E)		; Get ptr to H-block for this item
	MOVE B,HD.FLG(A)	; Get flags
	TXNE B,HD%RQD		; Required?
	CALL INCLUD		; Yes, prompt for and store this header-item
	AOBJN E,GETUH0		; OK, keep on truckin'
	RET


; Get prompted message

GETMS0:	CALL GETTO0		; Get To list without prompting
TOPS10<	CALL ECHOON >		; In case monitor command
	JRST GETMS1
GETMSG:
TOPS10<	CALL ECHOON >		; In case monitor command
	CALL GETTO		; To (with prompt)
	CALL GETCC		; cc
GETMS1:	CALL GETSUB		; Subject
	CALL GETUHD		; User-defined header-items
	JRST GETTXT		; Go get text and finish
; Remove user

.UNTO:	NOISE (user)
.UNTO1:	MOVEI U,STRBUF		; Place to put name string
	CALL GETUSR
	 RET			; Null address, just return
	HRRZ C,B		; Get code
	SETZ A,			; Assume not address-list
	CAIN C,PFXCOD		; Is this an address-list prefix?
	SETO A,			; Yes, flag that we're removing a list
	MOVEI U,STRBUF		; Start of buffer
	CALL DOUNTO		; Remove the name
	TXNE F,F%CMA		; More to come?
	 JRST .UNTO1		; Yep
	RET


;Remove a user (or list of users) from to or cc lists
;Call:	A/ -1 to remove address-list, 0 to remove single user
;	U/ address of name to remove (username or address-list name)
;Return	+1: always

DOUNTO:	TRVAR <PFXCNT>		; Count of prefixes seen
	MOVEM A,PFXCNT		;  also flag to remove list
	HRRZ V,TOPTRS		; Get to pointers
	MOVEI T,TCPAG
	TXZ F,F%CC		; Say not in cc
	CALL DOUNC1
	HLRZ V,TOPTRS		; Get cc pointers
	MOVEI T,TCPAG+NTCENT
	TXO F,F%CC		; Say in cc
DOUNC1:	JUMPE V,R		; None of this class
DOUNT0:	HRRZ A,(T)		; Get this one
	HRLI A,(<POINT 7,0>)
	MOVEI B,(U)		; Try to match this
	HRLI B,(<POINT 7,0>)
;	JRST DOUNT1
DOUNT1:	ILDB C,B		; Get char from target
	JUMPE C,DOUNT3		; Null means it matches
	CAIN C,"@"		; Starting host name?
	 TXNE F,F%AT		; Trying to match @ too?
	 CAIA			; No or yes
	 JRST DOUNT3		; Yes and no, matches
	ILDB D,A
	CAIN D,(C)
	 JRST DOUNT1		; Chars match?
	TRC D,(C)
	CAIN D,40		; Case only?
	 JRST DOUNT1		; Yes, keep looking
DOUNT2:	CAIL T,(V)		; Done with this list?
	 RET			; Yes, return
	AOJA T,DOUNT0		; No, check next entry

DOUNT3:	ILDB C,A		; Make sure we've matched entire target
	JUMPN C,DOUNT2		; There's more to target, this isn't a match
	MOVX A,AD%PFX		; Is this entry an address-list prefix?
	TDNE A,(T)		;  ..
	JRST [	SKIPN PFXCNT		; Yes, were we looking for one?
		JRST DOUNT2		; We weren't -- no match then
		JRST DOUNT4]		; We were -- this is it then
	SKIPE PFXCNT		; This isn't a prefix -- did we want one?
	JRST DOUNT2		; Yes, this is wrong -- no match
	CALL RMVADR		; Ordinary address -- remove it
	JRST DOUNT6		; Finish up and return

DOUNT4:	SETZM PFXCNT		; Init depth counter
DOUNT5:	MOVE A,(T)		; Get this entry
	TXNE A,AD%PFX		; Prefix?  (Always true 1st pass)
	AOS PFXCNT		; Yes, count depth
	TXNE A,AD%SFX		; Suffix?
	SOS PFXCNT		; Yes, one lest level now
	CALL RMVADR		; Remove this entry
	SKIPN PFXCNT		; This list totally removed yet?
	JRST DOUNT6		; Yes, finish up
	JUMPN V,DOUNT5		; Loop thru all entries in list
	WARN (Unterminated named address-list)

DOUNT6:	TXNE F,F%CC		; In cc field?
	 HRLM V,TOPTRS		; Yes update cc pointer
	TXNN F,F%CC
	 HRRM V,TOPTRS		; Else update to pointers
	CAIGE T,1(V)		; Was that the last in the list?
	 JUMPN V,DOUNT0		; Or the end of the list?
	RET			; Yes, return
;Remove one address from to or cc list.
;Call:	T/ address of entry in TCPAG to remove
;	V/ address of last entry in list
;Return	+1: always, T preserved, V updated (or zero if list empty)

RMVADR:	MOVX A,AD%SFX!AD%PRN	; Don't try deleting suffixes or personal names
	TDNN A,(T)		;  ..
	CALL NAMDEL		; delete this name
	CAIN T,(V)		; At the end of the list?
	 JRST RMVAD1		; Yes, no need to move anything
	MOVEI A,(T)
	HRLI A,1(T)		; Move up one word
	BLT A,-1(V)
RMVAD1:	CAIE V,TCPAG+NTCENT	; Have we emptied the list?
	 CAIN V,TCPAG		; ie., Was that the first entry?
	 TDZA V,V		; Yes, erase field then
	 SOJ V,			; Else update end pointer

;See if we have leading personal name entries which need to be flushed.

	JUMPE V,R		; If list empty, don't try this stuff
	MOVE A,-1(T)		; Get preceding entry
	TXNE A,AD%PRN		; Is it a personal name?
	SOJA T,[CALL RMVADR		; Yes, delete it
		JRST .+1]		;  and continue

;See if we've emptied a named list by removing the individual names in it.
; If so, must remove prefix and suffix entries.

	CAIN T,1(V)		; Was entry deleted the end entry?
	RET			; Yes, can't be any suffixes then
	MOVE A,(T)		; Get potential suffix
	TXNN A,AD%SFX		; Is deleted entry followed by suffix?
	RET			; No, done
	MOVE A,-1(T)		; Get possible prefix
	TXNN A,AD%PFX		; Is it?
	RET			; No, return
	MOVEI A,-1(T)		; Yes, must delete prefix and suffix
	HRLI A,1(T)		; So must remove two entries
	BLT A,-2(V)		;  ..
	SUBI V,2		;  ..
	CAIE V,TCPAG+NTCENT	; Check for emptied list
	 CAIN V,TCPAG-1		;  ..
	  SETZ V,		; If empty, zero end pointer
	RET

;
;	NAMDEL removes a name from the TO: or CC: list
;

NAMDEL:	MOVE A,NAMTAB		; Remove entry from name table
	HRR B,(T)		; Actual string
	HRLI B,(POINT 7,)	;  ..
	$CALL S%TBLK		; Find in table
	TXNN B,TL%EXM		; Found the entry?
	JRST [	HRR A,(T)		; No, point to string
		WARN (Can't find %1S in name table)
		RET]
	MOVE B,A
	MOVE A,NAMTAB
	HLRZ D,(A)		; [2404] Get the # entries in the table
	SKIPE D			; Don't try if table's empty
	$CALL S%TBDL		; Delete from table (can't fail?)
	RET

	END

; Edit 2443 to MS.MAC by TGRADY on 5-Sep-85
; Fix CPR's, BFD's, and PARSEF bug.
; Edit 2444 to MS.MAC by TGRADY on 5-Sep-85
; Fix up previous edit - bug in PARSEF.
; Edit 2449 to MS.MAC by JROSSELL on 30-Sep-85
; Add support for MSLCL to use GLXLIB's IPCF interface
; Edit 2451 to MS.MAC by JROSSELL on 1-Oct-85
; Do not set IPCF quotas
; Edit 2452 to MS.MAC by MAYO on 18-Oct-85
; "verb SAME" shouldn't always claim %No previous sequence exists
; Edit 2454 to MS.MAC by PRATT on 19-Oct-85
; Merge many of Ned's changes and a couple of other things:
;    Tops-20 conditionalize searching of MONSYM
;    Allow SYSTEM mail for Tops-10
;    Allow MAIL as program name along with MS
;    Remove some ISWS conditional code
;    VT200 series checking
;    Make HEADERS visible again, allow "H" as abrev
;    Make SUMMARIZE, ZSEND, and SSEND invisible
;    Allow ^Z for exiting MS on the -10
;    Make .FLAGX do a call to SEQUEN, change the .FLAGX callers
;    Fix up some comments and their alignment
;    Move the calling of SIZFIL a little bit in the GET1 code
;    Change a couple of label names and add .REXIZ
;    Make sure to call MRKMSG in the correct places
;    Make NET command type out an extra <crlf> before running sender programs
;    Don't blank screen on a PUSH
; Edit 2456 to MS.MAC by PRATT on 21-Oct-85
; Make "%EXPUNGE in progress" message a little more general
; Edit 2457 to MS.MAC by PRATT on 21-Oct-85
; Put STATUS back in
; Edit 2461 to MS.MAC by PRATT on 27-Oct-85
; Don't update message bit if we don't have to
; Edit 2463 to MS.MAC by PRATT on 30-Oct-85
; Redo the last edit the correct way, just before PARS14, make sure "in file"
; message bits are copied to the "in file" MSGBTS field.
; Edit 2462 to MS.MAC by PRATT on 4-Nov-85
; Merge many changes in -10, -20, and common code.
; *** Edit 2465 to MS.MAC by JROSSELL on 5-Nov-85
; Make SUBJEC a global symbol so it can be used by MSLCL
; *** Edit 2468 to MS.MAC by PRATT on 7-Nov-85
; Fix up commands tables; fix headers, add directory for vms compat, add the
; "Get file" bit to status.
; *** Edit 2469 to MS.MAC by PRATT on 9-Nov-85
; After Expunge, do PARSEF with "M" set up, so that we make sure that we have a
; message window after unmapping the old window.
; *** Edit 2471 to MS.MAC by PRATT on 14-Nov-85
; Changes to break up MS into a smaller module.
; *** Edit 2474 to MS.MAC by PRATT on 18-Nov-85
; Changes for TOPS10 to make MS.MAC smaller
; *** Edit 2477 to MS.MAC by MAYO on 20-Nov-85
; Make FORCE-DIRECTORY-LOOKUP be on by default.
; *** Edit 2484 to MS.MAC by SANTEE on 21-Nov-85
; Clean up the various edit histories.
; *** Edit 2486 to MS.MAC by PRATT on 22-Nov-85
; Copyright statements
; *** Edit 2487 to MS.MAC by MAYO on 25-Nov-85
; Merge MSGUSRs for the -10 and -20. Have MS.MAC call KILLST when cleaning up a
; ^U, etc. on the -10 side.
; *** Edit 2492 to MS.MAC by MAYO on 3-Dec-85
; Hack Reply-to addresses during ARPA mail so at least local nodenames get
; translated to ARPA names. Also, remove vestigal code for XMAILR.
; *** Edit 2604 to MS.MAC by PRATT on 9-Dec-85
; Fix problem with DIRECTORY at read level, wrong cmd macro was used
; *** Edit 2605 to MS.MAC by PRATT on 9-Dec-85
; Fix up REDISTRIBUTE. Make headers say Resent, Fix sequence handling, Use
; Auto-send flag, Remove checking of trailer, Change brief-address-list header
; table, Don't include user defined headers in when resending.
; *** Edit 2606 to MS.MAC by PRATT on 9-Dec-85
; Fix more problems with Redistribute
; *** Edit 2607 to MS.MAC by SANTEE on 10-Dec-85
; Make MS/MX get along well together. Have MS write dashes at the end of
; messages. While we're there remove some of the NETMAI code.
; *** Edit 2613 to MS.MAC by JROSSELL on 14-Dec-85
; Repair the REPAIR command
; *** Edit 2614 to MS.MAC by SANTEE on 18-Dec-85
; Keep the number of messages deleted, new, and flagged up-to-date. This makes
; several paths faster and we end up doing alot less work. Also, with windowing
; it is important on the -10 to know if we have any work to do at expunge time.
; Some minor code rearrangements were made in related areas for speed up
; purposes. Finally some comments were added or lined up and paging was
; adjusted in some places.
; *** Edit 2616 to MS.MAC by JROSSELL on 18-Dec-85
; When a message is read or typed; or when SKIM, SUMMARIZE, HEADERS, GET or
; NEXT is given - update the last time the mail file was read. On TOPS20 also
; update the FDB.
; *** Edit 2617 to MS.MAC by JROSSELL on 18-Dec-85
; Change GTJFN error codes when doing a REPAIR from TOPS-20 to GLXLIB so
; TOPS-10 can understand them
; *** Edit 2619 to MS.MAC by SANTEE on 19-Dec-85
; Fix bug with 2614 that caused the setting and unsetting of bits to only
; happen sometimes.
; *** Edit 2622 to MS.MAC by PRATT on 23-Dec-85
; Fix "MOVE or DELETE" length invalid error, SET DEF DIR, SET DEF PROT (-10)
; *** Edit 2626 to MS.MAC by MAYO on 3-Jan-86
; Teach MOVADR not to append nodenames to addresses if they don't already have
; one. Hence, local addresses just typed as NAME stay that way.
; *** Edit 2627 to MS.MAC by PRATT on 3-Jan-86
; Clean up command tables, make some more commands invisible
; *** Edit 2632 to MS.MAC by MAYO on 10-Jan-86
; Allow trailing spaces in a multi-line address (PRADDR)
; *** Edit 2633 to MS.MAC by JROSSELL on 10-Jan-86
; Make the REPAIR command noise words more informative
; *** Edit 2634 to MS.MAC by JROSSELL on 10-Jan-86
; Open up a second JFN as READ/WRITE in places where we don't want another
; process writing to the mail file.
; *** Edit 2635 to MS.MAC by PRATT on 13-Jan-86
; If RETRIEVE DRAFT can't find the TO: field, complain about it but don't abort
; the command.
; *** Edit 2636 to MS.MAC by APPELLOF on 15-Jan-86
; Finish SET DEFAULT DIRECTORY for TOPS-10
; *** Edit 2638 to MS.MAC by PRATT on 17-Jan-86
; Unmerge edit 2626, it's causing grief... will it ever end?
; *** Edit 2640 to MS.MAC by APPELLOF on 24-Jan-86
; SET/CLEAR the "new mail" bit in mail file RIB on TOPS-10 Bit is lit if there
; are unseen messages. Bit is cleared if there are no unseen messages.
; *** Edit 2641 to MS.MAC by APPELLOF on 27-Jan-86
; Re-apply preceeding edit properly
; *** Edit 2642 to MS.MAC by PRATT on 27-Jan-86
; Apply Henry's changes for return-receipt-requested.
; *** Edit 2644 to MS.MAC by PRATT on 27-Jan-86
; HBLKP should not be a TRVAR, and CRFFDH should not be in a common code INTERN
; statement.
; *** Edit 2645 to MS.MAC by SANTEE on 27-Jan-86
; Edit 2634 broke CHECK on the -10 side. Put the code back.
; *** Edit 2646 to MS.MAC by SANTEE on 28-Jan-86
; Eliminate a few duplicate INTERNALs and cause code to flow better.
; *** Edit 2651 to MS.MAC by SANTEE on 2-Feb-86
; Eliminate the need for MSUTAB at all. Move the few useful lines elsewhere.
; *** Edit 2653 to MS.MAC by JROSSELL on 10-Feb-86
; Correct the message length for saved outgoing REPAIRED mail
; *** Edit 2654 to MS.MAC by JROSSELL on 12-Feb-86
; If an unprivileged user is over quota, delete the empty .MAI file and do not
; send a message to MX. Inform the user of being over quota.
; *** Edit 2659 to MS.MAC by MAYO on 20-Feb-86
; Don't allow Aliases with parser-breaking characters in them (like comma).
; *** Edit 2662 to MS.MAC by MAYO on 26-Feb-86
; Fix Return-Receipt-Requested-to to properly parse addresses. Allow the normal
; range of possibilities offered by GETUSR.
; *** Edit 2666 to MS.MAC by MAYO on 3-Mar-86
; Make the -10's SET {no} DIRECTORY-CONFIRMATION command do the same things as
; the -20's SET FORCE-DIRECTORY-LOOKUP. Using either controls F%FDIR, which
; controls whether GETUSR verifies local usernames.
; *** Edit 2671 to MS.MAC by SANTEE on 3-Mar-86
; When we stopped talking to NETMAI we didn't need the storage. Get rid of it.
; *** Edit 2672 to MS.MAC by MAYO on 3-Mar-86
; SET DIRECTORY should be invisible, SET FORCE sufficies.
; *** Edit 2679 to MS.MAC by HDAVIS on 11-Mar-86 (TCO NO )
; Set default for sending RRR to yes. Don't call CHKDEL twice. Give user 4
; second to read error if sending RRR fails.
; *** Edit 2679 to MS.MAC by MAYO on 12-Mar-86
; Consolidate references to TENT1 and TENT. This prevents a BPN when redefining
; headers.
; *** Edit 2682 to MS.MAC by SANTEE on 16-Mar-86
; Forwarding of large messages could get rude if the message was larger than
; the window size. Make it more polite when large messages are present. Also
; make forwarding cause less thrashing of the window.
; *** Edit 2688 to MS.MAC by MAYO on 26-Mar-86
; In REPLY, if there is no FROM or REPLY-TO, complain and try to use SENDER.
; *** Edit 2689 to MS.MAC by APPELLOF on 26-Mar-86
; Prevent ERF (Error Reading File) on TOPS-10 if MX is appending when we check
; the size of the mail file. Also cut down on the number of LOOKUPs we do.
; *** Edit 2694 to MS.MAC by JROSSELL on 8-Apr-86
; If PARSEF detects that the mail file has changed size, have it assume that
; another reader exists and reparse the mail file. This is for TOPS20 only and
; must be used due to a lack of a complete global ENQ/DEQ mechanism.
; *** Edit 2698 to MS.MAC by RASPUZZI on 19-May-86
; Make DEFINE ALIAS * undefine aliases instead of address lists
; *** Edit 2704 to MS.MAC by SANTEE on 22-May-86
; A QUIT from MS SEND> level can get bad results if you entered with MS SEND.
; We check to see if this is a reply by looking at the message bits. Lets see
; if there are any first.
; *** Edit 2706 to MS.MAC by RASPUZZI on 27-May-86
; Teach MS not to use POBOX: when writing files. Instead, find out what STR: is
; being used (saved in MYSTR) and go from there.
; *** Edit 2707 to MS.MAC by PRATT on 28-May-86
; Make TYPE/VERBOSE-TYPE type out deleted messages after issueing a warning.
; The READ command will not do this.
; *** Edit 2708 to MS.MAC by PRATT on 30-May-86
; Fix problem with multiple "There are no messages in MAIL.TXT" messages.
; *** Edit 2716 to MS.MAC by RASPUZZI on 6-Jun-86
; Teach MS about looking for users on other structures when POBOX: contains a
; list of structures and there is no directory for a recipient of a message on
; the first structure listed in the logical name.
; *** Edit 2718 to MS.MAC by SANTEE on 10-Jun-86
; Get the personal name from the accounting system on TOPS-10. Also, while I
; was there clean up ^C (print it out at the right time and clear the scrolling
; region if set up) and make the listing just a little bit prettier.
; *** Edit 3074 to MS.MAC by RASPUZZI on 14-Aug-86, for SPR #21351
; Make sure MS gets the right EMACS from EDITOR:
; *** Edit 3075 to MS.MAC by RASPUZZI on 14-Aug-86
; Silly me. I forgot to put in the edit number for 3074. So now there are 2.
; *** Edit 3086 to MS.MAC by RASPUZZI on 27-Mar-87
; Prevent MS from looping through a non-existant message sequence when a user
; continues their MS fork.
; *** Edit 3087 to MS.MAC by RASPUZZI on 7-Apr-87
; Correct stupidity in edit 3086. Don't fool with MSGSEQ but instead, change
; MSGSSQ to clear the message sequence.
; *** Edit 3089 to MS.MAC by RASPUZZI on 9-Apr-87
; Make sure deleted messages are TYPEable at the read level since this is
; possible at the top level.
; *** Edit 3091 to MS.MAC by SANTEE on 31-Jul-87
; Fix up a few erroneous error messages
; *** Edit 3094 to MS.MAC by SANTEE on 7-Aug-87
; Don't have BBoard, which is invisible, interfere with Blank, which is
; visible.
; *** Edit 3095 to MS.MAC by SANTEE on 7-Aug-87
; Don't leave the mail file open after a quit. Tops-10 only.
; *** Edit 3096 to MS.MAC by SANTEE on 28-Sep-87
; Move all impure data together.
; *** Edit 3097 to MS.MAC by RASPUZZI on 18-Nov-87, for SPR #21573
; Prevent MS from blowing up when a VAX user sends over his personal name with
; an odd number of quotes in it. Also, MX must be fixed to prevent this from
; happening!
; *** Edit 3099 to MS.MAC by RASPUZZI on 1-Dec-87
; Make MS parse ARPA hosts and fix off by one bug

; Edit= 3106 to MS.MAC on 23-Sep-88 by SANTEE
;Remove the ambiguous option ^Z (TOPS-10 only) from the SEND level options.
;Also, remove the default (TEXT) from ERASE at SEND level.
; Edit= 3108 to MS.MAC on 23-Sep-88 by RASPUZZI
;Allow username characters to be in aliases and address lists.
; Edit= 3110 to MS.MAC on 15-Nov-88 by RASPUZZI
;Move IPCTIM out of LOWSEG for TOPS-10.
; Edit= 3111 to MS.MAC on 24-Mar-89 by GSCOTT
;Prevent bad username parse when "string" and <user@node> are split by CRLF.