: +p
	"." swap strcat
;
: say ( s -- )
	me @ swap notify
;
: error ( s -- )
	"MAIL %err> " swap strcat swap "%err" subst say
;
: fetch_pointer ( i -- s )
	prog me @ intostr "->" strcat rot intostr strcat +p getpropstr
;
: fetch_daemon ( -- i )
	prog ".daemon" getpropstr
	dup not if
		pop #-1
	else
		atoi dbref
	then
;
: toggle_line_numbers ( -- )
	me @ ".ln" getpropstr atoi not if
		"013" "line numbers on" error
		me @ ".ln" "1" 0 addprop
	else
		"014" "line numbers off" error
		me @ ".ln" remove_prop
	then
;
: command_mode ( s -- )
: attach_pointers ( s -- )
	over " " explode
	dup 2 + pick prog swap "->ptrs" strcat getpropstr
	atoi over + intostr over 3 + pick "->ptrs" strcat
	prog swap rot 0 addprop
	begin dup while
		over "Sending mail to: " swap strcat "008" swap error
		over .pmatch dup #-1 dbcmp if
			pop fetch_daemon
		then
		dup #-1 dbcmp if
			pop me @ "007"
			"recipient error, undeliverable mail returned"
			error
			over 2 + pick "->2" strcat me @ swap getpropstr
			" (Intended for: " strcat 4 pick strcat ")"
			strcat 3 pick 3 + pick "->2" strcat me @ swap
			rot 0 addprop
		then
		dup me @ dbcmp not if	
			dup "> You have new mail." notify
		then
		dup intostr "->yy" strcat +p prog swap getpropstr
		atoi 1 + intostr over intostr "->yy" strcat
		+p prog swap 3 pick 0 addprop
		over intostr "->" strcat swap strcat +p
		prog swap 4 pick 5 + pick 0 addprop pop
		swap pop 1 - loop
	pop
;
: fetch_mail_pointer ( -- s )
	random 1000000 % 1 +
	prog "." 3 pick intostr strcat "->1" strcat
	prop-exists? if
		pop fetch_mail_pointer
	then
	"." swap intostr strcat
;
: fetch_message ( i -- )
	me @ ".ln" "1" 0 addprop
	begin
	dup 3 - intostr ">" strcat say
	read dup "." strcmp 3 pick 100 < and while
		dup "#" 1 strncmp if
			me @ 4 pick "->" strcat 4 pick intostr strcat
			rot 0 addprop 1 +
		else
			1 strcut swap pop
			"^#!" over instr not if
				"010" "illegal editor command" error
			then
			dup "^" stringcmp not if
				swap 1 - swap
				over 4 < if
					swap pop 4 swap
					"011" "at top of file" error
				else
					"009" "backing up one line" error
				then
			then
			dup "#" stringcmp not if
				toggle_line_numbers
			then
			dup "!" stringcmp not if
				1 strcut swap pop
				dup "~" instr not if
					"012" "substitution error" error
				then
			then
		pop
		then
	loop pop pop me @ ".ln" remove_prop
;
: transcribe_message ( -- )
	1 begin
	over "->" strcat over intostr strcat
	me @ over prop-exists? while
		me @ over getpropstr
		prog 3 pick rot 0 addprop
		me @ swap remove_prop
		1 +
	loop pop pop
;
: send_mode ( s -- )
	dup not if
		"004" "no recipients specified" error
	then
	fetch_mail_pointer
	"Please enter a subject (. to abort)" say read
	dup "." strcmp not if
		pop pop pop
		"005" "quit command sent, mail aborted" error exit
	then
	dup not if
		pop "(None)"
	then
	me @ 3 pick "->1" strcat rot 0 addprop
	me @ over "->2" strcat me @ name 0 addprop
	me @ over "->3" strcat systime ctime 0 addprop
	"Enter message below (. to end or abort)" say
	4 fetch_message
	transcribe_message
	attach_pointers
;
: fetch_header ( s -- )
	" " say
	dup "->1" strcat prog swap getpropstr
	"Subj:  " swap strcat say
	dup "->2" strcat prog swap getpropstr
	"From:  " swap strcat say
	dup "->3" strcat prog swap getpropstr
	"Date:  " swap strcat say
	" " say
;
: delete_realmsg ( s -- )
	dup "->" instr 1 - strcut pop 1 begin
	over "->" strcat over intostr strcat
	prog swap prop-exists? while
		over "->" strcat over intostr strcat
		prog swap remove_prop
		1 +
	loop
	pop dup "->ptrs" strcat prog swap remove_prop
;
: delete_currmsg ( s -- )
	me @ "->xx" getpropstr
	dup not if
		pop "006" "no current message" exit
	then
	prog me @ intostr "->" strcat 3 pick strcat +p getpropstr
	"->ptrs" strcat dup prog swap getpropstr atoi 1 - intostr
	prog 3 pick 3 pick 0 addprop atoi not if
		delete_realmsg
	then
	pop prog me @ intostr "->yy" strcat +p getpropstr atoi
	over atoi over 1 for
		prog me @ intostr "->" strcat +p 3 pick 1 +
		intostr strcat getpropstr
		prog me @ intostr "->" strcat +p 4 rotate intostr
		strcat rot 0 addprop
	loop
	1 - intostr prog me @ intostr "->yy" strcat +p 3 pick 0 addprop
	atoi 1 + intostr prog me @ intostr "->"
  	strcat rot strcat +p remove_prop pop
	prog me @ intostr "->yy" strcat +p getpropstr atoi not if
		prog me @ intostr "->yy" strcat +p remove_prop
	then
;
: read_message ( s -- )
	dup prog me @ intostr "->yy" strcat +p getpropstr atoi
	swap atoi swap > if
		"002" "message number out of bounds" error exit
	then
	dup atoi fetch_pointer
	dup "->1" strcat prog swap prop-exists? not if
		pop "003" "invalid pointer to message" error exit
	then
	fetch_header
	4 begin over "->" strcat over intostr strcat
	prog over prop-exists? while
		prog swap getpropstr say 1 +
	loop pop pop pop " " say
;
: read_mode ( -- )
	begin
	"[ # d q -- ->xx of ->yy ]"
	me @ "->xx" getpropstr atoi intostr "->xx" subst
	prog me @ intostr "->yy" strcat +p getpropstr
	atoi intostr "->yy" subst say read dup "q" stringcmp while
		dup atoi 0 < if
			"001" "invalid message" error
		then
		dup atoi if
			atoi intostr read_message
			me @ "->xx" 3 pick atoi intostr 0 addprop
		else
			dup "d" stringcmp not if
				delete_currmsg
			then
		then
		prog me @ intostr "->yy" strcat +p getpropstr atoi
		me @ "->xx" getpropstr atoi < if
			me @ "->xx" remove_prop
		then pop
	loop
	me @ "->xx" remove_prop pop
;
: main ( s -- )
	dup not if
		pop read_mode exit
	then
	dup dup " " instr not swap "-" 1 strncmp not and if
		command_mode exit
	then
	send_mode
;