1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-20 18:17:20 +00:00

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.
This commit is contained in:
Po Lu 2023-07-20 09:22:41 +08:00
parent 1eb24c6c38
commit 882e1d659f
6 changed files with 217 additions and 45 deletions

View File

@ -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

View File

@ -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

View File

@ -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".

View File

@ -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

View File

@ -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.
"<touchscreen-hold>" #'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

View File

@ -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