Hi Rebols,
I once again tried the send function ...
So, now it is possible to
send ["Ingo Hohmann" [EMAIL PROTECTED]] {message ...}
And Mail-List-Rules/parse-mail-list returns
a block of ["name" address ...].
(When there is no real-name, it is/may just be
omitted.)
Please email me any errors that may occur, or
ideas to make it better.
(btw, as it is, it doesn't work well with
messenger.r, it confuses the addressbook.)
regards,
Ingo
-- _ . _
ingo@)|_ /| _| _ <We ARE all ONE www._|_o _ _ ._ _
www./_|_) |o(_|(/_ We ARE all FREE> ingo@| |(_|o(_)| (_|
http://www.2b1.de/Rebol/ ._| ._|
REBOL [
Title: "mail-patches"
Date: 1999-9-8
Purpose: {Patches for email system functions}
File: %mail-patches.r
Needs: 2.2
Author: "Ingo Hohmann"
email: [EMAIL PROTECTED]
site: http://www.2b1.de/Rebol/
Rights: "(c) Ingo Hohmann and others"
Comments: {Will be part of Patches.r}
Category: 'Utility
]
;
; email
;
History: [
[11-Nov-1999 "iho" {address block of the form [ [name] email ... ]
may now be used (name may be omitted).}]
[13-Sep-1999 "iho" {Added send "REALNAME <email@domain>" message
and Signature (to be set in system/user/signature)}]
[6-Sep-1999 "iho" {re-introduced my original version, you
may just move the comment mark, if you wish}]
[31-Aug-1999 "Allen Kamp" {Modified From output to include ""
as in "User Name" <[EMAIL PROTECTED]>}]
[8-Aug-1999 "iho" {Original Release} ]
]
send: func [
{Send a message to an address (or block of addresses)
patched by iho, to include your real name when sending,
this has to be set as system/user/name}
address [email! block!] "An address, block of addresses, or string"
message "Text of message. First line is subject."
/only "Send only one message to multiple addresses"
/header "Supply your own custom header"
header-obj [object!] "The header to use"
/local smtp-port content do-send addr-list
][
do-send: func [port data] [insert port reduce data]
smtp-port: open [scheme: 'smtp]
if not block? address [address: reduce [address]]
message: content: either string? message [copy message] [mold message]
if all [ found? find copy next first system/user 'signature
not none? system/user/signature
] [
insert tail message rejoin [ "^/" system/user/signature ]
]
if not header [
if none? system/user/email [
net-error "Can't set Email header: system/user/email not set"
]
header-obj: make system/standard/email [
either none? system/user/name [
From: system/user/email
][
; This is my original Version (Ingo Hohmann <[EMAIL PROTECTED]>)
;From: join system/user/name [" <" system/user/email ">"]
; This is from "Allen Kamp" <[EMAIL PROTECTED]>
; to get "" marks around the real name
From: rejoin [{"} system/user/name {" <} system/user/email ">"]
]
Subject: copy/part message any [find message newline 50]
]
]
if none? header-obj/from [net-error "Email header not set: no from address"]
if none? header-obj/to [header-obj/to: make string! 20]
if none? header-obj/date [header-obj/date: to-idate now]
either only [
addr-list: copy ""
do-send smtp-port ["MAIL FROM: " header-obj/from ]
until [
addr: pick address 1
if string? addr [
either email? pick address 2 [
addr: rejoin [ {"} addr {" <} pick address 2 ">" ]
do-send smtp-port [{RCPT TO: } addr ]
address: next address
] [
print "Error: name without address"
]
]
if email? addr [
addr: rejoin [ "<" addr ">" ]
do-send smtp-port ["RCPT TO: " addr ]
]
if string? addr [
either addr-list = "" [
append addr-list addr
] [
append addr-list rejoin [ ", ^/^-" addr ]
]
]
address: next address
tail? address
] ; until
header-obj/to: addr-list
insert insert message net-utils/export header-obj newline
do-send smtp-port ["DATA" message]
] [
until [
addr: pick address 1
catch [
if string? addr [
either email? pick address 2 [
addr: rejoin [ addr { <} pick address 2 {>} ]
address: next address
][
print [ "Error: Name without email (" addr ")" ]
throw
]
]
if email? addr [
addr: rejoin ["<" addr ">"]
]
either string? addr [
do-send smtp-port ["MAIL FROM: " header-obj/from ]
do-send smtp-port ["RCPT TO: " addr ]
header-obj/to: addr
message: rejoin [ net-utils/export header-obj newline content ]
do-send smtp-port ["DATA" message]
] [
print [ "Error: wrong type (" addr ")" ]
throw
]
] ; catch
address: next address
tail? address
] ; until
]
close smtp-port
]
Mail-List-Rules:
make object! [
addr-list: none
addy: none
addr: none
name: none
mailbox: [
copy addy [to "," | to ";" | to end] (
parse addy [
"(" copy name to ")" skip copy addr |
{"} copy name to {"} thru "<" copy addr to ">" |
copy name to "<" skip copy addr to ">" skip |
copy addr to "(" skip copy name to ")" skip |
copy addr to end
]
)
]
maillist: [
mailbox (if not none? name [
append addr-list trim name]
append addr-list to-email trim addr)
[[thru "," | thru ";"] maillist | none]
]
parse-mail-list: func [
data [string!]
][
addr-list: make block! 1
parse data maillist
addr-list
]
]
