From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Chong Yidong Newsgroups: gmane.emacs.devel Subject: Shift selection using interactive spec Date: Thu, 13 Mar 2008 19:29:45 -0400 Message-ID: <87k5k69p92.fsf@stupidchicken.com> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: ger.gmane.org 1205451151 28764 80.91.229.12 (13 Mar 2008 23:32:31 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Thu, 13 Mar 2008 23:32:31 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Fri Mar 14 00:32:59 2008 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1JZwuq-0001Jw-4s for ged-emacs-devel@m.gmane.org; Fri, 14 Mar 2008 00:32:52 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1JZwuH-0007It-3u for ged-emacs-devel@m.gmane.org; Thu, 13 Mar 2008 19:32:17 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1JZwuE-0007Io-9r for emacs-devel@gnu.org; Thu, 13 Mar 2008 19:32:14 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1JZwuC-0007Ic-PR for emacs-devel@gnu.org; Thu, 13 Mar 2008 19:32:13 -0400 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1JZwuC-0007IZ-J5 for emacs-devel@gnu.org; Thu, 13 Mar 2008 19:32:12 -0400 Original-Received: from cyd.mit.edu ([18.115.2.24]) by monty-python.gnu.org with esmtp (Exim 4.60) (envelope-from ) id 1JZwuC-0007gQ-6D for emacs-devel@gnu.org; Thu, 13 Mar 2008 19:32:12 -0400 Original-Received: by cyd.mit.edu (Postfix, from userid 1000) id E4E724E3B9; Thu, 13 Mar 2008 19:29:45 -0400 (EDT) X-detected-kernel: by monty-python.gnu.org: Linux 2.6 (newer, 2) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:92449 Archived-At: 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)