a496509ced
* .gitignore: Add new files.
* INSTALL.android: Explain how to build Emacs for ancient
versions of Android.
* admin/merge-gnulib (GNULIB_MODULES): Add getdelim.
* build-aux/config.guess (timestamp, version):
* build-aux/config.sub (timestamp, version): Autoupdate.
* configure.ac (BUILD_DETAILS, ANDROID_MIN_SDK):
(ANDROID_STUBIFY): Allow specifying CFLAGS via ANDROID_CFLAGS.
Add new configure tests for Android API version when not
explicitly specified.
* doc/emacs/android.texi (Android): Add reference to ``Other
Input Devices''.
(Android File System): Remove restrictions on directory-files on
the assets directory.
* doc/emacs/emacs.texi (Top): Add Other Input Devices to menu.
* doc/emacs/input.texi (Other Input Devices): New node.
* doc/lispref/commands.texi (Touchscreen Events): Document
changes to touchscreen input events.
* doc/lispref/frames.texi (Pop-Up Menus): Likewise.
* etc/NEWS: Announce changes.
* java/Makefile.in: Use lib-src/asset-directory-tool to generate
an `directory-tree' file placed in /assets.
* java/debug.sh: Large adjustments to support Android 2.2 and
later.
* java/org/gnu/emacs/EmacsContextMenu.java (inflateMenuItems):
* java/org/gnu/emacs/EmacsCopyArea.java (perform):
* java/org/gnu/emacs/EmacsDialog.java (toAlertDialog):
* java/org/gnu/emacs/EmacsDrawLine.java (perform):
* java/org/gnu/emacs/EmacsDrawRectangle.java (perform):
* java/org/gnu/emacs/EmacsDrawable.java (EmacsDrawable):
* java/org/gnu/emacs/EmacsFillPolygon.java (perform):
* java/org/gnu/emacs/EmacsFillRectangle.java (perform):
* java/org/gnu/emacs/EmacsGC.java (EmacsGC):
* java/org/gnu/emacs/EmacsPixmap.java (EmacsPixmap):
(destroyHandle):
* java/org/gnu/emacs/EmacsSdk7FontDriver.java (draw): Avoid
redundant canvas saves and restores.
* java/org/gnu/emacs/EmacsService.java (run):
* java/org/gnu/emacs/EmacsView.java (EmacsView):
(handleDirtyBitmap):
* java/org/gnu/emacs/EmacsWindow.java (changeWindowBackground)
(EmacsWindow): Make compatible with Android 2.2 and later.
* lib-src/Makefile.in (DONT_INSTALL): Add asset-directory-tool
on Android.:(asset-directory-tool{EXEEXT}): New target.
* lib-src/asset-directory-tool.c (struct directory_tree, xmalloc)
(main_1, main_2, main): New file.
* lib, m4: Merge from gnulib. This will be reverted before
merging to master.
* lisp/button.el (button-map):
(push-button):
* lisp/frame.el (display-popup-menus-p): Improve touchscreen
support.
* lisp/subr.el (event-start):
(event-end): Handle touchscreen events.
* lisp/touch-screen.el (touch-screen-handle-timeout):
(touch-screen-handle-point-update):
(touch-screen-handle-point-up):
(touch-screen-track-tap):
(touch-screen-track-drag):
(touch-screen-drag-mode-line-1):
(touch-screen-drag-mode-line): New functions.
([mode-line touchscreen-begin]):
([bottom-divider touchscreen-begin]): Bind new events.
* lisp/wid-edit.el (widget-event-point):
(widget-keymap):
(widget-event-start):
(widget-button--check-and-call-button):
(widget-button-click): Improve touchscreen support.
* src/alloc.c (make_lisp_symbol): Avoid ICE on Android NDK GCC.
(mark_pinned_symbols): Likewise.
* src/android.c (struct android_emacs_window): New struct.
(window_class): New variable.
(android_run_select_thread): Add workaround for Android platform
bug.
(android_extract_long, android_scan_directory_tree): New
functions.
(android_file_access_p): Use those functions instead.
(android_init_emacs_window): New function.
(android_init_emacs_gc_class): Update signature of `markDirty'.
(android_change_gc, android_set_clip_rectangles): Tell the GC
whether or not clip rects were dirtied.
(android_swap_buffers): Do not look up method every time.
(struct android_dir): Adjust for new directory tree lookup.
(android_opendir, android_readdir, android_closedir): Likewise.
(android_four_corners_bilinear): Fix coding style.
(android_ftruncate): New function.
* src/android.h: Update prototypes. Replace ftruncate with
android_ftruncate when necessary.
* src/androidterm.c (handle_one_android_event): Pacify GCC. Fix
touch screen tool bar bug.
* src/emacs.c (using_utf8): Fix compilation error.
* src/fileio.c (Ffile_system_info): Return Qnil when fsusage.o
is not built.
* src/filelock.c (BOOT_TIME_FILE): Fix definition for Android.
* src/frame.c (Fx_parse_geometry): Fix uninitialized variable
uses.
* src/keyboard.c (lispy_function_keys): Fix `back'.
* src/menu.c (x_popup_menu_1): Handle touch screen events.
(Fx_popup_menu): Document changes.
* src/sfnt.c (main): Improve tests.
* src/sfntfont-android.c (sfntfont_android_put_glyphs): Fix
minor problem.
(init_sfntfont_android): Check for
HAVE_DECL_ANDROID_GET_DEVICE_API_LEVEL.
* src/sfntfont.c (struct sfnt_font_desc): New fields `adstyle'
and `languages'.
(sfnt_parse_style): Append tokens to adstyle.
(sfnt_parse_languages): New function.
(sfnt_enum_font_1): Parse supported languages and adstyle.
(sfntfont_list_1): Handle new fields.
(sfntfont_text_extents): Fix uninitialized variable use.
(syms_of_sfntfont, mark_sfntfont): Adjust accordingly.
483 lines
21 KiB
EmacsLisp
483 lines
21 KiB
EmacsLisp
;;; touch-screen.el --- touch screen support for X and Android -*- lexical-binding: t; -*-
|
||
|
||
;; Copyright (C) 2023 Free Software Foundation, Inc.
|
||
|
||
;; Maintainer: emacs-devel@gnu.org
|
||
;; Package: emacs
|
||
|
||
;; This file is part of GNU Emacs.
|
||
|
||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;; This file provides code to recognize simple touch screen gestures.
|
||
;; It is used on X and Android, where the platform cannot recognize
|
||
;; them for us.
|
||
|
||
;;; Code:
|
||
|
||
(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
|
||
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-screen-handle-point-update' for the meanings of the fourth
|
||
element.")
|
||
|
||
(defvar touch-screen-current-timer nil
|
||
"Timer used to track long-presses.
|
||
This is always cleared upon any significant state change.")
|
||
|
||
(defcustom touch-screen-delay 0.7
|
||
"Delay in seconds before Emacs considers a touch to be a long-press."
|
||
:type 'number
|
||
: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.
|
||
|
||
If (posn-window posn) is the same as window, simply return the
|
||
coordinates in POSN. Otherwise, convert them to the frame, and
|
||
then back again."
|
||
(if (eq (posn-window posn) window)
|
||
(posn-x-y posn)
|
||
(let ((xy (posn-x-y posn))
|
||
(edges (window-inside-pixel-edges window)))
|
||
;; Make the X and Y positions frame relative.
|
||
(when (windowp (posn-window posn))
|
||
(let ((edges (window-inside-pixel-edges
|
||
(posn-window posn))))
|
||
(setq xy (cons (+ (car xy) (car edges))
|
||
(+ (cdr xy) (cadr edges))))))
|
||
;; Make the X and Y positions window relative again.
|
||
(cons (- (car xy) (car edges))
|
||
(- (cdr xy) (cadr edges))))))
|
||
|
||
(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))))
|
||
|
||
(defun touch-screen-handle-timeout (arg)
|
||
"Start the touch screen timeout or handle it depending on ARG.
|
||
When ARG is nil, start the `touch-screen-current-timer' to go off
|
||
in `touch-screen-delay' seconds, and call this function with ARG
|
||
t.
|
||
|
||
When ARG is t, beep. Then, set the fourth element of
|
||
touch-screen-current-tool to `held', and the mark to the last
|
||
known position of the tool."
|
||
(if (not arg)
|
||
;; Cancel the touch screen long-press timer, if it is still
|
||
;; there by any chance.
|
||
(progn
|
||
(when touch-screen-current-timer
|
||
(cancel-timer touch-screen-current-timer))
|
||
(setq touch-screen-current-timer
|
||
(run-at-time touch-screen-delay nil
|
||
#'touch-screen-handle-timeout
|
||
t)))
|
||
;; Beep.
|
||
(beep)
|
||
;; Set touch-screen-current-timer to nil.
|
||
(setq touch-screen-current-timer nil)
|
||
(when touch-screen-current-tool
|
||
;; Set the state to `held'.
|
||
(setcar (nthcdr 3 touch-screen-current-tool) 'held)
|
||
;; Go to the initial position of the touchpoint and activate the
|
||
;; mark.
|
||
(select-window (cadr touch-screen-current-tool))
|
||
(set-mark (posn-point (nth 4 touch-screen-current-tool)))
|
||
(goto-char (mark))
|
||
(activate-mark))))
|
||
|
||
(defun touch-screen-handle-point-update (point)
|
||
"Notice that the touch point POINT has changed position.
|
||
POINT must be the touch point currently being tracked as
|
||
`touch-screen-current-tool'.
|
||
|
||
If the fourth element of `touch-screen-current-tool' is nil, then
|
||
the touch has just begun. Determine how much POINT has moved.
|
||
If POINT has moved upwards or downwards by a significant amount,
|
||
then set the fourth element to `scroll'. Then, call
|
||
`touch-screen-handle-scroll' to scroll the display by that
|
||
amount.
|
||
|
||
If the fourth element of `touch-screen-current-tool' is `scroll',
|
||
then scroll the display by how much POINT has moved in the Y
|
||
axis.
|
||
|
||
If the fourth element of `touch-screen-current-tool' is `held',
|
||
then the touch has been held down for some time. If motion
|
||
happens, cancel `touch-screen-current-timer', and set the field
|
||
to `drag'. Then, activate the mark and start dragging.
|
||
|
||
If the fourth element of `touch-screen-current-tool' is `drag',
|
||
then move point to the position of POINT."
|
||
(let ((window (nth 1 touch-screen-current-tool))
|
||
(what (nth 3 touch-screen-current-tool)))
|
||
(cond ((null what)
|
||
(let* ((posn (cdr point))
|
||
(last-posn (nth 2 touch-screen-current-tool))
|
||
;; Now get the position of X and Y relative to
|
||
;; WINDOW.
|
||
(relative-xy
|
||
(touch-screen-relative-xy posn window))
|
||
(diff-x (- (car last-posn) (car relative-xy)))
|
||
(diff-y (- (cdr last-posn) (cdr relative-xy))))
|
||
;; Decide whether or not to start scrolling.
|
||
(when (or (> diff-y 10) (> diff-x 10)
|
||
(< diff-y -10) (< diff-x -10))
|
||
(setcar (nthcdr 3 touch-screen-current-tool)
|
||
'scroll)
|
||
(setcar (nthcdr 2 touch-screen-current-tool)
|
||
relative-xy)
|
||
(with-selected-window window
|
||
(touch-screen-handle-scroll diff-x diff-y))
|
||
;; Cancel the touch screen long-press timer, if it is
|
||
;; still there by any chance.
|
||
(when touch-screen-current-timer
|
||
(cancel-timer touch-screen-current-timer)
|
||
(setq touch-screen-current-timer nil)))))
|
||
((eq what 'scroll)
|
||
;; Cancel the touch screen long-press timer, if it is still
|
||
;; there by any chance.
|
||
(when touch-screen-current-timer
|
||
(cancel-timer touch-screen-current-timer)
|
||
(setq touch-screen-current-timer nil))
|
||
(let* ((posn (cdr point))
|
||
(last-posn (nth 2 touch-screen-current-tool))
|
||
;; Now get the position of X and Y relative to
|
||
;; WINDOW.
|
||
(relative-xy
|
||
(touch-screen-relative-xy posn window))
|
||
(diff-x (- (car last-posn) (car relative-xy)))
|
||
(diff-y (- (cdr last-posn) (cdr relative-xy))))
|
||
(setcar (nthcdr 3 touch-screen-current-tool)
|
||
'scroll)
|
||
(setcar (nthcdr 2 touch-screen-current-tool)
|
||
relative-xy)
|
||
(unless (and (zerop diff-x) (zerop diff-y))
|
||
(with-selected-window window
|
||
(touch-screen-handle-scroll diff-x diff-y)))))
|
||
((eq what 'held)
|
||
(let* ((posn (cdr point))
|
||
(relative-xy
|
||
(touch-screen-relative-xy posn window)))
|
||
(when touch-screen-current-timer
|
||
(cancel-timer touch-screen-current-timer)
|
||
(setq touch-screen-current-timer nil))
|
||
;; Now start dragging.
|
||
(setcar (nthcdr 3 touch-screen-current-tool)
|
||
'drag)
|
||
(setcar (nthcdr 2 touch-screen-current-tool)
|
||
relative-xy)
|
||
(with-selected-window window
|
||
;; Activate the mark. It should have been set by the
|
||
;; time `touch-screen-timeout' was called.
|
||
(activate-mark)
|
||
|
||
;; Figure out what character to go to. If this posn is
|
||
;; in the window, go to (posn-point posn). If not,
|
||
;; then go to the line before either window start or
|
||
;; window end.
|
||
(if (and (eq (posn-window posn) window)
|
||
(posn-point posn))
|
||
(goto-char (posn-point posn))
|
||
(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))))
|
||
(redisplay))
|
||
((> (cdr relative-xy)
|
||
(let ((edges (window-inside-pixel-edges)))
|
||
(- (nth 3 edges) (cadr edges))))
|
||
(ignore-errors
|
||
(goto-char (1+ (window-end nil t))))
|
||
(redisplay)))))))))
|
||
((eq what 'drag)
|
||
(let* ((posn (cdr point)))
|
||
;; Keep dragging.
|
||
(with-selected-window window
|
||
;; Figure out what character to go to. If this posn is
|
||
;; in the window, go to (posn-point posn). If not,
|
||
;; then go to the line before either window start or
|
||
;; window end.
|
||
(if (and (eq (posn-window posn) window)
|
||
(posn-point posn))
|
||
(goto-char (posn-point posn))
|
||
(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))))
|
||
(redisplay))
|
||
((> (cdr relative-xy)
|
||
(let ((edges (window-inside-pixel-edges)))
|
||
(- (nth 3 edges) (cadr edges))))
|
||
(ignore-errors
|
||
(goto-char (1+ (window-end nil t))))
|
||
(redisplay))))))))))))
|
||
|
||
(defun touch-screen-handle-point-up (point)
|
||
"Notice that POINT has been removed from the screen.
|
||
POINT should be the point currently tracked as
|
||
`touch-screen-current-tool'.
|
||
|
||
If the fourth argument of `touch-screen-current-tool' is nil,
|
||
move point to the position of POINT, selecting the window under
|
||
POINT as well, and deactivate the mark; if there is a button or
|
||
link at POINT, call the command bound to `mouse-2' there.
|
||
Otherwise, call the command bound to `mouse-1'."
|
||
(let ((what (nth 3 touch-screen-current-tool)))
|
||
(cond ((null what)
|
||
(when (windowp (posn-window (cdr point)))
|
||
;; Select the window that was tapped.
|
||
(select-window (posn-window (cdr point)))
|
||
;; Now simulate a mouse click there. If there is a link
|
||
;; or a button, use mouse-2 to push it.
|
||
(let ((event (list (if (or (mouse-on-link-p (cdr point))
|
||
(button-at (posn-point (cdr point))))
|
||
'mouse-2
|
||
'mouse-1)
|
||
(cdr point)))
|
||
;; Look for an extra keymap to look in.
|
||
(keymap (and (posn-object (cdr point))
|
||
(stringp
|
||
(posn-object (cdr point)))
|
||
(get-text-property
|
||
0 'keymap
|
||
(posn-object (cdr point)))))
|
||
command)
|
||
(save-excursion
|
||
(when (posn-point (cdr point))
|
||
(goto-char (posn-point (cdr point))))
|
||
(if keymap
|
||
(setq keymap (cons keymap (current-active-maps t)))
|
||
(setq keymap (current-active-maps t)))
|
||
(setq command (lookup-key keymap (vector (car event)))))
|
||
(deactivate-mark)
|
||
;; This is necessary for following links.
|
||
(goto-char (posn-point (cdr point)))
|
||
(when command
|
||
(call-interactively command nil
|
||
(vector event)))))))))
|
||
|
||
(defun touch-screen-handle-touch (event)
|
||
"Handle a single touch EVENT, and perform associated actions.
|
||
EVENT can either be a touchscreen-begin, touchscreen-update or
|
||
touchscreen-end event."
|
||
(interactive "e")
|
||
(cond
|
||
((eq (car event) 'touchscreen-begin)
|
||
;; A tool was just pressed against the screen. Figure out the
|
||
;; window where it is and make it the tool being tracked on the
|
||
;; window.
|
||
(let ((touchpoint (caadr event))
|
||
(position (cdadr event)))
|
||
;; Cancel the touch screen timer, if it is still there by any
|
||
;; chance.
|
||
(when touch-screen-current-timer
|
||
(cancel-timer touch-screen-current-timer)
|
||
(setq touch-screen-current-timer nil))
|
||
;; Replace any previously ongoing gesture. If POSITION has no
|
||
;; window or position, make it nil instead.
|
||
(setq touch-screen-current-tool (and (windowp (posn-window position))
|
||
(posn-point position)
|
||
(list touchpoint
|
||
(posn-window position)
|
||
(posn-x-y position)
|
||
nil position)))
|
||
;; Start the long-press timer.
|
||
(touch-screen-handle-timeout nil)))
|
||
((eq (car event) 'touchscreen-update)
|
||
;; The positions of tools currently pressed against the screen
|
||
;; have changed. If there is a tool being tracked as part of a
|
||
;; gesture, look it up in the list of tools.
|
||
(let ((new-point (assq (car touch-screen-current-tool)
|
||
(cadr event))))
|
||
(when new-point
|
||
(touch-screen-handle-point-update new-point))))
|
||
((eq (car event) 'touchscreen-end)
|
||
;; A tool has been removed from the screen. If it is the tool
|
||
;; currently being tracked, clear `touch-screen-current-tool'.
|
||
(when (eq (caadr event) (car touch-screen-current-tool))
|
||
;; Cancel the touch screen long-press timer, if it is still there
|
||
;; by any chance.
|
||
(when touch-screen-current-timer
|
||
(cancel-timer touch-screen-current-timer)
|
||
(setq touch-screen-current-timer nil))
|
||
(touch-screen-handle-point-up (cadr event))
|
||
(setq touch-screen-current-tool nil)))))
|
||
|
||
(define-key global-map [touchscreen-begin] #'touch-screen-handle-touch)
|
||
(define-key global-map [touchscreen-update] #'touch-screen-handle-touch)
|
||
(define-key global-map [touchscreen-end] #'touch-screen-handle-touch)
|
||
|
||
|
||
;; Exports. These functions are intended for use externally.
|
||
|
||
(defun touch-screen-track-tap (event &optional update data)
|
||
"Track a single tap starting from EVENT.
|
||
EVENT should be a `touchscreen-begin' event.
|
||
|
||
Read touch screen events until a `touchscreen-end' event is
|
||
received with the same ID as in EVENT. If UPDATE is non-nil and
|
||
a `touchscreen-update' event is received in the mean time and
|
||
contains a touch point with the same ID as in EVENT, call UPDATE
|
||
with that event and DATA.
|
||
|
||
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)))
|
||
(cond
|
||
((eq (car-safe new-event) 'touchscreen-update)
|
||
(when (and update (assq (caadr event) (cadr new-event)))
|
||
(funcall update new-event data)))
|
||
((eq (car-safe new-event) 'touchscreen-end)
|
||
(throw 'finish
|
||
;; Now determine whether or not the `touchscreen-end'
|
||
;; event has the same ID as EVENT. If it doesn't,
|
||
;; then this is another touch, so return nil.
|
||
(eq (caadr event) (caadr new-event))))
|
||
(t (throw 'finish nil)))))))
|
||
|
||
(defun touch-screen-track-drag (event update &optional data)
|
||
"Track a single drag starting from EVENT.
|
||
EVENT should be a `touchscreen-end' event.
|
||
|
||
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.
|
||
|
||
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)))
|
||
(cond
|
||
((eq (car-safe new-event) 'touchscreen-update)
|
||
(let ((tool (assq (caadr event) (nth 1 new-event))))
|
||
(when (and update tool)
|
||
(funcall update new-event data))))
|
||
((eq (car-safe new-event) 'touchscreen-end)
|
||
(throw 'finish
|
||
;; Now determine whether or not the `touchscreen-end'
|
||
;; event has the same ID as EVENT. If it doesn't,
|
||
;; then this is another touch, so return nil.
|
||
(eq (caadr event) (caadr new-event))))
|
||
(t (throw 'finish nil)))))))
|
||
|
||
|
||
|
||
;; Modeline dragging.
|
||
|
||
(defun touch-screen-drag-mode-line-1 (event)
|
||
"Internal helper for `touch-screen-drag-mode-line'.
|
||
This is called when that function determines it need not execute
|
||
any keymaps on the mode line at that particular spot."
|
||
;; 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))
|
||
(last-position (cdr relative-xy)))
|
||
(when (window-resizable window 0)
|
||
(touch-screen-track-drag
|
||
event (lambda (new-event &optional _data)
|
||
;; Find the position of the touchpoint in NEW-EVENT.
|
||
(let* ((touchpoint (assq (caadr event) (cadr new-event)))
|
||
(new-relative-xy
|
||
(touch-screen-relative-xy (cdr touchpoint)
|
||
window))
|
||
(position (cdr new-relative-xy))
|
||
growth)
|
||
;; Now set the new height of the window.
|
||
;; If new-relative-y is above relative-xy, then
|
||
;; make the window that much shorter. Otherwise,
|
||
;; make it bigger.
|
||
(unless (or (zerop (setq growth (- position last-position)))
|
||
(and (> growth 0)
|
||
(< position (+ (window-pixel-top window)
|
||
(window-pixel-height window))))
|
||
(and (< growth 0)
|
||
(> position (+ (window-pixel-top window)
|
||
(window-pixel-height window)))))
|
||
(adjust-window-trailing-edge window growth nil t))
|
||
(setq last-position position)))))))
|
||
|
||
(defun touch-screen-drag-mode-line (event)
|
||
"Begin dragging the mode line in response to a touch EVENT.
|
||
If EVENT lies on top of text with a mouse command bound, run
|
||
that command instead.
|
||
|
||
Change the height of the window based on where the touch point
|
||
in EVENT moves."
|
||
(interactive "e")
|
||
;; If there is an object at EVENT, then look either a keymap bound
|
||
;; 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.
|
||
(let* ((object (posn-object (cdadr event)))
|
||
(object-keymap (and (consp object)
|
||
(stringp (car object))
|
||
(or (get-text-property (cdr object)
|
||
'keymap
|
||
(car object))
|
||
(get-text-property (cdr object)
|
||
'local-map
|
||
(car object)))))
|
||
(keymap (lookup-key object-keymap [mode-line down-mouse-1]))
|
||
(command (or (lookup-key object-keymap [mode-line mouse-1])
|
||
keymap)))
|
||
(if (or (keymapp keymap) command)
|
||
(if (keymapp keymap)
|
||
(when (touch-screen-track-tap event)
|
||
(when-let* ((command (x-popup-menu event keymap))
|
||
(tem (lookup-key keymap
|
||
(if (consp command)
|
||
(apply #'vector command)
|
||
(vector command))
|
||
t)))
|
||
(call-interactively tem)))
|
||
(when (and (commandp command)
|
||
(touch-screen-track-tap event))
|
||
(call-interactively command nil
|
||
(vector (list 'mouse-1 (cdadr event))))))
|
||
(touch-screen-drag-mode-line-1 event))))
|
||
|
||
(global-set-key [mode-line touchscreen-begin]
|
||
#'touch-screen-drag-mode-line)
|
||
(global-set-key [bottom-divider touchscreen-begin]
|
||
#'touch-screen-drag-mode-line)
|
||
|
||
(provide 'touch-screen)
|
||
|
||
;;; touch-screen ends here
|