diff options
Diffstat (limited to 'lisp')
47 files changed, 1823 insertions, 195 deletions
diff --git a/lisp/battery.el b/lisp/battery.el index 4306d5b2058..c55fcbbee8c 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -29,9 +29,11 @@ ;; - The `/sys/class/power_supply/' files of Linux >= 2.6.39. ;; - The `/proc/acpi/' directory structure of Linux 2.4.20 and 2.6. ;; - The `/proc/apm' file format of Linux version 1.3.58 or newer. +;; - The Haiku ACPI battery driver. ;; - BSD by using the `apm' program. ;; - Darwin (macOS) by using the `pmset' program. ;; - Windows via the GetSystemPowerStatus API call. +;; - Android 5 or later via the BatteryManager APIs. ;;; Code: @@ -106,6 +108,12 @@ Value does not include \".\" or \"..\"." (file-readable-p "/proc/") (file-readable-p "/proc/apm")) #'battery-linux-proc-apm) + ;; Now try the Android battery status function. + ;; Note that even though the Linux kernel APIs are sometimes + ;; available on Android, they are badly implemented by Android + ;; kernels, so avoid using those. + ((eq system-type 'android) + #'battery-android) ((and (eq system-type 'berkeley-unix) (file-executable-p "/usr/sbin/apm")) #'battery-bsd-apm) @@ -1072,6 +1080,78 @@ The following %-sequences are provided: (cons ?t (or remaining-time "N/A"))))) +;;; `BatteryManager' interface for Android. + +(declare-function android-query-battery "androidfns.c") + +(defun battery-android () + "Get battery status information using Android. + +The following %-sequences are provided: +%c Current capacity (mAh) +%r Current rate of charge or discharge (mA) +%L AC line status (verbose). +%B Battery status (verbose) +%b Battery status, empty means high, `-' means low, + `+' means charging and `?' means unknown. +%d Temperature (in degrees Celsius) +%p Battery load percentage. +%m Remaining time (to charge) in minutes. +%h Remaining time (to charge) in hours. +%t Remaining time (to charge) in the form `h:min'." + (when-let* ((status (android-query-battery))) + (let* ((percentage nil) + (capacity nil) + (sym-status nil) + (symbol nil) + (rate nil) + (remaining nil) + (hours nil) + (minutes nil)) + ;; Figure out the percentage. + (setq percentage (number-to-string (car status))) + ;; Figure out the capacity + (setq capacity (number-to-string (/ (cadr status) 1000))) + ;; Figure out the battery status. + (let ((percentage (car status))) + (cl-ecase (nth 4 status) + (2 (setq sym-status "charging" symbol "+")) + (3 (setq sym-status "discharging" + symbol (if (< percentage 15) "-" " "))) + (5 (setq sym-status "full" symbol " ")) + (4 (setq sym-status "not charging" + symbol (if (< percentage 15) "-" " "))) + (1 (setq sym-status "unknown" symbol "?")))) + ;; Figure out the rate of charge. + (setq rate (/ (nth 3 status) 1000)) + ;; Figure out the remaining time. + (let* ((time (nth 5 status)) + (mins (/ time (* 1000 60))) + (hours-left (/ mins 60)) + (mins (mod mins 60))) + (unless (eq time -1) + (setq remaining (format "%d:%d" hours-left mins) + hours (number-to-string hours-left) + minutes (number-to-string mins)))) + ;; Return results. + (list (cons ?c capacity) + (cons ?p percentage) + (cons ?r rate) + (cons ?B sym-status) + (cons ?b symbol) + (cons ?m (or minutes "N/A")) + (cons ?h (or hours "N/A")) + (cons ?t (or remaining "N/A")) + (cons ?L (cl-case (nth 6 status) + (0 "off-line") + (1 "on-line") + (2 "on-line (dock)") + (3 "on-line (USB)") + (4 "on-line (wireless)") + (t "unknown"))) + (cons ?t (/ (or (nth 7 status) 0) 10.0)))))) + + ;;; Private functions. (defun battery-format (format alist) diff --git a/lisp/bindings.el b/lisp/bindings.el index c77b64c05da..eec51a4e413 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -1521,6 +1521,9 @@ if `inhibit-field-text-motion' is non-nil." (define-key special-event-map [sigusr1] 'ignore) (define-key special-event-map [sigusr2] 'ignore) +;; Text conversion +(define-key global-map [text-conversion] 'analyze-text-conversion) + ;; Don't look for autoload cookies in this file. ;; Local Variables: ;; no-update-autoloads: t diff --git a/lisp/button.el b/lisp/button.el index f043073ea86..65abb81ec46 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -72,7 +72,12 @@ Mode-specific keymaps may want to use this as their parent keymap." ;; mode-line or header-line, the `mode-line' or `header-line' prefix ;; shouldn't be necessary! "<mode-line> <mouse-2>" #'push-button - "<header-line> <mouse-2>" #'push-button) + "<header-line> <mouse-2>" #'push-button + ;; `push-button' will automatically dispatch to + ;; `touch-screen-track-tap'. + "<mode-line> <touchscreen-down>" #'push-button + "<header-line> <touchscreen-down>" #'push-button + "<touchscreen-down>" #'push-button) (define-minor-mode button-mode "A minor mode for navigating to buttons with the TAB key." @@ -454,18 +459,22 @@ instead of starting at the next button." (defun push-button (&optional pos use-mouse-action) "Perform the action specified by a button at location POS. -POS may be either a buffer position or a mouse-event. If -USE-MOUSE-ACTION is non-nil, invoke the button's `mouse-action' -property instead of its `action' property; if the button has no -`mouse-action', the value of `action' is used instead. +POS may be either a buffer position, a mouse-event, or a +`touchscreen-down' event. If USE-MOUSE-ACTION is non-nil, invoke +the button's `mouse-action' property instead of its `action' +property; if the button has no `mouse-action', the value of +`action' is used instead. + +If POS is a `touchscreen-down' event, wait for the corresponding +`touchscreen-up' event before calling `push-button'. The action in both cases may be either a function to call or a marker to display and is invoked using `button-activate' (which see). POS defaults to point, except when `push-button' is invoked -interactively as the result of a mouse-event, in which case, the -mouse event is used. +interactively as the result of a mouse-event or touchscreen +event, in which case, the position in the event event is used. If there's no button at POS, do nothing and return nil, otherwise return t. @@ -483,7 +492,12 @@ pushing a button, use the `button-describe' command." (if str-button ;; mode-line, header-line, or display string event. (button-activate str t) - (push-button (posn-point posn) t))))) + (if (eq (car pos) 'touchscreen-down) + ;; If touch-screen-track tap returns nil, then the + ;; tap was cancelled. + (when (touch-screen-track-tap pos) + (push-button (posn-point posn) t)) + (push-button (posn-point posn) t)))))) ;; POS is just normal position (let ((button (button-at (or pos (point))))) (when button diff --git a/lisp/cedet/semantic/db-ebrowse.el b/lisp/cedet/semantic/db-ebrowse.el index f8ea73cbdde..3e54b9e76cf 100644 --- a/lisp/cedet/semantic/db-ebrowse.el +++ b/lisp/cedet/semantic/db-ebrowse.el @@ -158,7 +158,8 @@ is specified by `semanticdb-default-save-directory'." ;; Call the EBROWSE command. (message "Creating ebrowse file: %s ..." savein) (call-process-region (point-min) (point-max) - "ebrowse" nil "*EBROWSE OUTPUT*" nil + ebrowse-program-name + nil "*EBROWSE OUTPUT*" nil (concat "--output-file=" savein) "--very-verbose") ) diff --git a/lisp/comint.el b/lisp/comint.el index 9d2c245247f..e1786e7e670 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -694,6 +694,9 @@ Entry to this mode runs the hooks on `comint-mode-hook'." (setq-local comint-last-input-start (point-min-marker)) (setq-local comint-last-input-end (point-min-marker)) (setq-local comint-last-output-start (make-marker)) + ;; It is ok to let the input method edit prompt text, but RET must + ;; be processed by Emacs. + (setq text-conversion-style 'action) (make-local-variable 'comint-last-prompt) (make-local-variable 'comint-prompt-regexp) ; Don't set; default (make-local-variable 'comint-input-ring-size) ; ...to global val. diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index dbef5f47cd6..d0eba71e754 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -2209,7 +2209,7 @@ and `face'." ;;; The `custom' Widget. (defface custom-button - '((((type x w32 ns haiku pgtk) (class color)) ; Like default mode line + '((((type x w32 ns haiku pgtk android) (class color)) ; Like default mode line :box (:line-width 2 :style released-button) :background "lightgrey" :foreground "black")) "Face for custom buffer buttons if `custom-raised-buttons' is non-nil." @@ -2217,7 +2217,7 @@ and `face'." :group 'custom-faces) (defface custom-button-mouse - '((((type x w32 ns haiku pgtk) (class color)) + '((((type x w32 ns haiku pgtk android) (class color)) :box (:line-width 2 :style released-button) :background "grey90" :foreground "black") (t @@ -2242,7 +2242,7 @@ and `face'." (if custom-raised-buttons 'custom-button-mouse 'highlight)) (defface custom-button-pressed - '((((type x w32 ns haiku pgtk) (class color)) + '((((type x w32 ns haiku pgtk android) (class color)) :box (:line-width 2 :style pressed-button) :background "lightgrey" :foreground "black") (t :inverse-video t)) diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el index b894965eae4..a7fd8e4a70e 100644 --- a/lisp/elec-pair.el +++ b/lisp/elec-pair.el @@ -162,6 +162,20 @@ Before attempting a skip, if `electric-pair-skip-whitespace' is non-nil, this function is called. It move point to a new buffer position, presumably skipping only whitespace in between.") +(defun electric-pair-analyze-conversion (string) + "Notice that STRING has been deleted by an input method. +If the last character of STRING is an electric pair character, +and the character after point is too, then delete that other +character." + (let* ((prev (aref string (1- (length string)))) + (next (char-after)) + (syntax-info (electric-pair-syntax-info prev)) + (syntax (car syntax-info)) + (pair (cadr syntax-info))) + (when (and next pair (memq syntax '(?\( ?\" ?\$)) + (eq pair next)) + (delete-char 1)))) + (defun electric-pair--skip-whitespace () "Skip whitespace forward, not crossing comment or string boundaries." (let ((saved (point)) diff --git a/lisp/electric.el b/lisp/electric.el index cef5326852c..8b379ed16e2 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -294,6 +294,7 @@ or comment." ;;;###autoload (define-key global-map "\C-j" 'electric-newline-and-maybe-indent) + ;;;###autoload (defun electric-newline-and-maybe-indent () "Insert a newline. diff --git a/lisp/faces.el b/lisp/faces.el index 739e5bdf310..dabe847698c 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2920,7 +2920,7 @@ Note: Other faces cannot inherit from the cursor face." (((type haiku)) :foreground "B_MENU_ITEM_TEXT_COLOR" :background "B_MENU_BACKGROUND_COLOR") - (((type x w32 ns pgtk) (class color)) + (((type x w32 ns pgtk android) (class color)) :background "grey75") (((type x) (class mono)) :background "grey")) diff --git a/lisp/files.el b/lisp/files.el index 148f47cbc97..e93181499b7 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5764,9 +5764,14 @@ Before and after saving the buffer, this function runs (run-hook-with-args-until-success 'write-file-functions) ;; If a hook returned t, file is already "written". ;; Otherwise, write it the usual way now. - (let ((dir (file-name-directory + (let ((file (buffer-file-name)) + (dir (file-name-directory (expand-file-name buffer-file-name)))) - (unless (file-exists-p dir) + ;; Some systems have directories (like /content on + ;; Android) in which files can exist without a + ;; corresponding parent directory. + (unless (or (file-exists-p file) + (file-exists-p dir)) (if (y-or-n-p (format-message "Directory `%s' does not exist; create? " dir)) diff --git a/lisp/frame.el b/lisp/frame.el index 39e8a4c88b8..ba5d1caafa2 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1653,6 +1653,7 @@ live frame and defaults to the selected one." (declare-function ns-frame-geometry "nsfns.m" (&optional frame)) (declare-function pgtk-frame-geometry "pgtkfns.c" (&optional frame)) (declare-function haiku-frame-geometry "haikufns.c" (&optional frame)) +(declare-function android-frame-geometry "androidfns.c" (&optional frame)) (defun frame-geometry (&optional frame) "Return geometric attributes of FRAME. @@ -1706,6 +1707,8 @@ and width values are in pixels. (pgtk-frame-geometry frame)) ((eq frame-type 'haiku) (haiku-frame-geometry frame)) + ((eq frame-type 'android) + (android-frame-geometry frame)) (t (list '(outer-position 0 . 0) @@ -1832,6 +1835,7 @@ of frames like calls to map a frame or change its visibility." (declare-function ns-frame-edges "nsfns.m" (&optional frame type)) (declare-function pgtk-frame-edges "pgtkfns.c" (&optional frame type)) (declare-function haiku-frame-edges "haikufns.c" (&optional frame type)) +(declare-function android-frame-edges "androidfns.c" (&optional frame type)) (defun frame-edges (&optional frame type) "Return coordinates of FRAME's edges. @@ -1859,6 +1863,8 @@ FRAME." (pgtk-frame-edges frame type)) ((eq frame-type 'haiku) (haiku-frame-edges frame type)) + ((eq frame-type 'android) + (android-frame-edges frame type)) (t (list 0 0 (frame-width frame) (frame-height frame)))))) @@ -1867,6 +1873,7 @@ FRAME." (declare-function ns-mouse-absolute-pixel-position "nsfns.m") (declare-function pgtk-mouse-absolute-pixel-position "pgtkfns.c") (declare-function haiku-mouse-absolute-pixel-position "haikufns.c") +(declare-function android-mouse-absolute-pixel-position "androidfns.c") (defun mouse-absolute-pixel-position () "Return absolute position of mouse cursor in pixels. @@ -1885,6 +1892,8 @@ position (0, 0) of the selected frame's terminal." (pgtk-mouse-absolute-pixel-position)) ((eq frame-type 'haiku) (haiku-mouse-absolute-pixel-position)) + ((eq frame-type 'android) + (android-mouse-absolute-pixel-position)) (t (cons 0 0))))) @@ -1893,6 +1902,8 @@ position (0, 0) of the selected frame's terminal." (declare-function w32-set-mouse-absolute-pixel-position "w32fns.c" (x y)) (declare-function x-set-mouse-absolute-pixel-position "xfns.c" (x y)) (declare-function haiku-set-mouse-absolute-pixel-position "haikufns.c" (x y)) +(declare-function android-set-mouse-absolute-pixel-position + "androidfns.c" (x y)) (defun set-mouse-absolute-pixel-position (x y) "Move mouse pointer to absolute pixel position (X, Y). @@ -1909,7 +1920,9 @@ position (0, 0) of the selected frame's terminal." ((eq frame-type 'w32) (w32-set-mouse-absolute-pixel-position x y)) ((eq frame-type 'haiku) - (haiku-set-mouse-absolute-pixel-position x y))))) + (haiku-set-mouse-absolute-pixel-position x y)) + ((eq frame-type 'android) + (android-set-mouse-absolute-pixel-position x y))))) (defun frame-monitor-attributes (&optional frame) "Return the attributes of the physical monitor dominating FRAME. @@ -2005,6 +2018,7 @@ workarea attribute." ;; TODO: implement this on PGTK. ;; (declare-function pgtk-frame-list-z-order "pgtkfns.c" (&optional display)) (declare-function haiku-frame-list-z-order "haikufns.c" (&optional display)) +(declare-function android-frame-list-z-order "androidfns.c" (&optional display)) (defun frame-list-z-order (&optional display) "Return list of Emacs' frames, in Z (stacking) order. @@ -2030,13 +2044,17 @@ Return nil if DISPLAY contains no Emacs frame." ;; (pgtk-frame-list-z-order display) nil) ((eq frame-type 'haiku) - (haiku-frame-list-z-order display))))) + (haiku-frame-list-z-order display)) + ((eq frame-type 'android) + (android-frame-list-z-order display))))) (declare-function x-frame-restack "xfns.c" (frame1 frame2 &optional above)) (declare-function w32-frame-restack "w32fns.c" (frame1 frame2 &optional above)) (declare-function ns-frame-restack "nsfns.m" (frame1 frame2 &optional above)) (declare-function pgtk-frame-restack "pgtkfns.c" (frame1 frame2 &optional above)) (declare-function haiku-frame-restack "haikufns.c" (frame1 frame2 &optional above)) +(declare-function android-frame-restack "androidfns.c" (frame1 frame2 + &optional above)) (defun frame-restack (frame1 frame2 &optional above) "Restack FRAME1 below FRAME2. @@ -2070,7 +2088,9 @@ Some window managers may refuse to restack windows." ((eq frame-type 'haiku) (haiku-frame-restack frame1 frame2 above)) ((eq frame-type 'pgtk) - (pgtk-frame-restack frame1 frame2 above)))) + (pgtk-frame-restack frame1 frame2 above)) + ((eq frame-type 'android) + (android-frame-restack frame1 frame2 above)))) (error "Cannot restack frames"))) (defun frame-size-changed-p (&optional frame) @@ -2105,6 +2125,7 @@ for FRAME." ;; or in https://debbugs.gnu.org/cgi/bugreport.cgi?bug=35058#17. (declare-function msdos-mouse-p "dosfns.c") +(declare-function android-detect-mouse "androidfns.c") (defun display-mouse-p (&optional display) "Return non-nil if DISPLAY has a mouse available. @@ -2119,6 +2140,8 @@ frame's display)." (> w32-num-mouse-buttons 0))) ((memq frame-type '(x ns haiku pgtk)) t) ;; We assume X, NeXTstep, GTK, and Haiku *always* have a pointing device + ((eq frame-type 'android) + (android-detect-mouse)) (t (or (and (featurep 'xt-mouse) xterm-mouse-mode) @@ -2134,8 +2157,12 @@ frame's display)." "Return non-nil if popup menus are supported on DISPLAY. DISPLAY can be a display name, a frame, or nil (meaning the selected frame's display). -Support for popup menus requires that the mouse be available." - (display-mouse-p display)) +Support for popup menus requires that a suitable pointing device +be available." + ;; Android menus work fine with touch screens as well, and one must + ;; be present. + (or (eq (framep-on-display display) 'android) + (display-mouse-p display))) (defun display-graphic-p (&optional display) "Return non-nil if DISPLAY is a graphic display. @@ -2144,7 +2171,8 @@ frames and several different fonts at once. This is true for displays that use a window system such as X, and false for text-only terminals. DISPLAY can be a display name, a frame, or nil (meaning the selected frame's display)." - (not (null (memq (framep-on-display display) '(x w32 ns pgtk haiku))))) + (not (null (memq (framep-on-display display) '(x w32 ns pgtk haiku + android))))) (defun display-images-p (&optional display) "Return non-nil if DISPLAY can display images. @@ -2196,7 +2224,7 @@ frame's display)." This means that, for example, DISPLAY can differentiate between the keybinding RET and [return]." (let ((frame-type (framep-on-display display))) - (or (memq frame-type '(x w32 ns pc pgtk haiku)) + (or (memq frame-type '(x w32 ns pc pgtk haiku android)) ;; MS-DOS and MS-Windows terminals have built-in support for ;; function (symbol) keys (memq system-type '(ms-dos windows-nt))))) @@ -2209,7 +2237,7 @@ DISPLAY should be either a frame or a display name (a string). If DISPLAY is omitted or nil, it defaults to the selected frame's display." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns haiku pgtk)) + ((memq frame-type '(x w32 ns haiku pgtk android)) (x-display-screens display)) (t 1)))) @@ -2229,7 +2257,7 @@ with DISPLAY. To get information for each physical monitor, use `display-monitor-attributes-list'." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns haiku pgtk)) + ((memq frame-type '(x w32 ns haiku pgtk android)) (x-display-pixel-height display)) (t (frame-height (if (framep display) display (selected-frame))))))) @@ -2249,7 +2277,7 @@ with DISPLAY. To get information for each physical monitor, use `display-monitor-attributes-list'." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns haiku pgtk)) + ((memq frame-type '(x w32 ns haiku pgtk android)) (x-display-pixel-width display)) (t (frame-width (if (framep display) display (selected-frame))))))) @@ -2287,7 +2315,7 @@ For graphical terminals, note that on \"multi-monitor\" setups this refers to the height in millimeters for all physical monitors associated with DISPLAY. To get information for each physical monitor, use `display-monitor-attributes-list'." - (and (memq (framep-on-display display) '(x w32 ns haiku pgtk)) + (and (memq (framep-on-display display) '(x w32 ns haiku pgtk android)) (or (cddr (assoc (or display (frame-parameter nil 'display)) display-mm-dimensions-alist)) (cddr (assoc t display-mm-dimensions-alist)) @@ -2308,7 +2336,7 @@ For graphical terminals, note that on \"multi-monitor\" setups this refers to the width in millimeters for all physical monitors associated with DISPLAY. To get information for each physical monitor, use `display-monitor-attributes-list'." - (and (memq (framep-on-display display) '(x w32 ns haiku pgtk)) + (and (memq (framep-on-display display) '(x w32 ns haiku pgtk android)) (or (cadr (assoc (or display (frame-parameter nil 'display)) display-mm-dimensions-alist)) (cadr (assoc t display-mm-dimensions-alist)) @@ -2326,7 +2354,7 @@ DISPLAY can be a display name or a frame. If DISPLAY is omitted or nil, it defaults to the selected frame's display." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns haiku pgtk)) + ((memq frame-type '(x w32 ns haiku pgtk android)) (x-display-backing-store display)) (t 'not-useful)))) @@ -2339,7 +2367,7 @@ DISPLAY can be a display name or a frame. If DISPLAY is omitted or nil, it defaults to the selected frame's display." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns haiku pgtk)) + ((memq frame-type '(x w32 ns haiku pgtk android)) (x-display-save-under display)) (t 'not-useful)))) @@ -2352,7 +2380,7 @@ DISPLAY can be a display name or a frame. If DISPLAY is omitted or nil, it defaults to the selected frame's display." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns haiku pgtk)) + ((memq frame-type '(x w32 ns haiku pgtk android)) (x-display-planes display)) ((eq frame-type 'pc) 4) @@ -2367,7 +2395,7 @@ DISPLAY can be a display name or a frame. If DISPLAY is omitted or nil, it defaults to the selected frame's display." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns haiku pgtk)) + ((memq frame-type '(x w32 ns haiku pgtk android)) (x-display-color-cells display)) ((eq frame-type 'pc) 16) @@ -2384,7 +2412,7 @@ DISPLAY can be a display name or a frame. If DISPLAY is omitted or nil, it defaults to the selected frame's display." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns haiku pgtk)) + ((memq frame-type '(x w32 ns haiku pgtk android)) (x-display-visual-class display)) ((and (memq frame-type '(pc t)) (tty-display-color-p display)) @@ -2402,6 +2430,8 @@ If DISPLAY is omitted or nil, it defaults to the selected frame's display." (&optional terminal)) (declare-function haiku-display-monitor-attributes-list "haikufns.c" (&optional terminal)) +(declare-function android-display-monitor-attributes-list "androidfns.c" + (&optional terminal)) (defun display-monitor-attributes-list (&optional display) "Return a list of physical monitor attributes on DISPLAY. @@ -2455,6 +2485,8 @@ monitors." (pgtk-display-monitor-attributes-list display)) ((eq frame-type 'haiku) (haiku-display-monitor-attributes-list display)) + ((eq frame-type 'android) + (android-display-monitor-attributes-list display)) (t (let ((geometry (list 0 0 (display-pixel-width display) (display-pixel-height display)))) @@ -2530,6 +2562,28 @@ symbols." 'core-keyboard)))))) +;;;; On-screen keyboard management. + +(declare-function android-toggle-on-screen-keyboard "androidfns.c") + +(defun frame-toggle-on-screen-keyboard (frame hide) + "Display or hide the on-screen keyboard. +On systems with an on-screen keyboard, display the on screen +keyboard on behalf of the frame FRAME if HIDE is nil. Else, hide +the on screen keyboard. + +Return whether or not the on screen keyboard may have been +displayed; that is, return t on systems with an on screen +keyboard, and nil on those without. + +FRAME must already have the input focus for this to work + reliably." + (let ((frame-type (framep-on-display frame))) + (cond ((eq frame-type 'android) + (android-toggle-on-screen-keyboard frame hide) t) + (t nil)))) + + ;;;; Frame geometry values (defun frame-geom-value-cons (type value &optional frame) diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index 582c598ac22..f870c0b8274 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -285,7 +285,7 @@ number." "Number of idle seconds to wait before checking for new mail." :type 'number) -(defcustom mail-source-movemail-program "movemail" +(defcustom mail-source-movemail-program movemail-program-name "If non-nil, name of program for fetching new mail." :version "26.2" :type '(choice (const nil) string)) diff --git a/lisp/hexl.el b/lisp/hexl.el index bb57f4ac4c3..5fa09459a46 100644 --- a/lisp/hexl.el +++ b/lisp/hexl.el @@ -60,7 +60,7 @@ (const 64)) :version "24.3") -(defcustom hexl-program "hexl" +(defcustom hexl-program hexl-program-name "The program that will hexlify and dehexlify its stdin. `hexl-program' will always be concatenated with `hexl-options' and \"-de\" when dehexlifying a buffer." diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index f0e38242e48..6c303226e54 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -308,13 +308,14 @@ done;") :tag "etags-cmd-alist" :type '(alist :key-type (string) :value-type (string))) -(defcustom hfy-etags-bin "etags" +(defcustom hfy-etags-bin etags-program-name "Location of etags binary (we begin by assuming it's in your path). Note that if etags is not in your path, you will need to alter the shell commands in `hfy-etags-cmd-alist'." :tag "etags-bin" - :type '(file)) + :type '(file) + :version "30.1") (defcustom hfy-shell-file-name "/bin/sh" "Shell (Bourne or compatible) to invoke for complex shell operations." diff --git a/lisp/ielm.el b/lisp/ielm.el index 5c370733c05..1eeec5fbb84 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el @@ -605,7 +605,7 @@ Customized bindings may be defined in `ielm-map', which currently contains: ;; Was cat, but on non-Unix platforms that might not exist, so ;; use hexl instead, which is part of the Emacs distribution. (condition-case nil - (start-process "ielm" (current-buffer) "hexl") + (start-process "ielm" (current-buffer) hexl-program-name) (file-error (start-process "ielm" (current-buffer) "cat"))) (set-process-query-on-exit-flag (ielm-process) nil) (goto-char (point-max)) diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index a2f175e4628..c778264d3ef 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -432,6 +432,8 @@ See also `wallpaper-default-width'.") ;;; wallpaper-set +(declare-function x-open-connection "xfns.c") + (defun wallpaper--x-monitor-name () "Get the monitor name for `wallpaper-set'. On a graphical display, try using the same monitor as the current diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index b72c68d9d59..bbb1993ba3c 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -200,7 +200,10 @@ (symbol . [#x201C #x2200 #x2500]) (braille #x2800) (ideographic-description #x2FF0) - (cjk-misc #x300E) + ;; Noto Sans Phags Pa is broken and reuses the CJK misc code + ;; points for some of its own characters. Add one actual CJK + ;; character to prevent finding such broken fonts. + (cjk-misc #x300E #xff0c #x300a #xff09 #x5b50) (kana #x304B) (bopomofo #x3105) (kanbun #x319D) @@ -685,7 +688,11 @@ (nil . "JISX0213.2000-2") (nil . "JISX0213.2004-1") ,(font-spec :registry "iso10646-1" :lang 'ja) - ,(font-spec :registry "iso10646-1" :lang 'zh)) + ,(font-spec :registry "iso10646-1" :lang 'zh) + ;; This is required, as otherwise many TrueType fonts with + ;; CJK characters but no corresponding ``design language'' + ;; declaration can't be found. + ,(font-spec :registry "iso10646-1" :script 'han)) (cjk-misc (nil . "GB2312.1980-0") (nil . "JISX0208*") @@ -704,7 +711,11 @@ (nil . "JISX0213.2000-1") (nil . "JISX0213.2000-2") ,(font-spec :registry "iso10646-1" :lang 'ja) - ,(font-spec :registry "iso10646-1" :lang 'zh)) + ,(font-spec :registry "iso10646-1" :lang 'zh) + ;; This is required, as otherwise many TrueType fonts + ;; with CJK characters but no corresponding ``design + ;; language'' declaration can't be found. + ,(font-spec :registry "iso10646-1" :script 'cjk-misc)) (hangul (nil . "KSC5601.1987-0") ,(font-spec :registry "iso10646-1" :lang 'ko)) diff --git a/lisp/isearch.el b/lisp/isearch.el index 094e02d605e..a17b22fd627 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -244,6 +244,10 @@ If you use `add-function' to modify this variable, you can use the `isearch-message-prefix' advice property to specify the prefix string displayed in the search message.") +(defvar isearch-text-conversion-style nil + "Value of `text-conversion-style' before Isearch mode +was enabled in this buffer.") + ;; Search ring. (defvar search-ring nil @@ -1221,6 +1225,8 @@ active region is added to the search string." ;; isearch-forward-regexp isearch-backward-regexp) ;; "List of commands for which isearch-mode does not recursive-edit.") +(declare-function set-text-conversion-style "textconv.c") + (defun isearch-mode (forward &optional regexp op-fun recursive-edit regexp-function) "Start Isearch minor mode. It is called by the function `isearch-forward' and other related functions. @@ -1237,6 +1243,8 @@ does not return to the calling function until the search is completed. To behave this way it enters a recursive edit and exits it when done isearching. +Also display the on-screen keyboard if necessary. + The arg REGEXP-FUNCTION, if non-nil, should be a function. It is used to set the value of `isearch-regexp-function'." @@ -1332,6 +1340,21 @@ used to set the value of `isearch-regexp-function'." (add-hook 'mouse-leave-buffer-hook 'isearch-mouse-leave-buffer) (add-hook 'kbd-macro-termination-hook 'isearch-done) + ;; If the keyboard is not up and the last event did not come from + ;; a keyboard, bring it up so that the user can type. + (when (or (not last-event-frame) + (not (eq (device-class last-event-frame + last-event-device) + 'keyboard))) + (frame-toggle-on-screen-keyboard (selected-frame) nil)) + + ;; Disable text conversion so that isearch can behave correctly. + + (when (fboundp 'set-text-conversion-style) + (setq isearch-text-conversion-style + text-conversion-style) + (set-text-conversion-style nil)) + ;; isearch-mode can be made modal (in the sense of not returning to ;; the calling function until searching is completed) by entering ;; a recursive-edit and exiting it when done isearching. @@ -1465,6 +1488,10 @@ NOPUSH is t and EDIT is t." (setq isearch-tool-bar-old-map nil)) (kill-local-variable 'tool-bar-map)) + ;; Restore the previous text conversion style. + (when (fboundp 'set-text-conversion-style) + (set-text-conversion-style isearch-text-conversion-style)) + (force-mode-line-update) ;; If we ended in the middle of some intangible text, diff --git a/lisp/loadup.el b/lisp/loadup.el index 1cc70348267..0a28c0592d0 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -258,6 +258,9 @@ (load "jit-lock") (load "mouse") +;; This loading happens on Android despite scroll bars being +;; unsupported, because scroll-bar-mode (the variable) must be +;; defined. (if (boundp 'x-toolkit-scroll-bars) (load "scroll-bar")) (load "select") @@ -295,6 +298,10 @@ (if (featurep 'dynamic-setting) (load "dynamic-setting")) +;; touch-screen.el is tiny and is used liberally throughout the button +;; code etc, so it may as well be preloaded everywhere. +(load "touch-screen") + (if (featurep 'x) (progn (load "x-dnd") @@ -306,6 +313,12 @@ (load "term/common-win") (load "term/haiku-win"))) +(if (featurep 'android) + (progn + (load "ls-lisp") + (load "term/common-win") + (load "term/android-win"))) + (if (or (eq system-type 'windows-nt) (featurep 'w32)) (progn @@ -429,6 +442,13 @@ lost after dumping"))) (defconst emacs-build-number (if versions (1+ (apply #'max versions)) 1)))) +;; Just set the repository branch during initial dumping on Android. +(if (and (eq system-type 'android) + (not (pdumper-stats))) + (setq emacs-repository-version + (ignore-errors (emacs-repository-get-version)) + emacs-repository-branch + (ignore-errors (emacs-repository-get-branch)))) (message "Finding pointers to doc strings...") (if (and (or (and (fboundp 'dump-emacs) @@ -546,66 +566,97 @@ lost after dumping"))) -(if dump-mode - (let ((output (cond ((equal dump-mode "pdump") "emacs.pdmp") - ((equal dump-mode "dump") "emacs") - ((equal dump-mode "bootstrap") "emacs") - ((equal dump-mode "pbootstrap") "bootstrap-emacs.pdmp") - (t (error "Unrecognized dump mode %s" dump-mode))))) - (when (and (featurep 'native-compile) - (equal dump-mode "pdump")) - ;; Don't enable this before bootstrap is completed, as the - ;; compiler infrastructure may not be usable yet. - (setq native-comp-enable-subr-trampolines t)) - (message "Dumping under the name %s" output) - (condition-case () - (delete-file output) - (file-error nil)) - ;; On MS-Windows, the current directory is not necessarily the - ;; same as invocation-directory. - (let (success) - (unwind-protect - (let ((tmp-dump-mode dump-mode) - (dump-mode nil) - (lexical-binding nil)) - (if (member tmp-dump-mode '("pdump" "pbootstrap")) - (dump-emacs-portable (expand-file-name output invocation-directory)) - (dump-emacs output (if (eq system-type 'ms-dos) - "temacs.exe" - "temacs")) - (message "%d pure bytes used" pure-bytes-used)) - (setq success t)) - (unless success - (ignore-errors - (delete-file output))))) - ;; Recompute NAME now, so that it isn't set when we dump. - (if (not (or (eq system-type 'ms-dos) - (eq system-type 'haiku) ;; BFS doesn't support hard links - ;; Don't bother adding another name if we're just - ;; building bootstrap-emacs. - (member dump-mode '("pbootstrap" "bootstrap")))) - (let ((name (format "emacs-%s.%d" emacs-version emacs-build-number)) - (exe (if (eq system-type 'windows-nt) ".exe" ""))) - (while (string-match "[^-+_.a-zA-Z0-9]+" name) - (setq name (concat (downcase (substring name 0 (match-beginning 0))) - "-" - (substring name (match-end 0))))) - (message "Adding name %s" (concat name exe)) - ;; When this runs on Windows, invocation-directory is not - ;; necessarily the current directory. - (add-name-to-file (expand-file-name (concat "emacs" exe) - invocation-directory) - (expand-file-name (concat name exe) - invocation-directory) - t) - (when (equal dump-mode "pdump") - (message "Adding name %s" (concat name ".pdmp")) - (add-name-to-file (expand-file-name "emacs.pdmp" +(if (eq system-type 'android) + (progn + ;; Dumping Emacs on Android works slightly differently from + ;; everywhere else. The first time Emacs starts, Emacs dumps + ;; itself to "emacs-%s.pdump", and then proceeds with loadup, + ;; where %s is replaced by the dump fingerprint. + ;; EmacsApplication.java removes any pdump files with a + ;; different build fingerprint upon being created, which happens + ;; the moment the Android system starts Emacs. Then, it passes + ;; the appropriate "--dump-file" to libemacs.so as it starts. + (when (not noninteractive) + (let ((temp-dir (getenv "TEMP")) + (dump-file-name (format "%semacs-%s.pdmp" + (file-name-as-directory "~") + pdumper-fingerprint)) + (dump-temp-file-name (format "%s~emacs-%s.pdmp" + (file-name-as-directory "~") + pdumper-fingerprint))) + (unless (pdumper-stats) + (condition-case () + (progn + (dump-emacs-portable dump-temp-file-name) + ;; Move the dumped file to the actual dump file name. + (rename-file dump-temp-file-name dump-file-name) + ;; Continue with loadup. + nil) + (error nil)))))) + (if dump-mode + (let ((output (cond ((equal dump-mode "pdump") "emacs.pdmp") + ((equal dump-mode "dump") "emacs") + ((equal dump-mode "bootstrap") "emacs") + ((equal dump-mode "pbootstrap") "bootstrap-emacs.pdmp") + (t (error "Unrecognized dump mode %s" dump-mode))))) + (when (and (featurep 'native-compile) + (equal dump-mode "pdump")) + ;; Don't enable this before bootstrap is completed, as the + ;; compiler infrastructure may not be usable yet. + (setq comp-enable-subr-trampolines t)) + (message "Dumping under the name %s" output) + (condition-case () + (delete-file output) + (file-error nil)) + ;; On MS-Windows, the current directory is not necessarily the + ;; same as invocation-directory. + (let (success) + (unwind-protect + (let ((tmp-dump-mode dump-mode) + (dump-mode nil) + (lexical-binding nil)) + (if (member tmp-dump-mode '("pdump" "pbootstrap")) + (dump-emacs-portable (expand-file-name output invocation-directory)) + (dump-emacs output (if (eq system-type 'ms-dos) + "temacs.exe" + "temacs")) + (message "%d pure bytes used" pure-bytes-used)) + (setq success t)) + (unless success + (ignore-errors + (delete-file output))))) + ;; Recompute NAME now, so that it isn't set when we dump. + (if (not (or (eq system-type 'ms-dos) + (eq system-type 'haiku) ;; BFS doesn't support hard links + ;; There's no point keeping old dumps around for + ;; the binary used to build Lisp on the build + ;; machine. + (featurep 'android) + ;; Don't bother adding another name if we're just + ;; building bootstrap-emacs. + (member dump-mode '("pbootstrap" "bootstrap")))) + (let ((name (format "emacs-%s.%d" emacs-version emacs-build-number)) + (exe (if (eq system-type 'windows-nt) ".exe" ""))) + (while (string-match "[^-+_.a-zA-Z0-9]+" name) + (setq name (concat (downcase (substring name 0 (match-beginning 0))) + "-" + (substring name (match-end 0))))) + (message "Adding name %s" (concat name exe)) + ;; When this runs on Windows, invocation-directory is not + ;; necessarily the current directory. + (add-name-to-file (expand-file-name (concat "emacs" exe) invocation-directory) - (expand-file-name (concat name ".pdmp") + (expand-file-name (concat name exe) invocation-directory) - t)))) - (kill-emacs))) + t) + (when (equal dump-mode "pdump") + (message "Adding name %s" (concat name ".pdmp")) + (add-name-to-file (expand-file-name "emacs.pdmp" + invocation-directory) + (expand-file-name (concat name ".pdmp") + invocation-directory) + t)))) + (kill-emacs)))) ;; This file must be loaded each time Emacs is run from scratch, e.g., temacs. ;; So run the startup code now. First, remove `-l loadup' from args. @@ -621,6 +672,13 @@ lost after dumping"))) (setq load-file-name nil) (eval top-level t) +;; loadup.el is loaded at startup, but clobbers current-load-list. +;; Set current-load-list to a list containing no definitions and only +;; its name, to prevent invalid entries from ending up in +;; Vload_history when running temacs interactively. + +(setq current-load-list (list "loadup.el")) + ;; Local Variables: ;; no-byte-compile: t diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 485ac4476ef..b0f86839740 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -184,7 +184,7 @@ if emulation is GNU then default is `(links uid gid)'." :group 'ls-lisp) (defcustom ls-lisp-use-insert-directory-program - (not (memq system-type '(ms-dos windows-nt))) + (not (memq system-type '(ms-dos windows-nt android))) "Non-nil causes ls-lisp to revert back to using `insert-directory-program'. This is useful on platforms where ls-lisp is dumped into Emacs, such as Microsoft Windows, but you would still like to use a program to list diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index f686c04536c..68f9dcfea0b 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -408,6 +408,12 @@ copy text to your preferred mail program.\n" "', version " (mapconcat #'number-to-string (x-server-version) ".") "\n") (error t))) + (when (and (boundp 'android-build-fingerprint) + (symbol-value 'android-build-fingerprint)) + ;; This is used on Android. + (insert "Android version and manufacturer: " + (symbol-value 'android-build-fingerprint) + "\n")) (let ((os (ignore-errors (report-emacs-bug--os-description)))) (if (stringp os) (insert "System Description: " os "\n\n"))) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index d07a1fda901..379e345bef1 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -263,7 +263,7 @@ Otherwise, look for `movemail' in the directories in ;; assuming it would work. ;; https://lists.gnu.org/r/bug-gnu-emacs/2008-02/msg00087.html (let ((progname (expand-file-name - (concat "movemail" + (concat movemail-program-name (if (memq system-type '(ms-dos windows-nt)) ".exe")) dir))) (when (and (not (file-directory-p progname)) @@ -1989,7 +1989,9 @@ Value is the size of the newly read mail after conversion." (buffer-disable-undo errors) (let ((args (append - (list (or rmail-movemail-program "movemail") nil errors nil) + (list (or rmail-movemail-program + movemail-program-name) + nil errors nil) (if rmail-preserve-inbox (list "-p") nil) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index d020cf6e90a..da002a46621 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -79,6 +79,14 @@ :help "Print current buffer with page headings")) menu)) +(defcustom menu-bar-close-window nil + "Whether or not to close the current window from the menu bar. +If non-nil, selecting Close from the File menu or clicking Close +in the tool bar will close the current window where possible." + :type 'boolean + :group 'menu + :version "30.1") + (defvar menu-bar-file-menu (let ((menu (make-sparse-keymap "File"))) @@ -472,6 +480,11 @@ (defvar menu-bar-edit-menu (let ((menu (make-sparse-keymap "Edit"))) + (bindings--define-key menu [execute-extended-command] + '(menu-item "Execute Command" execute-extended-command + :enable t + :help "Read a command name, its arguments, then call it.")) + ;; ns-win.el said: Add spell for platform consistency. (if (featurep 'ns) (bindings--define-key menu [spell] @@ -2163,12 +2176,19 @@ otherwise it could decide to silently do nothing." ;; (Bug#8184). ((not (menu-bar-menu-frame-live-and-visible-p))) ((menu-bar-non-minibuffer-window-p) - (kill-buffer (current-buffer))) + (kill-buffer (current-buffer)) + ;; Also close the current window if `menu-bar-close-windows' is + ;; set. + (when menu-bar-close-window + (ignore-errors (delete-window)))) (t (abort-recursive-edit)))) (defun kill-this-buffer-enabled-p () - "Return non-nil if the `kill-this-buffer' menu item should be enabled." + "Return non-nil if the `kill-this-buffer' menu item should be enabled. +It should be enabled there is at least one non-hidden buffer, or if +`menu-bar-close-window' is non-nil and there is more than one window on +this frame." (or (not (menu-bar-non-minibuffer-window-p)) (let (found-1) ;; Instead of looping over entire buffer list, stop once we've @@ -2178,7 +2198,9 @@ otherwise it could decide to silently do nothing." (unless (string-match-p "^ " (buffer-name buffer)) (if (not found-1) (setq found-1 t) - (throw 'found-2 t)))))))) + (throw 'found-2 t)))))) + (and menu-bar-close-window + (window-parent (selected-window))))) (put 'dired 'menu-enable '(menu-bar-non-minibuffer-window-p)) @@ -2647,20 +2669,25 @@ FROM-MENU-BAR, if non-nil, means we are dropping one of menu-bar's menus." POSITION can be an event, a posn- value, a value having the form ((XOFFSET YOFFSET) WINDOW), or nil. If nil, the current mouse position is used, or nil if there is no mouse." - (pcase position + (cond ;; nil -> mouse cursor position - ('nil + ((eq position nil) (let ((mp (mouse-pixel-position))) (list (list (cadr mp) (cddr mp)) (car mp)))) ;; Value returned from `event-end' or `posn-at-point'. - ((pred posnp) + ((posnp position) (let ((xy (posn-x-y position))) (list (list (car xy) (cdr xy)) (posn-window position)))) + ;; `touchscreen-begin' or `touchscreen-end' event. + ((or (eq (car-safe position) 'touchscreen-begin) + (eq (car-safe position) 'touchscreen-end)) + position) ;; Event. - ((pred eventp) + ((eventp position) (popup-menu-normalize-position (event-end position))) - (_ position))) + ;; Some other value. + (t position))) (defcustom tty-menu-open-use-tmm nil "If non-nil, \\[menu-bar-open] on a TTY will invoke `tmm-menubar'. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index a3dc1b0cfbf..36fff1520ac 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2938,7 +2938,10 @@ For customizing this mode, it is better to use `minibuffer-setup-hook' and `minibuffer-exit-hook' rather than the mode hook of this mode." :syntax-table nil - :interactive nil) + :interactive nil + ;; Enable text conversion, but always make sure `RET' does + ;; something. + (setq text-conversion-style 'action)) ;;; Completion tables. @@ -4592,6 +4595,59 @@ is included in the return value." default))) ": ")) + +;;; On screen keyboard support. +;; Try to display the on screen keyboard whenever entering the +;; mini-buffer, and hide it whenever leaving. + +(defvar minibuffer-on-screen-keyboard-timer nil + "Timer run upon exiting the minibuffer. +It will hide the on screen keyboard when necessary.") + +(defvar minibuffer-on-screen-keyboard-displayed nil + "Whether or not the on-screen keyboard has been displayed. +Set inside `minibuffer-setup-on-screen-keyboard'.") + +(defun minibuffer-setup-on-screen-keyboard () + "Maybe display the on-screen keyboard in the current frame. +Display the on-screen keyboard in the current frame if the +last device to have sent an input event is not a keyboard. +This is run upon minibuffer setup." + ;; Don't hide the on screen keyboard later on. + (when minibuffer-on-screen-keyboard-timer + (cancel-timer minibuffer-on-screen-keyboard-timer) + (setq minibuffer-on-screen-keyboard-timer nil)) + (setq minibuffer-on-screen-keyboard-displayed nil) + (when (and (framep last-event-frame) + (not (memq (device-class last-event-frame + last-event-device) + '(keyboard core-keyboard)))) + (setq minibuffer-on-screen-keyboard-displayed + (frame-toggle-on-screen-keyboard (selected-frame) nil)))) + +(defun minibuffer-exit-on-screen-keyboard () + "Hide the on-screen keyboard if it was displayed. +Hide the on-screen keyboard in a timer set to run in 0.1 seconds. +It will be cancelled if the minibuffer is displayed again within +that timeframe. + +Do not hide the on screen keyboard inside a recursive edit. +Likewise, do not hide the on screen keyboard if point in the +window that will be selected after exiting the minibuffer is not +on read-only text. + +The latter is implemented in `touch-screen.el'." + (unless (or (not minibuffer-on-screen-keyboard-displayed) + (> (recursion-depth) 1)) + (when minibuffer-on-screen-keyboard-timer + (cancel-timer minibuffer-on-screen-keyboard-timer)) + (setq minibuffer-on-screen-keyboard-timer + (run-with-timer 0.1 nil #'frame-toggle-on-screen-keyboard + (selected-frame) t)))) + +(add-hook 'minibuffer-setup-hook #'minibuffer-setup-on-screen-keyboard) +(add-hook 'minibuffer-exit-hook #'minibuffer-exit-on-screen-keyboard) + (provide 'minibuffer) ;;; minibuffer.el ends here diff --git a/lisp/mwheel.el b/lisp/mwheel.el index caa74159ecd..86ed7393a17 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -58,7 +58,8 @@ (defcustom mouse-wheel-down-event (if (or (featurep 'w32-win) (featurep 'ns-win) - (featurep 'haiku-win) (featurep 'pgtk-win)) + (featurep 'haiku-win) (featurep 'pgtk-win) + (featurep 'android-win)) 'wheel-up 'mouse-4) "Event used for scrolling down." @@ -79,7 +80,8 @@ (defcustom mouse-wheel-up-event (if (or (featurep 'w32-win) (featurep 'ns-win) - (featurep 'haiku-win) (featurep 'pgtk-win)) + (featurep 'haiku-win) (featurep 'pgtk-win) + (featurep 'android-win)) 'wheel-down 'mouse-5) "Event used for scrolling up." @@ -254,7 +256,8 @@ Also see `mouse-wheel-tilt-scroll'." (defvar mouse-wheel-left-event (if (or (featurep 'w32-win) (featurep 'ns-win) - (featurep 'haiku-win) (featurep 'pgtk-win)) + (featurep 'haiku-win) (featurep 'pgtk-win) + (featurep 'android-win)) 'wheel-left 'mouse-6) "Event used for scrolling left.") @@ -268,7 +271,8 @@ Also see `mouse-wheel-tilt-scroll'." (defvar mouse-wheel-right-event (if (or (featurep 'w32-win) (featurep 'ns-win) - (featurep 'haiku-win) (featurep 'pgtk-win)) + (featurep 'haiku-win) (featurep 'pgtk-win) + (featurep 'android-win)) 'wheel-right 'mouse-7) "Event used for scrolling right.") diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 0177d12f236..c2629b69d59 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -52,6 +52,7 @@ ;; browse-url-xdg-open freedesktop.org xdg-open ;; browse-url-kde KDE konqueror (kfm) ;; browse-url-elinks Elinks Don't know (tried with 0.12.GIT) +;; browse-url-default-android-browser Android 2.3.3 (should work on 2.2 too) ;; eww-browse-url Emacs Web Wowser ;; Browsers can cache web pages so it may be necessary to tell them to @@ -173,6 +174,9 @@ ,@(when (eq system-type 'darwin) (list '(function-item :tag "Default macOS browser" :value browse-url-default-macosx-browser))) + ,@(when (eq system-type 'android) + (list '(function-item :tag "Default Android browser" + :value browse-url-default-android-browser))) (function-item :tag "Default browser" :value browse-url-default-browser) (function :tag "Your own function") @@ -1057,6 +1061,8 @@ instead of `browse-url-new-window-flag'." 'browse-url-default-macosx-browser) ((featurep 'haiku) 'browse-url-default-haiku-browser) + ((eq system-type 'android) + 'browse-url-default-android-browser) ((browse-url-can-use-xdg-open) 'browse-url-xdg-open) ;;; ((executable-find browse-url-gnome-moz-program) 'browse-url-gnome-moz) ((executable-find browse-url-firefox-program) 'browse-url-firefox) @@ -1294,6 +1300,22 @@ Default to the URL around or before point." (function-put 'browse-url-default-haiku-browser 'browse-url-browser-kind 'external) +(declare-function android-browse-url "androidselect.c") + +;;;###autoload +(defun browse-url-default-android-browser (url &optional _new-window) + "Browse URL with the system default browser. +Default to the URL around or before point." + (interactive (browse-url-interactive-arg "URL: ")) + (setq url (browse-url-encode-url url)) + ;; Make sure the URL starts with an appropriate scheme. + (unless (string-match "\\(.+\\):/" url) + (setq url (concat "http://" url))) + (android-browse-url url)) + +(function-put 'browse-url-default-android-browser + 'browse-url-browser-kind 'external) + ;;;###autoload (defun browse-url-emacs (url &optional same-window) "Ask Emacs to load URL into a buffer and show it in another window. diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 61f0f47373d..26aee532255 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -249,7 +249,7 @@ parameter, and should return the (possibly) transformed URL." :version "29.1") (defface eww-form-submit - '((((type x w32 ns haiku pgtk) (class color)) ; Like default mode line + '((((type x w32 ns haiku pgtk android) (class color)) ; Like default mode line :box (:line-width 2 :style released-button) :background "#808080" :foreground "black")) "Face for eww buffer buttons." @@ -257,7 +257,7 @@ parameter, and should return the (possibly) transformed URL." :group 'eww) (defface eww-form-file - '((((type x w32 ns haiku pgtk) (class color)) ; Like default mode line + '((((type x w32 ns haiku pgtk android) (class color)) ; Like default mode line :box (:line-width 2 :style released-button) :background "#808080" :foreground "black")) "Face for eww buffer buttons." @@ -265,7 +265,7 @@ parameter, and should return the (possibly) transformed URL." :group 'eww) (defface eww-form-checkbox - '((((type x w32 ns haiku pgtk) (class color)) ; Like default mode line + '((((type x w32 ns haiku pgtk android) (class color)) ; Like default mode line :box (:line-width 2 :style released-button) :background "lightgrey" :foreground "black")) "Face for eww buffer buttons." @@ -273,7 +273,7 @@ parameter, and should return the (possibly) transformed URL." :group 'eww) (defface eww-form-select - '((((type x w32 ns haiku pgtk) (class color)) ; Like default mode line + '((((type x w32 ns haiku pgtk android) (class color)) ; Like default mode line :box (:line-width 2 :style released-button) :background "lightgrey" :foreground "black")) "Face for eww buffer buttons." diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el index 5dd2bfd59cd..990214f4117 100644 --- a/lisp/org/org-ctags.el +++ b/lisp/org/org-ctags.el @@ -156,7 +156,9 @@ Format is: /REGEXP/TAGNAME/FLAGS,TAGTYPE/ See the ctags documentation for more information.") (defcustom org-ctags-path-to-ctags - (if (executable-find "ctags-exuberant") "ctags-exuberant" "ctags") + (if (executable-find "ctags-exuberant") + "ctags-exuberant" + ctags-program-name) "Name of the ctags executable file." :version "24.1" :type 'file) diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index 487144144f5..d3287d936bb 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -500,6 +500,7 @@ Otherwise, redisplay will reset the window's vscroll." (set-window-start nil (pixel-point-at-unseen-line) t) (set-window-vscroll nil vscroll t)) +;;;###autoload (defun pixel-scroll-precision-scroll-down-page (delta) "Scroll the current window down by DELTA pixels. Note that this function doesn't work if DELTA is larger than @@ -556,6 +557,7 @@ the height of the current window." (setq delta (- delta max-height))) (pixel-scroll-precision-scroll-down-page delta))) +;;;###autoload (defun pixel-scroll-precision-scroll-up-page (delta) "Scroll the current window up by DELTA pixels. Note that this function doesn't work if DELTA is larger than diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el index dcf36c5c330..891274448d3 100644 --- a/lisp/play/doctor.el +++ b/lisp/play/doctor.el @@ -129,6 +129,9 @@ "C-j" #'doctor-read-print "RET" #'doctor-ret-or-read) +;; Actually defined in textconv.c. +(defvar text-conversion-style) + (define-derived-mode doctor-mode text-mode "Doctor" "Major mode for running the Doctor (Eliza) program. Like Text mode with Auto Fill mode @@ -137,6 +140,8 @@ reads the sentence before point, and prints the Doctor's answer." :interactive nil (doctor-make-variables) (turn-on-auto-fill) + ;; Make sure RET is processed by Emacs. + (setq text-conversion-style 'action) (doctor-type '(i am the psychotherapist \. (doc$ doctor--please) (doc$ doctor--describe) your (doc$ doctor--problems) \. each time you are finished talking\, type \R\E\T twice \.)) diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index 837508779e7..e290a9d73ec 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -1132,9 +1132,14 @@ treasures for points?" "4" "four") ;;;; Mode definitions for interactive mode +;; Actually defined in textconv.c. +(defvar text-conversion-style) + (define-derived-mode dun-mode text-mode "Dungeon" "Major mode for running dunnet." :interactive nil + ;; Make sure RET is processed by Emacs. + (setq text-conversion-style 'action) (setq-local scroll-step 2)) (defun dun-parse (_arg) diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index 54df983740e..bf195d6a0ec 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -411,7 +411,9 @@ convert to an Emacs image-spec instead") pixel-size (floor (* resy (/ point-size 72.27))) point-size (* (/ pixel-size resy) 72.27)) (face-spec-set gamegrid-face - `((t :height ,(floor (* point-size 10)))))))))) + ;; With some very high resolution displays, + ;; point-size floored can be zero. + `((t :height ,(max 8 (floor (* point-size 10))))))))))) (defun gamegrid-initialize-display () (setq gamegrid-display-mode (gamegrid-display-type)) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index ed021a7ebc9..d6efd5d75a4 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -6534,7 +6534,7 @@ in subdirectories too." ;; of etags has been commented out in the menu since ... well, ;; forever. So, let's just stick to ASCII here. -- haj, 2021-09-14 (interactive) - (let ((cmd "etags") + (let ((cmd etags-program-name) (args `("-l" "none" "-r" ;; 1=fullname 2=package? 3=name 4=proto? 5=attrs? (VERY APPROX!) ,(concat diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el index a434c7e9058..16497097061 100644 --- a/lisp/progmodes/prog-mode.el +++ b/lisp/progmodes/prog-mode.el @@ -337,6 +337,8 @@ support it." (setq-local require-final-newline mode-require-final-newline) (setq-local parse-sexp-ignore-comments t) (add-hook 'context-menu-functions 'prog-context-menu 10 t) + ;; Enable text conversion in this buffer. + (setq-local text-conversion-style t) ;; Any programming language is always written left to right. (setq bidi-paragraph-direction 'left-to-right)) diff --git a/lisp/shell.el b/lisp/shell.el index b74442f1961..c7979e84ba0 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -1372,7 +1372,12 @@ Returns t if successful." (while path-dirs (setq dir (file-name-as-directory (comint-directory (or (car path-dirs) "."))) comps-in-dir (and (file-accessible-directory-p dir) - (file-name-all-completions filenondir dir))) + (condition-case nil + (file-name-all-completions filenondir dir) + ;; Systems such as Android sometimes + ;; put inaccessible directories in + ;; PATH. + (permission-denied nil)))) ;; Go thru each completion found, to see whether it should be used. (while comps-in-dir (setq file (car comps-in-dir) diff --git a/lisp/simple.el b/lisp/simple.el index 73c2dfa365d..e79fa3f84e5 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10536,7 +10536,7 @@ call `normal-erase-is-backspace-mode' (which see) instead." (if (if (eq normal-erase-is-backspace 'maybe) (and (not noninteractive) (or (memq system-type '(ms-dos windows-nt)) - (memq window-system '(w32 ns pgtk haiku)) + (memq window-system '(w32 ns pgtk haiku android)) (and (eq window-system 'x) (fboundp 'x-backspace-delete-keys-p) (x-backspace-delete-keys-p)) @@ -10961,6 +10961,89 @@ If the buffer doesn't exist, create it first." "Change value in PLIST of PROP to VAL, comparing with `equal'." (declare (obsolete plist-put "29.1")) (plist-put plist prop val #'equal)) + + + +;; Text conversion support. See textconv.c for more details about +;; what this is. + + +;; Actually in textconv.c. +(defvar text-conversion-edits) + +;; Actually in elec-pair.el. +(defvar electric-pair-preserve-balance) +(declare-function electric-pair-analyze-conversion "elec-pair.el") + +(defun analyze-text-conversion () + "Analyze the results of the previous text conversion event. + +For each insertion: + + - Look for the insertion of a string starting or ending with a + character inside `auto-fill-chars', and fill the text around + it if `auto-fill-mode' is enabled. + + - Look for the insertion of a new line, and cause automatic + line breaking of the previous line when `auto-fill-mode' is + enabled. + + - Look for the deletion of a single electric pair character, + and delete the adjascent pair if + `electric-pair-delete-adjacent-pairs'. + + - Run `post-self-insert-functions' for the last character of + any inserted text so that modes such as `electric-pair-mode' + can work." + (interactive) + ;; The list must be processed in reverse. + (dolist (edit (reverse text-conversion-edits)) + ;; Filter out ephemeral edits and deletions. + (when (and (stringp (nth 3 edit))) + (with-current-buffer (car edit) + (if (not (eq (nth 1 edit) (nth 2 edit))) + ;; Process this insertion. (nth 3 edit) is the text which + ;; was inserted. + (let* ((inserted (nth 3 edit)) + ;; Get the first and last characters. + (start (aref inserted 0)) + (end (aref inserted (1- (length inserted)))) + ;; Figure out whether or not to auto-fill. + (auto-fill-p (or (aref auto-fill-chars start) + (aref auto-fill-chars end))) + ;; Figure out whether or not a newline was inserted. + (newline-p (string-search "\n" inserted)) + ;; FIXME: this leads to an error in + ;; `atomic-change-group', seemingly because + ;; buffer-undo-list is being modified or + ;; prematurely truncated. Turn it off for now. + (electric-pair-preserve-balance nil)) + (save-excursion + (if (and auto-fill-function newline-p) + (progn (goto-char (nth 2 edit)) + (previous-logical-line) + (funcall auto-fill-function)) + (when (and auto-fill-function auto-fill-p) + (progn (goto-char (nth 2 edit)) + (funcall auto-fill-function))))) + (goto-char (nth 2 edit)) + (let ((last-command-event end)) + (run-hooks 'post-self-insert-hook))) + ;; Process this deletion before point. (nth 2 edit) is the + ;; text which was deleted. Input methods typically prefer + ;; to edit words instead of deleting characters off their + ;; ends, but they seem to always send proper requests for + ;; deletion for punctuation. + (when (and (boundp 'electric-pair-delete-adjacent-pairs) + (symbol-value 'electric-pair-delete-adjacent-pairs) + ;; Make sure elec-pair is loaded. + (fboundp 'electric-pair-analyze-conversion) + ;; Only do this if only a single edit happened. + text-conversion-edits) + (save-excursion + (goto-char (nth 2 edit)) + (electric-pair-analyze-conversion (nth 3 edit))))))))) + (provide 'simple) diff --git a/lisp/speedbar.el b/lisp/speedbar.el index 0115a6f4ae4..f56c3915521 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -3531,7 +3531,7 @@ to be at the beginning of a line in the etags buffer. This variable is ignored if `speedbar-use-imenu-flag' is non-nil.") -(defcustom speedbar-fetch-etags-command "etags" +(defcustom speedbar-fetch-etags-command etags-program-name "Command used to create an etags file. This variable is ignored if `speedbar-use-imenu-flag' is t." :group 'speedbar diff --git a/lisp/startup.el b/lisp/startup.el index 9ae53f4e50b..fb14fbad17f 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -574,11 +574,24 @@ the updated value." (setq startup--original-eln-load-path (copy-sequence native-comp-eln-load-path)))) +(defvar android-fonts-enumerated nil + "Whether or not fonts have been enumerated already. +On Android, Emacs uses this variable internally at startup.") + (defun normal-top-level () "Emacs calls this function when it first starts up. It sets `command-line-processed', processes the command-line, reads the initialization files, etc. It is the default value of the variable `top-level'." + ;; Initialize the Android font driver late. + ;; This is done here because it needs the `mac-roman' coding system + ;; to be loaded. + (when (and (featurep 'android) + (fboundp 'android-enumerate-fonts) + (not android-fonts-enumerated)) + (funcall 'android-enumerate-fonts) + (setq android-fonts-enumerated t)) + (if command-line-processed (message internal--top-level-message) (setq command-line-processed t) diff --git a/lisp/subr.el b/lisp/subr.el index 03d3324f3d8..d49c9cb155e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1654,7 +1654,13 @@ nil or (STRING . POSITION)'. `posn-timestamp': The time the event occurred, in milliseconds. For more information, see Info node `(elisp)Click Events'." - (or (and (consp event) (nth 1 event)) + (or (and (consp event) + ;; Ignore touchscreen events. They store the posn in a + ;; different format, and can have multiple posns. + (not (memq (car event) '(touchscreen-begin + touchscreen-update + touchscreen-end))) + (nth 1 event)) (event--posn-at-point))) (defun event-end (event) @@ -1662,7 +1668,11 @@ For more information, see Info node `(elisp)Click Events'." EVENT should be a click, drag, or key press event. See `event-start' for a description of the value returned." - (or (and (consp event) (nth (if (consp (nth 2 event)) 2 1) event)) + (or (and (consp event) + (not (memq (car event) '(touchscreen-begin + touchscreen-update + touchscreen-end))) + (nth (if (consp (nth 2 event)) 2 1) event)) (event--posn-at-point))) (defsubst event-click-count (event) @@ -3445,6 +3455,9 @@ an error message." (minibuffer-message "Wrong answer") (sit-for 2))) +;; Defined in textconv.c. +(defvar overriding-text-conversion-style) + (defun read-char-from-minibuffer (prompt &optional chars history) "Read a character from the minibuffer, prompting for it with PROMPT. Like `read-char', but uses the minibuffer to read and return a character. @@ -3459,7 +3472,15 @@ while calling this function, then pressing `help-char' causes it to evaluate `help-form' and display the result. There is no need to explicitly add `help-char' to CHARS; `help-char' is bound automatically to `help-form-show'." - (let* ((map (if (consp chars) + + ;; If text conversion is enabled in this buffer, then it will only + ;; be disabled the next time `force-mode-line-update' happens. + (when (and (bound-and-true-p overriding-text-conversion-style) + (bound-and-true-p text-conversion-style)) + (force-mode-line-update)) + + (let* ((overriding-text-conversion-style nil) + (map (if (consp chars) (or (gethash (list help-form (cons help-char chars)) read-char-from-minibuffer-map-hash) (let ((map (make-sparse-keymap)) @@ -3471,15 +3492,15 @@ There is no need to explicitly add `help-char' to CHARS; ;; being a command char. (when help-form (define-key map (vector help-char) - (lambda () - (interactive) - (let ((help-form msg)) ; lexically bound msg - (help-form-show))))) + (lambda () + (interactive) + (let ((help-form msg)) ; lexically bound msg + (help-form-show))))) (dolist (char chars) (define-key map (vector char) - #'read-char-from-minibuffer-insert-char)) + #'read-char-from-minibuffer-insert-char)) (define-key map [remap self-insert-command] - #'read-char-from-minibuffer-insert-other) + #'read-char-from-minibuffer-insert-other) (puthash (list help-form (cons help-char chars)) map read-char-from-minibuffer-map-hash) map)) @@ -3581,10 +3602,15 @@ confusing to some users.") (defun use-dialog-box-p () "Return non-nil if the current command should prompt the user via a dialog box." (and last-input-event ; not during startup - (or (consp last-nonmenu-event) ; invoked by a mouse event + (or (featurep 'android) ; prefer dialog boxes on Android + (consp last-nonmenu-event) ; invoked by a mouse event from--tty-menu-p) ; invoked via TTY menu use-dialog-box)) +;; Actually in textconv.c. +(defvar overriding-text-conversion-style) +(declare-function set-text-conversion-style "textconv.c") + (defun y-or-n-p (prompt) "Ask user a \"y or n\" question. Return t if answer is \"y\" and nil if it is \"n\". @@ -3662,6 +3688,9 @@ like) while `y-or-n-p' is running)." (while (let* ((scroll-actions '(recenter scroll-up scroll-down scroll-other-window scroll-other-window-down)) + ;; Disable text conversion so that real key events + ;; are sent. + (overriding-text-conversion-style nil) (key (let ((cursor-in-echo-area t)) (when minibuffer-auto-raise @@ -3693,6 +3722,9 @@ like) while `y-or-n-p' is running)." (setq prompt (funcall padded prompt)) (let* ((enable-recursive-minibuffers t) (msg help-form) + ;; Disable text conversion so that real Y or N events are + ;; sent. + (overriding-text-conversion-style nil) (keymap (let ((map (make-composed-keymap y-or-n-p-map query-replace-map))) (when help-form @@ -3706,9 +3738,15 @@ like) while `y-or-n-p' is running)." map)) ;; Protect this-command when called from pre-command-hook (bug#45029) (this-command this-command) - (str (read-from-minibuffer - prompt nil keymap nil - (or y-or-n-p-history-variable t)))) + (str (progn + (when (active-minibuffer-window) + ;; If the minibuffer is already active, the + ;; selected window might not change. Disable + ;; text conversion by hand. + (set-text-conversion-style text-conversion-style)) + (read-from-minibuffer + prompt nil keymap nil + (or y-or-n-p-history-variable t))))) (setq answer (if (member str '("y" "Y")) 'act 'skip))))) (let ((ret (eq answer 'act))) (unless noninteractive diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 9d703b5d048..1a33eda0866 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -341,10 +341,12 @@ only when you click on its \"x\" close button." (unless (eq tab-number t) (tab-bar-close-tab tab-number)))) -(defun tab-bar-mouse-context-menu (event) - "Pop up the context menu for the tab on which you click." +(defun tab-bar-mouse-context-menu (event &optional posn) + "Pop up the context menu for the tab on which you click. +EVENT is a mouse or touch screen event. POSN is nil or the +position of EVENT." (interactive "e") - (let* ((item (tab-bar--event-to-item (event-start event))) + (let* ((item (tab-bar--event-to-item (or posn (event-start event)))) (tab-number (tab-bar--key-to-number (nth 0 item))) (menu (make-sparse-keymap (propertize "Context Menu" 'hide t)))) @@ -397,6 +399,78 @@ at the mouse-down event to the position at mouse-up event." (tab-bar-move-tab-to (if (null to) (1+ (tab-bar--current-tab-index)) to) from)))) + + +;;; Tab bar touchscreen support. + +(declare-function touch-screen-track-tap "touch-screen.el") + +(defun tab-bar-handle-timeout () + "Handle a touch-screen timeout on the tab bar. +Beep, then throw to `context-menu' and return." + (beep) + (throw 'context-menu 'context-menu)) + +(defun tab-bar-touchscreen-begin (event) + "Handle a touchscreen begin EVENT on the tab bar. + +Determine where the touch was made. If it was made on a tab +itself, start a timer set to go off after a certain amount of +time, and wait for the touch point to be released, and either +display a context menu or select a tab as appropriate. + +Otherwise, if it was made on a button, close or create a tab as +appropriate." + (interactive "e") + (let* ((posn (cdadr event)) + (item (tab-bar--event-to-item posn)) + (number (tab-bar--key-to-number (car item))) + timer) + (when (eq (catch 'context-menu + (cond ((integerp number) + ;; The touch began on a tab. Start a context + ;; menu timer and start tracking the tap. + (unwind-protect + (progn + (setq timer (run-at-time touch-screen-delay nil + #'tab-bar-handle-timeout)) + ;; Now wait for the tap to complete. + (when (touch-screen-track-tap event) + ;; And select the tab, or close it, + ;; depending on whether or not the + ;; close button was pressed. + (if (caddr item) + (tab-bar-close-tab number) + (tab-bar-select-tab number)))) + ;; Cancel the timer. + (cancel-timer timer))) + ((and (memq (car item) '(add-tab history-back + history-forward)) + (functionp (cadr item))) + ;; This is some kind of button. Wait for the + ;; tap to complete and press it. + (when (touch-screen-track-tap event) + (call-interactively (cadr item)))) + (t + ;; The touch began on the tab bar itself. + ;; Start a context menu timer and start + ;; tracking the tap, but don't do anything + ;; afterwards. + (unwind-protect + (progn + (setq timer (run-at-time touch-screen-delay nil + #'tab-bar-handle-timeout)) + ;; Now wait for the tap to complete. + (touch-screen-track-tap event)) + ;; Cancel the timer. + (cancel-timer timer))))) + 'context-menu) + ;; Display the context menu in response to a time out waiting + ;; for the tap to complete. + (tab-bar-mouse-context-menu event posn)))) + + + (defvar-keymap tab-bar-map :doc "Keymap for the commands used on the tab bar." "<down-mouse-1>" #'tab-bar-mouse-down-1 @@ -418,7 +492,8 @@ at the mouse-down event to the position at mouse-up event." "S-<wheel-up>" #'tab-bar-move-tab-backward "S-<wheel-down>" #'tab-bar-move-tab "S-<wheel-left>" #'tab-bar-move-tab-backward - "S-<wheel-right>" #'tab-bar-move-tab) + "S-<wheel-right>" #'tab-bar-move-tab + "<touchscreen-begin>" #'tab-bar-touchscreen-begin) (global-set-key [tab-bar] `(menu-item ,(purecopy "tab bar") ,(make-sparse-keymap) diff --git a/lisp/term.el b/lisp/term.el index e1392908b90..8fad9705c98 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -1136,6 +1136,9 @@ Entry to this mode runs the hooks on `term-mode-hook'." (setq-local term-last-input-end (make-marker)) (setq-local term-last-input-match "") + ;; Always display the onscreen keyboard. + (setq-local touch-screen-display-keyboard t) + ;; These local variables are set to their local values: (make-local-variable 'term-saved-home-marker) (make-local-variable 'term-saved-cursor) diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el new file mode 100644 index 00000000000..d425ea401a9 --- /dev/null +++ b/lisp/term/android-win.el @@ -0,0 +1,237 @@ +;;; x-win.el --- parse relevant switches and set up for Android -*- lexical-binding:t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; Author: FSF +;; Keywords: terminals, i18n, android + +;; 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 contains the support for initializing the Lisp side of +;; Android windowing. + +;;; Code: + + +(unless (featurep 'android) + (error "%s: Loading android-win without having Android" + invocation-name)) + +;; Documentation-purposes only: actually loaded in loadup.el. +(require 'frame) +(require 'mouse) +(require 'fontset) +(require 'dnd) +(require 'touch-screen) + +(add-to-list 'display-format-alist '(".*" . android)) + +(declare-function android-get-connection "androidfns.c") + +;; Window system initialization. This is extremely simple because all +;; initialization is done in android_term_init. + +(cl-defmethod window-system-initialization (&context (window-system android) + &optional _ignored) + "Set up the window system. WINDOW-SYSTEM must be ANDROID. +DISPLAY is ignored on Android." + ;; Create the default fontset. + (create-default-fontset) + ;; Just make sure the window system was initialized at startup. + (android-get-connection)) + +(cl-defmethod frame-creation-function (params &context (window-system android)) + (x-create-frame-with-faces params)) + +(cl-defmethod handle-args-function (args &context (window-system android)) + ;; Android has no command line to provide arguments on. + ;; However, call x-handle-args to handle file name args. + (x-handle-args args)) + + +;;; Selection support. + +(declare-function android-clipboard-exists-p "androidselect.c") +(declare-function android-get-clipboard "androidselect.c") +(declare-function android-set-clipboard "androidselect.c") +(declare-function android-clipboard-owner-p "androidselect.c") +(declare-function android-get-clipboard-targets "androidselect.c") +(declare-function android-get-clipboard-data "androidselect.c") + +(defvar android-primary-selection nil + "The last string placed in the primary selection. +Nil if there was no such string. + +Android does not have a primary selection of its own, so Emacs +emulates one inside Lisp.") + +(defun android-get-clipboard-1 (data-type) + "Return the clipboard data. +DATA-TYPE is a selection conversion target. `STRING' means to +return the contents of the clipboard as a string. `TARGETS' +means to return supported data types as a vector. + +Interpret any other symbol as a MIME type, and return its +corresponding data." + (or (and (eq data-type 'STRING) + (android-get-clipboard)) + (and (eq data-type 'TARGETS) + (android-clipboard-exists-p) + (vconcat [TARGETS STRING] + (let ((i nil)) + (dolist (type (android-get-clipboard-targets)) + ;; Don't report plain text as a valid target. + (unless (equal type "text/plain") + (push (intern type) i))) + (nreverse i)))) + (and (symbolp data-type) + (android-get-clipboard-data (symbol-name data-type))))) + +(defun android-get-primary (data-type) + "Return the last string placed in the primary selection, or nil. +Return nil if DATA-TYPE is anything other than STRING or TARGETS." + (when android-primary-selection + (or (and (eq data-type 'STRING) + android-primary-selection) + (and (eq data-type 'TARGETS) + [TARGETS])))) + +(defun android-selection-bounds (value) + "Return bounds of selection value VALUE. +The return value is a list (BEG END BUF) if VALUE is a cons of +two markers or an overlay. Otherwise, it is nil." + (cond ((bufferp value) + (with-current-buffer value + (when (mark t) + (list (mark t) (point) value)))) + ((and (consp value) + (markerp (car value)) + (markerp (cdr value))) + (when (and (marker-buffer (car value)) + (buffer-name (marker-buffer (car value))) + (eq (marker-buffer (car value)) + (marker-buffer (cdr value)))) + (list (marker-position (car value)) + (marker-position (cdr value)) + (marker-buffer (car value))))) + ((overlayp value) + (when (overlay-buffer value) + (list (overlay-start value) + (overlay-end value) + (overlay-buffer value)))))) + +(defun android-encode-select-string (value) + "Turn VALUE into a string suitable for placing in the clipboard. +VALUE should be something suitable for passing to +`gui-set-selection'." + (unless (stringp value) + (when-let ((bounds (android-selection-bounds value))) + (setq value (ignore-errors + (with-current-buffer (nth 2 bounds) + (buffer-substring (nth 0 bounds) + (nth 1 bounds))))))) + value) + +(cl-defmethod gui-backend-get-selection (type data-type + &context (window-system android)) + (cond ((eq type 'CLIPBOARD) + (android-get-clipboard-1 data-type)) + ((eq type 'PRIMARY) + (android-get-primary data-type)))) + +(cl-defmethod gui-backend-selection-exists-p (selection + &context (window-system android)) + (cond ((eq selection 'CLIPBOARD) + (android-clipboard-exists-p)) + ((eq selection 'PRIMARY) + (not (null android-primary-selection))))) + +(cl-defmethod gui-backend-selection-owner-p (selection + &context (window-system android)) + (cond ((eq selection 'CLIPBOARD) + (let ((ownership (android-clipboard-owner-p))) + ;; If ownership is `lambda', then Emacs couldn't determine + ;; whether or not it owns the clipboard. + (and (not (eq ownership 'lambda)) ownership))) + ((eq selection 'PRIMARY) + ;; Emacs always owns its own primary selection as long as it + ;; exists. + (not (null android-primary-selection))))) + +(cl-defmethod gui-backend-set-selection (type value + &context (window-system android)) + ;; First, try to turn value into a string. + ;; Don't set anything if that did not work. + (when-let ((string (android-encode-select-string value))) + (cond ((eq type 'CLIPBOARD) + (android-set-clipboard string)) + ((eq type 'PRIMARY) + (setq android-primary-selection string))))) + +;;; Character composition display. + +(defvar android-preedit-overlay nil + "The overlay currently used to display preedit text from a compose sequence.") + +;; With some input methods, text gets inserted before Emacs is told to +;; remove any preedit text that was displayed, which causes both the +;; preedit overlay and the text to be visible for a brief period of +;; time. This pre-command-hook clears the overlay before any command +;; and should be set whenever a preedit overlay is visible. +(defun android-clear-preedit-text () + "Clear the pre-edit overlay and remove itself from pre-command-hook. +This function should be installed in `pre-command-hook' whenever +preedit text is displayed." + (when android-preedit-overlay + (delete-overlay android-preedit-overlay) + (setq android-preedit-overlay nil)) + (remove-hook 'pre-command-hook #'android-clear-preedit-text)) + +(defun android-preedit-text (event) + "Display preedit text from a compose sequence in EVENT. +EVENT is a preedit-text event." + (interactive "e") + (when android-preedit-overlay + (delete-overlay android-preedit-overlay) + (setq android-preedit-overlay nil) + (remove-hook 'pre-command-hook #'android-clear-preedit-text)) + (when (nth 1 event) + (let ((string (propertize (nth 1 event) 'face '(:underline t)))) + (setq android-preedit-overlay (make-overlay (point) (point))) + (add-hook 'pre-command-hook #'android-clear-preedit-text) + (overlay-put android-preedit-overlay 'window (selected-window)) + (overlay-put android-preedit-overlay 'before-string string)))) + +(define-key special-event-map [preedit-text] 'android-preedit-text) + + +;; Android cursor shapes, named according to the X scheme. +;; Many X cursors are missing. + +(defconst x-pointer-arrow 1000) +(defconst x-pointer-left-ptr 1000) +(defconst x-pointer-left-side 1020) +(defconst x-pointer-sb-h-double-arrow 1014) +(defconst x-pointer-sb-v-double-arrow 1015) +(defconst x-pointer-watch 1004) +(defconst x-pointer-xterm 1008) +(defconst x-pointer-invisible 0) + + +(provide 'android-win) +;; android-win.el ends here. diff --git a/lisp/textmodes/reftex-global.el b/lisp/textmodes/reftex-global.el index acf0891432f..b8b0ae6a061 100644 --- a/lisp/textmodes/reftex-global.el +++ b/lisp/textmodes/reftex-global.el @@ -39,8 +39,10 @@ The TAGS file is also immediately visited with `visit-tags-table'." (reftex-access-scan-info current-prefix-arg) (let* ((master (reftex-TeX-master-file)) (files (reftex-all-document-files)) - (cmd (format "etags %s" (mapconcat #'shell-quote-argument - files " ")))) + (cmd (format "%s %s" + etags-program-name + (mapconcat #'shell-quote-argument + files " ")))) (with-current-buffer (reftex-get-file-buffer-force master) (message "Running etags to create TAGS file...") (shell-command cmd) diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el index 48cefc74d06..ccba1b063ab 100644 --- a/lisp/textmodes/text-mode.el +++ b/lisp/textmodes/text-mode.el @@ -41,6 +41,9 @@ "Non-nil if this buffer's major mode is a variant of Text mode.") (make-obsolete-variable 'text-mode-variant 'derived-mode-p "27.1") +;; Actually defined in textconv.c. +(defvar text-conversion-style) + (defvar text-mode-syntax-table (let ((st (make-syntax-table))) (modify-syntax-entry ?\" ". " st) @@ -125,6 +128,9 @@ You can thus get the full benefit of adaptive filling Turning on Text mode runs the normal hook `text-mode-hook'." (setq-local text-mode-variant t) (setq-local require-final-newline mode-require-final-newline) + + ;; Enable text conversion in this buffer. + (setq-local text-conversion-style t) (add-hook 'context-menu-functions 'text-mode-context-menu 10 t)) (define-derived-mode paragraph-indent-text-mode text-mode "Parindent" diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el new file mode 100644 index 00000000000..a7fa5b4829c --- /dev/null +++ b/lisp/touch-screen.el @@ -0,0 +1,667 @@ +;;; 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 nine 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, 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.") + +(defvar touch-screen-set-point-commands '(mouse-set-point) + "List of commands known to set the point. +This is used to determine whether or not to display the on-screen +keyboard after a mouse command is executed in response to a +`touchscreen-end' event.") + +(defvar touch-screen-current-timer nil + "Timer used to track long-presses. +This is always cleared upon any significant state change.") + +(defcustom touch-screen-display-keyboard nil + "If non-nil, always display the on screen keyboard. +A buffer local value means to always display the on screen +keyboard when the buffer is selected." + :type 'boolean + :group 'mouse + :version "30.1") + +(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") + +(defcustom touch-screen-precision-scroll nil + "Whether or not to use precision scrolling for touch screens. +See `pixel-scroll-precision-mode' for more details." + :type 'boolean + :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 WINDOW is the symbol `frame', simply convert the coordinates +to the frame that they belong in." + (if (or (eq (posn-window posn) window) + (and (eq window 'frame) + (framep (posn-window posn)))) + (posn-x-y posn) + (let ((xy (posn-x-y posn)) + (edges (and (windowp window) + (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)))))) + (if (eq window 'frame) + xy + ;; 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. +Perform vertical scrolling by DY, using `pixel-scroll-precision' +if `touch-screen-precision-scroll' is enabled. Next, perform +horizontal scrolling according to the movement in DX." + ;; Perform vertical scrolling first. Do not ding at buffer limits. + ;; Show a message instead. + (condition-case nil + (if touch-screen-precision-scroll + (if (> dy 0) + (pixel-scroll-precision-scroll-down-page dy) + (pixel-scroll-precision-scroll-up-page (- dy))) + ;; Start conventional scrolling. First, determine the + ;; direction in which the scrolling is taking place. Load the + ;; accumulator value. + (let ((accumulator (or (nth 5 touch-screen-current-tool) 0)) + (window (cadr touch-screen-current-tool)) + (lines-vscrolled (or (nth 7 touch-screen-current-tool) 0))) + (setq accumulator (+ accumulator dy)) ; Add dy. + ;; Figure out how much it has scrolled and how much remains + ;; on the top or bottom of the window. + (while (catch 'again + (let* ((line-height (window-default-line-height window))) + (if (and (< accumulator 0) + (>= (- accumulator) line-height)) + (progn + (setq accumulator (+ accumulator line-height)) + (scroll-down 1) + (setq lines-vscrolled (1+ lines-vscrolled)) + (when (not (zerop accumulator)) + ;; If there is still an outstanding + ;; amount to scroll, do this again. + (throw 'again t))) + (when (and (> accumulator 0) + (>= accumulator line-height)) + (setq accumulator (- accumulator line-height)) + (scroll-up 1) + (setq lines-vscrolled (1+ lines-vscrolled)) + (when (not (zerop accumulator)) + ;; If there is still an outstanding amount + ;; to scroll, do this again. + (throw 'again t))))) + ;; Scrolling is done. Move the accumulator back to + ;; touch-screen-current-tool and break out of the + ;; loop. + (setcar (nthcdr 5 touch-screen-current-tool) accumulator) + (setcar (nthcdr 7 touch-screen-current-tool) + lines-vscrolled) + nil)))) + (beginning-of-buffer + (message (error-message-string '(beginning-of-buffer)))) + (end-of-buffer + (message (error-message-string '(end-of-buffer))))) + + ;; Perform horizontal scrolling by DX, as this does not signal at + ;; the beginning of the buffer. + (let ((accumulator (or (nth 6 touch-screen-current-tool) 0)) + (window (cadr touch-screen-current-tool)) + (lines-vscrolled (or (nth 7 touch-screen-current-tool) 0)) + (lines-hscrolled (or (nth 8 touch-screen-current-tool) 0))) + (setq accumulator (+ accumulator dx)) ; Add dx; + ;; Figure out how much it has scrolled and how much remains on the + ;; left or right of the window. If a line has already been + ;; vscrolled but no hscrolling has happened, don't hscroll, as + ;; otherwise it is too easy to hscroll by accident. + (if (or (> lines-hscrolled 0) + (< lines-vscrolled 1)) + (while (catch 'again + (let* ((column-width (frame-char-width (window-frame window)))) + (if (and (< accumulator 0) + (>= (- accumulator) column-width)) + (progn + (setq accumulator (+ accumulator column-width)) + (scroll-right 1) + (setq lines-hscrolled (1+ lines-hscrolled)) + (when (not (zerop accumulator)) + ;; If there is still an outstanding amount to + ;; scroll, do this again. + (throw 'again t))) + (when (and (> accumulator 0) + (>= accumulator column-width)) + (setq accumulator (- accumulator column-width)) + (scroll-left 1) + (setq lines-hscrolled (1+ lines-hscrolled)) + (when (not (zerop accumulator)) + ;; If there is still an outstanding amount to + ;; scroll, do this again. + (throw 'again t))))) + ;; Scrolling is done. Move the accumulator back to + ;; touch-screen-current-tool and break out of the loop. + (setcar (nthcdr 6 touch-screen-current-tool) accumulator) + (setcar (nthcdr 8 touch-screen-current-tool) lines-hscrolled) + nil))))) + +(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-window-selection-changed (frame) + "Notice that FRAME's selected window has changed. +If point is now on read only text, hide the on screen keyboard. +Otherwise, cancel any timer that is supposed to hide the keyboard +in response to the minibuffer being closed." + (with-selected-frame frame + (if (or buffer-read-only + (get-text-property (point) 'read-only)) + (frame-toggle-on-screen-keyboard (selected-frame) t) + ;; Prevent hiding the minibuffer from hiding the on screen + ;; keyboard. + (when minibuffer-on-screen-keyboard-timer + (cancel-timer minibuffer-on-screen-keyboard-timer) + (setq minibuffer-on-screen-keyboard-timer nil))))) + +(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'. + +If the command being executed is listed in +`touch-screen-set-point-commands' also display the on-screen +keyboard if the current buffer and the character at the new point +is not read-only." + (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))) + ;; Figure out if the on screen keyboard needs to be + ;; displayed. + (when command + (call-interactively command nil + (vector event)) + (when (memq command touch-screen-set-point-commands) + (if (and (or (not buffer-read-only) + touch-screen-display-keyboard) + ;; Detect the splash screen and avoid + ;; displaying the on screen keyboard + ;; there. + (not (equal (buffer-name) "*GNU Emacs*"))) + ;; Once the on-screen keyboard has been opened, + ;; add `touch-screen-window-selection-changed' + ;; as a window selection change function This + ;; allows the on screen keyboard to be hidden + ;; if the selected window's point becomes read + ;; only at some point in the future. + (progn + (add-hook 'window-selection-change-functions + #'touch-screen-window-selection-changed) + (frame-toggle-on-screen-keyboard (selected-frame) nil)) + ;; Otherwise, hide the on screen keyboard now. + (frame-toggle-on-screen-keyboard (selected-frame) t)))))))))) + +(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 nil nil + nil nil))) + ;; 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." + (let ((disable-inhibit-text-conversion t)) + (catch 'finish + (while t + (let ((new-event (read-event nil))) + (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-begin' 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, once the touch point has moved +significantly by at least 5 pixels from where it was in EVENT. + +Return nil immediately if any other kind of event is received; +otherwise, return either t or `no-drag' once the +`touchscreen-end' event arrives; return `no-drag' returned if the +touch point in EVENT did not move significantly, and t otherwise." + (let ((return-value 'no-drag) + (start-xy (touch-screen-relative-xy (cdadr event) + 'frame)) + (disable-inhibit-text-conversion t)) + (catch 'finish + (while t + (let ((new-event (read-event nil))) + (cond + ((eq (car-safe new-event) 'touchscreen-update) + (when-let* ((tool (assq (caadr event) (nth 1 new-event))) + (xy (touch-screen-relative-xy (cdr tool) 'frame))) + (when (or (> (- (car xy) (car start-xy)) 5) + (< (- (car xy) (car start-xy)) -5) + (> (- (cdr xy) (cdr start-xy)) 5) + (< (- (cdr xy) (cdr start-xy)) -5)) + (setq return-value t)) + (when (and update tool (eq return-value t)) + (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. + (and (eq (caadr event) (caadr new-event)) + return-value))) + (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 that no drag really +happened. EVENT is the same as in `touch-screen-drag-mode-line'." + ;; 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. + ;; Also, select the window in EVENT. + (select-window (posn-window (cdadr event))) + (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))) + (when (or (keymapp keymap) command) + (if (keymapp keymap) + (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 (commandp command) + (call-interactively command nil + (vector (list 'mouse-1 (cdadr event))))))))) + +(defun touch-screen-drag-mode-line (event) + "Begin dragging the mode line in response to a touch EVENT. +Change the height of the window based on where the touch point in +EVENT moves. + +If it does not actually move anywhere and the touch point is +removed, and EVENT lies on top of text with a mouse command +bound, run that command instead." + (interactive "e") + ;; 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) + 'frame)) + (last-position (cdr relative-xy))) + (when (window-resizable window 0) + (when (eq + (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) 'frame)) + (position (cdr new-relative-xy)) + (window-resize-pixelwise t) + 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))))) + (when (ignore-errors + (adjust-window-trailing-edge window growth nil t) t) + (setq last-position position)))))) + 'no-drag) + ;; Dragging did not actually happen, so try to run any command + ;; necessary. + (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 diff --git a/lisp/version.el b/lisp/version.el index 9cadc59237f..ca61f8cfeee 100644 --- a/lisp/version.el +++ b/lisp/version.el @@ -26,6 +26,31 @@ ;;; Code: + + +(defun android-read-build-system () + "Obtain the host name of the system on which Emacs was built. +Use the data stored in the special file `/assets/build_info'. +Value is the string ``Unknown'' upon failure, else the hostname +of the build system." + (with-temp-buffer + (insert-file-contents "/assets/build_info") + (let ((string (buffer-substring 1 (line-end-position)))) + (and (not (equal string "Unknown")) string)))) + +(defun android-read-build-time () + "Obtain the time at which Emacs was built. +Use the data stored in the special file `/assets/build_info'. +Value is nil upon failure, else the time in the same format as +returned by `current-time'." + (with-temp-buffer + (insert-file-contents "/assets/build_info") + (end-of-line) + (let ((number (read (current-buffer)))) + (time-convert number 'list)))) + + + (defconst emacs-major-version (progn (string-match "^[0-9]+" emacs-version) (string-to-number (match-string 0 emacs-version))) @@ -36,10 +61,15 @@ (string-to-number (match-string 1 emacs-version))) "Minor version number of this version of Emacs.") -(defconst emacs-build-system (system-name) +(defconst emacs-build-system (or (and (eq system-type 'android) + (android-read-build-system)) + (system-name)) "Name of the system on which Emacs was built, or nil if not available.") -(defconst emacs-build-time (if emacs-build-system (current-time)) +(defconst emacs-build-time (if emacs-build-system + (or (and (eq system-type 'android) + (android-read-build-time)) + (current-time))) "Time at which Emacs was dumped out, or nil if not available.") (defconst emacs-build-number 1 ; loadup.el may increment this @@ -130,9 +160,22 @@ or if we could not determine the revision.") (looking-at "[[:xdigit:]]\\{40\\}")) (match-string 0))))) +(defun emacs-repository-version-android () + "Return the Emacs repository revision Emacs was built from. +Value is nil if Emacs was not built from a repository checkout. +Use information from the `/assets/version' special file." + (with-temp-buffer + (insert-file-contents "/assets/version") + (let ((string (buffer-substring 1 (line-end-position)))) + (and (not (equal string "Unknown")) string)))) + (defun emacs-repository-get-version (&optional dir _external) "Try to return as a string the repository revision of the Emacs sources. The format of the returned string is dependent on the VCS in use. + +If Emacs is built for Android, use the version information +embedded in the Emacs installation package. + Value is nil if the sources do not seem to be under version control, or if we could not determine the revision. Note that this reports on the current state of the sources, which may not @@ -140,13 +183,27 @@ correspond to the running Emacs. Optional argument DIR is a directory to use instead of `source-directory'. Optional argument EXTERNAL is ignored." - (emacs-repository-version-git (or dir source-directory))) + (cond ((eq system-type 'android) + (emacs-repository-version-android)) + (t (emacs-repository-version-git + (or dir source-directory))))) (defvar emacs-repository-branch nil "String giving the repository branch from which this Emacs was built. Value is nil if Emacs was not built from a repository checkout, or if we could not determine the branch.") +(defun emacs-repository-branch-android () + "Return the Emacs repository branch Emacs was built from. +Value is nil if Emacs was not built from a repository checkout. +Use information from the `/assets/version' special file." + (with-temp-buffer + (insert-file-contents "/assets/version") + (end-of-line) + (forward-char) + (let ((string (buffer-substring (point) (line-end-position)))) + (and (not (equal string "Unknown")) string)))) + (defun emacs-repository-branch-git (dir) "Ask git itself for the branch information for directory DIR." (message "Waiting for git...") @@ -162,12 +219,19 @@ or if we could not determine the branch.") (defun emacs-repository-get-branch (&optional dir) "Try to return as a string the repository branch of the Emacs sources. The format of the returned string is dependent on the VCS in use. + +If Emacs is built for Android, use the version information +embedded in the Emacs installation package. + Value is nil if the sources do not seem to be under version control, or if we could not determine the branch. Note that this reports on the current state of the sources, which may not correspond to the running Emacs. Optional argument DIR is a directory to use instead of `source-directory'." - (emacs-repository-branch-git (or dir source-directory))) + (cond ((eq system-type 'android) + (emacs-repository-branch-android)) + (t (emacs-repository-branch-git + (or dir source-directory))))) ;;; version.el ends here diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index cafd0ad0a4d..14864b5ac86 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -65,8 +65,11 @@ ;;; Compatibility. (defun widget-event-point (event) - "Character position of the end of event if that exists, or nil." - (posn-point (event-end event))) + "Character position of the end of event if that exists, or nil. +EVENT can either be a mouse event or a touch screen event." + (if (eq (car-safe event) 'touchscreen-begin) + (posn-point (cdadr event)) + (posn-point (event-end event)))) (defun widget-button-release-event-p (event) "Non-nil if EVENT is a mouse-button-release event object." @@ -1017,6 +1020,7 @@ button end points." (define-key map [backtab] 'widget-backward) (define-key map [down-mouse-2] 'widget-button-click) (define-key map [down-mouse-1] 'widget-button-click) + (define-key map [touchscreen-begin] 'widget-button-click) ;; The following definition needs to avoid using escape sequences that ;; might get converted to ^M when building loaddefs.el (define-key map [(control ?m)] 'widget-button-press) @@ -1072,8 +1076,18 @@ Note that such modes will need to require wid-edit.") "If non-nil, `widget-button-click' moves point to a button after invoking it. If nil, point returns to its original position after invoking a button.") +(defun widget-event-start (event) + "Return the start of EVENT. +If EVENT is not a touchscreen event, simply return its +`event-start'. Otherwise, it is a touchscreen event, so return +the posn of its touchpoint." + (if (eq (car event) 'touchscreen-begin) + (cdadr event) + (event-start event))) + (defun widget-button--check-and-call-button (event button) "Call BUTTON if BUTTON is a widget and EVENT is correct for it. +EVENT can either be a mouse event or a touchscreen-begin event. If nothing was called, return non-nil." (let* ((oevent event) (mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1))) @@ -1084,49 +1098,58 @@ If nothing was called, return non-nil." ;; in a save-excursion so that the click on the button ;; doesn't change point. (save-selected-window - (select-window (posn-window (event-start event))) + (select-window (posn-window (widget-event-start event))) (save-excursion - (goto-char (posn-point (event-start event))) + (goto-char (posn-point (widget-event-start event))) (let* ((overlay (widget-get button :button-overlay)) (pressed-face (or (widget-get button :pressed-face) widget-button-pressed-face)) (face (overlay-get overlay 'face)) (mouse-face (overlay-get overlay 'mouse-face))) (unwind-protect - ;; Read events, including mouse-movement - ;; events, waiting for a release event. If we - ;; began with a mouse-1 event and receive a - ;; movement event, that means the user wants - ;; to perform drag-selection, so cancel the - ;; button press and do the default mouse-1 - ;; action. For mouse-2, just highlight/ - ;; unhighlight the button the mouse was - ;; initially on when we move over it. + ;; Read events, including mouse-movement events, + ;; waiting for a release event. If we began with a + ;; mouse-1 event and receive a movement event, that + ;; means the user wants to perform drag-selection, so + ;; cancel the button press and do the default mouse-1 + ;; action. For mouse-2, just highlight/ unhighlight + ;; the button the mouse was initially on when we move + ;; over it. + ;; + ;; If this function was called in response to a + ;; touchscreen event, then wait for a corresponding + ;; touchscreen-end event instead. (save-excursion (when face ; avoid changing around image (overlay-put overlay 'face pressed-face) (overlay-put overlay 'mouse-face pressed-face)) - (unless (widget-apply button :mouse-down-action event) - (let ((track-mouse t)) - (while (not (widget-button-release-event-p event)) - (setq event (read--potential-mouse-event)) - (when (and mouse-1 (mouse-movement-p event)) - (push event unread-command-events) - (setq event oevent) - (throw 'button-press-cancelled t)) - (unless (or (integerp event) - (memq (car event) - '(switch-frame select-window)) - (eq (car event) 'scroll-bar-movement)) - (setq pos (widget-event-point event)) - (if (and pos - (eq (get-char-property pos 'button) - button)) - (when face - (overlay-put overlay 'face pressed-face) - (overlay-put overlay 'mouse-face pressed-face)) - (overlay-put overlay 'face face) - (overlay-put overlay 'mouse-face mouse-face)))))) + (if (eq (car event) 'touchscreen-begin) + ;; This a touchscreen event and must be handled + ;; specially through `touch-screen-track-tap'. + (progn + (unless (touch-screen-track-tap event) + (throw 'button-press-cancelled t))) + (unless (widget-apply button :mouse-down-action event) + (let ((track-mouse t)) + (while (not (widget-button-release-event-p event)) + (setq event (read--potential-mouse-event)) + (when (and mouse-1 (mouse-movement-p event)) + (push event unread-command-events) + (setq event oevent) + (throw 'button-press-cancelled t)) + (unless (or (integerp event) + (memq (car event) + '(switch-frame select-window)) + (eq (car event) 'scroll-bar-movement)) + (setq pos (widget-event-point event)) + (if (and pos + (eq (get-char-property pos 'button) + button)) + (when face + (overlay-put overlay 'face pressed-face) + (overlay-put overlay 'mouse-face pressed-face)) + (overlay-put overlay 'face face) + (overlay-put overlay 'mouse-face mouse-face))))))) ;; When mouse is released over the button, run ;; its action function. @@ -1148,32 +1171,35 @@ If nothing was called, return non-nil." (if (widget-event-point event) (let* ((mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1))) (pos (widget-event-point event)) - (start (event-start event)) + (start (widget-event-start event)) (button (get-char-property pos 'button (and (windowp (posn-window start)) (window-buffer (posn-window start)))))) (when (or (null button) (widget-button--check-and-call-button event button)) - (let ((up t) + (let ((up (not (eq (car event) 'touchscreen-begin))) command) ;; Mouse click not on a widget button. Find the global ;; command to run, and check whether it is bound to an ;; up event. - (if mouse-1 - (cond ((setq command ;down event - (lookup-key widget-global-map [down-mouse-1])) - (setq up nil)) - ((setq command ;up event - (lookup-key widget-global-map [mouse-1])))) - (cond ((setq command ;down event - (lookup-key widget-global-map [down-mouse-2])) - (setq up nil)) - ((setq command ;up event - (lookup-key widget-global-map [mouse-2]))))) + (cond + ((eq (car event) 'touchscreen-begin) + (setq command (lookup-key widget-global-map + [touchscreen-begin]))) + (mouse-1 (cond ((setq command ;down event + (lookup-key widget-global-map [down-mouse-1])) + (setq up nil)) + ((setq command ;up event + (lookup-key widget-global-map [mouse-1]))))) + (t (cond ((setq command ;down event + (lookup-key widget-global-map [down-mouse-2])) + (setq up nil)) + ((setq command ;up event + (lookup-key widget-global-map [mouse-2])))))) (when up ;; Don't execute up events twice. - (while (not (widget-button-release-event-p event)) + (while (not (and (widget-button-release-event-p event))) (setq event (read--potential-mouse-event)))) (when command (call-interactively command))))) |