.Title	From	- Print a summary of new mail messages
	.Ident	/V01.002/
	.Enable	SUP
	.Default Displacement,Word
	.Subtitle	Introduction

;+
;
; ----- From:  Print a summary of new mail messages
;
;
; Facility:
;
;	Mail system utilities
;
; Abstract:
;
;	This module will print a summary of new mail messages.
;
; Environment:
;
;	VAX/VMS native mode, VMS V5.0 or later.
;
;
;
; Version:	V01.002
; Date:		 1-Jul-1991
;
; Copyright © 1990, 1991  San Diego Supercomputer Center
;
; Gerard K. Newman	24-Jan-1990
; San Diego Supercomputer Center
; General Atomics
; P.O. Box 85608
; San Diego, CA  92138-5608
; 619.534.5076
;
; Internet:	GKN@SDS.SDSC.EDU
; BITNET:	GKN@SDSC.BITNET
; SPAN:		SDSC::GKN (27.1)
;
;
; Modifications:
;
;	 2-Feb-1990	GKN	"_" is a legal character in a folder name.
;	 1-Jul-1991	GKN	Output a * if a message is marked.
;
;-

	.Page
	.Subtitle	Local definitions

	.NoCross			;Save a tree

	$MAILDEF			;Define callable mail stuff
	$SSDEF				;System service codes
	$STSDEF				;Define status code bits
	$TPADEF				;TPARSE definitions

	.Cross				;Turn CREF back on


; Local macro

; Item:		Make an item list entry

.Macro	Item	Type=MAIL,Item=,Length=4,RetAdr=,RetLen= ;Make an item list entry
	.Word	Length,Type'$_'Item	;Length,,what
	.If	NB,RetAdr		;If we have a place to get/put things
	.Address RetAdr			; the use it
	.Iff				;  else
	.Long	0			;   we don't care
	.Endc				;	...
	.If	NB,RetLen		;If we have an explicit return length
	.Address RetLen			; then use it
	.Iff				;  else
	.Long	0			;   we don't care
	.Endc				;	...
.Endm	Item				;	...


; Local definitions

$DEFINI	ITM				;Define an item list entry

$DEF	ITM$W_LENG	.Blkw		;Length
$DEF	ITM$W_CODE	.Blkw		;Item code
$DEF	ITM$L_ADDR	.Blkl		;Address of data
$DEF	ITM$L_RETLENG	.Blkl		;Address to return length in
$DEF	ITM$K_LENGTH			;Length of an item list entry

$DEFEND	ITM				;That's all

	.Page
	.Subtitle	TPARSE state table

;+
;
; ----- Command syntax:
;
;
;	$ From [substring | *] [folder] [filename]
;
; Where:
;
;	substring = Substring to search for in the From: field.  * means
;		    wildcard and is the default.
;	folder	  = Optional folder name.  Defaults to NEWMAIL.
;	filename  = Optional mail file name.  Defaults to your MAIL.MAI,
;		    wherever it lives.
;
;-

	$INIT_STATE	FROM_STATE,FROM_KEYS	;Initialize the state table

	$STATE					;Initial state

	$TRAN	TPA$_EOS,TPA$_EXIT		;Quit if at EOS
	$TRAN	!FROM				;Store the From: substring

	$STATE					;Next state

	$TRAN	TPA$_EOS,TPA$_EXIT		;Quit if at EOS
	$TRAN	!FOLDER,,BLANKS_OFF		;Else store the folder name

	$STATE					;Last state - fetch a filename

	$TRAN	TPA$_EOS,TPA$_EXIT		   ;Quit if EOS
	$TRAN	TPA$_FILESPEC,TPA$_EXIT,STASH_FILE ;Else stash the filename

; Sub-expression to parse a from: string, delimited by blanks.

	$STATE	FROM				;Sub-expression to parse the From: substring

	$TRAN	TPA$_BLANK,FROM			;Swallow leading blanks
	$TRAN	TPA$_LAMBDA			;Else start storing non-blanks

	$STATE	FROM_1				;Collect characters here

	$TRAN	TPA$_EOS,TPA$_EXIT		;Quit at EOS
	$TRAN	TPA$_BLANK,TPA$_EXIT		;Quit on the next blank
	$TRAN	'*'				;Special case: *
	$TRAN	TPA$_ANY,FROM_1,STASH_FROM	;Stash the next character otherwise

	$STATE					;Here when we have a *

	$TRAN	TPA$_BLANK,TPA$_EXIT		;Quit on the next blank
	$TRAN	TPA$_EOS,TPA$_EXIT		;Or at EOS
	$TRAN	TPA$_LAMBDA,,STASH_FROM		;Else stash the *

	$STATE	FROM_2				;Collect more characters here

	$TRAN	TPA$_EOS,TPA$_EXIT		;Quit at EOS
	$TRAN	TPA$_BLANK,TPA$_EXIT		;Quit at the next blank
	$TRAN	TPA$_ANY,FROM_2,STASH_FROM	;Stash anything else

; Sub-expression to parse a folder name: A-Z, $, _, -.

	$STATE	FOLDER				;Sub-expression to parse a folder name

	$TRAN	TPA$_BLANK,FOLDER		;Swallow leading blanks
	$TRAN	TPA$_LAMBDA			;Else ...

	$STATE	FOLDER_1			;Expect a folder name

	$TRAN	TPA$_EOS,TPA$_EXIT		;Quit at EOS
	$TRAN	TPA$_BLANK,TPA$_EXIT		;Quit at a blank
	$TRAN	TPA$_ALPHA,FOLDER_1,STASH_FOLD	;Alphas Ok
	$TRAN	TPA$_DIGIT,FOLDER_1,STASH_FOLD	;Digits Ok
	$TRAN	'$',FOLDER_1,STASH_FOLD		;$ Ok
	$TRAN	'-',FOLDER_1,STASH_FOLD		;- Ok
	$TRAN	'_',FOLDER_1,STASH_FOLD		;_ Ok

	$END_STATE				;Done

	.Page
	.Subtitle	Impure storage

	.Psect	IMPURE_DATA	NOEXE,RD,WRT,PIC,NOSHR,PAGE


; Random impure data.

TPARSE_BLOCK:	.Long	TPA$K_COUNT0	;Argument count
		.Long	TPA$M_BLANKS	;Blanks are significant
IN_DESC:	.Long	128		;Input buffer
		.Address IN_BUFF	; descriptor
		.Long	0[5]		;Allocate the rest of the block
FOLD_LENG:	.Long	0		;User-specified folder string length
FROM_NEXT:	.Address FROM_SEL_BUFF	;Where to put the next From: substring character
FOLD_NEXT:	.Address FOLDER_BUFF	;Where to put the next folder string character
OUT_DESC:	.Blkl			;Generic output buffer
		.Address OUT_BUFF	; descriptor
FAO_ARGS:	.Blkl	10		;$FAOL argument list


; Things for dealing with callable mail.

FILE_CONTEXT:	.Blkl			;Context pointer for mail file routines
MSG_CONTEXT:	.Blkl			;Context pointer for message routines

NULL_LIST:	.Long	0[4]			    ;Null item list
FILE_LIST:	Item	Length=0,-		    ;Empty filename string
			Item=MailFile_Name	    ;We'll stash it later
		.Long	0			    ;That's all
MSG_BEGIN_IN:	Item	Item=Message_File_Ctx,-	    ;Specify the file context
			RetAdr=FILE_CONTEXT	    ;Here it is
		.Long	0			    ;No more
MSG_SEL_IN:	Item	Length=7,-		    ;Default folder length
			Item=Message_Folder,-	    ;Specify the folder name
			RetAdr=FOLDER_BUFF	    ;Here it is
MSG_SEL_FROM:	.Long	0[4]			    ;An empty item list in case we do From: selection
MSG_SEL_OUT:	Item	Item=Message_Selected,-	    ;Get the number of messages selected
			RetAdr=SELECTED_MSGS	    ;Put it here
		.Long	0			    ;That's all
MSG_INFO_IN:	Item	Length=0,-		    ;0 bytes
			Item=Message_Next	    ;We want the next message
NO_SIGNAL:	Item	Length=0,-		    ;0 bytes
			Item=NoSignal		    ;Don't signal errors
		.Long	0			    ;That's all
MSG_INFO_OUT:	Item	Length=8,-		    ;8 bytes
			Item=Message_Binary_Date,-  ;Get the date and time
			RetAdr=MSG_DATE		    ;Put it here
		Item	Length=64,-		    ;64 bytes
			Item=Message_From,-	    ;Get the From: line
			RetAdr=FROM_BUFF,-	    ;Put it here
			RetLen=FROM_DESC	    ;Return the length here
		Item	Length=128,-		    ;128 bytes
			Item=Message_Subject,-	    ;Get the Subject: string
			RetAdr=SUBJ_BUFF,-	    ;Put it here
			RetLen=SUBJ_DESC	    ;Return the length here
		Item	Item=Message_Size,-	    ;Get the message size
			RetAdr=MSG_SIZE		    ;Put it here
		Item	Length=2,-		    ;Only 2 bytes
			Item=Message_Return_Flags,- ;Get the message flags
			RetAdr=MSG_FLAGS	    ;Put 'em here.
		.Long	0			    ;Done


; Outputs from callable mail.

SELECTED_MSGS:	.Blkl			;Count of messages selected from the folder
MSG_SIZE:	.Blkl			;Message size in lines
MSG_DATE:	.Blkq			;Date message received
MSG_FLAGS:	.Blkl			;Message flags
FROM_DESC:	.Blkl			;From: string
		.Address FROM_BUFF	; descriptor
SUBJ_DESC:	.Blkl			;Subject: string
		.Address SUBJ_BUFF	; descriptor


; Buffers.

IN_BUFF:	.Blkb	128		   ;Input buffer
OUT_BUFF:	.Blkb	256		   ;Output buffer
FROM_BUFF:	.Blkb	64		   ;From: buffer
SUBJ_BUFF:	.Blkb	128		   ;Subject: buffer
FROM_SEL_BUFF:	.Blkb	128		   ;From: select buffer
FOLDER_BUFF:	.Ascii	"NEWMAIL"	   ;Folder to look in
		.Blkb	64-<.-FOLDER_BUFF> ;Pad to 64 bytes

	.Page
	.Subtitle	Pure storage

	.Psect	PURE_DATA	NOEXE,RD,NOWRT,PIC,SHR,PAGE

FAO_SELECT:	.Ascid	"[!UL message!%S selected]"
FAO_MESSAGE:	.Ascid	"!6%D !5%T !AC!24<!AS!>  !4UL  !64<!AS!>"
HEADER:		.Ascid	"    Date                From            Lines             Subject"
SPACE:		.Ascic	" "
SPLAT:		.Ascic	"*"

	.Page
	.Subtitle	Entry point

	.Psect	CODE		EXE,RD,NOWRT,PIC,SHR,PAGE

	.Entry	START,^M<>		;Entry here

; Grab our command line and feed it to TPARSE.

	PUSHAW	IN_DESC			;Return the length here
	CLRL	-(SP)			;No prompt
	PUSHAQ	IN_DESC			;Here's the input buffer
	CALLS	#3,G^LIB$GET_FOREIGN	;Retrieve our command line
	TSTW	IN_DESC			;Anything there?
	BEQL	20$			;If EQL no, use the defaults

; We had a command line -- feed it to LIB$TPARSE and see what it thinks

	PUSHAL	FROM_KEYS		;Keyword table address
	PUSHAL	FROM_STATE		;State table address
	PUSHAL	TPARSE_BLOCK		;TPARSE parameter block address
	CALLS	#3,G^LIB$TPARSE		;Crack the command line
	BLBS	R0,10$			;Win
	RET				;Lose.

; See if we have a From: substring to search with.

10$:	TSTW	MSG_SEL_FROM			;Do we have a From: substring?
	BEQL	20$				;If EQL no, drive on
	MOVW	#MAIL$_MESSAGE_FROM_SUBSTRING,-	;Else build the
		MSG_SEL_FROM+ITM$W_CODE		; rest of the item
	MOVAB	FROM_SEL_BUFF,-			;  list
		MSG_SEL_FROM+ITM$L_ADDR		;	...

; See if we have a different folder to use.

20$:	TSTL	FOLD_LENG		;Do we have a different folder?
	BEQL	30$			;If EQL no.
	MOVW	FOLD_LENG,-		;Else use
		MSG_SEL_IN+ITM$W_LENG	; it.

; Establish a "file" context.

30$:	PUSHAL	NULL_LIST		 ;Don't need to have anything returned
	PUSHL	(SP)			 ;Or specify anything, either.
	PUSHAL	FILE_CONTEXT		 ;Here's a context variable
	CALLS	#3,G^MAIL$MAILFILE_BEGIN ;Establish a context

; Open the mail file.

	PUSHAL	NULL_LIST		;Don't need to have anything returned
	PUSHL	(SP)			;Presume we're using our default mail file
	TSTW	FILE_LIST+ITM$W_LENG	;Do we have an alternate file?
	BEQL	40$			;If EQL no.
	MOVAL	FILE_LIST,(SP)		;Else use it.

40$:	PUSHAL	FILE_CONTEXT		;Here's the context
	CALLS	#3,G^MAIL$MAILFILE_OPEN	;Open the mail file.
	BLBS	R0,50$			;Win.
	BISL	#STS$M_INHIB_MSG,R0	;Shh.
	RET				;Back to DCL.

; Establish a "message" context.

50$:	PUSHAL	NULL_LIST		;Don't need anything
	PUSHAL	MSG_BEGIN_IN		;However, we have to specify the file context
	PUSHAL	MSG_CONTEXT		;Here's a new context
	CALLS	#3,G^MAIL$MESSAGE_BEGIN	;Establish a message context

; Now select the specified messages -- by folder and From: string.

	PUSHAL	MSG_SEL_OUT		 ;We'd like this info
	PUSHAL	MSG_SEL_IN		 ;Here's the folder (and maybe From:)
	PUSHAL	MSG_CONTEXT		 ;Here's the context
	CALLS	#3,G^MAIL$MESSAGE_SELECT ;Select some messages
	MOVL	SELECTED_MSGS,FAO_ARGS	 ;Copy the number of selected messages
	MOVAB	FAO_SELECT,R1		 ;Format with this string
	BSBW	FAO_IT			 ;Format & print.
	TSTL	SELECTED_MSGS		 ;Any work to do?
	BEQL	80$			 ;If EQL no, stop now.

; Build the FAO argument list.

	MOVAL	FAO_ARGS,R1		;A handy address
	MOVAQ	MSG_DATE,(R1)+		;Date
	MOVAQ	MSG_DATE,(R1)+		;Time
	MOVL	R1,R5			;Remember this spot!
	MOVAB	SPACE,(R1)+		;Space (or splat)
	MOVAQ	FROM_DESC,(R1)+		;From:
	MOVAL	(R1)+,R6		;Remembr this spot!
	MOVAQ	SUBJ_DESC,(R1)		;And the Subject:
	BSBW	BLANK_LINE		;Blank line
	MOVAQ	HEADER,R1		;Format with this string
	BSBW	FAO_IT			;	...
	BSBW	BLANK_LINE		;Blank line

; Loop here collecting information about each of the selected
; messages.

60$:	PUSHAL	MSG_INFO_OUT		;Return this info
	PUSHAL	MSG_INFO_IN		;Return info about this message
	PUSHAL	MSG_CONTEXT		;Here's the context
	CALLS	#3,G^MAIL$MESSAGE_INFO	;Fetch the info
	BLBC	R0,80$			;Done.
	MOVL	MSG_SIZE,(R6)		;Stash the message size
	MOVAB	SPACE,(R5)		;Presume not marked.
	BBC	#MAIL$V_MARKED,-	;Branch if this
		MSG_FLAGS,70$		; was a correct presumption
	MOVAB	SPLAT,(R5)		;Else use a splat.

70$:	MOVAB	FAO_MESSAGE,R1		;Format with this string
	BSBW	FAO_IT			;	...
	BRB	60$			;Loop.

; Here when we've run out of messages.

80$:	PUSHAL	NULL_LIST		 ;Don't need anything
	PUSHL	(SP)			 ;	...
	PUSHAL	MSG_CONTEXT		 ;Here's the context
	CALLS	#3,G^MAIL$MESSAGE_END	 ;Destroy the message context
	PUSHAL	NULL_LIST		 ;Don't need anything
	PUSHAL	NO_SIGNAL		 ;Shh.
	PUSHAL	FILE_CONTEXT		 ;Here's the context
	CALLS	#3,G^MAIL$MAILFILE_CLOSE ;Close the mail file
	PUSHAL	NULL_LIST		 ;Don't need anything
	PUSHL	(SP)			 ;	...
	PUSHAL	FILE_CONTEXT		 ;Here's the context
	CALLS	#3,G^MAIL$MAILFILE_END	 ;Destroy the file context
	RET				 ;Done.

	.Page
	.Subtitle	FAO_IT		- Feed $FAOL and LIB$PUT_OUTPUT

;+
;
; ----- FAO_IT:  Feed $FAOL and LIB$PUT_OUTPUT
;
;
; This routine will feed $FAOL and then LIB$PUT_OUTPUT.
;
; Inputs:
;
;	FAO_ARGS - $FAOL argument list.
;	OUT_DESC - Output buffer descriptor
;	R1	 - $FAOL control string
;
; Outputs:
;
;	As described above.
;
;-

FAO_IT:					;Feed $FAOL and LIB$PUT_OUTPUT

	MOVZWL	#256,OUT_DESC		;Reset the output descriptor length
	$FAOL_S	CTRSTR=(R1),-		;Format with this string
		OUTBUF=OUT_DESC,-	;Format into this buffer
		OUTLEN=OUT_DESC,-	;Return the length here
		PRMLST=FAO_ARGS		;Here are the arguments
	PUSHAQ	OUT_DESC		;Stack the descriptor address
	CALLS	#1,G^LIB$PUT_OUTPUT	;Display it
	RSB				;That was easy

	.Page
	.Subtitle	BLANK_LINE	- Output a blank line

;+
;
; ----- BLANK_LINE:  Output a blank line
;
;
; This routine will output a blank line.
;
; Inputs:
;
;	OUT_DESC - A handy descriptor.
;
; Outputs:
;
;	Blank line.
;
;-

BLANK_LINE:				;Output a blank line

	CLRW	OUT_DESC		;No bytes to output
	PUSHAQ	OUT_DESC		;Stack the descriptor address
	CALLS	#1,G^LIB$PUT_OUTPUT	;Easy enough.
	RSB				;	...

	.Page
	.Subtitle	BLANKS_OFF	- Turn on TPARSE space flush

;+
;
; ----- BLANKS_OFF:  Turn on TPARSE space flush
;
;
; This routine will turn on TPARSE space flush.
;
; Inputs:
;
;	(AP)	- TPARSE parameter block.
;
; Outputs:
;
;	TPA$M_BLANKS cleared in TPA$L_OPTIONS(AP).
;
;-

BLANKS_OFF: .Word ^m<>				;Turn on TPARSE space flush

	BICL	#TPA$M_BLANKS,TPA$L_OPTIONS(AP)	;Turn on space flush
	RET					;Easy.

	.Page
	.Subtitle	STASH_FILE	- TPARSE action routine to stash the filename

;+
;
; ----- STASH_FILE:  TPARSE action routine to stash the filename
;
;
; This routine is called as a TPARSE action routine to stash the
; mail file name to use.
;
; Inputs:
;
;	TPA$L_TOKENCNT(AP) - A descriptor of the filename
;	FILE_LIST	   - Prototype item list for specifying
;			     the filename.
;
; Outputs:
;
;	FILE_LIST filled in.
;
;-

STASH_FILE: .Word ^m<>			;TPARSE action routine to stash the filename

	MOVW	TPA$L_TOKENCNT(AP),-	;Stash the
		FILE_LIST+ITM$W_LENG	; filename length
	MOVL	TPA$L_TOKENPTR(AP),-	;Stash the
		FILE_LIST+ITM$L_ADDR	; filename address
	RET				;Easy enough.

	.Page
	.Subtitle	STASH_FOLD	- TPARSE action routine to stash the folder name

;+
;
; ----- STASH_FOLD:  TPARSE action routine to stash the folder name
;
;
; This routine is called as a TPARSE action routine to stash the
; name of the folder to look for (one byte at a time;  sigh).
;
; Inputs:
;
;	TPA$B_CHAR(AP)	- Next byte in the folder name
;	FOLD_LENG	- Length of the user-specified folder
;	FOLD_NEXT	- Address of where to stash the next byte.
;
; Outputs:
;
;	FOLD_LENG & FOLD_NEXT updated.
;
;-

STASH_FOLD: .Word ^m<>			  ;TPARSE action routine to stash the folder name

	MOVB	TPA$B_CHAR(AP),@FOLD_NEXT ;Stash the byte
	INCL	FOLD_LENG		  ;Another byte
	INCL	FOLD_NEXT		  ;Put the next one here.
	RET				  ;Done

	.Page
	.Subtitle	STASH_FROM	- TPARSE action routine to stash the From: search string

;+
;
; ----- STASH_FROM:  TPARSE action routine to stash the From: search string
;
;
; This routine is called as a TPARSE action routine to stash the
; From: search substring (one byte at a time ... sigh).
;
; Inputs:
;
;	TPA$B_CHAR(AP)	- Next byte in the string
;	FROM_NEXT	- Where it goes
;	MSG_SEL_FROM	- Prototype item list entry we update.
;
; Outputs:
;
;	FROM_NEXT and MSG_SEL_FROM updated.
;
;-

STASH_FROM: .Word ^m<>			  ;TPARSE action routine to stash the From: search string

	MOVB	TPA$B_CHAR(AP),@FROM_NEXT ;Stash the next byte
	INCW	MSG_SEL_FROM+ITM$W_LENG	  ;Another byte
	INCL	FROM_NEXT		  ;Put the next one here
	RET				  ;That's all



	.End	START