Trailing-Edge
-
PDP-10 Archives
-
msv11ck
-
10,7/mail/ms/msdspl.mac
There are 7 other files named msdspl.mac in the archive. Click here to see a list.
;This software is furnished under a license and may only be used
; or copied in accordance with the terms of such license.
;
;Copyright (C) 1979,1980,1981,1982 by Digital Equipment Corporation
; 1983,1984,1985,1986 Maynard, Massachusetts, USA
TITLE MSDSPL - Message typeout and display routines for MS
SEARCH GLXMAC,MSUNV,MACSYM
PROLOG (MS)
CPYRYT
MSINIT
.DIRECTIVE FLBLST
SALL
;Define globals
GLOBS ; Storage
GLOBRS ; Routines
;Routines defined herein
INTERNAL TYPBOD, TYPHDR, TYPLIT, TYPMHD
;Routines defined elsewhere
;MSUTL.MAC
EXTERNAL COUNTS, CRIF, CRLF, MOVST0, MOVSTR, TBOUT, TNOUT, TSOUT, REMAP
EXTERNAL GTBFL, WTOP, SETSFL
;Data items defined elsewhere
;MS.MAC
EXTERNAL LFCNT,MSGFAD,WBOT,MYHDPT,MYHSPT
SUBTTL Type header line for a message (HEADERS command)
TYPHDR: CALL CRIF ; CRLF if needed
SKIPG A,OUTIFN ; File or terminal?
MOVX A,.PRIOU ; No, must be to TTY then
SETZB C,D
GTMBL (M,B) ; Get ptr to message block
MOVE T,MSGBTS(B) ; Get message's bits
TXNE T,M%SEEN
SKIPA B,[" "]
MOVEI B,"N" ; New
CALL TBOUT
TXNN T,M%ATTN
SKIPA B,[" "]
MOVEI B,"F" ; FLAGGED
CALL TBOUT
TXNN T,M%RPLY
SKIPA B,[" "]
MOVEI B,"A" ; Answered
CALL TBOUT
TXNN T,M%DELE
SKIPA B,[" "]
MOVEI B,"D" ; Deleted
CALL TBOUT
MOVEI B,1(M) ; Message number
$TEXT (TYPHD9,<^D4R /B/ ^A>)
TXNN T,M%VALI ; Message parsed yet?
CALL PRSMS0 ; No, go parse it
GTMBL (M,B) ; Get ptr to message block
SKIPG B,MSGDAT(B) ; Date
JRST [ $TEXT (TYPHD9,< ^A>) ; Fill with spaces if not there
JRST TYPHD2]
$TEXT (TYPHD9,<^H6R /B/^A>)
; ..
; ..
TYPHD2: SKIPG A,OUTIFN ; File or TTY
MOVX A,.PRIOU ; ..
MOVEI B," " ; Delimit this column
CALL TBOUT ; ..
GTMBL (M,B) ; Get ptr to message block
MOVE A,MSGFRM(B) ; "From" field
MOVE C,MSGFRN(B) ; Size
MOVEI B,^D22 ; Limited to 22 chars
CALL TYPFME ; Is this message from me?
SKIPA ; No...
JRST [$TEXT (TYPHD9,<To: ^A>) ; Yes, use "To:" field instead
GTMBL (M,C) ; Get ptr to message block
MOVE A,MSGTO(C) ; ..
MOVE C,MSGTON(C) ; ..
SUBI B,4 ; Account for "To: " string
JRST TYPHD1] ; ..
TYPHD1: TXNE F,F%PRSN ; Personal name only?
CALL TYPPRN ; Yes, extract it and point A to it
CALL TYPHDS ; Type the field
JUMPE B,TYPHD3 ; None more needed
MOVE C,B ; Make room
MOVEI B," "
SKIPG A,OUTIFN ; LPT, file, or terminal?
MOVX A,.PRIOU ; Terminal
CALL TBOUT
SOJG C,.-1 ; Fill with spaces
TYPHD3: SKIPG A,OUTIFN ; File or TTY...
MOVX A,.PRIOU ; ..
MOVEI B,"|" ; Delimit this column with vertical bar
CALL TBOUT ; ..
GTMBL (M,B) ; Get ptr to message block
MOVE A,MSGSUB(B) ; Subject field
SKIPG B,LINEW ; Get tty line width
MOVEI B,^D72 ; If unknown or weird, assume 72
SUBI B,^D52 ; Make rest of line fit
GTMBL (M,C) ; Get ptr to message block
MOVE C,MSGBON(C) ; Get character count of msg
CAIL C,^D100 ; If length>100, need another column
SUBI B,1 ; ..
CAIL C,^D1000 ; If length>1000, need another
SUBI B,1 ; ..
CAIL C,^D10000 ; etc. etc.
SUBI B,1 ; 5 columns ought to do it!
GTMBL (M,C) ; Get ptr to message block
MOVE C,MSGSUN(C) ; Size of subject field
PUSH P,F
TXZ F,F%PRSN
CALL TYPHDS
POP P,F
SKIPG A,OUTIFN
MOVX A,.PRIOU
SETZB C,D
HRROI B,[ASCIZ / (/]
CALL TSOUT
GTMBL (M,B) ; Get ptr to message block
MOVE B,MSGBON(B) ; Length of message
MOVEI C,^D10 ; Base 10
CALL TNOUT
JFCL
HRROI B,[ASCIZ / chars)
/]
CALL TSOUT ; Finish off line
RET
;Here from $TEXT macros above
TYPHD9: MOVE B,A ; Character
SKIPG A,OUTIFN ; File
MOVEI A,.PRIOU ; or terminal
CALL TBOUT
$RET
TYPHD8: IDPB A,UPDPTR ; Just stuff it
RET
;TYPFME - Check to see if current message is from me
;Return +1: no
; +2: yes
TYPFME: $SAVE <A,B,C,F> ; Don't clobber temps
TRVAR <<TMPST,40>,SVNDPT> ; Temporary string space
GTMBL (M,B) ; Get ptr to message block
MOVE V,MSGFRM(B) ; Point to beginning of "from" field
MOVE W,MSGFRN(B) ; Length of "from" field
CALL SETSFL
PUSH P,V
SUB V,WBOT
MOVE A,MSGFAD
IMULI A,5
ADD V,A
CHR2BP ; Form byte pointer
POP P,V
MOVEI B,TMPST ; Pointer to temp space
HRLI B,(POINT 7,) ; ..
TXZ F,F%F1!F%F2 ; Init flags
TYPFM0: SOJL W,TYPFM3 ; Eat leading LWSP first
ILDB C,A ; ..
CAIE C," " ; ..
CAIN C,11 ; ..
JRST TYPFM0 ; LWSP, ignore it
JRST TYPFM2 ; OK, have non-LWSP char to examine now
TYPFM1: SOJL W,TYPFM3 ; Insure that we don't run off end of field
ILDB C,A ; Next char of "from" field
TYPFM2: CAIN C,42 ; Beginning of quoted string?
JRST [ SOJL W,TYPFM3 ; Yes, ignore - can't be real name
ILDB C,A ; ..
CAIE C,42 ; End of quoted string?
JRST . ; No, eat chars
JRST TYPFM0] ; Yes, start interpreting chars again
CAIE C,12 ; Stop at LF
CAIN C,15 ; or CR
JRST TYPFM3 ; ..
CAIE C,"(" ; or start of comment
SKIPN C ; or null
JRST TYPFM3 ; ..
TXNN F,F%F1 ; Inside real name yet?
IFSKP.
CAIN C,">" ; If so, check for closure
JRST TYPFM3 ; Real name closed, quit now
CAIE C,"@" ; Node name begin ?
JRST TYPFM6 ; No - Real name not done yet
TXO F,F%F2 ; Yes - Flag "got node"
TXZ F,F%F1 ; And get rid of real name flag
MOVEM A,SVNDPT ; Save current pointer for node check
JRST TYPFM3 ; Tie it off and start node name
ENDIF.
CAIN C,"<" ; Start of (trailing) real name?
JRST [ MOVEI B,TMPST ; Yes, discard personal name
HRLI B,(POINT 7,) ; Start checking real name
TXO F,F%F1 ; Flag this
JRST TYPFM0]
TYPFM6: IDPB C,B ; Character seems OK, stuff it
JRST TYPFM1
TYPFM3: SETZ C, ; End of string, insure ASCIZ
IDPB C,B ; ..
MOVEI B,TMPST ; Now scan what we've got to isolate 1st word
HRLI B,(POINT 7,)
TYPFM4: ILDB A,B ; For each character,
CAIN A," " ; if a space,
JRST [ SETZ A, ; Space ends 1st word, so
DPB A,B ; tie it off ASCIZ-wise
JRST TYPFM5] ; Now we can do the compare
JUMPN A,TYPFM4 ; Until null found, loop
TYPFM5: HRROI A,MYDIRS ; Compare extracted name
HRROI B,TMPST ; with my name
$CALL S%SCMP ; ..
TXNE F,F%F2 ; Got node name to ?
JUMPE A,TYPFM7 ; Yes, go check it
JUMPE A,RSKP ; No, A=0 implies match, so skip return
RET ; No match, nonskip return
TYPFM7: MOVEI B,TMPST ; Now scan the node name
HRLI B,(POINT 7,)
MOVE A,SVNDPT ; Get pointer to node name in message
TYPFM8: SOJL W,TYPFM9 ; Eat leading LWSP first
ILDB C,A ; ..
CAIE C," " ; ..
CAIN C,11 ; ..
JRST TYPFM8 ; LWSP, ignore it
SKIPE C ; Null ?
CAIN C,">" ; End of address spec ?
IFNSK.
SETZ C, ; Yes
IDPB C,B ; Terminate
JRST TYPFM9 ; And go check
ENDIF.
IDPB C,B ; Not white space, deposit it
JRST TYPFM8
TYPFM9: MOVE A,MYHDPT ; Compare our decnet node name
HRROI B,TMPST ; with my name
$CALL S%SCMP ; ..
JUMPE A,RSKP ; No, A=0 implies match, so skip return
MOVE A,MYHSPT
HRROI B,TMPST ; with my name
$CALL S%SCMP ; ..
JUMPE A,RSKP ; No, A=0 implies match, so skip return
RET ; No match, nonskip return
SUBTTL Utility routines for HEADERS command
;Extract personal name from field and point to it (just copy field
; if no personal name present)
; Call:
; A/ Character pointer to string
; B/ Width of field (not used, but preserved)
; C/ Length of string
TYPPRN: TRVAR <<ARGS,3>,SVFLGS,SPACES>
DMOVEM A,ARGS ; Save args
SETZM SPACES ; No spaces yet
MOVEM F,SVFLGS ; and flags
MOVEM C,2+ARGS ; ..
MOVEI T,[ASCIZ /
From-the-terminal-of: /]
GTMBL (M,MX) ; Get ptr to message block
CALL FNDHDR ; No, see if local mail crock
JRST TYPPR2 ; No, do usual
CALL FNDSB1 ; Compute length of this field
MOVEM V,ARGS ; Fudge ptr to point to this field
MOVEM W,2+ARGS ; Length of this field
TYPPR2: MOVE M,MSGNUM(MX) ; Restore M
MOVE V,ARGS ; Form byte ptr to string
MOVE C,[POINT 7,STRBUF] ; Where to put extracted name
SKIPN D,2+ARGS ; Length of field
JRST TYPPRX ; None there, point to empty field and quit
TXZ F,F%F1!F%F2 ; Not in quoted field or personal name yet
TYPPR0: CALL GTBFL ; Next char of field
AOS V
MOVE B,A
CAIN B,15 ; Ignore return
JRST [ SOJG D,TYPPR0 ; ..
JRST TYPPRX] ; ..
CAIN B,12 ; Turn LF into space
JRST [ MOVEI B,40 ; ..
SOJG D,TYPPR0 ; ..
JRST TYPPRX] ; ..
TXNE F,F%F2 ; Inside quoted string?
JRST [ CAIN B,42 ; Yes, is this the close quote?
TXZ F,F%F2 ; Yes, clear quote flag
JRST TYPPR1] ; Move char literally
CAIN B,40 ; Space?
JRST [ AOS SPACES ; Yes, count it
SOJG D,TYPPR0 ; ..
JRST TYPPRX]
CAIN B,42 ; Start of quoted string?
JRST [ TXO F,F%F2 ; Yes, flag quotedness
JRST TYPPR1] ; Go move the quote
TXNE F,F%F1 ; Inside name?
JRST [ CAIN B,")" ; End of comment (personal name)?
JRST TYPPRX ; Got it -- done
JRST TYPPR1] ; Still in quotes -- copy this char
CAIN B,74 ; Start of actual address (mach-ID) (brocket)?
JRST [ CALL GTBFL ; Yes, flush it
AOS V
MOVE B,A
SETZM SPACES ; Flush space counter too
CAIE B,76 ; End of mach-ID (close brocket)?
JRST [ SOJG D,. ; No, keep eating chars
JRST TYPPRX] ; Until no more left
SOJG D,TYPPR0 ; End of mach-ID, return to normal
JRST TYPPRX] ; processing, or quit if no more chars
CAIN B,"(" ; Start of comment field (personal name)?
JRST [ MOVE C,[POINT 7,STRBUF] ; Yes, discard stuff copied so far
SETZM STRBUF ; In case nothing inside parens
SETZM SPACES ; ..
TXO F,F%F1 ; Remember inside quotes
JRST TYPPR0] ; Go copy this stuff
TYPPR1: SKIPE SPACES ; Do we owe any spaces?
JRST [ PUSH P,B ; Yes, make one
MOVEI B,40 ; ..
IDPB B,C ; ..
POP P,B ; Get actual character
SETZM SPACES ; Reset space counter
JRST .+1]
IDPB B,C ; None of the above, move this char
SOJG D,TYPPR0 ; Do for all chars
TYPPRX: SETZ B, ; Insure ASCIZ
IDPB B,C ; ..
MOVE A,C ; Byte ptr to end of string
BP2CHR ; Form char ptr to end of string
MOVE B,V ; Preserve for a bit
MOVE A,[POINT 7,STRBUF] ; Ptr to beginning of string
BP2CHR ; Form char ptr
MOVE A,V ; Return it in A
SUB B,V ; Compute length of string
MOVEI C,-1(B) ; Return in C -- account for null
MOVE B,1+ARGS ; Return original B (width of column)
MOVE F,SVFLGS ; Restore flags and return
RET
;Type field
;
; A/ Character address of string
; B/ Width of field
; C/ Size of string
;
;Returns:
; B/ number of chars left unfilled
TYPHDS: JUMPE A,R ; Nothing there to type
MOVE V,A ; Start of field
JUMPE C,R ; Nothing if zero length
CAMLE C,B ; Or truncate
MOVE C,B
MOVN C,C
ADD B,C ; Get number of chars needed to fill
PUSH P,B
TXNE F,F%PRSN ; Personal name only?
JRST TPHDS1 ;YES
CALL SETSFL
PUSH P,V
SUB V,WBOT
MOVE A,MSGFAD
IMULI A,5
ADD V,A
TPHDS1: CHR2BP ; Get byte pointer
TXNN F,F%PRSN ; Personal name only?
POP P,V ;NO, RESTORE V
MOVE B,A
SKIPG A,OUTIFN ; LPT, file, or terminal
MOVX A,.PRIOU
CALL TSOUT
POP P,B
RET
;Type message headers
;Call: A/ pointer to name of single header-item to type, or 0 for all
; CALL TYPMHD
;Return +1: message badly-formed (headers not separate) or single
; header-item not found
; +2: OK, header name and contents typed
TYPMHD: TRVAR <<HDR0,20>,HDR1,SHDR> ; Header-name, temp ptr to its end, ptr to selected header
MOVEM A,SHDR ; Save pointer to single header-name
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,B)
SKIPN C,MSGBON(B) ; Is this message empty?
RET ; If empty, bad format
CAMN C,MSGHDN(B) ; Are headers distinguished from msg body?
RET ; No, give failure return then
SKIPE A,SHDR ; Single header being selected?
CALLRET TYPSHD ; Type the header-item and return
TXNE F,F%VBTY ; Verbosely type it?
JRST TYPMS2 ; Yes, no fancy header handling then
SKIPE E,OHSN ; Any "set only-headers-shown" cmd in effect?
JRST TYPM0A ; Yes, it takes precedence over supressed hdrs
GTMBL (M,B) ; Get ptr to message block
MOVE V,MSGBOD(B) ; Get start of message body
CALL REMAP ;MAKE SURE WE ARE OK
MOVE W,MSGHDN(B) ; Length of message headers
TYPM0B: MOVE A,MSGFAD
IMULI A,5
PUSH P,V
SUB V,WBOT
ADD V,A
CHR2BP
POP P,V
MOVEI B,HDR0 ; Where to store this headername
HRLI B,(POINT 7,) ; ..
SETZ E, ; Init length of this name
MOVEI X,^D79 ; Fence in case non-RFC733 header
TYPM0C: ILDB C,A ; Copy header name to temp space
SOJL X,[MOVEI A,1(M)
WARN <Incorrectly formatted header for message %1D
>
RET]
ADDI E,1 ; Count length of name
CAIN C,":" ; Go for name of this one
JRST TYPM0D
JUMPE C,TYPM0C ; Ignore nulls inserted by cretinous mailers
IDPB C,B ; Store real chars
JRST TYPM0C
;Here with header name stored in HDR0, see if suppressed or not
TYPM0D: MOVEM B,HDR1 ; Remember where string ends
SETZ C, ; Tie string off
IDPB C,B ; ..
PUSH P,W ; Save current length of rest of hdr area
SETZ W,
CALL FNDTO1 ; Compute length of arg for this hdr item
GTMBL (M,MX) ; Get ptr to message block
MOVE M,MSGNUM(MX)
POP P,W ; Restore header area byte count
ADDI X,2 ; Account for terminating CRLF
SKIPN A,CNCLHD ; Point to concealed-headers table
JRST TYPM0F ; None are concealed, type this one then
HRROI B,HDR0 ; Point to name we're checking on
$CALL S%TBLK ; Do the lookup
TXNE B,TL%EXM ; Found?
JRST TYPM0E ; Yes, don't type it
TYPM0F: SETZ A, ; Insure ASCIZ
IDPB A,HDR1 ; ..
HRRI A,HDR0 ; Form ptr to name of this header item
HRLI A,(POINT 7,) ; ..
TXNE F,F%BREF ; Want fancy (brief) address list display?
CALL ADDRSP ; Yes, see if this is an address field
SKIPA ; Not an address field, type it normally
JRST [MOVX A,.PRIOU ; Address field - first type its name
HRROI B,HDR0 ; Which we know is here
SETZ C, ; ..
CALL TSOUT ; ..
MOVEI B,":" ; Type the colon
CALL TBOUT ; ..
PUSH P,V ; Must preserve this, actually
ADDI V,(E) ; Reflect that we've typed name
CALL TYPMSA ; Now type its contents fancily
POP P,V ; Restore char pointer
JRST TYPM0E] ; ..
PUSH P,V
SUB V,WBOT
MOVE A,MSGFAD
IMULI A,5
ADD V,A
CHR2BP ; Not concealed - form BP to it
POP P,V
MOVE B,A ; Set up for TSOUT
MOVX A,.PRIOU ; Type on terminal
MOVE C,X ; Length of contents
ADDI C,(E) ; plus length of name
MOVN C,C ; Negate count, so embedded nulls have
SETZ D, ; no significance to TSOUT
CALL TSOUT ; Type this one
TYPM0E: SUBI W,(E) ; Account for length of name
ADDI V,(E) ; ..
SUBI W,(X) ; and for length of contents
ADDI V,(X) ; ..
CAILE W,2 ; Are we down to the extra CRLF?
JRST TYPM0B ; No, go handle next header-item
CALL CRLF ; Yes, type the blank line
RETSKP ; and return
;Here if doing "set only-headers-to-show"
TYPM0A: MOVN E,E ; Yes, build AOBJN ptr to table of names
HRLZ E,E ; ..
TYPMS0: MOVE A,OHSPTR(E) ; Get addr of first header name to show
HRLI A,(POINT 7,) ; Form byte pointer
CALL TYPSHD ; Type it if present
JFCL ; Don't care if not found
AOBJN E,TYPMS0 ; No, must be next header item... go check it
TYPM1B: CALL CRLF ; Make a blank line
RETSKP ; Return OK
;Here if doing no special header handling -- type all headers literally
TYPMS2: GTMBL (M,B) ; Get ptr to message block
MOVN C,MSGHDN(B) ; Get negative length of header area
MOVE V,MSGBOD(B) ; and start of entire message
CALL SETSFL
PUSH P,V
SUB V,WBOT
MOVE A,MSGFAD
IMULI A,5
ADD V,A
CHR2BP ; Form byte pointer
POP P,V
MOVE B,A ; Set up for TSOUT
MOVX A,.PRIOU ; Type on terminal
SETZ D,
CALL TSOUT
RETSKP
;Type body of message
TYPBOD: GTMBL (M,B) ; Get ptr to message block
MOVN C,MSGBON(B) ; Length of msg body
ADD C,MSGHDN(B) ; Minus length of hdrs (already handled)
MOVE V,MSGBOD(B) ; Beginning of msg body
ADD V,MSGHDN(B) ; Skip header area
CALL GTBFL ; MAKE SURE WE ARE IN THE WINDOW
TYPB1: MOVE D,V ; CURRENT CHAR POINTER
SUB D,WTOP ; Get negative count of bytes in window
SOS D ; Minus one.
MOVE A,C ; Get negative size of message body
CAMLE D,C ; Use the lesser of the two
MOVE A,D ;NO, USE D
MOVN D,A ;CALCULATE HOW MANY LEFT NONOUTPUT
ADD D,C
PUSH P,D ;AND STORE IT
MOVE C,A
PUSH P,C ;STORE CHAR COUNT
PUSH P,V
MOVE A,MSGFAD
IMULI A,5
SUB V,WBOT
ADD V,A
CHR2BP ; Form byte pointer to stuff to type
POP P,V
MOVE B,A ; Set up for TSOUT
MOVX A,.PRIOU ; Type on terminal
SETZ D,
CALL TSOUT ; Type it
POP P,C ;RESTORE COUNT
POP P,D ;RESTORE HOW MANY LEFT
SKIPN D ;IF NOTHING LEFT
RET ;RETURN
SUB V,C ;UPDATE CHAR COUNT
CALL REMAP ;SHAKE IT
MOVE C,D
JRST TYPB1 ;GO AGAIN
;Type single message header-item
;Call: A/ Pointer to name of header-item to type (without colon or CRLF)
; CALL TYPSHD
;Return +1: can't find header item, nothing typed
; +2: OK, header and contents typed and cursor back at left margin
TYPSHD: $SAVE <E> ; FNDHDR (called by FNDTO0) clobbers E
TRVAR <SNAM,LENTH,<STR0,40>>
MOVEM A,SNAM ; Save ptr to header name string
MOVEI A,STR0 ; Where to build string
HRLI A,(POINT 7,) ; ..
MOVEI B,[BYTE (7) 15, 12, 0] ; Start with CRLF
CALL MOVSTR ; ..
MOVE B,SNAM ; Now the header name
CALL MOVSTR ; ..
MOVEI B,[ASCIZ /:/] ; Now a colon
CALL MOVST0 ; Move it and the null
MOVEI T,STR0 ; Set up for FNDTO0
GTMBL (M,MX) ; Get ptr to message block
CALL FNDTO0 ; Find this one if you can
MOVE M,MSGNUM(MX)
JUMPE V,R ; Not found, give failure return
MOVE A,SNAM ; Get pointer to header-name
CALL COUNTS ; Count the bytes in it
ADDI A,1 ; Count the colon too
MOVEM A,LENTH ; Save length
SUB V,A ; Back up so name is typed as well as contents
ADD X,A ; Account for length in byte count
MOVE A,SNAM ; Point to name of header-item
TXNE F,F%VBTY ; Verbose-type?
JRST TYPSH0 ; Yes, don't compress address lists
TXNE F,F%BREF ; Want brief address lists?
CALL ADDRSP ; Yes, is this an address field?
SKIPA ; No to either, just type literally
JRST [CALL SETSFL ;MAKE SURE WE ARE OK
PUSH P,V ;SAVE CHAR POINTER
SUB V,WBOT
MOVE A,MSGFAD
IMULI A,5
ADD V,A
CHR2BP ; Form byte ptr to hdr name
MOVE B,A ; Set up for SOUT
MOVX A,.PRIOU ; ..
MOVE C,LENTH ; Length of header-item
CALL TSOUT ; Type header name
POP P,V ;RESTORE CHAR POINTER
MOVE A,LENTH ; Adjust pointer and count to reflect
ADDI V,(A) ; that we've typed the header name
SUBI X,(A) ; ..
CALL TYPMSA ; Type contents fancily
JRST TYPSHX] ; All done
TYPSH0: CALL SETSFL
PUSH P,V
SUB V,WBOT
MOVE A,MSGFAD
IMULI A,5
ADD V,A
CHR2BP ; Form byte pointer to header contents
POP P,V
MOVE B,A ; Set up for SOUT
MOVX A,.PRIOU ; Type on terminal
MOVE C,X ; Byte count
SETZ D,
CALL TSOUT
TYPSHX: CALL CRLF
RETSKP
;Type entire message, headers and text, literally
TYPLIT: GTMBL (M,B) ; Get ptr to message block
MOVN C,MSGBON(B) ; Type entire message body
MOVE V,MSGBOD(B) ; ..
CALL REMAP
PUSH P,V
SUB V,WBOT
MOVE A,MSGFAD
IMULI A,5
ADD V,A
CHR2BP ; Form byte pointer to stuff to type
POP P,V
MOVE B,A ; Set up for TSOUT
MOVX A,.PRIOU ; Type on terminal
SETZ D,
CALLRET TSOUT ; Type and return
;See if current header item in msg being typed is an address item
;Call:
; A/ pointer to name string for header item
; CALL ADDRSP
;Return +1: Not an address item
; +2: Is an address item
ADDRSP: MOVE B,A ; Set up for S%CMND
MOVEI A,ADDRST ; Table of address header-names
$CALL S%TBLK ; Lookup
TXNN B,TL%EXM ; Found?
RET ; No, nonskip
RETSKP ; Yes, skip return
DEFINE XXX(S),<[ASCIZ /S/],,0>
ADDRST: ADDRSC,,ADDRSC
XXX (cc)
XXX (Resent-cc)
XXX (Resent-to)
XXX (Reply-to)
XXX (To)
ADDRSC==.-ADDRST-1
;TYPMSA - Type address header item fancily (compress address lists and
; suppress machine addresses enclosed in angle brackets)
; Name of item already typed, this routine only handles contents
;Call:
; V/ character pointer to entire field
; X/ length of field
TYPMSA: $SAVE <X> ; Caller wants this preserved
TRVAR <LDEPTH,MACHID,SPACE,NSPACE,NOTMCH>
TXZ F,F%F1 ; Not in quoted string
SETZM LDEPTH ; Init depth of list nesting
SETZM MACHID ; Not in mach-ID
SETZM SPACE ; No spaces seen yet
SETZM NSPACE ; No nonspace chars seen yet
SETZM NOTMCH ; Nothing typed yet
CALL SETSFL
PUSH P,V
SUB V,WBOT
MOVE A,MSGFAD
IMULI A,5
ADD V,A
CHR2BP ; Point to string
POP P,V
MOVE D,A ; Safer AC
TYPMA1: SOJL X,TYPMAX ; When char count exhausted, return
ILDB A,D ; Get next character
TXNE F,F%F1 ; Inside quoted string?
JRST [ CAIN A,42 ; Yes, close quote?
TXZ F,F%F1 ; Yes, clear flag
JRST TYPMA2] ; No, continue
CAIN A,42 ; Open quote?
JRST [ TXO F,F%F1 ; Yes, flag quotedness
JRST TYPMA2] ; and continue
CAIN A,74 ; Open angle bracket?
JRST [ AOS MACHID ; Yes, flag that
SKIPN NOTMCH ; Anything typed so far ?
CALL TPSPCS ; Handle spaces if nothing typed
;SETZM SPACE ; Flush trailing spaces
JRST TYPMA2] ; Continue
CAIN A,";" ; Close of address list?
JRST [ SOSG LDEPTH ; Yes, decrement nesting depth
JRST TYPMA3 ; Outer list closed - type the ;
JRST TYPMA1] ; Flush this char otherwise
CAIN A,":" ; Opening of address list?
JRST [ AOS B,LDEPTH ; Yes, increment nesting depth
CAIN B,1 ; Outermost list?
$CALL KBFTOR ; Yes, type the colon
JRST TYPMA2]
TYPMA2: SKIPE LDEPTH ; Inside an address list?
JRST TYPMA1 ; Yes, just flush chars
SKIPN MACHID ; Inside mach-ID?
JRST TYPMA3 ; No, type this char out then
CAIN A,76 ; Yes, is this the closing angle bracket?
SOS MACHID ; Yes, count it
SKIPN NOTMCH ; Anything typed so far ?
$CALL KBFTOR ; No - so type something
JRST TYPMA1 ; But don't type it
TYPMA3: CAIN A,40 ; Only count spaces, don't type now
JRST [ AOS SPACE ; ..
JRST TYPMA1] ; ..
CAIN A,12 ; Line feed?
JRST [ SKIPN NSPACE ; Yes, did we type any nonspace chars?
JRST TYPMA4 ; No, reuse this line then
AOS LFCNT ; Yes, advance to next line and count
$CALL KBFTOR ; Type the LF
SETZM SPACE ; Flush space count
SETZM NSPACE ; Reinit nonspace count
JRST TYPMA1]
CALL TPSPCS ; Go handle spaces if any
SETOM NOTMCH ; Flag that we typed something
$CALL KBFTOR ; Nothing special, just type it
TYPMA4: CAIE A,15 ; Don't count returns as nonspace
AOS NSPACE ; Count nonspace characters
JRST TYPMA1
;Here to type out pending spaces if any
TPSPCS: SKIPLE SPACE ; Spaces pending?
JRST [ PUSH P,A ; Yes, save this char
MOVEI A,40 ; Type a space
$CALL KBFTOR ; ..
POP P,A ; Restore current character
SOS SPACE ; Count down spaces required
JRST .-1] ; Go check again
RET
;Here when done -- insure address lists closed, if not (because of badly-
; formatted message header), close lists, type CRLF (since suppression
; of address list contents suppressed the CRLF), and return.
TYPMAX: SKIPN D,LDEPTH ; Address lists closed properly?
RET ; Yes, all done then
TYPMX0: MOVEI A,";" ; No, type a closure symbol
$CALL KBFTOR ; ..
SOJG D,TYPMX0 ; for each unterminated list
CALL CRLF ; Close the line
SETZM LDEPTH ; Clean up the mess
RET ; and return
END
; *** Edit 2466 to MSDSPL.MAC by PRATT on 6-Nov-85
; Don't do brief address list display on the From field
; *** Edit 2484 to MSDSPL.MAC by SANTEE on 21-Nov-85
; Clean up the various edit histories.
; *** Edit 2485 to MSDSPL.MAC by MAYO on 21-Nov-85
;
; *** Edit 2486 to MSDSPL.MAC by PRATT on 22-Nov-85
; Copyright statements
; *** Edit 2603 to MSDSPL.MAC by PRATT on 6-Dec-85
; Fix "type from me" code to handle username and node names
; *** Edit 2605 to MSDSPL.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 2608 to MSDSPL.MAC by PRATT on 10-Dec-85
; Save F also in the type from me code (TYPFME)
; *** Edit 2629 to MSDSPL.MAC by PRATT on 3-Jan-86
; If brief-address-list set, and no personal name has been set, make sure that
; the address within the "<>"'s are typed out.