Trailing-Edge
-
PDP-10 Archives
-
bb-kl11k-bm_tops20_v7_0_tsu02_2_of_2
-
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.