emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

feature/pgtk 6ad5ff4 1/2: Merge remote-tracking branch 'origin/master' i


From: Po Lu
Subject: feature/pgtk 6ad5ff4 1/2: Merge remote-tracking branch 'origin/master' into feature/pgtk
Date: Sat, 18 Dec 2021 02:48:07 -0500 (EST)

branch: feature/pgtk
commit 6ad5ff4496085a74015a03d8bc0e891dbd4c3914
Merge: 5e5cde5 0c240e4
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>

    Merge remote-tracking branch 'origin/master' into feature/pgtk
---
 doc/lispref/commands.texi       |  21 ++--
 etc/NEWS                        |   2 +-
 etc/PROBLEMS                    |   6 ++
 lisp/emacs-lisp/ert.el          | 232 ++++++++++++++++++++--------------------
 lisp/emacs-lisp/multisession.el |  20 ++--
 lisp/net/tramp-adb.el           |   6 +-
 src/font.c                      |   9 +-
 src/haikuterm.c                 |  32 +++++-
 src/xterm.c                     |  23 +++-
 9 files changed, 206 insertions(+), 145 deletions(-)

diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index 136fa56..0a324a6 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -1842,18 +1842,18 @@ as the mouse cursor remains pointing to the same glyph 
in the text.
 @cindex support for touchscreens
 
 Some window systems provide support for input devices that react to
-the user's finger, and translate those finger movements into points at
-an on-screen position.  These input devices are known as touchscreens,
-and Emacs reports the movements they generate as @dfn{touchscreen
-events}.
+the user's touching the screen and moving fingers while touching the
+screen.  These input devices are known as touchscreens, and Emacs
+reports the events they generate as @dfn{touchscreen events}.
 
 Most individual events generated by a touchscreen only have meaning as
 part of a larger sequence of other events: for instance, the simple
 operation of tapping the touchscreen involves the user placing and
-releasing a finger on the touchscreen, and swiping the display to
+raising a finger on the touchscreen, and swiping the display to
 scroll it involves placing a finger, moving it many times upwards or
-downwards, and then releasing the finger.
+downwards, and then raising the finger.
 
+@cindex touch point, in touchscreen events
 While a simplistic model consisting of one finger is adequate for taps
 and scrolling, more complicated gestures require support for keeping
 track of multiple fingers, where the position of each finger is
@@ -1864,7 +1864,6 @@ positions of their individual points determine the amount 
by which to
 zoom the display, and the center of an imaginary line between those
 positions determines where to pan the display after zooming.
 
-@cindex touch point representation
 The low-level touchscreen events described below can be used to
 implement all the touch sequences described above.  In those events,
 each point is represented by a cons of an arbitrary number identifying
@@ -1879,15 +1878,15 @@ finger against the touchscreen.
 
 @cindex @code{touchscreen-update} event
 @item (touchscreen-update @var{points})
-This event is sent when an point on the touchscreen has changed
-position.  @var{points} is a list of touchpoints containing the
-up-to-date positions of each touchpoint currently on the touchscreen.
+This event is sent when a point on the touchscreen has changed
+position.  @var{points} is a list of touch points containing the
+up-to-date positions of each touch point currently on the touchscreen.
 
 @cindex @code{touchscreen-end} event
 @item (touchscreen-end @var{point})
 This event is sent when @var{point} is no longer present on the
 display, because another program took the grab, or because the user
-released the finger.
+raised the finger from the touchscreen.
 @end table
 
 @node Focus Events
diff --git a/etc/NEWS b/etc/NEWS
index 61e1cd1..bd1ed4d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1164,7 +1164,7 @@ assumes a time of 00:00 instead of signaling an error.
 
 +++
 ** New events for taking advantage of touchscreen devices.
-The events 'touchscreen-down', 'touchscreen-update' and
+The events 'touchscreen-begin, 'touchscreen-update', and
 'touchscreen-end' have been added to take better advantage of
 touch-capable display panels.
 
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index acff3be..e70f61b 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -1328,6 +1328,12 @@ A better approach might be to avoid navigation from 
Nautilus to Emacs
 for such files, and instead to open the file in Emacs using Tramp
 remote file name syntax.
 
+*** Gnome: GTK builds with XInput2 freeze when making a frame fullscreen.
+
+This problem exists with GTK 3.24.30 in GNOME 41.1 and possibly other
+versions.  The solution is to upgrade GNOME Shell to the version that
+comes with GNOME 41.2.
+
 *** KDE: When running on KDE, colors or fonts are not as specified for Emacs,
 or messed up.
 
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 597044c..019916e 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -1531,102 +1531,100 @@ the tests)."
   "Write a JUnit test report, generated from STATS."
   ;; 
https://www.ibm.com/docs/en/developer-for-zos/14.1.0?topic=formats-junit-xml-format
   ;; https://llg.cubic.org/docs/junit/
-  (unless (zerop (length (ert--stats-tests stats)))
-    (when-let ((test-file
-                (symbol-file
-                 (ert-test-name (aref (ert--stats-tests stats) 0)) 'ert--test))
-               (test-report (file-name-with-extension test-file "xml")))
-      (with-temp-file test-report
-        (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n")
-        (insert (format "<testsuites name=\"%s\" tests=\"%s\" errors=\"%s\" 
failures=\"%s\" skipped=\"%s\" time=\"%s\">\n"
-                        (file-name-nondirectory test-report)
-                        (ert-stats-total stats)
-                        (if (ert--stats-aborted-p stats) 1 0)
-                        (ert-stats-completed-unexpected stats)
-                        (ert-stats-skipped stats)
-                        (float-time
-                         (time-subtract
-                          (ert--stats-end-time stats)
-                          (ert--stats-start-time stats)))))
-        (insert (format "  <testsuite id=\"0\" name=\"%s\" tests=\"%s\" 
errors=\"%s\" failures=\"%s\" skipped=\"%s\" time=\"%s\" timestamp=\"%s\">\n"
-                        (file-name-nondirectory test-report)
-                        (ert-stats-total stats)
-                        (if (ert--stats-aborted-p stats) 1 0)
-                        (ert-stats-completed-unexpected stats)
-                        (ert-stats-skipped stats)
-                        (float-time
-                         (time-subtract
-                          (ert--stats-end-time stats)
-                          (ert--stats-start-time stats)))
-                        (ert--format-time-iso8601 (ert--stats-end-time 
stats))))
-        (insert "    <properties>\n"
-                (format "      <property name=\"selector\" value=\"%s\"/>\n"
-                        (ert--stats-selector stats))
-                "    </properties>\n")
-        (cl-loop for test across (ert--stats-tests stats)
-                 for result = (ert-test-most-recent-result test) do
-                 (insert (format "    <testcase name=\"%s\" status=\"%s\" 
time=\"%s\""
-                                 (xml-escape-string
-                                  (symbol-name (ert-test-name test)))
-                                 (ert-string-for-test-result
-                                  result
-                                  (ert-test-result-expected-p test result))
-                                 (ert-test-result-duration result)))
-                 (if (and (ert-test-result-expected-p test result)
-                          (not (ert-test-aborted-with-non-local-exit-p result))
-                          (not (ert-test-skipped-p result))
-                          (zerop (length (ert-test-result-messages result))))
-                     (insert "/>\n")
-                   (insert ">\n")
-                   (cond
-                    ((ert-test-skipped-p result)
-                     (insert (format "      <skipped message=\"%s\" 
type=\"%s\">\n"
-                                     (xml-escape-string
-                                      (string-trim
-                                       (ert-reason-for-test-result result)))
-                                     (ert-string-for-test-result
-                                      result
-                                      (ert-test-result-expected-p
-                                       test result)))
-                             (xml-escape-string
-                              (string-trim
-                               (ert-reason-for-test-result result)))
-                             "\n"
-                             "      </skipped>\n"))
-                    ((ert-test-aborted-with-non-local-exit-p result)
-                     (insert (format "      <error message=\"%s\" 
type=\"%s\">\n"
-                                     (file-name-nondirectory test-report)
-                                     (ert-string-for-test-result
-                                      result
-                                      (ert-test-result-expected-p
-                                       test result)))
-                             (format "Test %s aborted with non-local exit\n"
-                                     (xml-escape-string
-                                      (symbol-name (ert-test-name test))))
-                             "      </error>\n"))
-                    ((not (ert-test-result-type-p
-                           result (ert-test-expected-result-type test)))
-                     (insert (format "      <failure message=\"%s\" 
type=\"%s\">\n"
-                                     (xml-escape-string
-                                      (string-trim
-                                       (ert-reason-for-test-result result)))
-                                     (ert-string-for-test-result
-                                      result
-                                      (ert-test-result-expected-p
-                                       test result)))
-                             (xml-escape-string
-                              (string-trim
-                               (ert-reason-for-test-result result)))
-                             "\n"
-                             "      </failure>\n")))
-                   (unless (zerop (length (ert-test-result-messages result)))
-                     (insert "      <system-out>\n"
-                             (xml-escape-string
-                              (ert-test-result-messages result))
-                             "      </system-out>\n"))
-                   (insert "    </testcase>\n")))
-        (insert "  </testsuite>\n")
-        (insert "</testsuites>\n")))))
+  (when-let ((symbol (car (apropos-internal "" #'ert-test-boundp)))
+             (test-file (symbol-file symbol 'ert--test))
+             (test-report (file-name-with-extension test-file "xml")))
+    (with-temp-file test-report
+      (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n")
+      (insert (format "<testsuites name=\"%s\" tests=\"%s\" errors=\"%s\" 
failures=\"%s\" skipped=\"%s\" time=\"%s\">\n"
+                      (file-name-nondirectory test-report)
+                      (ert-stats-total stats)
+                      (if (ert--stats-aborted-p stats) 1 0)
+                      (ert-stats-completed-unexpected stats)
+                      (ert-stats-skipped stats)
+                      (float-time
+                       (time-subtract
+                        (ert--stats-end-time stats)
+                        (ert--stats-start-time stats)))))
+      (insert (format "  <testsuite id=\"0\" name=\"%s\" tests=\"%s\" 
errors=\"%s\" failures=\"%s\" skipped=\"%s\" time=\"%s\" timestamp=\"%s\">\n"
+                      (file-name-nondirectory test-report)
+                      (ert-stats-total stats)
+                      (if (ert--stats-aborted-p stats) 1 0)
+                      (ert-stats-completed-unexpected stats)
+                      (ert-stats-skipped stats)
+                      (float-time
+                       (time-subtract
+                        (ert--stats-end-time stats)
+                        (ert--stats-start-time stats)))
+                      (ert--format-time-iso8601 (ert--stats-end-time stats))))
+      (insert "    <properties>\n"
+              (format "      <property name=\"selector\" value=\"%s\"/>\n"
+                      (ert--stats-selector stats))
+              "    </properties>\n")
+      (cl-loop for test across (ert--stats-tests stats)
+               for result = (ert-test-most-recent-result test) do
+               (insert (format "    <testcase name=\"%s\" status=\"%s\" 
time=\"%s\""
+                               (xml-escape-string
+                                (symbol-name (ert-test-name test)))
+                               (ert-string-for-test-result
+                                result
+                                (ert-test-result-expected-p test result))
+                               (ert-test-result-duration result)))
+               (if (and (ert-test-result-expected-p test result)
+                        (not (ert-test-aborted-with-non-local-exit-p result))
+                        (not (ert-test-skipped-p result))
+                        (zerop (length (ert-test-result-messages result))))
+                   (insert "/>\n")
+                 (insert ">\n")
+                 (cond
+                  ((ert-test-skipped-p result)
+                   (insert (format "      <skipped message=\"%s\" 
type=\"%s\">\n"
+                                   (xml-escape-string
+                                    (string-trim
+                                     (ert-reason-for-test-result result)))
+                                   (ert-string-for-test-result
+                                    result
+                                    (ert-test-result-expected-p
+                                     test result)))
+                           (xml-escape-string
+                            (string-trim
+                             (ert-reason-for-test-result result)))
+                           "\n"
+                           "      </skipped>\n"))
+                  ((ert-test-aborted-with-non-local-exit-p result)
+                   (insert (format "      <error message=\"%s\" type=\"%s\">\n"
+                                   (file-name-nondirectory test-report)
+                                   (ert-string-for-test-result
+                                    result
+                                    (ert-test-result-expected-p
+                                     test result)))
+                           (format "Test %s aborted with non-local exit\n"
+                                   (xml-escape-string
+                                    (symbol-name (ert-test-name test))))
+                           "      </error>\n"))
+                  ((not (ert-test-result-type-p
+                         result (ert-test-expected-result-type test)))
+                   (insert (format "      <failure message=\"%s\" 
type=\"%s\">\n"
+                                   (xml-escape-string
+                                    (string-trim
+                                     (ert-reason-for-test-result result)))
+                                   (ert-string-for-test-result
+                                    result
+                                    (ert-test-result-expected-p
+                                     test result)))
+                           (xml-escape-string
+                            (string-trim
+                             (ert-reason-for-test-result result)))
+                           "\n"
+                           "      </failure>\n")))
+                 (unless (zerop (length (ert-test-result-messages result)))
+                   (insert "      <system-out>\n"
+                           (xml-escape-string
+                            (ert-test-result-messages result))
+                           "      </system-out>\n"))
+                 (insert "    </testcase>\n")))
+      (insert "  </testsuite>\n")
+      (insert "</testsuites>\n"))))
 
 (defun ert-write-junit-test-summary-report (&rest logfiles)
   "Write a JUnit summary test report, generated from LOGFILES."
@@ -1637,24 +1635,30 @@ the tests)."
       (dolist (logfile logfiles)
         (let ((test-report (file-name-with-extension logfile "xml")))
           (if (not (file-readable-p test-report))
-              (let ((logfile (file-name-with-extension logfile "log")))
-                (insert (format "  <testsuite id=\"%s\" name=\"%s\" 
tests=\"1\" errors=\"1\" failures=\"0\" skipped=\"0\" time=\"0\" 
timestamp=\"%s\">\n"
-                                id test-report
-                                (ert--format-time-iso8601 (current-time))))
-                (insert (format "    <testcase name=\"Test report missing %s\" 
status=\"error\" time=\"0\">\n"
-                                (file-name-nondirectory test-report)))
-                (insert (format "      <error message=\"Test report missing 
%s\" type=\"error\">\n"
-                                (file-name-nondirectory test-report)))
-                (when (file-readable-p logfile)
-                  (insert (xml-escape-string
-                           (with-temp-buffer
-                             (insert-file-contents-literally logfile)
-                             (buffer-string)))))
-                (insert "      </error>\n"
-                        "    </testcase>\n"
-                        "  </testsuite>\n")
-                (cl-incf errors 1)
-                (cl-incf id 1))
+              (let* ((logfile (file-name-with-extension logfile "log"))
+                     (logfile-contents
+                      (when (file-readable-p logfile)
+                        (with-temp-buffer
+                          (insert-file-contents-literally logfile)
+                          (buffer-string)))))
+                (unless
+                    ;; No defined tests, perhaps a helper file.
+                    (and logfile-contents
+                         (string-match-p "^Running 0 tests" logfile-contents))
+                  (insert (format "  <testsuite id=\"%s\" name=\"%s\" 
tests=\"1\" errors=\"1\" failures=\"0\" skipped=\"0\" time=\"0\" 
timestamp=\"%s\">\n"
+                                  id test-report
+                                  (ert--format-time-iso8601 (current-time))))
+                  (insert (format "    <testcase name=\"Test report missing 
%s\" status=\"error\" time=\"0\">\n"
+                                  (file-name-nondirectory test-report)))
+                  (insert (format "      <error message=\"Test report missing 
%s\" type=\"error\">\n"
+                                  (file-name-nondirectory test-report)))
+                  (when logfile-contents
+                    (insert (xml-escape-string logfile-contents)))
+                  (insert "      </error>\n"
+                          "    </testcase>\n"
+                          "  </testsuite>\n")
+                  (cl-incf errors 1)
+                  (cl-incf id 1)))
 
             (insert-file-contents-literally test-report)
             (when (looking-at-p
diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el
index 17c9384..bce888a 100644
--- a/lisp/emacs-lisp/multisession.el
+++ b/lisp/emacs-lisp/multisession.el
@@ -26,7 +26,6 @@
 (require 'cl-lib)
 (require 'eieio)
 (require 'sqlite)
-(require 'url)
 (require 'tabulated-list)
 
 (defcustom multisession-storage 'files
@@ -158,7 +157,7 @@ DOC should be a doc string, and ARGS are keywords as 
applicable to
          multisession--db
          "create unique index multisession_idx on multisession (package, 
key)")))))
 
-(cl-defmethod multisession-backend-value ((_type (eql sqlite)) object)
+(cl-defmethod multisession-backend-value ((_type (eql 'sqlite)) object)
   (multisession--ensure-db)
   (let ((id (list (multisession--package object)
                   (multisession--key object))))
@@ -198,7 +197,7 @@ DOC should be a doc string, and ARGS are keywords as 
applicable to
      (t
       (multisession--cached-value object)))))
 
-(cl-defmethod multisession--backend-set-value ((_type (eql sqlite))
+(cl-defmethod multisession--backend-set-value ((_type (eql 'sqlite))
                                                object value)
   (catch 'done
     (let ((i 0))
@@ -234,13 +233,13 @@ DOC should be a doc string, and ARGS are keywords as 
applicable to
                    id)))
       (setf (multisession--cached-value object) value))))
 
-(cl-defmethod multisession--backend-values ((_type (eql sqlite)))
+(cl-defmethod multisession--backend-values ((_type (eql 'sqlite)))
   (multisession--ensure-db)
   (sqlite-select
    multisession--db
    "select package, key, value from multisession order by package, key"))
 
-(cl-defmethod multisession--backend-delete ((_type (eql sqlite)) object)
+(cl-defmethod multisession--backend-delete ((_type (eql 'sqlite)) object)
   (sqlite-execute multisession--db
                   "delete from multisession where package = ? and key = ?"
                   (list (multisession--package object)
@@ -278,7 +277,7 @@ DOC should be a doc string, and ARGS are keywords as 
applicable to
            ".value")
    multisession-directory))
 
-(cl-defmethod multisession-backend-value ((_type (eql files)) object)
+(cl-defmethod multisession-backend-value ((_type (eql 'files)) object)
   (let ((file (multisession--object-file-name object)))
     (cond
      ;; We have no value yet; see whether it's stored.
@@ -301,7 +300,7 @@ DOC should be a doc string, and ARGS are keywords as 
applicable to
      (t
       (multisession--cached-value object)))))
 
-(cl-defmethod multisession--backend-set-value ((_type (eql files))
+(cl-defmethod multisession--backend-set-value ((_type (eql 'files))
                                                object value)
   (let ((file (multisession--object-file-name object))
         (time (current-time)))
@@ -322,14 +321,15 @@ DOC should be a doc string, and ARGS are keywords as 
applicable to
       ;; file for somewhat better atomicity.
       (let ((coding-system-for-write 'utf-8)
             (create-lockfiles nil)
-            (temp (make-temp-name file)))
+            (temp (make-temp-name file))
+            (write-region-inhibit-fsync nil))
         (write-region (point-min) (point-max) temp nil 'silent)
         (set-file-times temp time)
         (rename-file temp file t)))
     (setf (multisession--cached-sequence object) time
           (multisession--cached-value object) value)))
 
-(cl-defmethod multisession--backend-values ((_type (eql files)))
+(cl-defmethod multisession--backend-values ((_type (eql 'files)))
   (mapcar (lambda (file)
             (let ((bits (file-name-split file)))
               (list (url-unhex-string (car (last bits 2)))
@@ -343,7 +343,7 @@ DOC should be a doc string, and ARGS are keywords as 
applicable to
            (expand-file-name "files" multisession-directory)
            "\\.value\\'")))
 
-(cl-defmethod multisession--backend-delete ((_type (eql files)) object)
+(cl-defmethod multisession--backend-delete ((_type (eql 'files)) object)
   (let ((file (multisession--object-file-name object)))
     (when (file-exists-p file)
       (delete-file file))))
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index bc94092..b662e0b 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -415,10 +415,12 @@ Emacs dired can't find files."
 (defun tramp-adb-ls-output-time-less-p (a b)
   "Sort \"ls\" output by time, descending."
   (let (time-a time-b)
+    ;; Once we can assume Emacs 27 or later, the two calls
+    ;; (apply #'encode-time X) can be replaced by (encode-time X).
     (string-match tramp-adb-ls-date-regexp a)
-    (setq time-a (encode-time (parse-time-string (match-string 0 a))))
+    (setq time-a (apply #'encode-time (parse-time-string (match-string 0 a))))
     (string-match tramp-adb-ls-date-regexp b)
-    (setq time-b (encode-time (parse-time-string (match-string 0 b))))
+    (setq time-b (apply #'encode-time (parse-time-string (match-string 0 b))))
     (time-less-p time-b time-a)))
 
 (defun tramp-adb-ls-output-name-less-p (a b)
diff --git a/src/font.c b/src/font.c
index fa831f2..f2fd64e 100644
--- a/src/font.c
+++ b/src/font.c
@@ -2768,7 +2768,6 @@ font_delete_unmatched (Lisp_Object vec, Lisp_Object spec, 
int size)
              int candidate = XFIXNUM (AREF (entity, prop)) >> 8;
 
              if (candidate != required
-#ifdef HAVE_NTGUI
                  /* A kludge for w32 font search, where listing a
                     family returns only 4 standard weights: regular,
                     italic, bold, bold-italic.  For other values one
@@ -2778,10 +2777,14 @@ font_delete_unmatched (Lisp_Object vec, Lisp_Object 
spec, int size)
                     weight, so if we require exact match, the
                     non-regular font will be rejected.  So we relax
                     the accuracy of the match here, and let
-                    font_sort_entities find the best match.  */
+                    font_sort_entities find the best match.
+
+                    Similar things happen on Posix platforms, when
+                    people use font families that don't have the
+                    regular weight, only the medium weight: these
+                    families get rejected if we require an exact match.  */
                  && (prop != FONT_WEIGHT_INDEX
                      || eabs (candidate - required) > 100)
-#endif
                  )
                prop = FONT_SPEC_MAX;
            }
diff --git a/src/haikuterm.c b/src/haikuterm.c
index f95a013..24fa44b 100644
--- a/src/haikuterm.c
+++ b/src/haikuterm.c
@@ -2571,6 +2571,25 @@ haiku_make_fullscreen_consistent (struct frame *f)
   store_frame_param (f, Qfullscreen, lval);
 }
 
+static void
+flush_dirty_back_buffers (void)
+{
+  block_input ();
+  Lisp_Object tail, frame;
+  FOR_EACH_FRAME (tail, frame)
+    {
+      struct frame *f = XFRAME (frame);
+      if (FRAME_LIVE_P (f) &&
+          FRAME_HAIKU_P (f) &&
+          FRAME_HAIKU_WINDOW (f) &&
+          !FRAME_GARBAGED_P (f) &&
+          !buffer_flipping_blocked_p () &&
+          FRAME_DIRTY_P (f))
+        haiku_flip_buffers (f);
+    }
+  unblock_input ();
+}
+
 static int
 haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
 {
@@ -2580,6 +2599,7 @@ haiku_read_socket (struct terminal *terminal, struct 
input_event *hold_quit)
   ssize_t b_size;
   struct unhandled_event *unhandled_events = NULL;
   int button_or_motion_p;
+  int need_flush = 0;
 
   if (!buf)
     buf = xmalloc (200);
@@ -2827,8 +2847,11 @@ haiku_read_socket (struct terminal *terminal, struct 
input_event *hold_quit)
                tab_bar_p = EQ (window, f->tab_bar_window);
 
                if (tab_bar_p)
-                 tab_bar_arg = handle_tab_bar_click
-                   (f, x, y, type == BUTTON_DOWN, inev.modifiers);
+                 {
+                   tab_bar_arg = handle_tab_bar_click
+                     (f, x, y, type == BUTTON_DOWN, inev.modifiers);
+                   need_flush = 1;
+                 }
              }
 
            if (WINDOWP (f->tool_bar_window)
@@ -2845,7 +2868,7 @@ haiku_read_socket (struct terminal *terminal, struct 
input_event *hold_quit)
                  {
                    handle_tool_bar_click
                      (f, x, y, type == BUTTON_DOWN, inev.modifiers);
-                   redisplay ();
+                   need_flush = 1;
                  }
              }
 
@@ -3223,6 +3246,9 @@ haiku_read_socket (struct terminal *terminal, struct 
input_event *hold_quit)
       xfree (old);
     }
 
+  if (need_flush)
+    flush_dirty_back_buffers ();
+
   unblock_input ();
   return message_count;
 }
diff --git a/src/xterm.c b/src/xterm.c
index fa60a4e..03f509b 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -10074,6 +10074,12 @@ handle_one_xevent (struct x_display_info *dpyinfo,
              if (!device || !device->master_p)
                goto XI_OTHER;
 
+#ifdef XI_TouchBegin
+             if (xev->flags & XIPointerEmulated
+                 && dpyinfo->xi2_version >= 2)
+               goto XI_OTHER;
+#endif
+
              x_display_set_last_user_time (dpyinfo, xi_event->time);
 
 #ifdef HAVE_XWIDGETS
@@ -10884,6 +10890,21 @@ handle_one_xevent (struct x_display_info *dpyinfo,
                  xi_link_touch_point (device, xev->detail, xev->event_x,
                                       xev->event_y);
 
+#ifdef HAVE_GTK3
+                 if (FRAME_X_OUTPUT (f)->menubar_widget
+                     && xg_event_is_for_menubar (f, event))
+                   {
+                     bool was_waiting_for_input = waiting_for_input;
+                     /* This hack was adopted from the NS port.  Whether
+                        or not it is actually safe is a different story
+                        altogether.  */
+                     if (waiting_for_input)
+                       waiting_for_input = 0;
+                     set_frame_menubar (f, true);
+                     waiting_for_input = was_waiting_for_input;
+                   }
+#endif
+
                  inev.ie.kind = TOUCHSCREEN_BEGIN_EVENT;
                  inev.ie.timestamp = xev->time;
                  XSETFRAME (inev.ie.frame_or_window, f);
@@ -10914,7 +10935,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
              touchpoint = xi_find_touch_point (device, xev->detail);
 
              if (!touchpoint)
-               emacs_abort ();
+               goto XI_OTHER;
 
              touchpoint->x = xev->event_x;
              touchpoint->y = xev->event_y;



reply via email to

[Prev in Thread] Current Thread [Next in Thread]