%--------------------------------*-SLang-*--------------------------------
% wmark.sl
% Implements Windows style of marking - for Windows users
% Author: Luchesar Ionkov
%
% Modified By JED
% modified by mj olesen
%
% Holding down Shift key and using arrow keys selects text
% Delete Key cuts the block of text.
% Inserting a character will replace the block with the character.
% Yanking will replace the block with the text in the yank buffer

!if (is_defined ("Wmark_Del_Region_Exec_Funs"))
{
   variable Wmark_Del_Region_Exec_Funs = ",self_insert_cmd,yank,yp_yank";
}

!if (is_defined ("Wmark_Del_Region_Funs"))
{
   variable
     Wmark_Del_Region_Funs = strcat (",backward_delete_char_untabify,",
				     "delete_char_cmd,",
				     "backward_delete_char,");
}

static variable Wmark_Movement_Flag = 0;
static variable Wmark_Selection_Mode = 0;

static define wmark_prefix ()
{
   !if (is_visible_mark ()) push_visible_mark ();
   Wmark_Movement_Flag = 1;
}

static define wmark_suffix ()
{
   variable f, fstr;
   variable type;

   if (Wmark_Selection_Mode)
     return;

   Wmark_Selection_Mode = 1;

   do
     {
	update_sans_update_hook (1);

	forever
	  {
	     (type, f) = get_key_binding ();
	     if (f != NULL)
	       break;
	     beep ();
	  }

	if (strncmp (f, "wmark_", 6))
	  {
	     fstr = sprintf (",%s,", f);

	     if (is_substr (Wmark_Del_Region_Funs, fstr))
	       {
		  call ("kill_region");
		  break;
	       }

	     if (is_substr (Wmark_Del_Region_Exec_Funs, fstr))
	       del_region ();
	     else
	       Wmark_Selection_Mode = 0; % allow function to act on region

	     Wmark_Movement_Flag = 0;
	  }


	ERROR_BLOCK
	  _clear_error ();

	if (type)
	  call (f);
	else
	  eval (f);

	% Test to see whether or not function acted on region.
	if (not (Wmark_Selection_Mode) and is_visible_mark ())
	  pop_mark_0 ();
     }
   while (Wmark_Movement_Flag);

   Wmark_Selection_Mode = 0;
}

% regular functions
static define wmark (fun)
{
   variable mf = Wmark_Movement_Flag;

   ERROR_BLOCK
     {
	!if (mf)
	  pop_mark_0 ();
	Wmark_Movement_Flag = mf;
     }

   wmark_prefix ();
   @fun ();
   wmark_suffix ();
}

% internal functions - using `call'
static define wmark_call (fun)
{
   variable mf = Wmark_Movement_Flag;
   ERROR_BLOCK
     {
	!if (mf)
	  pop_mark_0 ();
	Wmark_Movement_Flag = mf;
     }

   wmark_prefix ();
   call (fun);
   wmark_suffix ();
}

% the various functions

define wmark_up () { wmark_call ("previous_line_cmd"); }
define wmark_down () { wmark_call ("next_line_cmd"); }
define wmark_left () { wmark_call ("previous_char_cmd"); }
define wmark_right () { wmark_call ("next_char_cmd"); }
define wmark_page_up () { wmark_call ("page_up"); }
define wmark_page_down () { wmark_call ("page_down"); }
define wmark_bol () { wmark (&bol); }
define wmark_eol () { wmark (&eol); }
define wmark_bob () { wmark (&bob); }
define wmark_eob () { wmark (&eob); }
define wmark_skip_word () { wmark (&skip_word); }
define wmark_bskip_word () { wmark (&bskip_word); }

#ifdef IBMPC_SYSTEM
setkey ("wmark_up",	"\xE01");	% S-Up
setkey ("wmark_down",	"\xE06");	% S-Down
setkey ("wmark_left",	"\xE03");	% S-Left
setkey ("wmark_right",	"\xE04");	% S-Right
setkey ("wmark_page_up",	"\xE02");	% S-PageUp
setkey ("wmark_page_down","\xE07");	% S-PageDown
setkey ("wmark_bol",	"\xE00");	% S-Home
setkey ("wmark_eol",	"\xE05");	% S-End
setkey ("yank",		"\xE08");	% S-Insert
setkey ("kill_region",	"\xE09");	% S-Delete
setkey ("copy_region",	"\xE0\x92");	% C-Insert
setkey ("del_region",	"\xE0\x93");	% C-Delete

#else	% UNIX VMS XWINDOWS

static define wmark_reset_display_hook ()
{
   tt_send("\e[?35h");
}

static define wmark_init_display_hook ()
{
   tt_send("\e[?35l");
}

$1 = getenv ("TERM"); if ($1 == NULL) $1 = "";

if (string_match ($1, "^xterm.color", 1)
    or string_match ($1, "^rxvt", 1))
{
   % rxvt: bypass XTerm shift keys and allow S-Prior, S-Next, S-Insert
   add_to_hook ("_jed_reset_display_hooks", &wmark_reset_display_hook);
   add_to_hook ("_jed_init_display_hooks", &wmark_init_display_hook);
}

% These keybindings will work in rxvt as well as Xjed
setkey ("wmark_up",	"\e[a");	% S-Up
setkey ("wmark_down",	"\e[b");	% S-Down
setkey ("wmark_left",	"\e[d");	% S-Left
setkey ("wmark_right",	"\e[c");	% S-Right
setkey ("wmark_page_up",	"\e[5$");	% S-Prior
setkey ("wmark_page_down","\e[6$");	% S-Next
% rxvt can have Home, End = "\e[1~", "\e[4~" or "\e[7~", "\e[8~"
setkey ("wmark_bol",	"\e[1$");	% S-Home
setkey ("wmark_bol",	"\e[7$");	% S-Home
setkey ("wmark_eol",	"\e[4$");	% S-End
setkey ("wmark_eol",	"\e[8$");	% S-End

% use regular (not yamk-pop) kill buffer
setkey ("yank",		"\e[2$");	% S-Insert
setkey ("kill_region",	"\e[3$");	% S-Delete
setkey ("copy_region",	"\e[2^");	% C-Insert
setkey ("del_region",	"\e[3^");	% C-Delete

%setkey ("wmark_eob",	"\e[34~");		% Shift-Ctrl-End
%setkey ("wmark_skip_word",	"\e[31~");	% Shift-Ctrl-Right
%setkey ("wmark_bskip_word",	"\e[32~");	% Shift-Ctrl-Left
#endif
