feature/android 089a710ab0e: Improve word selection behavior

[Po Lu]

branch: feature/android
commit 089a710ab0ede81f00e4f66c47836c65f0f588d1
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>

    Improve word selection behavior
    
    * lisp/tab-bar.el (tab-bar-map): Don't bind touch-screen-drag.
    * lisp/touch-screen.el (touch-screen-drag): Extend the region
    based on the position of the mark, not the position of point
    relative to EVENT.
    (touch-screen-translate-touch): Don't generate virtual function
    keys for non-mouse events.
    (function-key-map): Remove redundant definitions.
    * src/keyboard.c (read_key_sequence): Don't generate *-bar
    prefix keys for mock input (such as input from function key
    translation.)
---
 lisp/tab-bar.el      |   4 +-
 lisp/touch-screen.el | 109 +++++++++++++++++++++++----------------------------
 src/keyboard.c       |  10 ++++-
 3 files changed, 60 insertions(+), 63 deletions(-)

diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index a81f42fc751..044337260ce 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -493,9 +493,7 @@ appropriate."
   "S-<wheel-down>"  #'tab-bar-move-tab
   "S-<wheel-left>"  #'tab-bar-move-tab-backward
   "S-<wheel-right>" #'tab-bar-move-tab
-  "<touchscreen-begin>" #'tab-bar-touchscreen-begin
-  ;; Trying to set this in `touch-screen.el' runs afoul of the filter.
-  "<touchscreen-drag>"  'touchscreen-drag)
+  "<touchscreen-begin>" #'tab-bar-touchscreen-begin)
 
 (global-set-key [tab-bar]
                 `(menu-item ,(purecopy "tab bar") ,(make-sparse-keymap)
diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el
index 4543dc5e8ce..f500076c78a 100644
--- a/lisp/touch-screen.el
+++ b/lisp/touch-screen.el
@@ -405,22 +405,28 @@ area."
                     ;; BEGV if this word is there.
                     (backward-word-strictly)
                     (setq word-start (point)))
-                  ;; If point is greater than the current point, set
-                  ;; it to word-end.
-                  (if (> point (point))
-                      (goto-char word-end)
-                    ;; Else, go to the start of the word.
-                    (goto-char word-start))
-                  ;; If point is less than mark, which is is less than
-                  ;; the end of the word that was originally selected,
-                  ;; try to keep it selected by moving mark there.
-                  (when (and initial (<= (point) (mark))
-                             (< (mark) (cdr initial)))
-                    (set-mark (cdr initial)))
-                  ;; Do the opposite when the converse is true.
-                  (when (and initial (>= (point) (mark))
-                             (> (mark) (car initial)))
-                    (set-mark (car initial)))
+                  (let ((mark (mark)))
+                    ;; Extend the region to cover either word-end or
+                    ;; word-start; whether to goto word-end or
+                    ;; word-start is subject to the position of the
+                    ;; mark relative to point.
+                    (if (< word-start mark)
+                        ;; The start of the word is behind mark.
+                        ;; Extend the region towards the start.
+                        (goto-char word-start)
+                      ;; Else, go to the end of the word.
+                      (goto-char word-end))
+                    ;; If point is less than mark, which is is less
+                    ;; than the end of the word that was originally
+                    ;; selected, try to keep it selected by moving
+                    ;; mark there.
+                    (when (and initial (<= (point) mark)
+                               (< mark (cdr initial)))
+                      (set-mark (cdr initial)))
+                    ;; Do the opposite when the converse is true.
+                    (when (and initial (>= (point) mark)
+                               (> mark (car initial)))
+                      (set-mark (car initial))))
                   (if bounds
                       (progn (setcar bounds word-start)
                              (setcdr bounds word-end))
@@ -439,33 +445,28 @@ area."
                   (when (and (>= (point) (mark))
                              (> (mark) (car initial)))
                     (set-mark (car initial))))
-                (setq touch-screen-word-select-bounds nil)))
-            (let ((relative-xy
-                   (touch-screen-relative-xy posn window)))
-              (let ((scroll-conservatively 101))
-                (cond
-                 ((< (cdr relative-xy) 0)
-                  (ignore-errors
-                    (goto-char (1- (window-start)))
-                    (setq touch-screen-word-select-bounds nil))
-                  (redisplay))
-                 ((> (cdr relative-xy)
-                     (let ((edges (window-inside-pixel-edges)))
-                       (- (nth 3 edges) (cadr edges))))
-                  (ignore-errors
-                    (goto-char (1+ (window-end nil t)))
-                    (setq touch-screen-word-select-bounds nil))
-                  (redisplay))))))))))
+                (setq touch-screen-word-select-bounds nil))))
+        ;; POSN is outside the window.  Scroll accordingly.
+        (let ((relative-xy
+               (touch-screen-relative-xy posn window)))
+          (let ((scroll-conservatively 101))
+            (cond
+             ((< (cdr relative-xy) 0)
+              (ignore-errors
+                (goto-char (1- (window-start)))
+                (setq touch-screen-word-select-bounds nil))
+              (redisplay))
+             ((> (cdr relative-xy)
+                 (let ((edges (window-inside-pixel-edges)))
+                   (- (nth 3 edges) (cadr edges))))
+              (ignore-errors
+                (goto-char (1+ (window-end nil t)))
+                (setq touch-screen-word-select-bounds nil))
+              (redisplay)))))))))
 
 (global-set-key [touchscreen-hold] #'touch-screen-hold)
 (global-set-key [touchscreen-drag] #'touch-screen-drag)
 
-;; Bind this to most of the virtual prefix keys as well.
-(global-set-key [tool-bar touchscreen-drag] #'touch-screen-drag)
-(global-set-key [header-line touchscreen-drag] #'touch-screen-drag)
-(global-set-key [mode-line touchscreen-drag] #'touch-screen-drag)
-(global-set-key [tab-line touchscreen-drag] #'touch-screen-drag)
-
 
 
 ;; Touch screen event translation.  The code here translates raw touch
@@ -911,6 +912,11 @@ if POSN is on a link or a button, or `mouse-1' otherwise."
         ;; or an empty vector if it is nil, meaning that
         ;; no key events have been translated.
         (if event (or (and prefix (consp event)
+                           ;; Only generate virtual function keys for
+                           ;; mouse events.
+                           (memq (car event)
+                                 '(down-mouse-1 mouse-1
+                                   mouse-2 mouse-movement))
                            ;; If this is a mode line event, then
                            ;; generate the appropriate function key.
                            (vector prefix event))
@@ -932,8 +938,6 @@ if POSN is on a link or a button, or `mouse-1' otherwise."
 
 (define-key function-key-map [mode-line touchscreen-begin]
             #'touch-screen-translate-touch)
-(define-key function-key-map [mode-line touchscreen-update]
-            #'touch-screen-translate-touch)
 (define-key function-key-map [mode-line touchscreen-end]
             #'touch-screen-translate-touch)
 
@@ -942,67 +946,54 @@ if POSN is on a link or a button, or `mouse-1' otherwise."
 
 (define-key function-key-map [nil touchscreen-begin]
             #'touch-screen-translate-touch)
-(define-key function-key-map [nil touchscreen-update]
-            #'touch-screen-translate-touch)
 (define-key function-key-map [nil touchscreen-end]
             #'touch-screen-translate-touch)
 
 (define-key function-key-map [header-line touchscreen-begin]
             #'touch-screen-translate-touch)
-(define-key function-key-map [header-line touchscreen-update]
-            #'touch-screen-translate-touch)
 (define-key function-key-map [header-line touchscreen-end]
             #'touch-screen-translate-touch)
 
 (define-key function-key-map [bottom-divider touchscreen-begin]
             #'touch-screen-translate-touch)
-(define-key function-key-map [bottom-divider touchscreen-update]
-            #'touch-screen-translate-touch)
 (define-key function-key-map [bottom-divider touchscreen-end]
             #'touch-screen-translate-touch)
 
 (define-key function-key-map [right-divider touchscreen-begin]
             #'touch-screen-translate-touch)
-(define-key function-key-map [right-divider touchscreen-update]
-            #'touch-screen-translate-touch)
 (define-key function-key-map [right-divider touchscreen-end]
             #'touch-screen-translate-touch)
 
 (define-key function-key-map [right-divider touchscreen-begin]
             #'touch-screen-translate-touch)
-(define-key function-key-map [right-divider touchscreen-update]
-            #'touch-screen-translate-touch)
 (define-key function-key-map [right-divider touchscreen-end]
             #'touch-screen-translate-touch)
 
 (define-key function-key-map [left-fringe touchscreen-begin]
             #'touch-screen-translate-touch)
-(define-key function-key-map [left-fringe touchscreen-update]
-            #'touch-screen-translate-touch)
 (define-key function-key-map [left-fringe touchscreen-end]
             #'touch-screen-translate-touch)
 
 (define-key function-key-map [right-fringe touchscreen-begin]
             #'touch-screen-translate-touch)
-(define-key function-key-map [right-fringe touchscreen-update]
-            #'touch-screen-translate-touch)
 (define-key function-key-map [right-fringe touchscreen-end]
             #'touch-screen-translate-touch)
 
 (define-key function-key-map [left-margin touchscreen-begin]
             #'touch-screen-translate-touch)
-(define-key function-key-map [left-margin touchscreen-update]
-            #'touch-screen-translate-touch)
 (define-key function-key-map [left-margin touchscreen-end]
             #'touch-screen-translate-touch)
 
 (define-key function-key-map [right-margin touchscreen-begin]
             #'touch-screen-translate-touch)
-(define-key function-key-map [right-margin touchscreen-update]
-            #'touch-screen-translate-touch)
 (define-key function-key-map [right-margin touchscreen-end]
             #'touch-screen-translate-touch)
 
+(define-key function-key-map [tool-bar touchscreen-begin]
+            #'touch-screen-translate-touch)
+(define-key function-key-map [tool-bar touchscreen-end]
+            #'touch-screen-translate-touch)
+
 
 ;; Exports.  These functions are intended for use externally.
 
diff --git a/src/keyboard.c b/src/keyboard.c
index fa5eea31c3b..78105fa9e05 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -10762,7 +10762,15 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object 
prompt,
              posn = POSN_POSN (xevent_start (key));
              /* Handle menu-bar events:
                 insert the dummy prefix event `menu-bar'.  */
-             if (EQ (posn, Qmenu_bar) || EQ (posn, Qtab_bar) || EQ (posn, 
Qtool_bar))
+             if ((EQ (posn, Qmenu_bar) || EQ (posn, Qtab_bar)
+                  || EQ (posn, Qtool_bar))
+                 /* Only insert the prefix key if the event comes
+                    directly from the keyboard buffer.  Key
+                    translation functions might return events with a
+                    `posn-area' of tool-bar or tab-bar without
+                    intending for these prefix events to be
+                    generated.  */
+                 && (mock_input <= t))
                {
                  if (READ_KEY_ELTS - t <= 1)
                    error ("Key sequence too long");