% -*- SLang -*-

% muttmail.sl
%
% This file was originally written by the following people:
%      Ulli "Framstag" Horlacher's <framstag@belwue.de>
%      Thomas Roessler <roessler@guug.de>
%
% It was substantially modified and is currently being
% maintained the following people:
%      Abraham vd Merwe <abz@frogfoot.net>
%         http://oasis/index.php?feedme=jed
%      Johann Botha <http://blue.frogfoot.net/contact>
%         http://blue.frogfoot.net/unix/jed/
%
% Bugs
%
% - DFA rules bug (i.e. the <g> <foo@bar.com> bug). I really think this
%   a jed thing though, so we'll see...
%
% Todo
%
% - add asb. 'n initial paragraph formatting feature op jou muttmail todo list
%
% Changelog
%
% 2000-12-06     Abraham vd Merwe
%    - added more smiley DFA rules
%    - added DFA rules for expressions (*sigh*, etc.)
%    - now display hotkeys when hotkey shortcut is pressed (Ctrl-C)
%    - disabled bracket matching
%
% 2000-11-23     Abraham vd Merwe
%    - changed the email DFA regex to comply to RFC 822
%    - rearranged all the rules to try and avoid the DFA bug,
%      but it doesn't seem to work
%
% 2000-11-21     Abraham vd Merwe
%    - sorted out the save_buffers() mystery
%
% 2000-11-20     Abraham vd Merwe
%    - cleaned up the code
%    - made the mode compatible with jed 0.99.12
%    - changed code not to save the buffers when we're finished since it
%      breaks in the new jed. i might put this back when i've sorted it out
%    - fixed DFA syntax highlighting and added loads of extra rules
%    - added custom color definitions for this mode
%
% 2000-10-11     Abraham vd Merwe
%    - changed cut_signature to only cut stuff on the same level
%      of indenting, thus avoiding cutting replies below uncut
%      signatures
%
% 2000-09-29     Abraham vd Merwe
%    - changed pipe_cmd_to_buffer to include the command issued
%      and automatically put output in snip tags
%
% 2000-09-28     Abraham vd Merwe
%    - fixed the header scanning routines
%    - added DFA syntax highlighting for url's and email addys
%    - fixed bug in cut_signature
%    - wrote cut_empty_tags
%    - added top_view
%    - added pipe_cmd_to_buffer
%    - changed reply mode to NOT put in the extra spaces below the greeting
%      since you rarely just start typing when replying to messages
%    - added the X-Edited-With-Muttmode scheme to disable message processing
%      on multiple edit's
%
% 2000-09-27     Abraham vd Merwe
%    - removed all previous comments and reformatted the code
%    - wrote cut_signature, cut_greeting and cut_auto_reply_string
%    - add help function for hotkeys
%    - various bugfixes to existing code
%    - changed dequote_buffer to remove the space after the quote
%
% 2001-06-06     Johann Botha
%    - Updated for use with Jed 0.99.14
%    - Changed function names to dfa_*
%    - Used "dfa_set_init_callback", as the new jed supports
%      enabling DFA per mode and not globally.
%    - Use something like enable_dfa_syntax_for_mode ("muttmail"); in /etc/jed.conf
%    - Moved color variables into the setup_dfa_callback function
%
% 2001-09-21     Abraham vd Merwe
%    - Got rid of $1 (dangerous)
%    - replaced the predefined color keywords with language dependant ones
%    - force DFA for this mode (it's useless without it anyway)
%    - Changed cut_greeting() to keep the text after the greeting (if any)
%
% 2001-09-27     Abraham vd Merwe
%    - Added "Yo" as a greeting and I cut the entire greeting line if there
%      are less than mail_greeting_threshold words on the line
%    - Changed some things to static to avoid polluting the namespace too
%      much.
%
% 2001-10-27     Abraham vd Merwe
%    - Added "Dear" as a greeting

%_debug_info = 1;
%_traceback = 1;

static variable muttmail = "muttmail";

create_syntax_table (muttmail);

!if (keymap_p (muttmail)) make_keymap (muttmail);

% Do we recognize mbox style "From " lines as headers?
static variable mail_mode_have_mbox = 1;
static variable mail_maybe_header = 1;
static variable Shell_Last_Shell_Command = Null_String;
static variable muttmode_version = "muttmail.sl - 2001-09-27";
static variable mail_greeting_threshold = 2;

% disable bracket matching
BLINK = 0;

create_syntax_table (muttmail);

define_syntax ("([{",")]}",'(',muttmail);			% parentheses
define_syntax ("-0-9a-zA-Z_",'w',muttmail);		% words
define_syntax ("-+0-9",'0',muttmail);				% numbers
define_syntax (",;:",',',muttmail);				% delimiters
define_syntax ("%-+/&*=<>|!~^",'+',muttmail);		% operators

static variable bg = "black";

set_color ("keyword1","green",bg);
set_color ("keyword2","brightcyan",bg);
set_color ("keyword3","cyan",bg);
set_color ("keyword4","brightblue",bg);
set_color ("keyword5","brightred",bg);
set_color ("keyword6","brown",bg);
set_color ("keyword7","yellow",bg);

#ifdef HAS_DFA_SYNTAX
%%% DFA_CACHE_BEGIN %%%
static define setup_dfa_callback (name)
{ 
   variable color_from = "keyword1";
   variable color_to = "keyword7";
   variable color_subject = "keyword2";
   variable color_header = "keyword3";
   variable color_url = "keyword3";
   variable color_signature = "keyword3";
   variable color_email = "keyword1";
   variable color_reply = "keyword4";
   variable color_smiley = "keyword5";
   variable color_snip = "keyword6";
   variable color_line = "keyword1";

   %use_dfa_syntax (1);
   %enable_dfa_syntax_for_mode(name);
   
   dfa_enable_highlight_cache ("muttmail.dfa",name);
   
   dfa_define_highlight_rule ("^To: .*",color_to,name);
   dfa_define_highlight_rule ("^Cc: .*",color_header,name);
   dfa_define_highlight_rule ("^Bcc: .*",color_header,name);
   dfa_define_highlight_rule ("^Date: .*",color_header,name);
   dfa_define_highlight_rule ("^From: .*",color_from,name);
   dfa_define_highlight_rule ("^Subject: .*",color_subject,name);
   dfa_define_highlight_rule ("^(Reply-To|X-Uptime): .*",color_header,name);
   dfa_define_highlight_rule ("^(Message-ID|User-Agent): .*",color_header,name);
   dfa_define_highlight_rule ("^In-Reply-To: .*",color_header,name);
   dfa_define_highlight_rule ("^Organization: .*",color_header,name);
   dfa_define_highlight_rule ("^X-GPG-Public-Key: .*",color_header,name);
   dfa_define_highlight_rule ("^X-Operating-System: .*",color_header,name);
   dfa_define_highlight_rule ("^X-Edited-With-Muttmode: .*",color_header,name);
   
   dfa_define_highlight_rule ("[\\(\\)]+-?[:;P\\^]|[:;P\\^]-?[\\(\\)]+",color_smiley,name);
   dfa_define_highlight_rule ("([Hh]+[AaEe]+[Hh]+)+([AaEe]+[Hh]+)*[AaEe]*",color_smiley,name);
   dfa_define_highlight_rule ("[Bb](([Uu]+|[Aa]+)([Hh]+[Aa]+)+|[Aa][Aa]+)",color_smiley,name);
   dfa_define_highlight_rule ("\\*([A-Za-z]+\\.)*[A-Za-z]+\\*|<+[Ee]?[Gg]>+",color_smiley,name);
   
   dfa_define_highlight_rule ("(http|ftp|file|https)://[^ \t\n>]+",color_url,name);
   
   dfa_define_highlight_rule ("[\\-A-Za-z0-9_\\.]+@[A-Za-z]([\\-A-Za-z0-9]*[A-Za-z0-9])?(\\.[A-Za-z]([\\-A-Za-z0-9]*[A-Za-z0-9])?)*",color_email,name);
   
   dfa_define_highlight_rule ("^--",color_signature,name);
   dfa_define_highlight_rule ("^>.*",color_reply,name);
   
   dfa_define_highlight_rule ("___+",color_line,name);
   
   dfa_define_highlight_rule ("^--.*--$",color_snip,name);
   
   dfa_build_highlight_table (name);
}
dfa_set_init_callback (&setup_dfa_callback, "muttmail");
%%% DFA_CACHE_END %%%
#endif

static define skip_header ()
{
   while (not (re_looking_at ("^[ \t]*$"))) !if (down_1 ()) break;
}

static define top_view ()
{
   recenter (what_line ());
}

static define has_been_edited ()
{
   variable result;
   push_spot ();
   bob ();
   result = bol_fsearch ("X-Edited-With-Muttmode: ");
   pop_spot ();
   return (result);
}

static define mark_as_edited ()
{
   push_spot ();
   bob ();
   skip_header ();
   insert (sprintf ("X-Edited-With-Muttmode: %s\n",muttmode_version));
   pop_spot ();
}

static define bol_skip_tags (ntags)
{
   variable col = 0;
   variable n = 0;
   bol ();
   while (looking_at_char ('>') or looking_at_char (' ') or looking_at_char ('\t'))
	 {
		if (looking_at_char ('>'))
		  {
			 if (n == ntags) break;
			 n++;
			 col = what_column ();
		  }
		!if (right (1)) break;
	 }
   goto_column (col);
   if (looking_at_char ('>')) go_right_1 ();
}

static define count_tags ()
{
   variable n = 0;
   push_spot ();
   bol ();
   while (looking_at_char ('>') or looking_at_char (' ') or looking_at_char ('\t'))
	 {
		if (looking_at_char ('>')) n++;
		!if (right (1)) break;
	 }
   pop_spot ();
   return (n);
}

static define bol_skip_all_tags ()
{
   bol_skip_tags (count_tags ());
}

static define skip_empty_tags ()
{
   forever
	 {
		bol_skip_all_tags ();
		skip_white ();
		if (looking_at_char ('\n'))
		  {
			 !if (down_1 ()) break;
		  }
		else break;
	 }
   bol ();
}

static define skip_empty_tags_upwards ()
{
   forever
	 {
		bol_skip_all_tags ();
		skip_white ();
		if (looking_at_char ('\n'))
		  {
			 !if (up_1 ()) break;
		  }
		else break;
	 }
   bol ();
}

static define cut_auto_reply_string ()
{
   push_spot ();
   while (not (re_looking_at ("^>+"))) !if (down_1 ())
	 {
		pop_spot ();
		return;
	 }
   push_mark ();
   bol_skip_all_tags ();
   skip_white ();
   !if (re_looking_at ("^[Oo][Nn].*[Ww][Rr][Oo][Tt][Ee]"))
	 {
		pop_mark (1);
		return;
	 }
   go_down_1 ();
   bol ();
   skip_empty_tags ();
   del_region ();
   pop_spot ();
   go_down_1 ();
}

static define count_words ()
{
   variable n = 0;
   push_spot ();
   while (not eolp ())
	 {
		n++;
		re_fsearch ("[\t\n ]");
		skip_white ();
	 }
   pop_spot ();
   return (n);
}

static define cut_greeting ()
{
   push_spot ();
   while (not (re_looking_at ("^>+"))) !if (down_1 ())
	 {
		pop_spot ();
		return;
	 }
   push_mark ();
   bol_skip_all_tags ();
   skip_white ();
   !if (re_looking_at ("^[Hh][Ii]+") or
		re_looking_at ("^[Hh]+[AEae]+[Ll]+[Oo]+") or
		re_looking_at ("^[Hh][Oo]+[Ww]+[Dd][Yy]+") or
		re_looking_at ("^[Dd][Ee][Aa][Rr]") or
		re_looking_at ("^[Yy][Oo]+"))
	 {
		pop_mark (1);
		return;
	 }
   if (count_words () < mail_greeting_threshold)
	 {
		bol ();
		go_down_1 ();
		del_region ();
	 }
   else
	 {
		re_fsearch ("[\t\n ]");
		skip_white ();
		if (looking_at ("\n"))
		  {
			 go_down_1 ();
			 bol ();
			 skip_empty_tags ();
			 del_region ();
		  }
		else
		  {
			 del_region ();
			 insert ("> ");
		  }
	 }
   pop_spot ();
}

static define cut_empty_tags ()
{
   push_spot ();
   while (not (re_looking_at ("^>+"))) !if (down_1 ())
	 {
		pop_spot ();
		return;
	 }
   push_mark ();
   bol ();
   skip_empty_tags ();
   del_region ();
   pop_spot ();
}

static define maybe_signature ()
{
   variable a,b;
   push_spot ();
   bol_skip_all_tags ();
   skip_white ();
   !if (re_looking_at ("--[ \t]*$"))
	 {
		pop_spot ();
		return 0;
	 }
   right (2);
   skip_white ();
   eolp ();
   pop_spot ();
}

static define cut_signature ()
{
   variable n;
   push_spot ();
   while (not (re_looking_at ("^>+"))) !if (down_1 ())
	 {
		pop_spot ();
		return;
	 }
   forever
	 {
		!if (count_tags ())
		  {
			 pop_spot ();
			 return;
		  }
		bol_skip_all_tags ();
		skip_white ();
		if (re_looking_at ("--[ \t]*$"))
		  break;
		else
		  {
			 !if (down_1 ())
			   {
				  pop_spot ();
				  return;
			   }
		  }
	 }
   n = count_tags ();
   bol ();
   push_mark ();
   go_down_1 ();
   while (count_tags () == n) !if (down_1 ()) break;
   forever
	 {
		skip_white ();
		if (eolp ())
		  {
			 !if (down_1 ()) break;
		  }
		else break;
	 }
   bol ();
   del_region ();
   push_mark ();
   go_up_1 ();
   skip_empty_tags_upwards ();
   go_down_1 ();
   del_region ();
   insert ("\n");
   pop_spot ();
}

static define dequote_buffer (ntags)
{
   variable n = count_tags ();
   push_spot ();
   bob ();
   forever
	 {
		bol ();
		push_mark ();
		bol_skip_tags (ntags);
		% uncomment the following line if you prefer the space
		if (looking_at_char (' ')) go_right_1 ();
		if (ntags < n) skip_white ();
		del_region ();
		!if (down_1 ()) break;
	 }
   pop_spot ();
}

static define requote_buffer (ntags)
{
   variable i;
   push_spot ();
   bob ();
   forever
	 {
		bol ();
		for(i = 0; i < ntags; i++) insert("> ");
		!if (down_1 ()) break;
	 }
   pop_spot ();
}

static define empty_quoted_line ()
{
   push_spot ();
   bol ();
   while (looking_at_char ('>') or looking_at_char (' ') or looking_at_char ('\t'))
	 {
		if (not (right (1))) break;
	 }
   skip_white ();
   eolp ();
   pop_spot ();
}

static define mail_is_tag ()
{
   push_spot ();
   bol ();
   (mail_mode_have_mbox and bobp () and looking_at ("From ")) or (1 == re_looking_at ("^[A-Za-z][^: ]*:"));
   pop_spot ();
}

static define mail_have_header ()
{
   push_spot ();
   bob ();
   mail_is_tag ();
   pop_spot ();
}

static define mail_is_body ()
{
   !if (mail_maybe_header) return 1;
   !if (mail_have_header ()) return 1;
   push_spot ();
   re_bsearch ("^$");
   pop_spot ();
}

static define mail_is_header_tag ()
{
   if (mail_is_body ()) return 0;
   return (mail_is_tag ());
}

define mail_parsep ()
{
   push_spot ();
   bol ();
   if (not (mail_is_body ()))
	 {
		(mail_is_header_tag () or (skip_white (),eolp ()));
	 }
   else
	 {
		(maybe_signature () or (skip_white (),eolp ()) or empty_quoted_line ());
	 }
   pop_spot ();
}

static define mail_backward_paragraph ()
{
   variable n;
   if (mail_parsep ()) return;
   n = count_tags ();
   while (not (mail_parsep ()) and (count_tags () == n))
	 {
		!if (up_1 ()) break;
	 }
   bol ();
}

static define mail_forward_paragraph ()
{
   variable n;
   if (mail_parsep ()) return;
   n = count_tags ();
   while (not (mail_parsep ()) and (count_tags () == n))
	 {
		!if(down_1 ()) break;
	 }
   bol ();
}

static define mail_begin_of_paragraph ()
{
   mail_backward_paragraph ();
   !if (bobp ()) go_down_1 ();
}

static define mail_select_paragraph ()
{
   if (mail_parsep ())
	 {
		push_mark ();
		return;
	 }
   mail_begin_of_paragraph ();
   push_mark ();
   mail_forward_paragraph ();
   eol ();
   !if (eobp ()) go_up_1 ();
   eol ();
}

define dequote ()
{
   push_spot ();
   !if (markp ()) mail_select_paragraph ();
   narrow ();
   dequote_buffer (1);
   widen ();
   pop_spot ();
}

define requote ()
{
   push_spot ();
   !if (markp ()) mail_select_paragraph ();
   narrow ();
   requote_buffer (1);
   widen ();
   pop_spot ();
}

static define mail_fix_quotes ()
{
   variable l,m;
   push_spot ();
   bob ();
   while (not (mail_is_body ()))
	 {
		if (not (down_1 ())) break;
	 }
   if (not (mail_is_body ()))
	 {
		pop_spot ();
		return;
	 }
   % pass 1: pull quote tags together.
   push_spot ();
   forever
	 {
		bol ();
		if (empty_quoted_line ())
		  {
			 while (not (eolp ())) del ();
		  }
		while (looking_at (">>"))
		  {
			 if (not (right (1))) break;
		  }
		if (looking_at ("> >"))
		  {
			 del ();
			 del ();
			 del ();
			 insert (">>");
		  }
		else
		  {
			 if (not (down_1 ())) break;
		  }
	 }
   pop_spot ();
   % pass 2: insert correct paragraph separators.
   m = -1;
   forever
	 {
		l = m;
		if (mail_parsep ()) m = -1; else m = count_tags ();
		!if (mail_parsep ())
		  {
			 if ((m != -1) and (l != -1) and (m != l))
			   {
				  bol ();
				  push_spot ();
				  insert ("\n");
				  pop_spot ();
				  go_down_1 ();
			   }
		  }
		!if (down_1 ()) break;
	 }
   pop_spot ();
}

static define reformat_header ()
{
   push_spot ();
   while (not (mail_is_header_tag ()))
	 {
		!if(up_1 ()) break;
	 }
   if (not (mail_is_header_tag ()))
	 {
		pop_spot ();
		return;
	 }
   bol ();
   while (not (looking_at (":"))) go_right_1 ();
   go_right_1 ();
   push_spot ();
   insert ("\n");
   bol_trim ();
   bol ();
   insert (" ");
   call ("format_paragraph");
   pop_spot ();
   del ();
   pop_spot ();
}

static define reformat_quote ()
{
   variable n,o,l1,l2;
   n = count_tags ();
   o = mail_maybe_header;
   l1 = 0;
   l2 = 0;
   mail_maybe_header = 0;
   push_spot ();
   !if (markp ())
	 {
		push_spot ();
		mail_begin_of_paragraph ();
		l1 = what_line ();
		pop_spot ();
		l2 = what_line ();
		mail_select_paragraph ();
	 }
   narrow ();
   dequote_buffer (n);
   bob ();
   down (l2 - l1);
   call ("format_paragraph");
   requote_buffer (n);
   widen ();
   mail_maybe_header = o;
   pop_spot ();
}

static define mail_indent_calculate ()
{
   variable col = 0;
   push_spot_bol ();
   !if (re_bsearch ("[^ \t\n]"))
	 {
		pop_spot ();
		return col;
	 }
   bol_skip_white ();
   col = what_column () - 1;
   pop_spot ();
   return col;
}

define mail_indent_line ()
{
   variable col;
   push_spot ();
   col = mail_indent_calculate ();
   if (not (mail_is_body ()))
	 {
		if (mail_is_header_tag ())
		  col = 0;
		else
		  {
			 if (col == 0) col = 1;
		  }
	 }
   bol_trim ();
   whitespace (col);
   pop_spot ();
}

define mail_reformat ()
{
   if (mail_is_body ()) reformat_quote (); else reformat_header ();
}

define insnip ()
{
   insert ("------------< snip <------< snip <------< snip <------------\n");
%   insert ("------------8<------------< snip >------------8<------------\n");
}

define pipe_cmd_to_buffer ()
{
   variable cmd,dir,msg = "opening pipe...";
   cmd = read_mini ("Shell Command:",Null_String,Shell_Last_Shell_Command);
   !if (strlen (cmd)) return;
   Shell_Last_Shell_Command = cmd;
   flush (msg);
   insnip ();
   run_shell_cmd (sprintf ("echo $USER@$HOSTNAME:~$ %s",Shell_Last_Shell_Command));
   run_shell_cmd (sprintf ("(%s) 2>&1 < /dev/null",Shell_Last_Shell_Command));
   insnip ();
   flush (strcat (msg,"done"));
}

static define mail_read_key (help)
{
   variable key;
   !if (input_pending (3)) flush (help);
   tolower (getkey ());
}

define mail_keymap ()
{
   variable key = mail_read_key ("Reformat[^f] Quote[\\eq] Unquote[^q] Snip[^s] Command[\\es]");
   switch (key)
	 { case 'r': mail_reformat (); }
	 { case 'q': requote (); }
	 { case 'u': dequote (); }
	 { case 's': insnip (); }
     { case 'c': pipe_cmd_to_buffer (); }
   flush ("");
}

define mail_mode ()
{
   no_mode ();
   set_mode (muttmail,1);
   use_keymap (muttmail);
   use_syntax_table (muttmail);
   local_setkey ("mail_reformat","^f");
   local_setkey ("dequote","^q");
   local_setkey ("requote","\eq");
   local_setkey ("insnip","^S");
   local_setkey ("mail_keymap","^c");
   local_setkey ("pipe_cmd_to_buffer","\es");
   if (is_defined ("Edt_Keypad"))
	 {
		local_setkey ("mail_reformat","\eOP\eOx");
		local_setkey ("dequote","\eOP<");
		local_setkey ("requote","\eOP>");
	 }
   set_buffer_hook ("par_sep","mail_parsep");
   set_buffer_hook ("indent_hook","mail_indent_line");
   runhooks ("text_mode_hook");
   runhooks ("mail_mode_hook");
   skip_header ();
   !if (has_been_edited ())
	 {
		while (re_looking_at ("^[ \t]*$")) !if (down_1 ()) break;
		!if (re_looking_at ("^Hi"))
		  {
			 go_up_1 ();
			 insert ("Hi!\n\n\n");
			 go_up_1 ();
		  }
		else
		  {
			 cut_signature ();
			 go_down_1 ();
			 cut_auto_reply_string ();
			 cut_greeting ();
			 cut_empty_tags ();
		  }
		mark_as_edited ();
	 }
   else go_down (2);
   top_view ();
   save_buffers ();
   enable_dfa_syntax_for_mode (muttmail);
}