Re: Shift selection using interactive spec

[Chong Yidong <cyd@stupidchicken.com>]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

> The way I see it "only-TTM" is a more brittle and less used&tested
> implementation than "temporary-TTM", so everything else being equal
> I prefer "temporary-TTM".  In this case I'm not convinced the difference
> matters, so I prefer "temporary-TTM".

Here's a patch that changes `only' mode so that it is not explicitly
turned off by the command loop.  It should play nicely with
transient-mark-mode, temporary mark (C-SPC C-SPC), and mouse
selection.  Play around with the shift selection and let me know what
you think.

*** /home/cyd/trunk/src/callint.c.~1.161.~	2008-03-20 00:53:18.000000000 -0400
--- /home/cyd/trunk/src/callint.c	2008-03-16 20:40:38.000000000 -0400
***************
*** 51,56 ****
--- 51,58 ----
     even if mark_active is 0.  */
  Lisp_Object Vmark_even_if_inactive;
  
+ Lisp_Object Qhandle_shift_selection;
+ 
  Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
  
  Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif, Qwhen;
***************
*** 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;
--- 123,134 ----
  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 `this-command-keys-shift-translated'
!  is non-nil, Emacs calls `handle-shift-selection' before reading
!  any arguments.
! You may use `@', `*', and `^' together; they are processed in the
!  order that they appear.
  usage: (interactive ARGS)  */)
       (args)
       Lisp_Object args;
***************
*** 447,452 ****
--- 453,463 ----
  	    }
  	  string++;
  	}
+       else if (*string == '^')
+ 	{
+ 	  call0 (Qhandle_shift_selection);
+ 	  string++;
+ 	}
        else break;
      }
  
***************
*** 936,941 ****
--- 947,955 ----
    Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
    staticpro (&Qmouse_leave_buffer_hook);
  
+   Qhandle_shift_selection = intern ("handle-shift-selection");
+   staticpro (&Qhandle_shift_selection);
+ 
    DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
  		 doc: /* The value of the prefix argument for the next editing command.
  It may be a number, or the symbol `-' for just a minus sign as arg,
*** /home/cyd/trunk/src/keyboard.c.~1.948.~	2008-03-20 00:53:23.000000000 -0400
--- /home/cyd/trunk/src/keyboard.c	2008-03-20 00:52:22.000000000 -0400
***************
*** 132,137 ****
--- 132,140 ----
  Lisp_Object raw_keybuf;
  int raw_keybuf_count;
  
+ /* Non-nil if the present key sequence was obtained by shift translation.  */
+ Lisp_Object Vthis_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)  \
***************
*** 659,665 ****
     to support it.  */
  static int cannot_suspend;
  
! extern Lisp_Object Qidentity, Qonly;
  \f
  /* Install the string STR as the beginning of the string of echoing,
     so that it serves as a prompt for the next character.
--- 662,668 ----
     to support it.  */
  static int cannot_suspend;
  
! /* extern Lisp_Object Qidentity, Qonly; */
  \f
  /* Install the string STR as the beginning of the string of echoing,
     so that it serves as a prompt for the next character.
***************
*** 1648,1653 ****
--- 1651,1657 ----
        Vthis_command = Qnil;
        real_this_command = Qnil;
        Vthis_original_command = Qnil;
+       Vthis_command_keys_shift_translated = Qnil;
  
        /* Read next key sequence; i gets its length.  */
        i = read_key_sequence (keybuf, sizeof keybuf / sizeof keybuf[0],
***************
*** 1754,1767 ****
  	}
        else
  	{
! 	  if (NILP (current_kboard->Vprefix_arg))
  	    {
  	      /* In case we jump to directly_done.  */
  	      Vcurrent_prefix_arg = current_kboard->Vprefix_arg;
  
  	      /* 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));
--- 1758,1775 ----
  	}
        else
  	{
! 	  if (NILP (current_kboard->Vprefix_arg)
! 	      && NILP (Vthis_command_keys_shift_translated))
  	    {
  	      /* In case we jump to directly_done.  */
  	      Vcurrent_prefix_arg = current_kboard->Vprefix_arg;
  
  	      /* Recognize some common commands in common situations and
  		 do them directly.  */
! 	      if (EQ (Vthis_command, Qforward_char) && PT < ZV
! 		  && NILP (Vthis_command_keys_shift_translated)
! 		  && (NILP (Vtransient_mark_mode)
! 		      || EQ (Vtransient_mark_mode, Qt)))
  		{
                    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));
--- 1809,1818 ----
  		    direct_output_forward_char (1);
  		  goto directly_done;
  		}
! 	      else if (EQ (Vthis_command, Qbackward_char) && PT > BEGV
! 		       && NILP (Vthis_command_keys_shift_translated)
! 		       && (NILP (Vtransient_mark_mode)
! 			   || EQ (Vtransient_mark_mode, Qt)))
  		{
                    struct Lisp_Char_Table *dp
  		    = window_display_table (XWINDOW (selected_window));
***************
*** 1961,1974 ****
  
        if (!NILP (current_buffer->mark_active) && !NILP (Vrun_hooks))
  	{
- 	  /* Setting transient-mark-mode to `only' is a way of
- 	     turning it on for just one command.  */
- 
- 	  if (EQ (Vtransient_mark_mode, Qidentity))
- 	    Vtransient_mark_mode = Qnil;
- 	  if (EQ (Vtransient_mark_mode, Qonly))
- 	    Vtransient_mark_mode = Qidentity;
- 
  	  if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
  	    {
  	      /* We could also call `deactivate'mark'.  */
--- 1972,1977 ----
***************
*** 9194,9199 ****
--- 9197,9207 ----
    /* Likewise, for key_translation_map and input-decode-map.  */
    volatile keyremap keytran, indec;
  
+   /* This is non-zero if we are trying to map a key by changing an
+      upper-case letter to lower-case or a shifted function key to an
+      unshifted one.  */
+   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 ****
--- 10121,10127 ----
  	  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 ****
--- 10163,10169 ----
  	      fkey.start = fkey.end = 0;
  	      keytran.start = keytran.end = 0;
  
+ 	      shift_translated = 1;
  	      goto replay_sequence;
  	    }
  	}
***************
*** 10171,10177 ****
    if ((dont_downcase_last || first_binding >= nmaps)
        && t > 0
        && t - 1 == original_uppercase_position)
!     keybuf[t - 1] = original_uppercase;
  
    /* Occasionally we fabricate events, perhaps by expanding something
       according to function-key-map, or by adding a prefix symbol to a
--- 10181,10193 ----
    if ((dont_downcase_last || first_binding >= nmaps)
        && t > 0
        && t - 1 == original_uppercase_position)
!     {
!       keybuf[t - 1] = original_uppercase;
!       shift_translated = 0;
!     }
! 
!   if (shift_translated)
!     Vthis_command_keys_shift_translated = Qt;
  
    /* Occasionally we fabricate events, perhaps by expanding something
       according to function-key-map, or by adding a prefix symbol to a
***************
*** 10190,10197 ****
        add_command_key (keybuf[t]);
      }
  
- 
- 
    UNGCPRO;
    return t;
  }
--- 10206,10211 ----
***************
*** 12083,12088 ****
--- 12097,12110 ----
  will be in `last-command' during the following command.  */);
    Vthis_command = Qnil;
  
+   DEFVAR_LISP ("this-command-keys-shift-translated",
+ 	       &Vthis_command_keys_shift_translated,
+ 	       doc: /* Non-nil if the key sequence invoking this command was shift-translated.
+ Shift translation occurs when there is no binding for the entered key
+ sequence, and a binding is found by changing an upper-case letter to
+ lower-case or a shifted function key to an unshifted one.  */);
+   Vthis_command_keys_shift_translated = Qnil;
+ 
    DEFVAR_LISP ("this-original-command", &Vthis_original_command,
  	       doc: /* The command bound to the current key sequence before remapping.
  It equals `this-command' if the original command was not remapped through
*** /home/cyd/trunk/lisp/simple.el.~1.906.~	2008-03-20 00:56:04.000000000 -0400
--- /home/cyd/trunk/lisp/simple.el	2008-03-20 00:45:01.000000000 -0400
***************
*** 3322,3327 ****
--- 3322,3331 ----
    (cond
     ((eq transient-mark-mode 'lambda)
      (setq transient-mark-mode nil))
+    ((eq transient-mark-mode 'only)
+     (setq transient-mark-mode nil))
+    ((eq (car-safe transient-mark-mode) 'only)
+     (setq transient-mark-mode (cdr transient-mark-mode)))
     (transient-mark-mode
      (setq mark-active nil)
      (run-hooks 'deactivate-mark-hook))))
***************
*** 3487,3492 ****
--- 3491,3499 ----
      (if arg
  	(pop-to-mark-command)
        (push-mark-command t)))
+    ((eq (car-safe transient-mark-mode) 'only)
+     (deactivate-mark)
+     (push-mark-command nil))
     ((and set-mark-command-repeat-pop
  	 (eq last-command 'pop-to-mark-command))
      (setq this-command 'pop-to-mark-command)
***************
*** 3572,3577 ****
--- 3579,3602 ----
        (goto-char omark)
        nil)))
  
+ (defun handle-shift-selection ()
+   (if this-command-keys-shift-translated
+       (temporary-region-highlight)
+     (temporary-region-unhighlight)))
+ 
+ (defun temporary-region-highlight ()
+   (unless (eq (car-safe transient-mark-mode) 'only)
+     (setq transient-mark-mode
+ 	  (cons 'only
+ 		(unless (eq transient-mark-mode 'lambda)
+ 		  transient-mark-mode)))
+     (push-mark nil nil t)))
+ 
+ (defun temporary-region-unhighlight ()
+   (when (eq (car-safe transient-mark-mode) 'only)
+     (setq transient-mark-mode (cdr transient-mark-mode))
+     (deactivate-mark)))
+ 
  (define-minor-mode transient-mark-mode
    "Toggle Transient Mark mode.
  With arg, turn Transient Mark mode on if arg is positive, off otherwise.
***************
*** 3654,3660 ****
  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))
--- 3679,3685 ----
  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))
***************
*** 3687,3693 ****
  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
--- 3712,3718 ----
  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
***************
*** 4310,4316 ****
  (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)
--- 4335,4341 ----
  (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)
*** /home/cyd/trunk/src/cmds.c.~1.102.~	2008-03-20 00:53:19.000000000 -0400
--- /home/cyd/trunk/src/cmds.c	2008-03-16 20:37:21.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)
*** /home/cyd/trunk/src/syntax.c.~1.210.~	2008-03-20 00:53:24.000000000 -0400
--- /home/cyd/trunk/src/syntax.c	2008-03-16 20:37:33.000000000 -0400
***************
*** 1324,1330 ****
    return from;
  }
  
! DEFUN ("forward-word", Fforward_word, Sforward_word, 0, 1, "p",
         doc: /* Move point forward ARG words (backward if ARG is negative).
  Normally returns t.
  If an edge of the buffer or a field boundary is reached, point is left there
--- 1324,1330 ----
    return from;
  }
  
! DEFUN ("forward-word", Fforward_word, Sforward_word, 0, 1, "^p",
         doc: /* Move point forward ARG words (backward if ARG is negative).
  Normally returns t.
  If an edge of the buffer or a field boundary is reached, point is left there
*** /home/cyd/trunk/lisp/textmodes/paragraphs.el.~1.91.~	2008-03-20 00:56:30.000000000 -0400
--- /home/cyd/trunk/lisp/textmodes/paragraphs.el	2008-03-16 20:39:03.000000000 -0400
***************
*** 217,223 ****
  A paragraph end is the beginning of a line which is not part of the paragraph
  to which the end of the previous line belongs, or the end of the buffer.
  Returns the count of paragraphs left to move."
!   (interactive "p")
    (or arg (setq arg 1))
    (let* ((opoint (point))
  	 (fill-prefix-regexp
--- 217,223 ----
  A paragraph end is the beginning of a line which is not part of the paragraph
  to which the end of the previous line belongs, or the end of the buffer.
  Returns the count of paragraphs left to move."
!   (interactive "^p")
    (or arg (setq arg 1))
    (let* ((opoint (point))
  	 (fill-prefix-regexp
***************
*** 361,367 ****
  blank line.
  
  See `forward-paragraph' for more information."
!   (interactive "p")
    (or arg (setq arg 1))
    (forward-paragraph (- arg)))
  
--- 361,367 ----
  blank line.
  
  See `forward-paragraph' for more information."
!   (interactive "^p")
    (or arg (setq arg 1))
    (forward-paragraph (- arg)))
  
***************
*** 445,451 ****
  
  The variable `sentence-end' is a regular expression that matches ends of
  sentences.  Also, every paragraph boundary terminates sentences as well."
!   (interactive "p")
    (or arg (setq arg 1))
    (let ((opoint (point))
          (sentence-end (sentence-end)))
--- 445,451 ----
  
  The variable `sentence-end' is a regular expression that matches ends of
  sentences.  Also, every paragraph boundary terminates sentences as well."
!   (interactive "^p")
    (or arg (setq arg 1))
    (let ((opoint (point))
          (sentence-end (sentence-end)))
***************
*** 477,483 ****
  (defun backward-sentence (&optional arg)
    "Move backward to start of sentence.  With arg, do it arg times.
  See `forward-sentence' for more information."
!   (interactive "p")
    (or arg (setq arg 1))
    (forward-sentence (- arg)))
  
--- 477,483 ----
  (defun backward-sentence (&optional arg)
    "Move backward to start of sentence.  With arg, do it arg times.
  See `forward-sentence' for more information."
!   (interactive "^p")
    (or arg (setq arg 1))
    (forward-sentence (- arg)))