Re: Shift selection using interactive spec

[Chong Yidong]

> If transient mark mode is on, activating shift selection should
> resets and activates the mark, and the first unshifted command
> should then return transient mark mode to its original non-nil
> value.  Thus shift selection "stacks" on top of transient mark mode.
> I am not certain if there is a clean way to do this.  Maybe allow
> transient-mark-mode to take the form of a list?  Any suggestions?

Here is one stab at the problem: allow transient-mark-mode to be a
cons cell.  If the car of the cell is `only' or `identity', the effect
is the same as setting transient-mark-mode itself to `only' or
`identity'.  The only difference is that at the end of the command
transient-mark-mode is set to the cdr of the cons cell, instead of
nil.

This lets us record the `old' value of transient-mark-mode when
setting the transient mark temporarily.

Here is a proposed patch, including the shift-selection behavior,
handled using a new elisp function handle-shift-selection.

*** trunk/src/callint.c.~1.161.~        2008-03-16 20:41:57.000000000 -0400
--- 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,
*** trunk/src/keyboard.c.~1.948.~       2008-03-16 07:24:34.000000000 -0400
--- trunk/src/keyboard.c        2008-03-16 20:31:24.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)  \
***************
*** 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,1760 ****
        }
        else
        {
!         if (NILP (current_kboard->Vprefix_arg))
            {
              /* In case we jump to directly_done.  */
              Vcurrent_prefix_arg = current_kboard->Vprefix_arg;
--- 1758,1765 ----
        }
        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;
***************
*** 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));
--- 1806,1813 ----
                    direct_output_forward_char (1);
                  goto directly_done;
                }
!             else if (EQ (Vthis_command, Qbackward_char) && PT > BEGV
!                      && NILP (Vthis_command_keys_shift_translated))
                {
                    struct Lisp_Char_Table *dp
                    = window_display_table (XWINDOW (selected_window));
***************
*** 1964,1972 ****
          /* 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))
--- 1970,1989 ----
          /* Setting transient-mark-mode to `only' is a way of
             turning it on for just one command.  */
  
!         if (CONSP (Vtransient_mark_mode))
!           {
!             if (EQ (XCAR (Vtransient_mark_mode), Qidentity))
!               {
!                 Vtransient_mark_mode = XCDR (Vtransient_mark_mode);
!                 if (! NILP (Vtransient_mark_mode))
!                   Vdeactivate_mark = Qt;
!               }
!             else if (EQ (XCAR (Vtransient_mark_mode), Qonly))
!               XSETCAR (Vtransient_mark_mode, Qidentity);
!           }
!         else if (EQ (Vtransient_mark_mode, Qidentity))
            Vtransient_mark_mode = Qnil;
!         else if (EQ (Vtransient_mark_mode, Qonly))
            Vtransient_mark_mode = Qidentity;
  
          if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
***************
*** 9194,9199 ****
--- 9211,9221 ----
    /* 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 ****
--- 10135,10141 ----
          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 ****
--- 10177,10183 ----
              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
--- 10195,10207 ----
    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;
  }
--- 10220,10225 ----
***************
*** 12083,12088 ****
--- 12111,12124 ----
  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
*** trunk/lisp/simple.el.~1.906.~       2008-03-16 20:41:07.000000000 -0400
--- trunk/lisp/simple.el        2008-03-16 20:40:38.000000000 -0400
***************
*** 3572,3577 ****
--- 3572,3590 ----
        (goto-char omark)
        nil)))
  
+ (defun handle-shift-selection ()
+   (when this-command-keys-shift-translated
+     (temporary-region-highlight)))
+ 
+ (defun temporary-region-highlight ()
+   (if (consp transient-mark-mode)
+       (progn (unless (eq (car transient-mark-mode) 'identity)
+              (push-mark nil nil t))
+            (setcar transient-mark-mode 'only))
+     (unless (eq transient-mark-mode 'identity)
+       (push-mark nil nil t))
+     (setq transient-mark-mode (cons 'only transient-mark-mode))))
+ 
  (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))
--- 3667,3673 ----
  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
--- 3700,3706 ----
  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)
--- 4323,4329 ----
  (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)
*** trunk/src/cmds.c.~1.102.~   2008-02-01 11:00:53.000000000 -0500
--- 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)
*** trunk/src/syntax.c.~1.210.~ 2008-02-12 16:29:33.000000000 -0500
--- 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
*** trunk/lisp/textmodes/paragraphs.el.~1.91.~  2008-03-14 13:42:15.000000000 
-0400
--- 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)))