Here is a prototype for implementing shift-selection using a new
interactive spec code, `^'. It uses transient-mark-mode's `only'
setting as suggested by Miles and Johan.
I haven't changed all the movement commands, just enough of them to
play around with the shift selection. (left, right, up, down, etc).
Currently, M-F doesn't DTRT, but this appears to be due to an existing
bug (feature?): if there is no mapping for M-F, Emacs 22 translates it
to M-f, while Emacs 23 translates it to f. I haven't tracked down
where this change was made.
A few observations:
Firstly, if we adopt this approach, we have to work around the fact
that read_key_sequence automatically attempts translates unbound key
sequences by trying to shift them (e.g., changing S-right to right).
Here, I create a new global variable
this_command_keys_shift_translated, which is set to 1 by
read_key_sequence when it does this translation. This tells
Fcall_interactively that the activating key sequence is indeed
shifted, regardless of what this_command_keys says.
The present code probably doesn't handle shifting/shifting properly
when Fread_key_sequence is called from Lisp, but that is easily
remedied.
Secondly, there are two C level functions, direct_output_forward_char
and direct_output_forward_char, which are called instead of
forward_char and backward_char if certain conditions are met. This is
a redisplay optimization. To get this to work, we must avoid using
these functions when appropriate. In the present code, I don't call
them when this_command_keys_shift_translated is non-zero, but this may
need more analysis.
Thirdly, I'm not too happy about the variable separation in this code.
Here, callint.c pulls in this_command_keys_shift_translated and
this_single_command_key_start from keyboard.c, Qonly from frame.h,
Qidentity from casefiddle.c, and it needs to call intern ("shift") on
each invokation to get the symbol for `shift'. If we end up going
with this approach, maybe someone could suggest a way to clean up
these variables.
Comments are welcome.
*** trunk/src/callint.c.~1.161.~ 2008-02-21 11:10:47.000000000 -0500
--- trunk/src/callint.c 2008-03-13 18:48:05.000000000 -0400
***************
*** 121,128 ****
If the string begins with `@', then Emacs searches the key sequence
which invoked the command for its first mouse click (or any other
event which specifies a window), and selects that window before
! reading any arguments. You may use both `@' and `*'; they are
! processed in the order that they appear.
usage: (interactive ARGS) */)
(args)
Lisp_Object args;
--- 121,132 ----
If the string begins with `@', then Emacs searches the key sequence
which invoked the command for its first mouse click (or any other
event which specifies a window), and selects that window before
! reading any arguments.
! If the string begins with `^', and the key sequence which invoked the
! command contains the shift modifier, then Emacs activates Transient
! Mark Mode temporarily for this command.
! You may use `@', `*', and `^' together; they are processed in the
! order that they appear.
usage: (interactive ARGS) */)
(args)
Lisp_Object args;
***************
*** 244,249 ****
--- 248,258 ----
}
}
+ extern int this_command_keys_shift_translated;
+ extern int this_single_command_key_start;
+ extern Lisp_Object Qonly;
+ extern Lisp_Object Qidentity;
+
DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
doc: /* Call FUNCTION, reading args according to its interactive
calling specs.
Return the value FUNCTION returns.
***************
*** 423,428 ****
--- 432,469 ----
/* Ignore this for semi-compatibility with Lucid. */
else if (*string == '-')
string++;
+ else if (*string == '^')
+ {
+ Lisp_Object *key = XVECTOR (this_command_keys)->contents
+ + this_single_command_key_start;
+ Lisp_Object *key_max = XVECTOR (this_command_keys)->contents
+ + this_command_key_count;
+ Lisp_Object shift = intern ("shift");
+ int shifted = this_command_keys_shift_translated;
+
+ if (!shifted)
+ for (; key < key_max; ++key)
+ {
+ if (SYMBOLP (*key))
+ shifted = !NILP (Fmemq (shift,
+ Fget (*key, Qevent_symbol_elements)));
+ if (!shifted)
+ break;
+ }
+
+ if (shifted)
+ {
+ Lisp_Object push_mark_call[4] = { intern ("push-mark"),
+ Qnil, Qnil, Qt };
+ if (!EQ (Vtransient_mark_mode, Qidentity))
+ Ffuncall (4, push_mark_call);
+ if (EQ (Vtransient_mark_mode, Qidentity)
+ || NILP (Vtransient_mark_mode))
+ Vtransient_mark_mode = Qonly;
+ }
+
+ string++;
+ }
else if (*string == '@')
{
Lisp_Object event, tem;
*** trunk/src/keyboard.c.~1.947.~ 2008-02-25 11:04:08.000000000 -0500
--- trunk/src/keyboard.c 2008-03-13 18:49:38.000000000 -0400
***************
*** 132,137 ****
--- 132,142 ----
Lisp_Object raw_keybuf;
int raw_keybuf_count;
+ /* This is non-zero if the present key sequence was obtained by
+ unshifting a key sequence (i.e. changing an upper-case letter to
+ lower-case or a shifted function key to an unshifted one). */
+ int this_command_keys_shift_translated;
+
#define GROW_RAW_KEYBUF \
if (raw_keybuf_count == XVECTOR (raw_keybuf)->size) \
raw_keybuf = larger_vector (raw_keybuf, raw_keybuf_count * 2, Qnil) \
***************
*** 1648,1653 ****
--- 1653,1659 ----
Vthis_command = Qnil;
real_this_command = Qnil;
Vthis_original_command = Qnil;
+ this_command_keys_shift_translated = 0;
/* Read next key sequence; i gets its length. */
i = read_key_sequence (keybuf, sizeof keybuf / sizeof keybuf[0],
***************
*** 1761,1767 ****
/* Recognize some common commands in common situations and
do them directly. */
! if (EQ (Vthis_command, Qforward_char) && PT < ZV)
{
struct Lisp_Char_Table *dp
= window_display_table (XWINDOW (selected_window));
--- 1767,1774 ----
/* Recognize some common commands in common situations and
do them directly. */
! if (EQ (Vthis_command, Qforward_char) && PT < ZV
! && !this_command_keys_shift_translated)
{
struct Lisp_Char_Table *dp
= window_display_table (XWINDOW (selected_window));
***************
*** 1801,1807 ****
direct_output_forward_char (1);
goto directly_done;
}
! else if (EQ (Vthis_command, Qbackward_char) && PT > BEGV)
{
struct Lisp_Char_Table *dp
= window_display_table (XWINDOW (selected_window));
--- 1808,1815 ----
direct_output_forward_char (1);
goto directly_done;
}
! else if (EQ (Vthis_command, Qbackward_char) && PT > BEGV
! && !this_command_keys_shift_translated)
{
struct Lisp_Char_Table *dp
= window_display_table (XWINDOW (selected_window));
***************
*** 9194,9199 ****
--- 9202,9212 ----
/* Likewise, for key_translation_map and input-decode-map. */
volatile keyremap keytran, indec;
+ /* If we are trying to map a key by unshifting it (i.e. changing an
+ upper-case letter to lower-case or a shifted function key to an
+ unshifted one), then we set this to != 0. */
+ volatile int shift_translated = 0;
+
/* If we receive a `switch-frame' or `select-window' event in the middle of
a key sequence, we put it off for later.
While we're reading, we keep the event here. */
***************
*** 10113,10118 ****
--- 10126,10133 ----
keybuf[t - 1] = new_key;
mock_input = max (t, mock_input);
+ shift_translated = 1;
+
goto replay_sequence;
}
/* If KEY is not defined in any of the keymaps,
***************
*** 10154,10159 ****
--- 10169,10176 ----
fkey.start = fkey.end = 0;
keytran.start = keytran.end = 0;
+ shift_translated = 1;
+
goto replay_sequence;
}
}
***************
*** 10191,10196 ****
--- 10208,10215 ----
}
+ if (shift_translated && read_key_sequence_cmd)
+ this_command_keys_shift_translated = 1;
UNGCPRO;
return t;
*** trunk/src/cmds.c.~1.102.~ 2008-02-01 13:47:24.000000000 -0500
--- trunk/src/cmds.c 2008-03-13 13:36:57.000000000 -0400
***************
*** 56,62 ****
return make_number (PT + XINT (n));
}
! DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "p",
doc: /* Move point right N characters (left if N is negative).
On reaching end of buffer, stop and signal error. */)
(n)
--- 56,62 ----
return make_number (PT + XINT (n));
}
! DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "^p",
doc: /* Move point right N characters (left if N is negative).
On reaching end of buffer, stop and signal error. */)
(n)
***************
*** 92,98 ****
return Qnil;
}
! DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "p",
doc: /* Move point left N characters (right if N is negative).
On attempt to pass beginning or end of buffer, stop and signal error. */)
(n)
--- 92,98 ----
return Qnil;
}
! DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "^p",
doc: /* Move point left N characters (right if N is negative).
On attempt to pass beginning or end of buffer, stop and signal error. */)
(n)
*** trunk/lisp/simple.el.~1.905.~ 2008-03-10 21:57:09.000000000 -0400
--- trunk/lisp/simple.el 2008-03-13 13:39:17.000000000 -0400
***************
*** 3651,3657 ****
If you are thinking of using this in a Lisp program, consider
using `forward-line' instead. It is usually easier to use
and more reliable (no dependence on goal column, etc.)."
! (interactive "p\np")
(or arg (setq arg 1))
(if (and next-line-add-newlines (= arg 1))
(if (save-excursion (end-of-line) (eobp))
--- 3651,3657 ----
If you are thinking of using this in a Lisp program, consider
using `forward-line' instead. It is usually easier to use
and more reliable (no dependence on goal column, etc.)."
! (interactive "^p\np")
(or arg (setq arg 1))
(if (and next-line-add-newlines (= arg 1))
(if (save-excursion (end-of-line) (eobp))
***************
*** 3684,3690 ****
If you are thinking of using this in a Lisp program, consider using
`forward-line' with a negative argument instead. It is usually easier
to use and more reliable (no dependence on goal column, etc.)."
! (interactive "p\np")
(or arg (setq arg 1))
(if (interactive-p)
(condition-case nil
--- 3684,3690 ----
If you are thinking of using this in a Lisp program, consider using
`forward-line' with a negative argument instead. It is usually easier
to use and more reliable (no dependence on goal column, etc.)."
! (interactive "^p\np")
(or arg (setq arg 1))
(if (interactive-p)
(condition-case nil
***************
*** 4307,4313 ****
(defun backward-word (&optional arg)
"Move backward until encountering the beginning of a word.
With argument, do this that many times."
! (interactive "p")
(forward-word (- (or arg 1))))
(defun mark-word (&optional arg allow-extend)
--- 4307,4313 ----
(defun backward-word (&optional arg)
"Move backward until encountering the beginning of a word.
With argument, do this that many times."
! (interactive "^p")
(forward-word (- (or arg 1))))
(defun mark-word (&optional arg allow-extend)