feature/android 62da1e57426 2/2: Improve touch-screen support

[Po Lu]

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

    Improve touch-screen support
    
    * doc/lispref/commands.texi (Touchscreen Events): Document
    changes.
    * lisp/touch-screen.el (touch-screen-current-tool): Update doc
    string.
    (touch-screen-precision-scroll): New user option.
    (touch-screen-handle-scroll): Use traditional scrolling by
    default.
    (touch-screen-handle-touch): Adust format of
    touch-screen-current-tool.
    (touch-screen-track-tap): Don't print waiting for events.
    (touch-screen-track-drag): Likewise.  Also, don't call UPDATE
    until threshold is reached.
    (touch-screen-drag-mode-line-1, touch-screen-drag-mode-line):
    Improve window dragging.
---
 doc/lispref/commands.texi |  6 ++--
 lisp/touch-screen.el      | 77 ++++++++++++++++++++++++++++++++++++-----------
 2 files changed, 64 insertions(+), 19 deletions(-)

diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index 484c7dc2a06..2c0787521a5 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -2058,8 +2058,10 @@ This function is used to track a single ``drag'' gesture 
originating
 from the @code{touchscreen-begin} event @code{event}.
 
 It behaves like @code{touch-screen-track-tap}, except that it returns
-@code{no-drag} if the touchpoint in @code{event} did not move far
-enough to qualify as an actual drag.
+@code{no-drag} and refrains from calling @var{update} if the
+touchpoint in @code{event} did not move far enough (by default, 5
+pixels from its position in @code{event}) to qualify as an actual
+drag.
 @end defun
 
 @node Focus Events
diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el
index a1c9e0b4afd..855eebcc43f 100644
--- a/lisp/touch-screen.el
+++ b/lisp/touch-screen.el
@@ -30,11 +30,12 @@
 
 (defvar touch-screen-current-tool nil
   "The touch point currently being tracked, or nil.
-If non-nil, this is a list of five elements: the ID of the touch
+If non-nil, this is a list of six elements: the ID of the touch
 point being tracked, the window where the touch began, a cons
 containing the last known position of the touch point, relative
 to that window, a field used to store data while tracking the
-touch point, and the initial position of the touchpoint.  See
+touch point, the initial position of the touchpoint, and another
+field to used store data while tracking the touch point.  See
 `touch-screen-handle-point-update' for the meanings of the fourth
 element.")
 
@@ -54,6 +55,13 @@ This is always cleared upon any significant state change.")
   :group 'mouse
   :version "30.1")
 
+(defcustom touch-screen-precision-scroll nil
+  "Whether or not to use precision scrolling for touch screens.
+See `pixel-scroll-precision-mode' for more details."
+  :type 'boolean
+  :group 'mouse
+  :version "30.1")
+
 (defun touch-screen-relative-xy (posn window)
   "Return the coordinates of POSN, a mouse position list.
 However, return the coordinates relative to WINDOW.
@@ -86,10 +94,41 @@ to the frame that they belong in."
 (defun touch-screen-handle-scroll (dx dy)
   "Scroll the display assuming that a touch point has moved by DX and DY."
   (ignore dx)
-  ;; This only looks good with precision pixel scrolling.
-  (if (> dy 0)
-      (pixel-scroll-precision-scroll-down-page dy)
-    (pixel-scroll-precision-scroll-up-page (- dy))))
+  (if touch-screen-precision-scroll
+      (if (> dy 0)
+          (pixel-scroll-precision-scroll-down-page dy)
+        (pixel-scroll-precision-scroll-up-page (- dy)))
+    ;; Start conventional scrolling.  First, determine the direction
+    ;; in which the scrolling is taking place.  Load the accumulator
+    ;; value.
+    (let ((accumulator (or (nth 5 touch-screen-current-tool) 0))
+          (window (cadr touch-screen-current-tool)))
+      (setq accumulator (+ accumulator dy)) ; Add dy.
+      ;; Figure out how much it has scrolled and how much remains on
+      ;; the top or bottom of the window.
+      (while (catch 'again
+               (let* ((line-height (window-default-line-height window)))
+                 (if (and (< accumulator 0)
+                          (>= (- accumulator) line-height))
+                     (progn
+                       (setq accumulator (+ accumulator line-height))
+                       (scroll-down 1)
+                       (when (not (zerop accumulator))
+                         ;; If there is still an outstanding amount to
+                         ;; scroll, do this again.
+                         (throw 'again t)))
+                   (when (and (> accumulator 0)
+                              (>= accumulator line-height))
+                     (setq accumulator (- accumulator line-height))
+                       (scroll-up 1)
+                       (when (not (zerop accumulator))
+                         ;; If there is still an outstanding amount to
+                         ;; scroll, do this again.
+                         (throw 'again t)))))
+               ;; Scrolling is done.  Move the accumulator back to
+               ;; touch-screen-current-tool and break out of the loop.
+               (setcar (nthcdr 5 touch-screen-current-tool) accumulator)
+               nil)))))
 
 (defun touch-screen-handle-timeout (arg)
   "Start the touch screen timeout or handle it depending on ARG.
@@ -338,7 +377,7 @@ touchscreen-end event."
                                            (list touchpoint
                                                  (posn-window position)
                                                  (posn-x-y position)
-                                                 nil position)))
+                                                 nil position nil)))
       ;; Start the long-press timer.
       (touch-screen-handle-timeout nil)))
    ((eq (car event) 'touchscreen-update)
@@ -382,7 +421,7 @@ Return nil immediately if any other kind of event is 
received;
 otherwise, return t once the `touchscreen-end' event arrives."
   (catch 'finish
     (while t
-      (let ((new-event (read-event)))
+      (let ((new-event (read-event nil)))
         (cond
          ((eq (car-safe new-event) 'touchscreen-update)
           (when (and update (assq (caadr event) (cadr new-event)))
@@ -403,7 +442,8 @@ Read touch screen events until a `touchscreen-end' event is
 received with the same ID as in EVENT.  For each
 `touchscreen-update' event received in the mean time containing a
 touch point with the same ID as in EVENT, call UPDATE with the
-touch point in event and DATA.
+touch point in event and DATA, once the touch point has moved
+significantly by at least 5 pixels from where it was in EVENT.
 
 Return nil immediately if any other kind of event is received;
 otherwise, return either t or `no-drag' once the
@@ -414,7 +454,7 @@ touch point in EVENT did not move significantly, and t 
otherwise."
                                             'frame)))
     (catch 'finish
       (while t
-        (let ((new-event (read-event)))
+        (let ((new-event (read-event nil)))
           (cond
            ((eq (car-safe new-event) 'touchscreen-update)
             (when-let* ((tool (assq (caadr event) (nth 1 new-event)))
@@ -424,7 +464,7 @@ touch point in EVENT did not move significantly, and t 
otherwise."
                         (> (- (cdr xy) (cdr start-xy)) 5)
                         (< (- (cdr xy) (cdr start-xy)) -5))
                 (setq return-value t))
-              (when (and update tool)
+              (when (and update tool (eq return-value t))
                 (funcall update new-event data))))
            ((eq (car-safe new-event) 'touchscreen-end)
             (throw 'finish
@@ -447,6 +487,8 @@ happened.  EVENT is the same as in 
`touch-screen-drag-mode-line'."
   ;; to [down-mouse-1] or a command bound to [mouse-1].  Then, if a
   ;; keymap was found, pop it up as a menu.  Otherwise, wait for a tap
   ;; to complete and run the command found.
+  ;; Also, select the window in EVENT.
+  (select-window (posn-window (cdadr event)))
   (let* ((object (posn-object (cdadr event)))
          (object-keymap (and (consp object)
                              (stringp (car object))
@@ -483,8 +525,8 @@ bound, run that command instead."
   (interactive "e")
   ;; Find the window that should be dragged and the starting position.
   (let* ((window (posn-window (cdadr event)))
-         (relative-xy (touch-screen-relative-xy
-                       (cdadr event) window))
+         (relative-xy (touch-screen-relative-xy (cdadr event)
+                                                'frame))
          (last-position (cdr relative-xy)))
     (when (window-resizable window 0)
       (when (eq
@@ -495,9 +537,9 @@ bound, run that command instead."
                       (let* ((touchpoint (assq (caadr event)
                                                (cadr new-event)))
                              (new-relative-xy
-                              (touch-screen-relative-xy (cdr touchpoint)
-                                                        window))
+                              (touch-screen-relative-xy (cdr touchpoint) 
'frame))
                              (position (cdr new-relative-xy))
+                             (window-resize-pixelwise t)
                              growth)
                         ;; Now set the new height of the window.  If
                         ;; new-relative-y is above relative-xy, then
@@ -513,8 +555,9 @@ bound, run that command instead."
                                          (> position
                                             (+ (window-pixel-top window)
                                                (window-pixel-height window)))))
-                          (adjust-window-trailing-edge window growth nil t))
-                        (setq last-position position))))
+                          (when (ignore-errors
+                                  (adjust-window-trailing-edge window growth 
nil t) t)
+                            (setq last-position position))))))
              'no-drag)
         ;; Dragging did not actually happen, so try to run any command
         ;; necessary.