Allow terminals to generate key sequences like ?\C-\S-a.

[Alan Mackenzie]

Hello, Emacs!

Currently, terminals (such as Linux tty) cannot generate certain key
sequences, specifically ones with \C-\S-<letter>.  Well, to be more
accurate, the terminal _can_ generate the code, but Emacs deliberately,
knowingly, puzzlingly, infuriatingly discards a critical part of the
key sequence.

The function in question is `event-apply-modifier'.  It's doc string is
not amongst the most enlightening, but it would typically be called like
this, (when event is a symbol) to add Meta to up,:

(event-apply-modifier up 'meta 27 "M-")
                      |  |     |  |---> prefix
                      |  |     |---> shiftby
                      |  |---> symbol
                      |---> event
, and it returns the symbol M-up.  This is fine.

When the event is a number (i.e. a character like ?\<), it looks
something like this:

(event-apply-modifier ?\< 'control 26 "C-")
                      |   |        |  |---> prefix
                      |   |        |---> shiftby
                      |   |---> symbol
                      |---> event
, and it returns #x400003c, which is also just fine.



HOWEVER, (event-apply-modifier ?a 'control 26 "C-") and
         (event-apply-modifier ?A 'control 26 "C-")

both return #x01 (aka \C-a) which is NOT OK.  The second of these should
surely return #x10000001 (b25 for <shift>).


Also, there's some wierdness in event-apply-modifier, specifically this
code:
               (if (and (<= (downcase event) ?Z)
                        (>= (downcase event) ?A))
, which can surely _never_ evaluate to t.


So I propose the following patch to allow ttys to generate things like
\C-\S-a properly:


 

*** simple.el   2008-05-02 19:26:10.478108384 +0000
--- simple.020508.new.el        2008-05-02 21:52:38.317153784 +0000
***************
*** 5580,5605 ****
    (vector (event-apply-modifier (read-event) 'meta 27 "M-")))
  
  (defun event-apply-modifier (event symbol lshiftby prefix)
!   "Apply a modifier flag to event EVENT.
! SYMBOL is the name of this modifier, as a symbol.
! LSHIFTBY is the numeric value of this modifier, in keyboard events.
! PREFIX is the string that represents this modifier in an event type symbol."
    (if (numberp event)
!       (cond ((eq symbol 'control)
!            (if (and (<= (downcase event) ?z)
!                     (>= (downcase event) ?a))
!                (- (downcase event) ?a -1)
!              (if (and (<= (downcase event) ?Z)
!                       (>= (downcase event) ?A))
!                  (- (downcase event) ?A -1)
!                (logior (lsh 1 lshiftby) event))))
!           ((eq symbol 'shift)
!            (if (and (<= (downcase event) ?z)
!                     (>= (downcase event) ?a))
!                (upcase event)
!              (logior (lsh 1 lshiftby) event)))
!           (t
!            (logior (lsh 1 lshiftby) event)))
      (if (memq symbol (event-modifiers event))
        event
        (let ((event-type (if (symbolp event) event (car event))))
--- 5580,5601 ----
    (vector (event-apply-modifier (read-event) 'meta 27 "M-")))
  
  (defun event-apply-modifier (event symbol lshiftby prefix)
!   "Apply a modifier flag to an event.
! EVENT is either a number \(e.g. the character ?a) or a symbol \(e.g. 'up)
! SYMBOL is the name of the modifier, as a symbol \(e.g. 'control).
! LSHIFTBY is the bit position of this modifier in a keyboard event \(e.g. 27
!   for #x8000000).
! PREFIX is the string that represents this modifier in an event type symbol
!   \(e.g. \"C-\")."
    (if (numberp event)
!       (let ((letter (logand event 4194303))) ; 2^22 - 1
!       (if (eq symbol 'control)
!           (cond ((and (>= letter ?A) (<= letter ?Z))
!                  (- (logior (lsh 1 25) event) ?A -1)) ; add <shift>
!                 ((and (>= letter ?a) (<= letter ?z))
!                  (- event ?a -1))
!                 (t (logior (lsh 1 lshiftby) event)))
!         (logior (lsh 1 lshiftby) event)))
      (if (memq symbol (event-modifiers event))
        event
        (let ((event-type (if (symbolp event) event (car event))))

-- 
Alan Mackenzie (Nuremberg, Germany).