github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-05 02:34:56 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/decmai/ms/ms.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

5423 lines
167 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
;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
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
TOPS10< CMD (\"32,.EXIT0,CM%INV) > ; Blueness
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,,,,,[FLDDB. (.CMFLD,,,<name of alias>)])])]
JRST .DEFS1
;Define address-list
.DEFSS: SETZ B, ; This kind will be visible to recipient
MOVEI A,[FLDDB. (.CMTOK,,<POINT 7,[ASCIZ /*/]>,,,[FLDDB. (.CMQST,,,,,[FLDDB. (.CMFLD,,,<name of address list>)])])]
; 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)
MOVEI A,[FLDDB. (.CMKEY,,ECMDTB,,<text>)]
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
; Skip to close quote (same as PRADD4)
PRADD9: IDPB B,U
ILDB B,SRC
;**;[3097] Add 5 lines at PRADD9:+2L MDR 18-NOV-87
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,42
JRST PRADD9
JRST PRADD3
;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
Reference in New Issue View Git Blame Copy Permalink