From 882e1d659fec8062e96cfb614e73954840c6ecfe Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 20 Jul 2023 09:22:41 +0800 Subject: [PATCH] Introduce a `dired-click-select' mode * doc/emacs/dired.texi (Marks vs Flags): Document command bound to `touchscreen-hold'. * doc/lispref/commands.texi (Touchscreen Events): Describe `touch-screen-inhibit-drag'. * etc/NEWS: Improve description of changes to touch screen support. * lisp/dired-aux.el (dired-do-chxxx, dired-do-chmod) (dired-do-print, dired-do-shell-command, dired-do-compress-to) (dired-do-create-files, dired-do-rename, dired-do-isearch) (dired-do-isearch-regexp, dired-do-search) (dired-do-query-replace-regexp, dired-do-find-regexp) (dired-vc-next-action): Disable ``click to select'' after running this command. * lisp/dired.el (dired-insert-set-properties): Attach click-to-select keymap to file names if necessary. (dired-mode-map): Bind `touchscreen-hold' to click to select mode. (dired-post-do-command): New function. (dired-do-delete): Call it. (dired-mark-for-click, dired-enable-click-to-select-mode): New functions. (dired-click-to-select-mode): New minor mode. * lisp/touch-screen.el (touch-screen-current-tool): Fix doc string. (touch-screen-inhibit-drag): New function. --- doc/emacs/dired.texi | 13 ++++ doc/lispref/commands.texi | 27 +++++-- etc/NEWS | 8 ++- lisp/dired-aux.el | 35 ++++++--- lisp/dired.el | 146 ++++++++++++++++++++++++++++++++------ lisp/touch-screen.el | 33 +++++++-- 6 files changed, 217 insertions(+), 45 deletions(-) diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 77c4e09c826..244dd7eb525 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -684,6 +684,19 @@ cause trouble. For example, after renaming one or more files, @code{dired-undo} restores the original names in the Dired buffer, which gets the Dired buffer out of sync with the actual contents of the directory. + +@item touchscreen-hold +@kindex touchscreen-hold @r{(Dired)} +@findex dired-click-to-select-mode +@findex dired-enable-click-to-select-mode +Enter a ``click to select'' mode, where using the mouse button +@kbd{mouse-2} on a file name will cause its mark to be toggled. This +mode is useful when performing file management using a touch screen +device. + +It is enabled when a ``hold'' gesture (@pxref{Touchscreens}) is +detected over a file name, and is automatically disabled once a Dired +command operates on the marked files. @end table @node Operating on Files diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index d53e45a73de..9a7146d7eae 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2145,10 +2145,11 @@ the initial @code{touchscreen-begin} event within that touch sequence. @cindex handling touch screen events @cindex tap and drag, touch screen gestures -Emacs provides two functions to handle touch screen events independent -of gesture recognition or mouse event translation. They are intended -to be used by commands bound to @code{touchscreen-begin}, to recognize -and handle common gestures. +Several functions are provided for Lisp programs that handle touch +screen events. The intended use of the first two functions described +below is from commands bound directly to @code{touchscreen-begin} +events; they allow responding to commonly used touch screen gestures +separately from mouse event translation. @defun touch-screen-track-tap event &optional update data This function is used to track a single ``tap'' gesture originating @@ -2178,6 +2179,24 @@ pixels from its position in @code{event}) to qualify as an actual drag. @end defun +In addition to those two functions, a function is provided for +commands bound to some types of events generated through mouse event +translation to prevent unwanted events from being generated after it +is called. + +@defun touch-screen-inhibit-drag +This function inhibits the generation of @code{touchscreen-drag} +events during mouse event translation for the duration of the touch +sequence being translated after it is called. It must be called from +a command which is bound to a @code{touchscreen-hold} or +@code{touchscreen-drag} event, and signals an error otherwise. + +Since this function can only be called after a gesture is already +recognized during mouse event translation, no mouse events will be +generated from touch events constituting the previously mentioned +touch sequence after it is called. +@end defun + @node Focus Events @subsection Focus Events @cindex focus event diff --git a/etc/NEWS b/etc/NEWS index c0cec91e77f..b59624e0df8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -126,9 +126,11 @@ right-aligned to is controlled by the new user option * Editing Changes in Emacs 30.1 +++ -** Emacs now has better support for touchscreen events. -Many touch screen gestures are now implemented, as is support for -tapping buttons and opening menus. +** Emacs now has better support for touchscreen devices. +Many touch screen gestures are now implemented and translated into +mouse or gesture events, and support for tapping tool bar buttons and +opening menus has been written. Countless packages, such as Dired and +Custom have been adjusted to better understand touch screen input. --- ** On X, Emacs now supports input methods which perform "string conversion". diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index a07406e4c0d..3e8b4c3c8fc 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -480,7 +480,8 @@ List has a form of (file-name full-file-name (attribute-list))." (if failures (dired-log-summary (format "%s: error" operation) - nil)))) + nil))) + (dired-post-do-command)) ;;;###autoload (defun dired-do-chmod (&optional arg) @@ -531,7 +532,8 @@ has no effect on MS-Windows." (if num-modes num-modes (file-modes-symbolic-to-number modes (file-modes file 'nofollow))) 'nofollow)) - (dired-do-redisplay arg))) + (dired-do-redisplay arg)) + (dired-post-do-command)) ;;;###autoload (defun dired-do-chgrp (&optional arg) @@ -634,7 +636,8 @@ Uses the shell command coming from variables `lpr-command' and lpr-switches)) " ") 'print arg file-list))) - (dired-run-shell-command (dired-shell-stuff-it command file-list nil)))) + (dired-run-shell-command (dired-shell-stuff-it command file-list nil))) + (dired-post-do-command)) (defun dired-mark-read-string (prompt initial op-symbol arg files &optional default-value collection) @@ -918,7 +921,8 @@ Also see the `dired-confirm-shell-command' variable." nil file-list) ;; execute the shell command (dired-run-shell-command - (dired-shell-stuff-it command file-list nil arg))))))) + (dired-shell-stuff-it command file-list nil arg)))))) + (dired-post-do-command)) ;; Might use {,} for bash or csh: (defvar dired-mark-prefix "" @@ -1547,7 +1551,8 @@ and `dired-compress-files-alist'." "Compressed %d files to %s" (length in-files)) (length in-files) - (file-name-nondirectory out-file))))))) + (file-name-nondirectory out-file)))))) + (dired-post-do-command)) ;;;###autoload (defun dired-compress-file (file) @@ -2554,7 +2559,8 @@ Optional arg HOW-TO determines how to treat the target. (and (functionp dired-do-revert-buffer) (funcall dired-do-revert-buffer target))) (dired-fun-in-all-buffers (file-name-directory target) nil - #'revert-buffer)))))) + #'revert-buffer))))) + (dired-post-do-command)) ;; Read arguments for a marked-files command that wants a file name, ;; perhaps popping up the list of marked files. @@ -2887,7 +2893,8 @@ Also see `dired-do-revert-buffer'." (dired-get-marked-files nil arg)) (user-error "Can't rename \".\" or \"..\" files")) (dired-do-create-files 'move #'dired-rename-file - "Move" arg dired-keep-marker-rename "Rename")) + "Move" arg dired-keep-marker-rename "Rename") + (dired-post-do-command)) ;;; Operate on files matched by regexp @@ -3579,14 +3586,18 @@ It's intended to override the default search function." "Search for a string through all marked files using Isearch." (interactive) (multi-isearch-files - (dired-get-marked-files nil nil #'dired-nondirectory-p nil t))) + (prog1 (dired-get-marked-files nil nil + #'dired-nondirectory-p nil t) + (dired-post-do-command)))) ;;;###autoload (defun dired-do-isearch-regexp () "Search for a regexp through all marked files using Isearch." (interactive) - (multi-isearch-files-regexp - (dired-get-marked-files nil nil 'dired-nondirectory-p nil t))) + (prog1 (multi-isearch-files-regexp + (dired-get-marked-files nil nil + 'dired-nondirectory-p nil t)) + (dired-post-do-command))) (declare-function fileloop-continue "fileloop" ()) @@ -3603,6 +3614,7 @@ To continue searching for next match, use command \\[fileloop-continue]." regexp (dired-get-marked-files nil nil #'dired-nondirectory-p) 'default) + (dired-post-do-command) (fileloop-continue)) ;;;###autoload @@ -3626,6 +3638,7 @@ resume the query replace with the command \\[fileloop-continue]." (if (and buffer (with-current-buffer buffer buffer-read-only)) (error "File `%s' is visited read-only" file)))) + (dired-post-do-command) (fileloop-initialize-replace from to (dired-get-marked-files nil nil #'dired-nondirectory-p) (if (equal from (downcase from)) nil 'default) @@ -3675,6 +3688,7 @@ REGEXP should use constructs supported by your local `grep' command." (user-error "No matches for: %s" regexp)) (message "Searching...done") xrefs)))) + (dired-post-do-command) (xref-show-xrefs fetcher nil))) ;;;###autoload @@ -3767,6 +3781,7 @@ case, the VERBOSE argument is ignored." (file-name-as-directory file) file)) marked-files)))) + (dired-post-do-command) (if mark-files (let ((transient-hook (make-symbol "vc-dir-mark-files"))) (fset transient-hook diff --git a/lisp/dired.el b/lisp/dired.el index 90342069154..084ef063c4c 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1872,6 +1872,9 @@ other marked file as well. Otherwise, unmark all files." keymap) "Keymap applied to file names when `dired-mouse-drag-files' is enabled.") +(defvar dired-click-to-select-mode) +(defvar dired-click-to-select-map) + (defun dired-insert-set-properties (beg end) "Add various text properties to the lines in the region, from BEG to END." (save-excursion @@ -1893,27 +1896,27 @@ other marked file as well. Otherwise, unmark all files." (when (member (cl-incf i) dired-hide-details-preserved-columns) (put-text-property opoint (point) 'invisible nil)) (setq opoint (point))))) - (when (and dired-mouse-drag-files (fboundp 'x-begin-drag)) - (put-text-property (point) - (save-excursion - (dired-move-to-end-of-filename) - (backward-char) - (point)) - 'keymap - dired-mouse-drag-files-map)) - (add-text-properties - (point) - (progn - (dired-move-to-end-of-filename) - (point)) - `(mouse-face - highlight - dired-filename t - help-echo ,(if (and dired-mouse-drag-files - (fboundp 'x-begin-drag)) - "down-mouse-1: drag this file to another program + (let ((beg (point)) (end (save-excursion + (dired-move-to-end-of-filename) + (1- (point))))) + (if dired-click-to-select-mode + (put-text-property beg end 'keymap + dired-click-to-select-map) + (when (and dired-mouse-drag-files (fboundp 'x-begin-drag)) + (put-text-property beg end 'keymap + dired-mouse-drag-files-map))) + (add-text-properties + beg (1+ end) + `(mouse-face + highlight + dired-filename t + help-echo ,(if dired-click-to-select-mode + "mouse-2: mark or unmark this file" + (if (and dired-mouse-drag-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"))) + "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)))) @@ -2287,7 +2290,9 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." ": d" #'epa-dired-do-decrypt ": v" #'epa-dired-do-verify ": s" #'epa-dired-do-sign - ": e" #'epa-dired-do-encrypt) + ": e" #'epa-dired-do-encrypt + ;; Click-to-select. + "" #'dired-enable-click-to-select-mode) (put 'dired-find-file :advertised-binding (kbd "RET")) @@ -3700,6 +3705,11 @@ non-empty directories is allowed." (or nomessage (message "(No deletions requested)"))))) +(defun dired-post-do-command () + "Disable `dired-click-to-select-mode' after an operation." + (when dired-click-to-select-mode + (dired-click-to-select-mode -1))) + (defun dired-do-delete (&optional arg) "Delete all marked (or next ARG) files. `dired-recursive-deletes' controls whether deletion of @@ -3717,7 +3727,8 @@ non-empty directories is allowed." m)) arg)) arg t) - (dolist (m markers) (set-marker m nil)))) + (dolist (m markers) (set-marker m nil))) + (dired-post-do-command)) (defvar dired-deletion-confirmer 'yes-or-no-p) ; or y-or-n-p? @@ -4938,6 +4949,97 @@ Interactively with prefix argument, read FILE-NAME." (interactive nil dired-mode) (eww-open-file (dired-get-file-for-visit))) + +;;; Click-To-Select mode + +(defvar dired-click-to-select-map (make-sparse-keymap) + "Keymap placed on files under `dired-click-to-select' mode.") + +(define-key dired-click-to-select-map [mouse-2] + #'dired-mark-for-click) + +(defun dired-mark-for-click (event) + "Mark or unmark the file underneath the mouse click at EVENT. +See `dired-click-to-select-mode' for more details." + (interactive "e") + (let ((posn (event-start event)) + (inhibit-read-only t)) + (with-selected-window (posn-window posn) + (goto-char (posn-point posn)) + (save-excursion + (dired-repeat-over-lines + 1 (lambda () + (let ((char (char-after))) + (when (or (not (looking-at-p dired-re-dot)) + (not (equal dired-marker-char dired-del-marker))) + (delete-char 1) + (insert (if (eq char dired-marker-char) + ;; Insert a space to unmark the file if + ;; it's already marked. + ?\s + ;; Otherwise mark the file. + dired-marker-char)))))))))) + +(defun dired-enable-click-to-select-mode (event) + "Enable `dired-click-to-select-mode' and mark the file under EVENT. +If there is no file under EVENT, call `touch-screen-hold' with +EVENT instead." + (interactive "e") + (let* ((posn (event-start event)) + (window (posn-window posn)) + (point (posn-point posn))) + (if (and window point + (get-text-property point 'dired-filename + (window-buffer window))) + (progn (beep) + (touch-screen-inhibit-drag) + (with-selected-window window + (goto-char point) + (save-excursion (dired-mark 1)) + (dired-click-to-select-mode 1))) + (touch-screen-hold event)))) + +(define-minor-mode dired-click-to-select-mode + "Toggle click-to-select inside this Dired buffer. +When this minor mode is enabled, using `mouse-2' on a file name +within a Dired buffer will toggle its mark instead of going to it +within another window. + +Disabling this minor mode will unmark all files within the Dired +buffer. + +`dired-click-to-select-mode' is automatically disabled after any +Dired operation (command whose name starts with `dired-do') +completes." + :group 'dired + :lighter " Click-To-Select" + (unless (derived-mode-p 'dired-mode 'wdired-mode) + (error "Not a Dired buffer")) + (if dired-click-to-select-mode + (setq-local tool-bar-map + `(keymap (exit-click-to-select menu-item + "Exit Click To Select Mode" + dired-click-to-select-mode + :help "Exit `dired-click-to-select-mode'." + :image ,(tool-bar--image-expression "close") + :enable t))) + ;; Reset the default tool bar. + (kill-local-variable 'tool-bar-map) + (dired-unmark-all-marks)) + ;; Repropertize this Dired buffer. + (let ((inhibit-read-only t)) + (remove-text-properties (point-min) (point-max) + '(invisible nil + keymap nil + dired-filename nil + help-echo nil + mouse-face nil)) + (when dired-make-directory-clickable + (dired--make-directory-clickable)) + (dired-insert-set-properties (point-min) (point-max))) + ;; Redisplay the tool bar. + (force-mode-line-update)) + (provide 'dired) (run-hooks 'dired-load-hook) ; for your customizations diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index 19b3d3b2cf4..df9a5a454fc 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -23,11 +23,11 @@ ;;; 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. +;; It is used on X and Android, currently the only systems where Emacs +;; supports touch input. ;; -;; See (elisp)Touchscreen Events for a description of the details of touch -;; events. +;; See (elisp)Touchscreen Events for a description of the details of +;; touch events. ;;; Code: @@ -39,8 +39,9 @@ containing the last known position of the touch point, relative 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' for the meanings of the -fourth element.") +See `touch-screen-handle-point-update' and +`touch-screen-handle-point-up' for the meanings of the fifth +element.") (defvar touch-screen-set-point-commands '(mouse-set-point) "List of commands known to set the point. @@ -1211,6 +1212,26 @@ touch point in EVENT did not move significantly, and t otherwise." +;;; Event handling exports. These functions are intended for use by +;;; Lisp commands bound to touch screen gesture events. + +(defun touch-screen-inhibit-drag () + "Inhibit subsequent `touchscreen-drag' events from being sent. +Prevent `touchscreen-drag' and translated mouse events from being +sent until the touch sequence currently being translated ends. +Must be called from a command bound to a `touchscreen-hold' or +`touchscreen-drag' event." + (let* ((tool touch-screen-current-tool) + (current-what (nth 4 tool))) + ;; Signal an error if no hold or drag is in progress. + (when (and (not (eq current-what 'hold) + (eq current-what 'drag))) + (error "Calling `touch-screen-inhibit-drag' outside hold or drag")) + ;; Now set the fourth element of tool to `command-inhibit'. + (setcar (nthcdr 3 tool) 'command-inhibit))) + + + (provide 'touch-screen) ;;; touch-screen ends here -- 2.39.5