% -*- SLang -*-

_debug_info = 1;

% mail_mode.sl
%
% This is an almost complete rewrite of 
% Ulli "Framstag" Horlacher's <framstag@belwue.de>
% mail_mode for jed.
%
% Thomas Roessler <roessler@does-not-exist.org>
% Fri Aug 11 20:15:01 CEST 2006
%
% Added wrap_hook to make this work with jed 0.99.18.  Yes, I
% am using code for more than 7 years without changing it.
%
% Thomas Roessler <roessler@guug.de>
% Thu Jun 10 00:11:45 MEST 1999
%
% This version was adapted to jed 0.99.6.
%
% (Thanks to John Davis himself.)
% 
% 
% 1999-10-26	Framstag
%	added EDT-support, again
%	added better documentation
%
% Todo: Work with prefix strings instead of tag counts,
% so different sequences of tag chars are actually recognized
% to separate paragraphs.
%
%
% This file is under the GNU Public Licence copyright.
%
%
% mail_mode.sl implements a mail mode that is useful for editing mail/news.
% To invoke, add this line to $JED_ROOT/lib/defaults.sl or $HOME/.jedrc :
%
%	autoload("mail_mode","mail_mode");
%
% Optionally, set your favourite colours by adding this function to
% $JED_ROOT/lib/jed.rc or $HOME/.jedrc :
%
%	define mail_mode_hook() {
%         % "comment" will be used for quoted lines
%         % "string" will be used for header lines
%         % "preprocess" will be used for signatures
%	  if (USE_ANSI_COLORS) {
%	    if (getenv("DISPLAY") == NULL) {
%            % colors for text conxole
%	     set_color("comment",   "green","black");
%	     set_color("string",    "blue", "black");
%	     set_color("preprocess","grey", "black");
%	  } else {
%            % colors for X11
%	     set_color("comment",   "green","white");
%	     set_color("string",    "blue", "white");
%	     set_color("preprocess","grey", "white");
%	  }	   
%	}
%
%
% "comment" will be used for quoted lines
% "string" will be used for header lines
% "preprocess" will be used for signatures
%
% to invoke mail_mode automatically, you can add the following
%   in $HOME/.elm/elmrc (if you use elm):
%	editor = jed %s -tmp -f mail_mode
%   in $HOME/.muttrc (if you use mutt):
%	set editor="jed %s -tmp -f mail_mode"
%   in $HOME/.tin/tinrc (if you use tin):
%	default_editor_format=jed %F -g %N -tmp -f mail_mode
%   in $HOME/.slrnrc (if you use slrn):
%	set editor_command "jed --score-arrange-score %s -g %d -tmp --mail-mode"
%
%
% When mail_mode() is activated you have the following new functions:
% 
% - reformat_quote()
%   This function reformates the current `>' quoted paragraph. Usefull if you
%   have too long lines or if you want to edit the quoted paragraph.
%   It is bound to the key sequences Esc q and PF1 KP8 .
% 
% - dequote()
%   This function removes one level of quoting with `>' from a paragraph
%   or a marked block.
%   It is bound to the key sequences Ctrl-C < and PF1 < .
% 
% - requote()
%   This function quotes the current paragraph with `>'
%   or a marked block.
%   It is bound to the key sequences Ctrl-C > and PF1 > .
% 
% - dequote_buffer(number, flag)
%   Removes number of quotelevels for the whole buffer.
% 
% - requote_buffer(number)
%   Adds number of quotelevels for the whole buffer.
%
% - header editing
%   You get some support with message header editing.  More precisely,
%   mail_mode can jump to existing headers and - when necessary - insert 
%   the header tags for you.
%
%   Key bindings:
%	^Cf	From:
%	^Ct	To:
%	^Cc	Cc:
% 	^Cb	Bcc:
% 	^Cs	Subject:
%	^Cr	Reply-To:
%	^CF	Followup-To:
%	^Cn	Newsgroups:
%
% - signature editing
%
%   You can just press ^C- to jump into the message's .signature, or
%   to create a new one.
%
%   
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


% Do we recognize mbox style "From " lines as headers?
variable mail_mode_have_mbox = 1;
variable mail_maybe_header = 1;

variable mail_is_flowed = 0;

% Quote tag characters.
variable mail_mode_quote_chars = ">|:";

create_syntax_table("Mail");

set_syntax_flags ("Mail", 2);
set_fortran_comment_chars ("Mail", mail_mode_quote_chars);


%%%%% PROTOTYPES

define dequote();
define dequote_buffer (ntags, remove_whitespace);
define mail_backward_paragraph();
define mail_forward_paragraph();
define mail_indent_calculate();
define mail_indent_line();
define mail_mode();
define mail_recenter();
define mail_reformat();
define mail_select_paragraph();
define mail_update_hook();
define mail_update_marks();
define mail_update_partial ();
define mail_flow();
define reformat_header();
define reformat_quote();
define requote();
define requote_buffer(ntags);
static define bol_skip_all_tags();
static define bol_skip_tags (ntags);
static define count_tags();
static define empty_quoted_line();
static define looking_at_quote_char ();
static define mail_determine_color (nstr, body_hint, quote_hint);
static define mail_fix_mark (nstr, n, level);
static define mail_have_header();
static define mail_is_body();
static define mail_is_header_tag();
static define mail_is_tag();
static define mail_line_key (n);
static define mail_parsep();
static define maybe_signature (skip_tags);


define bol_maybe_skip_white ()
{
  if (mail_is_flowed)
    bol();
  else
    bol_skip_white();
}

define maybe_skip_white()
{
  !if (mail_is_flowed)
    skip_white();
}

% generate a key to be used with our associative buffers.

static define mail_line_key (n)
{
  return strcat (whatbuf(), strcat (":", string (n)));
}

% Are we looking at a quote mark?
static define looking_at_quote_char ()
{
  is_substr (mail_mode_quote_chars, char (what_char ()));
}

% Go to the beginning of the line, skip whitespace,
% and then skip n levels of quotes.

static define bol_skip_tags (ntags)
{
  variable col = 0;
  variable n = 0;

  bol_maybe_skip_white ();

  while (looking_at_quote_char () and not eolp())
  {
    if (n == ntags)
      return;
    go_right_1 ();
    n++;
    maybe_skip_white ();
  }
  bskip_white ();
}

% count leading quote tags

static define count_tags()
{
  variable n = 0;
  
  push_spot();
  bol_maybe_skip_white ();
  while (looking_at_quote_char () and not eolp())
  {
    n++;
    go_right_1 ();
    maybe_skip_white ();
  }
  pop_spot();
  return n;
}

% Go to the first non-quote character on a line.

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

% remove a certain number of tags from a buffer.

define dequote_buffer (ntags, remove_whitespace)
{
  variable n;

  push_spot();
  bob();
  
  do
  {
    n = count_tags ();
    push_mark();
    bol_skip_tags (ntags);
    if (ntags < n)
      maybe_skip_white();
    del_region();
  }
  while (down_1 ());

  if (remove_whitespace and not mail_is_flowed)
  {
    bob();
    n = -1;
    do 
    {
      bol_skip_white ();
      if ((n == -1) or (what_column () < n))
	n = what_column ();
    }
    while (down_1 ());
    
    n--;
    bob ();
    
    do 
    {
      bol ();
      push_mark ();
      go_right (n);
      del_region ();
    }
    while (down_1 ());
  }

  pop_spot();
}

define requote_buffer(ntags)
{
   variable tags;
   push_spot();
   bob();
   
  tags = "";
  loop (ntags) tags = strcat (tags, ">");
  do
  {
    insert (tags);
  }
  while (down_1 ());
  pop_spot();
}

static define empty_quoted_line()
{
   push_spot();

   bol();
   skip_chars (strcat (mail_mode_quote_chars + " \t"));
   eolp();

   pop_spot();
}


static define mail_is_tag()
{
   push_spot();
   EXIT_BLOCK
     {
	pop_spot();
     }

   bol();

   if (mail_mode_have_mbox and bobp() and looking_at("From "))
     return 1;

   % Simulate re_looking_at("^[A-Za-z][^: ]*:") the hard way

   skip_chars ("A-Za-z");
   if (bolp ())
     return 0;
   skip_chars ("^: ");
   looking_at (":");
}

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();
  bol_bsearch ("\n"); % re_bsearch("^$");
  pop_spot();
}

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

static define maybe_signature (skip_tags)
{
  
  push_spot();

  if (skip_tags)
  {
    bol_skip_all_tags();
    skip_white();
  }
  else
     bol(); 
   
  !if(looking_at("--"))
  {
    pop_spot();
    return 0;
  }

  go_right (2);
  skip_white();
  eolp();
  pop_spot();
}

static define mail_parsep()
{
  push_spot();

  bol();
  if(not (mail_is_body()))
  {
    (mail_is_header_tag() or
     (skip_white(), eolp()));
  }
  else
  {
    bol_skip_all_tags();
    (maybe_signature(1) or
     (skip_white(), eolp()) or
     empty_quoted_line()
     );
  }

  pop_spot();
}

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;
  }
  !if (bobp ())
    go_down (1);
  bol();
}

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();
}

define mail_select_paragraph()
{
  if(mail_parsep())
  {
    push_mark();
    return;
  }

  mail_backward_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, 1);
  widen();
  mail_update_partial();
  pop_spot();
}
  
define requote()
{
  push_spot();
  
  !if(markp())
    mail_select_paragraph();

  narrow();
  requote_buffer(1);
  widen();
  mail_update_partial();
  pop_spot();
}

define reformat_header()
{
  variable old_wrap;

  push_spot();
  
  while(not(mail_is_header_tag()))
  {
    !if(up_1()) break;
  }
  
  if(not(mail_is_header_tag()))
  {
    pop_spot();
    return;
  }

  old_wrap = WRAP;
  WRAP -= 15;
  
  if (WRAP < old_wrap / 2)
    WRAP = old_wrap / 2;
  
  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();

  WRAP = old_wrap;
  
  pop_spot();
  mail_update_partial ();
}

static define restuff_buffer ()
{
  push_spot ();

  bob ();
  do 
  {
    bol();
    push_spot ();
    !if (mail_parsep())
    {
      if (up_1())
      {
	eol();
	insert_char (' ');
      }
    }
    pop_spot ();
    if (looking_at ("From "))
      insert_char (' ');
    else if (looking_at (">"))
      insert_char (' ');
    else if (looking_at (" "))
      insert_char (' ');
  }
  while (down_1());

  pop_spot ();
}

static define destuff_buffer()
{
  push_spot ();
  bob();
  
  do
  {
    bol();
    if (looking_at_char (' '))
      del();
  }
  while (down_1());
  pop_spot ();
}
  
define reformat_quote()
{
  variable n;
  variable o;

  variable l1, l2;

  variable old_wrap;
  
  n = count_tags();
  o = mail_maybe_header;

  l1 = 0; l2 = 0;
  
  mail_maybe_header = 0;
  
  push_spot();
  
  !if(markp())
  {
    push_spot();
    mail_backward_paragraph();
    l1 = what_line();
    pop_spot();
    l2 = what_line();

    mail_select_paragraph();
  }

  narrow();
  dequote_buffer(n, 0);
  
  if (mail_is_flowed)
    destuff_buffer();
  
  bob();
  go_down(l2 - l1);

  old_wrap = WRAP;
  WRAP -= n * 2;
  
  if (WRAP < old_wrap / 2)
    WRAP = old_wrap / 2;

  call("format_paragraph");

  WRAP = old_wrap;

  if (mail_is_flowed)
    restuff_buffer();
  
  requote_buffer(n);
  widen();

  mail_maybe_header = o;
  
  pop_spot();
}

define mail_indent_calculate()
{
  variable col = 0;

  push_spot_bol();
  EXIT_BLOCK {
    pop_spot ();
  }

  go_up (1);
  bol ();

  !if (mail_is_flowed and (looking_at (" From ") or
	looking_at (" >")))
    skip_white();
    
  col = what_column() - 1;
  return col;
}

define mail_indent_line()
{
  variable col;
  variable b;

  push_spot ();
  col = mail_indent_calculate();
  b = mail_is_body ();

  if(b == 0)
  {
    if(mail_is_header_tag())
      col = 0;
    else
    {
      if(col == 0)
	col = 1;
    }
  }

%  error ("in mail_indent_line()");
  
  bol_trim();
  whitespace(col);
  
  pop_spot ();
  skip_white ();

  if (b == 0)
    mail_update_partial ();
  
}

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

variable Line_Mark = Assoc_Type[Mark_Type];

define mail_update_marks()
{
  variable n;
  variable nstr;
  variable body = 0;

  push_spot ();

  bob();
  do
  {
    !if (body)
      body = mail_is_body ();
    
    n = what_line ();
    nstr = mail_line_key (n);
    if (USE_ANSI_COLORS) mail_determine_color (nstr, body, -1);
  }
  while (down_1 ());

  pop_spot();
}

static define mail_determine_color (nstr, body_hint, quote_hint)
{
  push_spot ();
  bol ();

  if (body_hint < 0)
    body_hint = mail_is_body ();

  !if (body_hint)
  {
    pop_spot ();
    Line_Mark[nstr] = create_line_mark (color_number ("string"));
    return;
  }
  
%  if (quote_hint < 0)
%    quote_hint = looking_at_quote_char ();
%
%  if (quote_hint)
%  {
%    pop_spot ();
%    Line_Mark[nstr] = create_line_mark (color_number ("comment"));
%    return;
%  }

  if (maybe_signature(0))
  {
    pop_spot ();
    Line_Mark[nstr] = create_line_mark (color_number ("preprocess"));
    return;
  }
  else
  {
    loop (4)
    {
      !if (up (1))
	break;

      bol();
      if (maybe_signature(0))
      {
	pop_spot ();
	Line_Mark[nstr] = create_line_mark (color_number ("preprocess"));
	return;
      }
    }
  }

  pop_spot ();
%  Line_Mark[nstr] = create_line_mark (color_number ("normal"));

  assoc_delete_key (Line_Mark, nstr);
}

static define mail_fix_mark (nstr, n, level)
{
  variable mark;
  variable key;
  variable m;
  variable r = 0;

  if (level > 100)	% fall back to complete refresh in
    			% order to avoid stack overflows.
  {
    return 1;
  }
  else if (assoc_key_exists (Line_Mark, nstr))
  {
    push_spot ();
    mark = Line_Mark[nstr];
    
    goto_user_mark (mark);
    m = what_line ();
    key = mail_line_key (m);

    !if (m == n)
    {
      assoc_delete_key (Line_Mark, nstr);
      r = mail_fix_mark (key, m, level + 1);
    }
    mark = NULL;
    pop_spot ();
  }

  if (r == 0)
  {
    assoc_delete_key (Line_Mark, nstr);
    if (USE_ANSI_COLORS) mail_determine_color (nstr, -1, -1);
  }

  return r;
}

define mail_update_hook()
{ 
  variable nstr;
  variable n;

  n = what_line ();
  nstr = mail_line_key (n);

  if (mail_fix_mark(nstr, n, 0) == 1)
    mail_update_marks ();
}

define mail_update_partial ()
{
  variable count;

  push_spot ();
  
  !if (up(SCREEN_HEIGHT)) bob ();
  
  count = SCREEN_HEIGHT * 2;
  
  loop (count)
  {
    mail_update_hook ();
    !if (down (1))
      break;
  }
  
  pop_spot ();
}

define mail_recenter()
{
  recenter (0);
  mail_update_partial ();
}

define mail_edit_header(tag)
{
  variable found = 0;
  variable pattern;
  
  pattern = sprintf ("^%s:", tag, 2);

  !if (mail_maybe_header)
  {
    error ("Header editing disabled!");
    return;
  }
  
  bob ();
  if (re_fsearch (pattern))
  {
    !if (mail_is_body())
    {
      found = 1;
      () = re_fsearch (":");
      go_right_1();
      skip_white();
    }
  }
  
  !if (found)
  {
    bob ();
    insert ("\n");
    bob ();
    insert (tag);
    insert (": ");
    mail_update_partial ();
  }
}

define mail_edit_subject ()
{
  mail_edit_header("Subject");
}

define mail_edit_cc ()
{
  mail_edit_header ("Cc");
}

define mail_edit_to ()
{
  mail_edit_header ("To");
}

define mail_edit_bcc ()
{
  mail_edit_header ("Bcc");
}

define mail_edit_from ()
{
  mail_edit_header ("From");
}

define mail_edit_replyto ()
{
  mail_edit_header ("Reply-To");
}

define mail_edit_followup ()
{
  mail_edit_header ("Followup-To");
}

define mail_edit_newsgroups ()
{
  mail_edit_header ("Newsgroups");
}

define mail_edit_signature ()
{
  eob ();
  !if (re_bsearch("^-- $"))
  {
    insert ("\n-- \n");
    mail_update_partial ();
  }
  else
    go_down_1();
}

%!%S-Lang user function (0 args)
%!%This function actives the mail mode for the current buffer, which is:
%!% - text mode
%!% - highlight quotes
%!% - enable quote paragraph reformating
define mail_mode()
{
  variable km = "mail_map";
  variable buf = "*mail*";
  
  no_mode();
  set_mode("Mail", 1);
  use_syntax_table("Mail");

  !if (strcmp(buf,whatbuf)) 
  {
    if (keymap_p(km)) 
      use_keymap(km);
  }

  local_setkey("mail_reformat", "\eq");

  % somewhat meaningful bindings
  local_setkey("dequote","^C<");
  local_setkey("requote","^C>");

  local_setkey("mail_edit_cc", "^Cc");
  local_setkey("mail_edit_to", "^Ct");
  local_setkey("mail_edit_bcc", "^Cb");
  local_setkey("mail_edit_subject", "^Cs");
  local_setkey("mail_edit_from", "^Cf");
  local_setkey("mail_edit_replyto", "^Cr");
  local_setkey("mail_edit_followup", "^CF");
  local_setkey("mail_edit_newsgroups", "^Cn");
  local_setkey("mail_edit_signature", "^C-");

  local_setkey("mail_recenter", "^L");
  
  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);
  set_buffer_hook ("wrap_hook", &mail_indent_line);
%  set_buffer_hook ("newline_indent_hook", &mail_indent_line);
  set_buffer_hook ("update_hook", &mail_update_hook);

  runhooks("text_mode_hook");
  runhooks("mail_mode_hook");

  % this must be done after running the hooks, so
  % mail-mode specific color schemes apply.

  mail_update_marks ();
  
  save_buffers();
}

. "dequote" "requote" "reformat_quote"
. "mail_mode" 
loop (_stkdepth) add_completion(());