File: //usr/share/jed/lib/rmail.sl
% See jed/doc/rmail.txt for more information.
% Mark Olesen's patches added.
%!% variable that controls the location of the mailbox for new mail
ifnot (is_defined("Rmail_Spool_Mailbox_File"))
{
variable Rmail_Spool_Mailbox_File = getenv ("MAIL");
if (NULL == Rmail_Spool_Mailbox_File)
{
Rmail_Spool_Mailbox_File = "/var/spool/mail";
if (2 != file_status (Rmail_Spool_Mailbox_File))
{
Rmail_Spool_Mailbox_File = "/usr/mail"; % HP-UX
}
Rmail_Spool_Mailbox_File = dircat (Rmail_Spool_Mailbox_File, getenv ("USER"));
}
}
%!% where the JED mail reader should put the mail
ifnot (is_defined("Rmail_Directory"))
{
variable Rmail_Directory = dircat(getenv("HOME"), "Mail");
}
%!% temporary mailbox where newmail is moved to before parsed and converted.
variable Rmail_Tmp_Mbox = dircat(Rmail_Directory, "#NewMail#");
variable Rmail_Master_Index_File = dircat(Rmail_Directory, "_Root_Index.index");
variable Rmail_Folder_Buffer = Null_String;
variable Rmail_Folder_Name = Null_String;
variable Rmail_Newmail_Folder = "New-Mail";
variable Rmail_Root_Buffer = "Rmail: Folder List";
variable Rmail_Mail_Buffer_Name = Null_String;
ifnot (is_defined("Rmail_Dont_Reply_To"))
{
% comma separated list of name to not reply to.
variable Rmail_Dont_Reply_To;
$1 = getenv("USER"); if ($1 == NULL) $1 = "";
$2 = getenv("HOST"); if ($2 == NULL) $2 = "";
Rmail_Dont_Reply_To = $1;
if (strlen($1) and strlen ($2))
Rmail_Dont_Reply_To = sprintf("%s,%s@%s", $1, $1, $2);
else
Rmail_Dont_Reply_To = $1;
}
Rmail_Dont_Reply_To = strlow (Rmail_Dont_Reply_To);
variable Rmail_Message_Number = Null_String; %/* this is a string!! */
% check for existence of Rmail directory. Create it if it does not exist.
ifnot (file_status(Rmail_Directory))
{
if (mkdir(Rmail_Directory, 0700))
error("Unable to create " + Rmail_Directory);
if (chmod(Rmail_Directory, 0700))
error ("chmod failed!");
}
ifnot (is_defined ("Rmail_Ask_About_Cc"))
{
variable Rmail_Ask_About_Cc = 0;
}
define rmail_buffer_name(folder)
{
"Rmail: " + folder;
}
ifnot (is_defined ("mime_rfc1522_parse_buffer"))
{
autoload ("mime_rfc1522_parse_buffer", "mime");
autoload ("mime_qp_parse_buffer", "mime");
}
define rmail_folder_file(folder)
{
dircat (Rmail_Directory, folder) + ".index";
}
% set buffer flags so that autosave is off but save anyway is on.
% This way it gets saved in case of a power failure or something.
define rmail_set_buffer_flags()
{
variable flags = getbuf_info();
flags = (flags | 0x80) & ~(0x2); % turn off autosave, turn on save
flags = flags & ~(0x20); % turn off undo
flags = flags | 0x100; % No backup file.
setbuf_info(flags);
() = set_buffer_umask (0077);
define_blocal_var ("save_session", 0);
}
define rmail_save_buffer_secure ()
{
variable dir, file, flags;
(file, dir,,flags) = getbuf_info();
ifnot (buffer_modified () and strlen (file))
return;
file = dircat(dir, file);
() = write_buffer(file);
() = chmod(file, 0600);
}
define rmail_update_master_index (folder, n, total, n_unread)
{
variable cbuf = whatbuf(), f, fline;
fline = sprintf("Folder:\t%20s\t(%d/%d) messages. %d unread.\n",
folder, n, total, n_unread);
variable flags;
() = read_file(Rmail_Master_Index_File);
rmail_set_buffer_flags();
push_spot_bob ();
% only save if necessary.
ifnot (bol_fsearch(fline))
{
ifnot (bol_fsearch(sprintf("Folder:\t%20s\t(", folder))) eob();
set_readonly(0);
delete_line();
insert(fline);
set_readonly(1);
}
rmail_save_buffer_secure(); % only if modified.
pop_spot();
setbuf(cbuf);
}
define rmail_save_folder (folder, delit)
{
ifnot (bufferp(Rmail_Folder_Buffer)) return;
variable file = rmail_folder_file(folder), n;
variable total, n_ok, n_unread;
setbuf(Rmail_Folder_Buffer);
set_readonly(0);
n = string(what_line());
% This is a good place to update the master index.
% calculate total messages and number of deleted ones.
eob(); bskip_chars(" \t\n");
total = what_line();
if (bobp ())
{
total = 0; n = "0";
}
bob();
n_ok = total;
n_unread = 0;
forever
{
switch (what_char ())
{ case 'D': n_ok--; }
{ case '-': n_unread++; }
ifnot (down_1 ()) break;
bol();
}
rmail_update_master_index(folder, n_ok, total, n_unread);
widen();
bob();
go_down_1 ();
if (n != line_as_string ())
{
delete_line();
insert(n);
newline();
}
rmail_save_buffer_secure();
if (delit)
{
delbuf(whatbuf());
return;
}
%
% narrow it back
%
bob();
() = bol_fsearch("\x1F\xC\n"); go_down_1 ();
push_mark_eob (); narrow();
}
define rmail_find_folder (folder)
{
variable file = rmail_folder_file(folder);
rmail_save_folder(Rmail_Folder_Name, 1);
Rmail_Folder_Buffer = rmail_buffer_name(folder);
() = find_file(file);
rmail_set_buffer_flags();
rename_buffer(Rmail_Folder_Buffer);
Rmail_Folder_Name = folder;
% make sure buffer is properly formatted. Routines expect this to be
% widened.
widen();
bob();
if (eobp())
{
% new, format it
insert("0\n1\n\x1F\xC\n");
}
}
define rmail_get_header (header, continue_flag, multi_flag)
{
variable h, dh;
bob();
if (strlow (header) == "date: ")
{
% special treatment for date. It always looks like:
% Wed, 11 jun 1993
% or: Sun Dec 04, 1994 11:05:52 GMT
% The day and , are somtimes missing and 1993 may be just 93.
if (re_fsearch("^Date:[ \t]+[a-zA-Z,]* *0?\\([1-3]?\\d\\) +\\([a-zA-Z]+\\) +"))
return sprintf("%s-%s", regexp_nth_match(1), regexp_nth_match(2));
if (re_fsearch("^Date:[ \t]+[a-zA-Z]+ \\([a-zA-Z]+\\) +0?\\([1-3]?\\d\\)[ ,]+"))
return sprintf("%s-%s", regexp_nth_match(2), regexp_nth_match(1));
return Null_String;
}
h = "";
while (bol_fsearch(header))
{
go_right (strlen(header));
skip_white();
push_mark ();
eol ();
if (continue_flag)
{
while (down_1 ())
{
skip_white ();
if (bolp ())
{
go_left_1 ();
break;
}
}
}
dh = bufsubstr();
if (strlen (h)) h += ",";
h += dh;
ifnot (multi_flag) break;
}
return strtrim (str_replace_all (h, "\n", " "));
}
define rmail_narrow_to_headers ()
{
bob ();
push_mark ();
ifnot (bol_fsearch("\n")) eob();
narrow();
bob ();
}
define rmail_extract_headers ()
{
variable from = Null_String, date = Null_String, subject = Null_String;
push_spot ();
rmail_narrow_to_headers ();
from = rmail_get_header("From: ", 0, 0);
ifnot (strlen(from)) from = rmail_get_header("From ", 0, 0);
date = rmail_get_header("Date: ", 0, 0);
subject = rmail_get_header("Subject: ", 0, 0);
widen();
pop_spot();
% RAFE (flags, the - means it has not been read.)
% The 'from' string may have multibyte characters, which will not
% will not be handled properly via the printf width specifier. So
% pad it outside the printf call.
variable width = 25;
variable len = strwidth (from);
if (len > width)
{
variable ch, new_from = "";
foreach ch (from) using ("chars")
{
ch = char (ch);
if (strwidth (new_from + ch) > width)
break;
new_from += ch;
}
from = new_from;
len = strwidth (from);
}
loop (width-len) from += " ";
sprintf(" %6s %s %s\n", date, from, subject);
% Note: The column widths may not be correct when UTF-8 characters are
% present.
}
% This routine assumes that the buffer is narrow.
define rmail_make_filename()
{
variable cbuf = whatbuf(), n;
setbuf(Rmail_Folder_Buffer);
bob();
push_mark_eol ();
n = bufsubstr_delete();
if (strlen(n)) n = integer(n); else n = 0;
++n;
n = string(n);
bob();
insert(n);
if (eobp())
{
insert("\n1\n\x1F\xC\n");
}
setbuf(cbuf);
return n;
}
define rmail_create_folder(folder)
{
variable dir = dircat(Rmail_Directory, folder);
if (file_status(dir)) return dir;
if (mkdir(dir, 0700))
error ("Unable to create folder directory.");
() = chmod(dir, 0700);
rmail_update_master_index(folder, 0, 0, 0);
return (dir);
}
define rmail_parse_mime ()
{
variable h;
push_spot ();
rmail_narrow_to_headers ();
if (re_fsearch ("\\?[QqBb]\\?"))
mime_rfc1522_parse_buffer ();
h = rmail_get_header ("Content-Transfer-Encoding: ", 1, 0);
eob ();
widen ();
if (is_substr (strlow (h), "quoted-printable"))
{
push_mark ();
eob ();
narrow ();
mime_qp_parse_buffer ();
widen ();
}
pop_spot ();
}
define rmail_output_newmail()
{
variable headers;
variable cbuf = whatbuf();
variable n = rmail_make_filename(), file;
file = rmail_create_folder (Rmail_Folder_Name);
file = dircat(file, n);
bob(); push_mark(); skip_chars("\n \t"); del_region();
push_mark_eob();
() = write_region_to_file(file);
% () = chmod(file, 0600);
rmail_parse_mime ();
headers = rmail_extract_headers();
setbuf(Rmail_Folder_Buffer);
eob();
% If this format is changed, change it in xpunge as well.
vinsert ("-%3s", n); insert(headers);
setbuf(cbuf);
}
define rmail_newmail_narrow (from)
{
variable content_length = 0;
push_mark_eol ();
ifnot (bol_fsearch_char ('\n'))
eob ();
narrow ();
if (re_bsearch ("^\\CContent-Length:[ \t]+\\(\\d+\\)$"))
content_length = integer (regexp_nth_match (1));
bob ();
widen ();
push_mark_eol ();
if (content_length)
{
if (bol_fsearch_char ('\n'))
{
content_length++;
if ((content_length == right (content_length))
and (skip_chars ("\n"),
(re_looking_at (from) or eobp ())))
{
ifnot (eobp ()) go_up_1 ();
narrow ();
return;
}
}
pop_mark_1 ();
push_mark_eol ();
}
forever
{
if (re_fsearch (from))
{
if (blooking_at ("\n\n"))
{
go_up_1 ();
break;
}
eol ();
continue;
}
eob ();
break;
}
narrow();
}
private define rmail_process_newmail (mbox, newmail_folder)
{
variable n = 0, from = "^\\cFrom ";
rmail_find_folder(newmail_folder);
eob(); push_spot();
setbuf(" *rmail-newmail*");
erase_buffer();
if (insert_file(mbox) <= 0) error ("File not inserted.");
bob(); push_mark();
if (0 == re_fsearch(from))
{
message ("New mail with no messages!");
pop_mark_1 ();
pop_spot ();
return 0;
}
del_region();
() = set_buffer_umask (0077);
forever
{
rmail_newmail_narrow (from);
++n;
flush (sprintf ("Processing %d messages...", n));
rmail_output_newmail();
erase_buffer();
widen();
if (eobp()) break;
del();
}
% pop back to beginning of the newest messages in the folder.
% in addition, save_folder expects the buffer to be narrowed.
whatbuf();
setbuf(Rmail_Folder_Buffer);
bob();
() = bol_fsearch("\x1F\xC\n");
go_down_1 (); push_mark_eob(); narrow();
pop_spot();
setbuf(());
rmail_save_folder(newmail_folder, 1);
return n;
}
define rmail_get_newmail_from_file (file, tmp_mbox, folder)
{
variable n, st;
variable nomail, cmd;
variable getmail = dircat(Jed_Bin_Dir, "getmail");
nomail = sprintf ("No new mail in %s", file);
st = stat_file (file);
if ((st == NULL) || (st.st_size <= 0))
{
message (nomail);
return (0);
}
flush("Getting new mail...");
if (file_status(getmail) != 1)
{
error (getmail + " not found!");
}
cmd = sprintf("%s %s %s", getmail, file, tmp_mbox);
push_mark();
if (pipe_region(cmd))
error ("getmail returned error.");
n = rmail_process_newmail (tmp_mbox, folder);
% delete_file(Rmail_Tmp_Mbox);
return n;
}
define rmail_get_newmail ()
{
rmail_get_newmail_from_file (Rmail_Spool_Mailbox_File, Rmail_Tmp_Mbox, Rmail_Newmail_Folder);
}
define rmail_folder_mode()
{
variable flags;
() = find_file(Rmail_Master_Index_File);
set_readonly(1);
rmail_set_buffer_flags();
rename_buffer(Rmail_Root_Buffer);
bob();
use_keymap("Rmail-Folder");
}
define rmail_exit_folder ()
{
rmail_save_folder(Rmail_Folder_Name, 1);
if (bufferp(Rmail_Root_Buffer)) pop2buf(Rmail_Root_Buffer);
else rmail_folder_mode();
onewindow();
if (bufferp(Rmail_Mail_Buffer_Name))
{
delbuf(Rmail_Mail_Buffer_Name);
Rmail_Message_Number = Null_String;
}
Rmail_Mail_Buffer_Name = Null_String;
clear_message ();
}
variable Rmail_Headers_Hidden = 0;
define rmail_unhide_headers ()
{
variable mark = "\x1F\xC\n";
Rmail_Headers_Hidden = 0;
set_readonly(0);
widen();
bob(); push_mark();
ifnot (bol_fsearch("\n")) eob();
narrow();
bob();
% make a mark if not found
if (bol_fsearch(mark))
{
go_down_1 (); push_spot();
% delete visible headers
push_mark_eob(); del_region();
% restore old ones
bob(); push_mark(); () = bol_fsearch(mark);
bufsubstr(); eob(); insert();
pop_spot();
}
else
{
insert(mark);
push_mark_eob();
bskip_chars("\n");
bufsubstr();
bob();
insert();
newline();
go_down(2);
}
push_mark(); widen(); eob(); narrow();
bob(); set_readonly(1);
}
define rmail_hide_headers()
{
variable ok_headers = "From,Subj,Cc,Organ,In-Reply,Date,Reply-To,To";
variable header;
rmail_unhide_headers();
Rmail_Headers_Hidden = 1;
widen(); bob(); push_mark();
ifnot (bol_fsearch("\n")) eob();
narrow();
bob();
ifnot (bol_fsearch("\x1F\xC\n")) error ("Unable to find marker.");
set_readonly(0);
push_spot();
% Unwrap lines
forever
{
eol (); trim ();
ifnot (looking_at ("\n ") or looking_at ("\n\t"))
break;
del ();
trim ();
insert_single_space ();
}
goto_spot ();
% mark ok lines
foreach (strtok (ok_headers, ","))
{
header = ();
while (bol_fsearch(header))
{
insert("\xFF");
}
#ifnfalse
while (down_1 () and
not (skip_white (), bolp ()))
{
bol ();
insert ("\xFF");
}
#endif
goto_spot ();
}
pop_spot();
eol(); go_right_1 ();
% delete unmarked lines
while(not(eobp()))
{
bol();
if (looking_at("\xFF"))
{
del();
eol(); go_right_1 ();
continue;
}
push_mark_eol(); skip_chars("\n"); del_region();
eol();
}
%newline();
widen();
bob();
() = bol_fsearch("\x1F\xC\n");
go_down_1 ();
push_mark_eob(); narrow();
bob();
}
% This routines returns the file number of current summary line as a string.
% If the line is invalid, it returns the null string.
define rmail_extract_file_number()
{
bol();
go_right_1 (); skip_white();
push_mark();
skip_chars("0-9");
bufsubstr();
}
define rmail_add_flag(flag)
{
variable n = 13, flags = "RFE";
flag = char(flag);
n += is_substr(flags, flag);
goto_column(n);
ifnot (looking_at(flag))
{
insert(flag);
del();
}
}
% this routine returns 0 if line does not contain a valid message
% 1 if the message is already in the window, 2 if not but it exists, -1
% if it had to be read in.
define rmail_get_message(flag)
{
variable buf, file, n, n1, pop_buf, ret;
ifnot (bufferp(Rmail_Folder_Buffer)) return (0);
pop2buf(Rmail_Folder_Buffer);
file = rmail_extract_file_number ();
ifnot (strlen(file)) return 0;
Rmail_Message_Number = file;
set_readonly(0);
bol(); if (looking_at_char ('-'))
{
del(); insert_single_space ();
}
if (flag) rmail_add_flag(flag);
set_readonly(1);
buf = sprintf("Rmail: %s(%s)", Rmail_Folder_Name, file);
pop_buf = buf;
ret = 2;
if ((buf != Rmail_Mail_Buffer_Name) or not(bufferp(buf)))
{
%
% we have to read it in.
%
ret = -1;
if (bufferp(Rmail_Mail_Buffer_Name))
{
pop_buf = Rmail_Mail_Buffer_Name;
}
}
if (buffer_visible(pop_buf))
{
pop2buf(pop_buf);
if (ret == 2) ret = 1;
}
else
{
% I want summary window at top. There is no nice way to do it
% at present.
onewindow();
n = window_info('r');
pop2buf(pop_buf);
if (TOP_WINDOW_ROW == window_info('t'))
{
pop2buf(Rmail_Folder_Buffer);
sw2buf(pop_buf);
}
n1 = window_info('r');
% we want n to be 4 lines
% now it is:
n -= n1 + 1;
loop (n - 4) enlargewin();
pop2buf(Rmail_Folder_Buffer);
pop2buf(pop_buf);
}
if (ret != -1) return ret;
define_blocal_var ("save_session", 0);
() = set_buffer_umask (077);
set_readonly(0);
widen();
erase_buffer();
Rmail_Mail_Buffer_Name = buf;
file = dircat(dircat(Rmail_Directory, Rmail_Folder_Name), file);
n = insert_file(file);
ERROR_BLOCK
{
set_readonly(1);
set_buffer_modified_flag(0);
}
if (n < 0)
{
mark_buffer ();
() = write_region_to_file (file);
error ("File not found!");
}
bob();
rename_buffer(buf);
#iftrue
rmail_parse_mime ();
#endif
rmail_hide_headers();
EXECUTE_ERROR_BLOCK;
return (ret);
}
define rmail_toggle_headers()
{
ifnot (rmail_get_message(0)) return;
if (Rmail_Headers_Hidden)
{
rmail_unhide_headers();
}
else rmail_hide_headers();
set_buffer_modified_flag(0);
set_readonly(1);
pop2buf(Rmail_Folder_Buffer);
}
define rmail_scroll_forward ()
{
ERROR_BLOCK
{
pop2buf(Rmail_Folder_Buffer);
}
if (rmail_get_message(0) == 1)
{
update_sans_update_hook(0);
call("page_down");
}
EXECUTE_ERROR_BLOCK;
}
define rmail_skip_quotes ()
{
variable str = "^ *[>:|=]";
ERROR_BLOCK
{
pop2buf(Rmail_Folder_Buffer);
}
if (1 == rmail_get_message (0))
{
update(0);
goto_top_of_window ();
go_down_1 ();
if (re_fsearch (str))
{
while (
(push_mark (), narrow (), bol (), re_fsearch (str), widen ())
|| (skip_white (), eolp ())
)
{
ifnot (down_1 ()) break;
}
recenter (1);
}
}
EXECUTE_ERROR_BLOCK;
}
define rmail_scroll_backward()
{
ERROR_BLOCK
{
pop2buf(Rmail_Folder_Buffer);
}
if (rmail_get_message(0) == 1)
{
update(0);
call("page_up");
}
EXECUTE_ERROR_BLOCK;
}
define rmail_format_mail_buffer ()
{
variable opt_headers = NULL;
if (_NARGS == 1)
opt_headers = ();
pop2buf (Rmail_Folder_Buffer);
mail();
%onewindow();
if (buffer_modified ())
{
ifnot (get_yes_no("Mail already being composed. Erase it")) return 0;
}
mail_format_buffer (1, opt_headers);
1;
}
define rmail_forward_message ()
{
variable cbuf, subj;
ifnot (rmail_get_message('F'))
{
beep();
return;
}
cbuf = whatbuf ();
push_spot ();
bob ();
subj = "Fwd: ";
if (bol_fsearch ("Subject: "))
{
go_right (9);
push_mark ();
eol ();
subj = sprintf ("Fwd: [%s]", bufsubstr ());
}
pop_spot ();
ifnot (rmail_format_mail_buffer ())
return;
eob();
insert ("----Begin Forwarded Message----\n");
insbuf(cbuf);
insert ("----End Forwarded Message----\n");
bob();
if (bol_fsearch ("Subject: "))
{
eol ();
insert (subj);
}
bob ();
eol();
}
% This function assumes that the buffer has been narrowed about the headers.
define rmail_unfold_headers ()
{
variable flags;
flags = getbuf_info ();
setbuf_info (0);
push_spot ();
bob ();
do
{
while (eol (),
(looking_at ("\n ") or looking_at ("\n\t")))
del ();
}
while (down_1 ());
() = getbuf_info ();
setbuf_info (flags);
pop_spot ();
}
define rmail_insert_attribution (from, date, cc)
{
variable you = "you";
if (strlen (cc) and strlen(from)) you = from;
if (strlen (date))
vinsert ("On %s, %s said:\n", date, you);
else
vinsert ("%s said:\n", you);
}
define rmail_parse_email_address (from)
{
variable pos, len;
% First try to remove comments. We have 2 forms to consider:
% "not@a.comment, This is a comment <this@is.not>, this@is_not (This is)"
% Knock out parenthesis form. Try to handle nested ones
while (pos = string_match (from, "\\(([^()]*)\\)", 1), pos)
{
(pos, len) = string_match_nth (1);
from = substrbytes (from, 1, pos) + substrbytes (from, pos + len + 1, -1);
}
% Remove double quote type comments
from = str_uncomment_string (from, "\"", "\"");
% Now try to get rid of ", This is a comment <this is not> bla" form
% In general, we must handle commas:
% 1. "not comment,is comment <not comment> is comment, not comment"
% So we do the following:
% (However, we still incorrectly handle commas in comments!)
while (pos = string_match (from, ",?\\([^,]*<\\([^>]*\\)>[^,]*\\)", 1), pos)
{
variable pos1, len1;
(pos, len) = string_match_nth (1);
(pos1, len1) = string_match_nth (2);
from = substrbytes (from, 1, pos)
+ substrbytes (from, pos1 + 1, len1)
+ substrbytes (from, pos + len + 1, -1);
}
% Now replace all space, tab, and newline by commas
return strcompress (str_replace_all (strcompress(from, " \t\n") , " ", ","), ",");
}
define rmail_apply_dont_reply_to (from)
{
variable sub_f, n, num;
% add to list, see if any part of it is in the list.
","; % delimiter for create_delimited_string
n = 0;
num = 0;
from = strlow (from);
while (sub_f = extract_element (from, n, ','), sub_f != NULL)
{
n++;
variable pats;
variable matches;
pats = "^" + strchop (Rmail_Dont_Reply_To, ',', '\\') + "$";
matches = array_map (Int_Type, &string_match, sub_f, pats, 1);
ifnot (any (matches))
{
sub_f;
num++;
}
}
create_delimited_string (num);
}
define rmail_reply ()
{
ifnot (rmail_get_message('R'))
{
beep();
return;
}
variable subj, cc, to, replyto, from, msgid=NULL;
variable date = "";
variable cbuf = whatbuf ();
push_spot ();
variable headers_hidden = Rmail_Headers_Hidden;
rmail_unhide_headers ();
rmail_narrow_to_headers ();
set_buffer_modified_flag(0);
set_readonly(1);
replyto = rmail_get_header ("Reply-To: ", 1, 0);
ifnot (strlen (replyto))
replyto = rmail_get_header ("From: ", 1, 0);
to = rmail_get_header ("To: ", 1, 1);
subj = rmail_get_header ("Subject: ", 1, 0);
ifnot (strlen (subj))
subj = "(No Subject)";
msgid = rmail_get_header ("Message-ID: ", 1, 0);
cc = rmail_get_header ("Cc:", 1, 1);
if (Rmail_Ask_About_Cc and strlen (cc))
{
ERROR_BLOCK
{
cc = "";
_clear_error ();
}
ifnot (get_yes_no ("Include the cc: header"))
cc = Null_String;
}
cc += "," + to;
cc = rmail_apply_dont_reply_to (rmail_parse_email_address (cc));
replyto = rmail_parse_email_address (replyto);
from = rmail_get_header ("From: ", 1, 0);
eob ();
% get the date for the attribution string
if (re_bsearch("^Date:[ \t]*\\(.*\\)$"))
date = regexp_nth_match (1);
widen();
if (headers_hidden)
{
rmail_hide_headers ();
set_buffer_modified_flag(0);
set_readonly(1);
}
pop_spot();
variable opt_headers = NULL;
if (msgid != "")
opt_headers = sprintf ("In-Reply-To: %s\n", msgid);
ifnot (rmail_format_mail_buffer (opt_headers))
return;
bob();
do
{
if (looking_at("To:"))
{
eol ();
insert (replyto);
}
else if (looking_at("Cc:"))
{
eol ();
insert (cc);
}
else if (looking_at("Subject:"))
{
eol ();
push_spot ();
insert (subj);
pop_spot ();
ifnot (looking_at("Re:")) insert ("Re: ");
}
}
while (down_1 () and not (looking_at ("X-Mailer:")));
eob();
if (bol_bsearch ("-- \n")) % find signature
up_1 ();
push_mark();
narrow();
% This trick allows a single undo to remove the later insertion:
erase_buffer();
insbuf(cbuf);
bob();
rmail_insert_attribution (from, date, cc);
push_spot ();
do
{
bol();
insert_char ('>');
}
while (down_1 ());
newline();
pop_spot ();
widen();
ifnot (strlen (to))
{
bob(); eol();
}
}
define rmail_edit ()
{
variable file;
ifnot (get_y_or_n ("Are you sure you want to edit")) return;
ifnot (rmail_get_message ('E'))
return;
% Now we are in the message buffer. The global variable Rmail_Message_Number
% should be correct.
file = dircat(dircat(Rmail_Directory, Rmail_Folder_Name), Rmail_Message_Number);
if (1 != file_status (file))
verror ("Unable to read %s", file);
set_buffer_modified_flag (0);
delbuf (whatbuf ());
() = find_file (file);
text_mode ();
set_buffer_no_backup ();
}
define rmail_find_next_message ()
{
push_mark();
while (down_1 () and looking_at_char ('D'));
if (eobp())
{
pop_mark_1 ();
message("No more undeleted messages.");
return 0;
}
pop_mark_0 ();
1;
}
define rmail_find_prev_message()
{
push_mark();
while (up_1 (), bol(), () and looking_at_char ('D'));
if (bobp() and looking_at_char ('D'))
{
pop_mark_1 ();
message("No more undeleted messages.");
return 0;
}
pop_mark_0 ();
1;
}
define rmail_delete_cmd ()
{
bol();
if (eolp()) return beep();
ifnot (looking_at_char ('D'))
{
set_readonly(0);
del(); insert_char ('D');
set_readonly(1);
}
}
define rmail_delete_backward ()
{
rmail_delete_cmd ();
() = rmail_find_prev_message ();
}
define rmail_delete_forward ()
{
rmail_delete_cmd ();
() = rmail_find_next_message();
}
define rmail_undelete ()
{
push_mark_eol();
if (bol_bsearch_char ('D'))
{
set_readonly(0);
del(); insert_single_space ();
set_readonly(1);
pop_mark_0 ();
return;
}
pop_mark_1 ();
beep();
}
define rmail_next_message()
{
if (rmail_find_next_message())
{
rmail_scroll_forward();
}
}
define rmail_prev_message()
{
if (rmail_find_prev_message())
{
rmail_scroll_forward();
}
}
define rmail_select_folder (folder)
{
variable n;
rmail_find_folder(folder);
bob();
go_down_1 ();
n = integer(line_as_string ());
() = bol_fsearch("\x1F\xC\n");
go_down_1 ();
push_mark_eob();
narrow();
pop2buf(whatbuf());
goto_line(n); bol();
use_keymap("Rmail-Read");
set_status_line("Jed %b Folder. (%p) %t", 0);
set_readonly(1);
run_mode_hooks ("rmail_folder_hook");
}
define rmail_build_folder_list ()
{
variable slist = Null_String;
variable cbuf = whatbuf ();
setbuf (Rmail_Root_Buffer);
push_spot_bob ();
while (bol_fsearch("Folder:\t"))
{
go_right (8);
skip_white ();
push_mark ();
() = ffind ("\t");
slist += "," + bufsubstr ();
}
pop_spot ();
setbuf (cbuf);
slist;
}
private define folder_exists (folder)
{
folder = dircat(Rmail_Directory, folder);
return file_status(folder) == 2;
}
private define query_create_folder (default_folder)
{
variable folder, new_dir;
folder = read_string_with_completion ("Move to folder:",
default_folder,
rmail_build_folder_list ());
if (not (strlen (folder)))
return NULL;
if (folder == Rmail_Folder_Name)
return folder;
if (0 == folder_exists (folder))
{
if (1 != get_yes_no(sprintf("Folder %s does not exist, create it", folder)))
return NULL;
() = rmail_create_folder(folder);
}
return folder;
}
define rmail_folder_newmail ()
{
variable n;
variable file = Rmail_Spool_Mailbox_File;
variable folder;
folder = Rmail_Newmail_Folder;
if (-1 != prefix_argument (-1))
{
file = read_file_from_mini ("Input MailBox:");
ifnot (strlen (file)) return;
folder = query_create_folder (folder);
if (folder == NULL)
return;
}
n = rmail_get_newmail_from_file (file, Rmail_Tmp_Mbox, folder);
if (n)
{
flush(sprintf("%d new messages.", n));
rmail_select_folder(folder);
}
}
variable Rmail_Last_Folder = Null_String;
% This routine deletes buffer containing message n if it exists
% it returns 1 if is exists and is visible otherwise it returns 0.
define rmail_validate_message ()
{
variable vis = 0;
variable buf = sprintf("Rmail: %s(%s)", Rmail_Folder_Name, Rmail_Message_Number);
if (bufferp(buf))
{
vis = buffer_visible(buf);
delbuf(buf);
}
return vis;
}
define rmail_update_folder_and_save ()
{
variable new_n;
eob ();
bskip_chars ("\n \t");
bol ();
new_n = rmail_extract_file_number ();
ifnot (strlen(new_n)) new_n = "0";
widen();
bob(); push_mark_eol();
if (bufsubstr() != new_n)
{
delete_line();
insert(new_n);
newline();
}
() = bol_fsearch("\x1F\xC\n");
go_down_1 (); push_mark_eob(); narrow();
pop_mark_1 ();
rmail_save_folder(Rmail_Folder_Name, 0);
}
define rmail_resequence_folder ()
{
variable n, file, new_file, dir, new_n = "0";
variable update_message = 0;
variable res_fmt = "Resequencing folder [%d/%d]...";
variable nmax;
ERROR_BLOCK
{
rmail_update_folder_and_save ();
pop_spot ();
}
push_spot();
set_readonly(0);
dir = dircat(Rmail_Directory, Rmail_Folder_Name);
n = 0;
eob ();
nmax = what_line () - 1;
bob();
flush (sprintf (res_fmt, n, nmax));
while (file = rmail_extract_file_number (), strlen(file))
{
n++;
new_n = string(n);
ifnot (n mod 10)
flush (sprintf (res_fmt, n, nmax));
if (file != new_n)
{
file = dircat(dir, file);
new_file = dircat(dir, new_n);
if (file_status (new_file))
verror ("File %s exists. Cannot rename %s to it.",
new_file, file);
if (rename_file(file, new_file))
error ("Error renaming ", file);
bol();
go_right_1 ();
push_mark();
skip_white();
skip_chars("0-9");
del_region();
vinsert ("%3s", new_n);
if (new_n == Rmail_Message_Number)
{
update_message = rmail_validate_message ();
}
}
ifnot (down_1 ()) break;
}
% update the last file number
rmail_update_folder_and_save ();
pop_spot();
eol (); bskip_chars("\n"); bol ();
set_readonly(1);
if (update_message or (integer(new_n) < integer(Rmail_Message_Number)))
{
Rmail_Message_Number = Null_String;
rmail_scroll_forward ();
}
message("done.");
}
define rmail_output_to_folder()
{
variable folder = NULL, header, old_n, new_n, new_file, old_file;
variable old_folder = Rmail_Folder_Name;
variable buf, vis;
if (_NARGS)
folder = ();
variable new_dir, old_dir = dircat(Rmail_Directory, Rmail_Folder_Name);
old_n = rmail_extract_file_number ();
ifnot (strlen(old_n)) return;
if ((folder == NULL) || (0 == folder_exists (folder)))
folder = query_create_folder (Rmail_Last_Folder);
if (folder == NULL)
return;
new_dir = dircat(Rmail_Directory, folder);
% lets get this header
header = line_as_string ();
rmail_find_folder (folder);
%
% generate a new filename
%
new_n = rmail_make_filename();
new_file = dircat(new_dir, new_n);
old_file = dircat(old_dir, old_n);
if (rename_file(old_file, new_file))
{
rmail_select_folder(old_folder);
error("Unable to rename file.");
}
eob();
insert(header);
bol();
go_right_1 ();
push_mark();
skip_white();
skip_chars("0-9");
del_region();
vinsert ("%3s", new_n);
Rmail_Last_Folder = folder;
% Now narrow it so next routine can process it
bob();
() = bol_fsearch("\x1F\xC\n");
go_down_1 ();
push_mark_eob();
narrow();
rmail_select_folder(old_folder);
set_readonly(0);
bob();
() = bol_fsearch(header);
delete_line();
rmail_resequence_folder();
}
define rmail_output_deleted_to_folder ()
{
variable folder = NULL, header, old_n, new_n, new_file, old_file;
variable old_folder = Rmail_Folder_Name;
variable buf, vis;
if (_NARGS)
folder = ();
variable new_dir, old_dir = dircat(Rmail_Directory, Rmail_Folder_Name);
if ((folder == NULL) || (0 == folder_exists (folder)))
folder = query_create_folder (Rmail_Last_Folder);
if (folder == NULL)
return;
new_dir = dircat(Rmail_Directory, folder);
push_spot ();
try
{
bob ();
while (bol_fsearch_char ('D'))
{
old_n = rmail_extract_file_number();
ifnot (strlen(old_n))
{
eol();
continue;
}
flush ("Moving ${old_n}"$);
% lets get this header
header = line_as_string ();
rmail_find_folder (folder);
%
% generate a new filename
%
new_n = rmail_make_filename ();
new_file = dircat(new_dir, new_n);
old_file = dircat(old_dir, old_n);
if (rename_file(old_file, new_file))
throw OSError, "Unable to rename ${old_file} to ${new_file}"$;
eob();
insert(header);
bol();
go_right_1 ();
push_mark();
skip_white();
skip_chars("0-9");
del_region();
vinsert ("%3s", new_n);
Rmail_Last_Folder = folder;
% Now narrow it so next routine can process it
bob();
() = bol_fsearch("\x1F\xC\n");
go_down_1 ();
push_mark_eob();
narrow();
rmail_select_folder(old_folder);
set_readonly(0);
bob();
() = bol_fsearch(header);
delete_line();
}
}
finally:
{
rmail_select_folder(old_folder);
rmail_resequence_folder();
pop_spot ();
}
}
define rmail_unhide_deleted ()
{
push_spot ();
mark_buffer ();
set_region_hidden (0);
pop_spot ();
}
define rmail_hide_deleted ()
{
push_spot ();
rmail_unhide_deleted ();
bob ();
while (bol_fsearch_char ('D'))
{
set_line_hidden (1);
eol ();
}
pop_spot ();
}
% This function is assumed to be called from within a folder. It REALLY
% deletes files marked with the D.
define rmail_xpunge_deletions ()
{
variable file, dir, n, new_file;
% variable old_n = Null_String;
flush("Expunging messages...");
push_mark();
ERROR_BLOCK
{
rmail_resequence_folder ();
pop_mark_0 ();
set_readonly(1);
}
set_readonly(0);
dir = dircat(Rmail_Directory, Rmail_Folder_Name);
bob();
while (bol_fsearch_char ('D'))
{
file = rmail_extract_file_number();
ifnot (strlen(file)) continue;
% ifnot (strcmp(file, Rmail_Message_Number))
% {
% old_n = file;
% }
file = dircat(dir, file);
if (1 != file_status(file))
error ("Unable to access ", file);
ifnot (delete_file(file))
error ("Unable to delete ", file);
delete_line ();
}
pop_mark_1 ();
rmail_resequence_folder ();
}
define rmail_xpunge_or_move_deletions ()
{
variable rsp = get_mini_response ("X-punge, M-ove, or C-cancel deleted messages?");
rsp |= 0x20;
if (rsp == 'x')
{
rmail_xpunge_deletions ();
return;
}
if (rsp == 'm')
{
rmail_output_deleted_to_folder ();
return;
}
}
$1 = "Rmail-Read";
ifnot (keymap_p($1))
{
make_keymap($1);
_for (' ', 127, 1)
{
$2 = char(());
undefinekey($2, $1);
}
definekey("rmail_skip_quotes", "\t", $1);
definekey("rmail_delete_backward", "D", $1);
definekey("rmail_delete_forward", "d", $1);
definekey("rmail_exit_folder", "q", $1);
definekey("rmail_exit_folder", "Q", $1);
definekey("rmail_folder_newmail", "g", $1);
definekey("rmail_folder_newmail", "G", $1);
definekey("rmail_next_message", "n", $1);
definekey("rmail_next_message", "N", $1);
definekey("rmail_prev_message", "p", $1);
definekey("rmail_prev_message", "P", $1);
definekey("rmail_toggle_headers", "t", $1);
definekey("rmail_toggle_headers", "T", $1);
definekey("rmail_scroll_forward", " ", $1);
definekey("rmail_scroll_forward", "\r", $1);
definekey("rmail_scroll_backward", "^?", $1);
definekey("rmail_xpunge_or_move_deletions", "x", $1);
definekey("rmail_xpunge_or_move_deletions", "X", $1);
definekey("rmail_reply", "r", $1);
definekey("rmail_reply", "R", $1);
definekey("rmail_forward_message", "f", $1);
definekey("rmail_forward_message", "F", $1);
definekey("rmail_output_to_folder", "o", $1);
definekey("rmail_undelete", "u", $1);
definekey("rmail_undelete", "U", $1);
definekey("rmail_edit", "E", $1);
definekey("mail", "m", $1);
definekey("mail", "M", $1);
}
define rmail_select_this_folder ()
{
bol();
ifnot (looking_at("Folder:\t")) return beep();
() = ffind("\t");
skip_white();
push_mark();
ifnot (ffind("\t("))
{
pop_mark(0);
beep();
return;
}
rmail_select_folder (bufsubstr());
}
$1 = "Rmail-Folder";
ifnot (keymap_p($1))
{
make_keymap($1);
_for (' ', 127, 1)
{
$2 = char(());
undefinekey($2, $1);
}
definekey("rmail_folder_newmail", "g", $1);
definekey("rmail_folder_newmail", "G", $1);
definekey("rmail_quit_rmail", "q", $1);
definekey("rmail_quit_rmail", "Q", $1);
definekey("rmail_select_this_folder", " ", $1);
definekey("rmail_select_this_folder", "\r", $1);
definekey("mail", "m", $1);
definekey("mail", "M", $1);
}
% if parameter is 0, unlock it if it is ours. Otherwise, lock or steal it.
% it returns 1 if the lock was made, 0 if not.
define rmail_check_lock_file(lck)
{
variable lpid, this_pid = string(getpid()), do_del;
variable lfn = "___LOCKED___";
variable lock_file = dircat (Rmail_Directory, lfn);
variable ret = 0, write_it = 0;
variable errbuf;
variable ourhost = getenv ("HOST"); if (ourhost == NULL) ourhost = "";
variable lockhost = Null_String;
variable lock_buffer;
variable flags;
lock_buffer = " " + lfn;
ERROR_BLOCK
{
if (bufferp (lock_buffer))
{
setbuf (lock_buffer);
set_buffer_modified_flag(0);
delbuf (lock_buffer);
}
}
EXECUTE_ERROR_BLOCK;
() = read_file(lock_file); clear_message ();
(,flags) = getbuf_info ();
setbuf_info (lock_buffer, flags);
set_buffer_no_backup ();
% extract the pid, it will be null if file was created
bob(); push_mark();
if (ffind_char (':'))
{
lockhost = bufsubstr ();
go_right_1 ();
push_mark ();
}
eol(); lpid = bufsubstr();
delete_line();
vinsert ("%s:%s", ourhost, this_pid);
if (lck)
{
if (strlen (lockhost))
{
if (lockhost != ourhost)
{
verror ("Pid %s on host %s is locking the mail file. Sorry.",
lpid, lockhost);
}
}
% check existence of pid
if (kill(integer (lpid), 0)) lpid = "";
if (strlen (lpid) and (lpid != this_pid))
{
verror ("Pid %s is locking mail directory. Sorry.",
lpid);
}
save_buffer ();
% Now that we have created a lock file, we use a trick to unlock it
% in case jed is exited ungracefully.
erase_buffer ();
rmail_set_buffer_flags ();
return 1;
}
% We get here if we are unlocking the file.
#iffalse
if ((lockhost != ourhost) or (lpid != this_pid))
return 0;
() = delete_file(lock_file);
#else
if ((lockhost == ourhost) and (lpid == this_pid))
() = delete_file(lock_file);
#endif
if (bufferp (lock_buffer))
{
setbuf(lock_buffer);
set_buffer_modified_flag (0);
delbuf (lock_buffer);
}
return 0;
}
define rmail_quit_rmail()
{
rmail_exit_folder();
% This puts us at the root again so save and get out.
rmail_save_buffer_secure();
delbuf(Rmail_Root_Buffer);
() = rmail_check_lock_file(0); % deletes the lock file.
}
define rmail ()
{
variable n;
ifnot (rmail_check_lock_file(1)) return;
rmail_save_folder(Rmail_Folder_Name, 1);
Rmail_Folder_Buffer = Null_String;
rmail_folder_mode();
n = rmail_get_newmail();
if (n)
{
flush(sprintf("%d new messages.", n));
rmail_select_folder(Rmail_Newmail_Folder);
}
}