From e1761019a99f80b22f63e94be10ab1a5722d01b2 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 21 Jul 2023 12:23:08 +0800 Subject: [PATCH] Update Android port * doc/emacs/input.texi (Touchscreens): Document `touch-screen-preview-select'. * doc/lispref/commands.texi (Touchscreen Events): Fix typo in the descriptions of two touch screen events. * lisp/dired.el (dired-insert-set-properties): Adjust for changes to file end computation. * lisp/minibuffer.el (clear-minibuffer-message): Don't clear minibuffer message if dragging. * lisp/touch-screen.el (touch-screen-current-tool): Fix doc string. (touch-screen-preview-select): New function. (touch-screen-drag): Call it if point changes. --- doc/emacs/input.texi | 11 +++ doc/lispref/commands.texi | 4 +- lisp/dired.el | 8 +- lisp/minibuffer.el | 14 +++- lisp/touch-screen.el | 158 ++++++++++++++++++++++++++++++++++++-- 5 files changed, 180 insertions(+), 15 deletions(-) diff --git a/doc/emacs/input.texi b/doc/emacs/input.texi index f5b0d0570e1..671901fea88 100644 --- a/doc/emacs/input.texi +++ b/doc/emacs/input.texi @@ -77,6 +77,17 @@ within a single gesture. If the user option of the point or the mark within a window will begin a new ``drag'' gesture, where the region will be extended in the direction of any subsequent movement. + +@vindex touch-screen-preview-select +@cindex previewing the region during selection, touchscreens + Difficulties in making accurate adjustments to the region can also +be alleviated by indicating the position of the point relative to its +containing line within the echo area, since the window cursor may be +physically obscured by the tool. If +@code{touch-screen-preview-select} is non-@code{nil}, the line +containing point is displayed in the echo area (@pxref{Echo Area}) +during the motion of the tool, followed by another line indicating the +position of point within the first line. @end itemize @vindex touch-screen-delay diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 9a7146d7eae..52f7bcd302f 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2011,7 +2011,7 @@ the position of the finger when the event occurred. This event is sent when @var{point} is created by the user pressing a finger against the touchscreen. -These events also have imaginary prefixes keys added by +Imaginary prefix keys are also affixed to these events @code{read-key-sequence} when they originate on top of a special part of a frame or window. @xref{Key Sequence Input}. @@ -2032,7 +2032,7 @@ intercepted by another program (such as the window manager), and Emacs should undo or avoid any editing commands that would otherwise result from the touch sequence. -These events also have imaginary prefixes keys added by +Imaginary prefix keys are also affixed to these events @code{read-key-sequence} when they originate on top of a special part of a frame or window. @end table diff --git a/lisp/dired.el b/lisp/dired.el index 084ef063c4c..80aefd59771 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1916,10 +1916,10 @@ other marked file as well. Otherwise, unmark all files." (fboundp 'x-begin-drag)) "down-mouse-1: drag this file to another program mouse-2: visit this file in other window" - "mouse-2: visit this file in other window"))))) - (when (< (+ (point) 4) (line-end-position)) - (put-text-property (+ (point) 4) (line-end-position) - 'invisible 'dired-hide-details-link)))) + "mouse-2: visit this file in other window")))) + (when (< (+ end 5) (line-end-position)) + (put-text-property (+ end 5) (line-end-position) + 'invisible 'dired-hide-details-link))))) (forward-line 1)))) (defun dired--make-directory-clickable () diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 3cf679867b3..35b359a75e2 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -973,10 +973,16 @@ Intended to be called via `clear-message-function'." (when (overlayp minibuffer-message-overlay) (delete-overlay minibuffer-message-overlay) (setq minibuffer-message-overlay nil))) - - ;; Return nil telling the caller that the message - ;; should be also handled by the caller. - nil) + ;; Don't clear the message if touch screen drag-to-select is in + ;; progress, because a preview message might currently be displayed + ;; in the echo area. FIXME: find some way to place this in + ;; touch-screen.el. + (if (and touch-screen-preview-select + (eq (nth 3 touch-screen-current-tool) 'drag)) + 'dont-clear-message + ;; Return nil telling the caller that the message + ;; should be also handled by the caller. + nil)) (setq clear-message-function 'clear-minibuffer-message) diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index 89dc1c61cb6..f9611e269f4 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -40,7 +40,7 @@ to that window, a field used to store data while tracking the touch point, the initial position of the touchpoint, and another four fields to used store data while tracking the touch point. See `touch-screen-handle-point-update' and -`touch-screen-handle-point-up' for the meanings of the fifth +`touch-screen-handle-point-up' for the meanings of the fourth element.") (defvar touch-screen-set-point-commands '(mouse-set-point) @@ -96,6 +96,15 @@ active." :group 'mouse :version "30.1") +(defcustom touch-screen-preview-select nil + "If non-nil, display a preview while selecting text. +When enabled, a preview of the visible line within the window +will be displayed in the echo area while dragging combined with +an indication of the position of point within that line." + :type 'boolean + :group 'mouse + :version "30.1") + (defvar-local touch-screen-word-select-bounds nil "The start and end positions of the word last selected. Normally a cons of those two positions or nil if no word was @@ -377,6 +386,134 @@ word around EVENT; otherwise, set point to the location of EVENT." touch-screen-word-select-initial-word (cons word-start word-end))))))))) +(defun touch-screen-preview-select () + "Display a preview of the line around point in the echo area. +Unless the minibuffer is an active or the current line is +excessively tall, display an indication of the position of point +and the contents of the visible line around it within the echo +area. + +If the selected window is hscrolled or lines may be truncated, +attempt to find the extents of the text between column 0 and the +right most column of the window using `posn-at-x-y'." + (interactive) + ;; First, establish that the minibuffer isn't active and the line + ;; isn't taller than two times the frame character height. + (unless (or (> (minibuffer-depth) 0) + ;; The code below doesn't adapt well to buffers + ;; containing long lines. + (long-line-optimizations-p) + (let ((window-line-height (window-line-height)) + (maximum-height (* 2 (frame-char-height)))) + (or (and window-line-height + (> (car window-line-height) + maximum-height)) + ;; `window-line-height' isn't available. + ;; Redisplay first and try to ascertain the height + ;; of the line again. + (prog1 nil (redisplay t)) + ;; Likewise if the line height still isn't + ;; available. + (not (setq window-line-height + (window-line-height))) + ;; Actually check the height now. + (> (car window-line-height) + maximum-height)))) + (if (catch 'hscrolled-away + (let ((beg nil) end string y) + ;; Detect whether or not the window is hscrolled. If it + ;; is, set beg to the location of the first column + ;; instead. + (when (> (window-hscroll) 0) + (setq y (+ (or (cdr (posn-x-y (posn-at-point))) + (throw 'hscrolled-away t)) + (window-header-line-height) + (window-tab-line-height))) + (let* ((posn (posn-at-x-y 0 y)) + (point (posn-point posn))) + (setq beg point))) + ;; Check if lines are being truncated; if so, use the + ;; character at the end of the window as the end of the + ;; text to be displayed, as the visual line may extend + ;; past the window. + (when (or truncate-lines beg) ; truncate-lines or hscroll. + (setq y (or y (+ (or (cdr (posn-x-y (posn-at-point))) + (throw 'hscrolled-away t)) + (window-header-line-height) + (window-tab-line-height)))) + (let* ((posn (posn-at-x-y (1- (window-width nil t)) y)) + (point (posn-point posn))) + (setq end point))) + ;; Now find the rest of the visual line. + (save-excursion + (unless beg + (beginning-of-visual-line) + (setq beg (point))) + (unless end + (end-of-visual-line) + (setq end (point)))) + ;; Obtain a substring containing the beginning of the + ;; visual line and the end. + (setq string (buffer-substring beg end)) + ;; Hack `invisible' properties within the new string. + ;; Look for each change of the property that is a variable + ;; name and replace it with its actual value according to + ;; `buffer-invisibility-spec'. + (when (listp buffer-invisibility-spec) + (let ((index 0) + (property (get-text-property 0 + 'invisible + string)) + index1 invisible) + (while index + ;; Find the end of this text property. + (setq index1 (next-single-property-change index + 'invisible + string)) + ;; Replace the property with whether or not it is + ;; non-nil. + (when property + (setq invisible nil) + (catch 'invisible + (dolist (spec buffer-invisibility-spec) + ;; Process one element of the buffer + ;; invisibility specification. + (if (consp spec) + (when (eq (cdr spec) 't) + ;; (ATOM . t) makes N invisible if N is + ;; equal to ATOM or a list containing + ;; ATOM. + (when (or (eq (car spec) property) + (and (listp spec) + (memq (car spec) invisible))) + (throw 'invisible (setq invisible t)))) + ;; Otherwise, N is invisible if SPEC is + ;; equal to N. + (when (eq spec property) + (throw 'invisible (setq invisible t)))))) + (put-text-property index (or index1 + (- end beg)) + 'invisible invisible string)) + ;; Set index to that of the next text property and + ;; continue. + (setq index index1 + property (and index1 + (get-text-property index1 + 'invisible + string)))))) + (let ((resize-mini-windows t) difference width + (message-log-max nil)) + ;; Find the offset of point from beg and display a cursor + ;; below. + (setq difference (- (point) beg) + width (string-pixel-width + (substring string 0 difference))) + (message "%s\n%s^" string + (propertize " " + 'display (list 'space + :width (list width))))) + nil))))) + (defun touch-screen-drag (event) "Handle a drag EVENT by setting the region to its new point. If `touch-screen-word-select' and EVENT lies outside the last @@ -387,15 +524,17 @@ area." (let* ((posn (cadr event)) ; Position of the tool. (point (posn-point posn)) ; Point of the event. ; Window where the tap originated. - (window (nth 1 touch-screen-current-tool))) + (window (nth 1 touch-screen-current-tool)) + initial-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. + (setq initial-point (point)) (if (and (eq (posn-window posn) window) - point (not (eq point (point)))) + point (not (eq point initial-point))) (let* ((bounds touch-screen-word-select-bounds) (initial touch-screen-word-select-initial-word) (maybe-select-word (or (not touch-screen-word-select) @@ -464,7 +603,12 @@ area." (when (and (>= (point) (mark)) (> (mark) (car initial))) (set-mark (car initial)))) - (setq touch-screen-word-select-bounds nil)))) + (setq touch-screen-word-select-bounds nil))) + ;; Finally, display a preview of the line around point if + ;; requested by the user. + (when (and touch-screen-preview-select + (not (eq (point) initial-point))) + (touch-screen-preview-select))) ;; POSN is outside the window. Scroll accordingly. (let ((relative-xy (touch-screen-relative-xy posn window))) @@ -481,7 +625,11 @@ area." (ignore-errors (goto-char (1+ (window-end nil t))) (setq touch-screen-word-select-bounds nil)) - (redisplay))))))))) + (redisplay))) + ;; Finally, display a preview of the line now around point + ;; if requested by the user. + (when touch-screen-preview-select + (touch-screen-preview-select)))))))) (defun touch-screen-restart-drag (event) "Restart dragging to select text. -- 2.39.5