commit 2bc6d8283189bcbbf9bceeac5013b9e41a511222 (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Tue Jul 26 05:41:25 2022 +0000 Handle modifiers during Haiku DND wheel movement * lisp/term/haiku-win.el (haiku-dnd-modifier-mask) (haiku-dnd-wheel-modifier-type): New functions. (haiku-handle-drag-wheel): Use them. * lisp/x-dnd.el (x-dnd-modifier-mask): Remove outdated comment. * src/haikuselect.c (haiku_note_drag_wheel): Pass modifiers to wheel function. (syms_of_haikuselect): Update doc strings. diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el index 9d9c31970d..a16169d477 100644 --- a/lisp/term/haiku-win.el +++ b/lisp/term/haiku-win.el @@ -489,19 +489,56 @@ Return the number of clicks that were made in quick succession." (defvar haiku-drag-wheel-function) -(defun haiku-handle-drag-wheel (frame x y horizontal up) +(defun haiku-dnd-modifier-mask (mods) + "Return the internal modifier mask for the Emacs modifier state MODS. +MODS is a single symbol, or a list of symbols such as `shift' or +`control'." + (let ((mask 0)) + (unless (consp mods) + (setq mods (list mods))) + (dolist (modifier mods) + (cond ((eq modifier 'shift) + (setq mask (logior mask ?\S-\0))) + ((eq modifier 'control) + (setq mask (logior mask ?\C-\0))) + ((eq modifier 'meta) + (setq mask (logior mask ?\M-\0))) + ((eq modifier 'hyper) + (setq mask (logior mask ?\H-\0))) + ((eq modifier 'super) + (setq mask (logior mask ?\s-\0))) + ((eq modifier 'alt) + (setq mask (logior mask ?\A-\0))))) + mask)) + +(defun haiku-dnd-wheel-modifier-type (flags) + "Return the modifier type of an internal modifier mask. +FLAGS is the internal modifier mask of a turn of the mouse wheel." + (let ((modifiers (logior ?\M-\0 ?\C-\0 ?\S-\0 + ?\H-\0 ?\s-\0 ?\A-\0))) + (catch 'type + (dolist (modifier mouse-wheel-scroll-amount) + (when (and (consp modifier) + (eq (haiku-dnd-modifier-mask (car modifier)) + (logand flags modifiers))) + (throw 'type (cdr modifier)))) + nil))) + +(defun haiku-handle-drag-wheel (frame x y horizontal up modifiers) "Handle wheel movement during drag-and-drop. FRAME is the frame on top of which the wheel moved. X and Y are the frame-relative coordinates of the wheel movement. HORIZONTAL is whether or not the wheel movement was horizontal. -UP is whether or not the wheel moved up (or left)." +UP is whether or not the wheel moved up (or left). +MODIFIERS is the internal modifier mask of the wheel movement." (when (not (equal haiku-last-wheel-direction (cons horizontal up))) (setq haiku-last-wheel-direction (cons horizontal up)) (when (consp haiku-dnd-wheel-count) (setcar haiku-dnd-wheel-count 0))) - (let ((function (cond + (let ((type (haiku-dnd-wheel-modifier-type modifiers)) + (function (cond ((and (not horizontal) (not up)) mwheel-scroll-up-function) ((not horizontal) @@ -512,14 +549,27 @@ UP is whether or not the wheel moved up (or left)." (t (if mouse-wheel-flip-direction mwheel-scroll-left-function mwheel-scroll-right-function)))) - (timestamp (time-convert nil 1000))) + (timestamp (time-convert nil 1000)) + (amt 1)) + (cond ((and (eq type 'hscroll) + (not horizontal)) + (setq function (if (not up) + mwheel-scroll-left-function + mwheel-scroll-right-function))) + ((and (eq type 'global-text-scale)) + (setq function 'global-text-scale-adjust + amt (if up 1 -1))) + ((and (eq type 'text-scale)) + (setq function 'text-scale-adjust + amt (if up 1 -1)))) (when function (let ((posn (posn-at-x-y x y frame))) (when (windowp (posn-window posn)) (with-selected-window (posn-window posn) (funcall function - (or (and (not mouse-wheel-progressive-speed) 1) - (haiku-note-wheel-click (car timestamp)))))))))) + (* amt + (or (and (not mouse-wheel-progressive-speed) 1) + (haiku-note-wheel-click (car timestamp))))))))))) (setq haiku-drag-wheel-function #'haiku-handle-drag-wheel) diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index 10fd9e5dac..bdfe444bc1 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -708,7 +708,6 @@ MODS is a single symbol, or a list of symbols such as `shift' or (unless (consp mods) (setq mods (list mods))) (dolist (modifier mods) - ;; TODO: handle virtual modifiers such as Meta and Hyper. (cond ((eq modifier 'shift) (setq mask (logior mask 1))) ; ShiftMask ((eq modifier 'control) diff --git a/src/haikuselect.c b/src/haikuselect.c index 268d8b1ec9..7eb93a2754 100644 --- a/src/haikuselect.c +++ b/src/haikuselect.c @@ -1062,8 +1062,9 @@ haiku_note_drag_wheel (struct input_event *ie) if (!NILP (Vhaiku_drag_wheel_function) && (haiku_dnd_allow_same_frame || XFRAME (ie->frame_or_window) != haiku_dnd_frame)) - safe_call (6, Vhaiku_drag_wheel_function, ie->frame_or_window, - ie->x, ie->y, horizontal ? Qt : Qnil, up ? Qt : Qnil); + safe_call (7, Vhaiku_drag_wheel_function, ie->frame_or_window, + ie->x, ie->y, horizontal ? Qt : Qnil, up ? Qt : Qnil, + make_int (ie->modifiers)); redisplay_preserve_echo_area (35); } @@ -1149,12 +1150,12 @@ These are only called if a connection to the Haiku display was opened. */); DEFVAR_LISP ("haiku-drag-wheel-function", Vhaiku_drag_wheel_function, doc: /* Function called upon wheel movement while dragging a message. -If non-nil, it is called with 5 arguments when the mouse wheel moves +If non-nil, it is called with 6 arguments when the mouse wheel moves while a drag-and-drop operation is in progress: the frame where the mouse moved, the frame-relative X and Y positions where the mouse -moved, whether or not the wheel movement was horizontal, and whether -or not the wheel moved up (or left, if the movement was -horizontal). */); +moved, whether or not the wheel movement was horizontal, whether or +not the wheel moved up (or left, if the movement was horizontal), and +keyboard modifiers currently held down. */); Vhaiku_drag_wheel_function = Qnil; DEFSYM (QSECONDARY, "SECONDARY"); commit f6040018c5e281ee31a3e499f43f29fbf1e817e9 Merge: 06cec5ee0b 970190b844 Author: Stefan Kangas Date: Tue Jul 26 06:30:19 2022 +0200 Merge from origin/emacs-28 970190b844 Avoid infloop in 'recenter' a866674b2a Fix inaccuracies in "lax search" documentation commit 06cec5ee0bd2c2a8fbc761bd5eb0254a4ecf10f4 Author: Po Lu Date: Tue Jul 26 10:29:16 2022 +0800 Remove some redundant checks in the DND code * src/xterm.c (handle_one_xevent): Don't check tab_bar_p or tool_bar_p before clearing last items during drag-and-drop. diff --git a/src/xterm.c b/src/xterm.c index e953f54d6d..6f8291b494 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -19062,10 +19062,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, dpyinfo->grabbed |= (1 << event->xbutton.button); dpyinfo->last_mouse_frame = f; - if (f && !tab_bar_p) + + if (f) f->last_tab_bar_item = -1; #if ! defined (USE_GTK) - if (f && !tool_bar_p) + if (f) f->last_tool_bar_item = -1; #endif /* not USE_GTK */ } @@ -20479,10 +20480,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (device) device->grab |= (1 << xev->detail); - if (f && !tab_bar_p) + if (f) f->last_tab_bar_item = -1; #if ! defined (USE_GTK) - if (f && !tool_bar_p) + if (f) f->last_tool_bar_item = -1; #endif /* not USE_GTK */ } commit d04701c0c4959d3c42587a4e1277bb517a2ea04b Author: Paul Eggert Date: Mon Jul 25 12:59:26 2022 -0700 Note guideline for doc string expressions * doc/lispref/tips.texi (Documentation Tips): Mention \\=' and \\=` and say that expressions like (NAME TYPE RANGE) should not be quoted. diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index 30146a89eb..d03698d354 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -689,6 +689,18 @@ line. This looks nice in the source code, but looks bizarre when users view the documentation. Remember that the indentation before the starting double-quote is not part of the string! +@item +When documentation should display an ASCII apostrophe or grave accent, +use @samp{\\='} or @samp{\\=`} in the documentation string literal so +that the character is displayed as-is. + +@item +In documentation strings, do not quote expressions that are not Lisp symbols, +as these expressions can stand for themselves. For example, write +@samp{Return the list (NAME TYPE RANGE) ...}@: instead of +@samp{Return the list `(NAME TYPE RANGE)' ...}@: or +@samp{Return the list \\='(NAME TYPE RANGE) ...}. + @anchor{Docstring hyperlinks} @item @cindex curly quotes commit 970190b84485e4511b094546395a7e710f894fae (refs/remotes/origin/emacs-28) Author: Eli Zaretskii Date: Mon Jul 25 21:59:55 2022 +0300 Avoid infloop in 'recenter' * src/window.c (Frecenter): Avoid infinite loop in the minibuffer under 'fido-vertical-mode'. (Bug#56765) diff --git a/src/window.c b/src/window.c index 0cf6373e0b..2576b66a18 100644 --- a/src/window.c +++ b/src/window.c @@ -6631,7 +6631,7 @@ and redisplay normally--don't erase and redraw the frame. */) considered to be part of the visible height of the line. */ h += extra_line_spacing; - while (-it.current_y > h) + while (-it.current_y > h && it.what != IT_EOB) move_it_by_lines (&it, 1); charpos = IT_CHARPOS (it); commit 0f9c28f00879e86713350a5bbff1f6f158874273 Author: Mattias Engdegård Date: Mon Jul 25 18:08:47 2022 +0200 ; * test/lisp/net/tramp-tests.el (tramp--test-enabled): fix regexp diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 4524d56a9b..784ef93f5b 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -204,7 +204,7 @@ being the result.") ;; Remove old test files. (dolist (dir `(,temporary-file-directory ,ert-remote-temporary-file-directory)) - (dolist (file (directory-files dir 'full "^\\(\\.#\\)?tramp-test")) + (dolist (file (directory-files dir 'full "\\`\\(\\.#\\)?tramp-test")) (ignore-errors (if (file-directory-p file) (delete-directory file 'recursive) commit 4c9d3d199c04c43d3c1b0c7c1a873f22c07dd699 Author: Michael Albinus Date: Mon Jul 25 17:19:02 2022 +0200 Fix regexp in tramp-tests.el * test/lisp/net/tramp-tests.el (tramp--test-enabled): Fix regexp for Tramp test files. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index f2ef520162..4524d56a9b 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -204,7 +204,7 @@ being the result.") ;; Remove old test files. (dolist (dir `(,temporary-file-directory ,ert-remote-temporary-file-directory)) - (dolist (file (directory-files dir 'full "^\\(.#\\)?tramp-test")) + (dolist (file (directory-files dir 'full "^\\(\\.#\\)?tramp-test")) (ignore-errors (if (file-directory-p file) (delete-directory file 'recursive) commit b86569f1302a48d4c402d0cffad75679989f2236 Author: Robert Pluim Date: Tue Mar 1 11:34:11 2022 +0100 Make package-archives URL treatment slighty laxer 'package-archives' URLs are expected to end in '/', but we can cater for people typoing that by using 'url-expand-file-name'. * lisp/emacs-lisp/package.el (package--with-response-buffer-1): Use 'url-expand-file-name' instead of 'concat'. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 5ea0c819e9..b25865f429 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1325,7 +1325,7 @@ errors signaled by ERROR-FORM or by BODY). (cl-defun package--with-response-buffer-1 (url body &key async file error-function noerror &allow-other-keys) (if (string-match-p "\\`https?:" url) - (let ((url (concat url file))) + (let ((url (url-expand-file-name file url))) (if async (package--unless-error #'ignore (url-retrieve commit ffe12ff2503917e47c0356195b31430996c148f9 Author: João Távora Date: Fri Jul 22 09:23:02 2022 +0100 Clean up more robustly in compile.el * lisp/progmodes/compile.el (compilation-sentinel): Use unwind-protect. diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index c71a50d4fd..a665fccc73 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -2464,22 +2464,23 @@ commands of Compilation major mode are available. See (defun compilation-sentinel (proc msg) "Sentinel for compilation buffers." (if (memq (process-status proc) '(exit signal)) - (let ((buffer (process-buffer proc))) - (if (null (buffer-name buffer)) - ;; buffer killed - (set-process-buffer proc nil) - (with-current-buffer buffer - ;; Write something in the compilation buffer - ;; and hack its mode line. - (compilation-handle-exit (process-status proc) - (process-exit-status proc) - msg) - ;; Since the buffer and mode line will show that the - ;; process is dead, we can delete it now. Otherwise it - ;; will stay around until M-x list-processes. - (delete-process proc))) + (unwind-protect + (let ((buffer (process-buffer proc))) + (if (null (buffer-name buffer)) + ;; buffer killed + (set-process-buffer proc nil) + (with-current-buffer buffer + ;; Write something in the compilation buffer + ;; and hack its mode line. + (compilation-handle-exit (process-status proc) + (process-exit-status proc) + msg)))) (setq compilation-in-progress (delq proc compilation-in-progress)) - (compilation--update-in-progress-mode-line)))) + (compilation--update-in-progress-mode-line) + ;; Since the buffer and mode line will show that the + ;; process is dead, we can delete it now. Otherwise it + ;; will stay around until M-x list-processes. + (delete-process proc)))) (defun compilation-filter (proc string) "Process filter for compilation buffers. commit a866674b2ab24e349b8132cff1cda4a971881d56 Author: Eli Zaretskii Date: Mon Jul 25 14:49:23 2022 +0300 Fix inaccuracies in "lax search" documentation * doc/emacs/search.texi (Lax Search): Update the examples of character folding in search. (Bug#56747) diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 8b799f093b..269ea71aa8 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1413,16 +1413,18 @@ of its accented cousins like @code{@"a} and @code{@'a}, i.e., the match disregards the diacritics that distinguish these variants. In addition, @code{a} matches other characters that resemble it, or have it as part of their graphical representation, -such as U+249C @sc{parenthesized latin small letter a} and U+2100 -@sc{account of} (which looks like a small @code{a} over @code{c}). +such as U+00AA @sc{feminine ordinal indicator} and U+24D0 +@sc{circled latin small letter a} (which looks like a small @code{a} +inside a circle). Similarly, the @acronym{ASCII} double-quote character @code{"} matches all the other variants of double quotes defined by the Unicode standard. Finally, character folding can make a sequence of one or more characters match another sequence of a different length: for example, the sequence of two characters @code{ff} matches U+FB00 -@sc{latin small ligature ff}. Character sequences that are not identical, -but match under character folding are known as @dfn{equivalent -character sequences}. +@sc{latin small ligature ff} and the sequence @code{(a)} matches +U+249C @sc{parenthesized latin small letter a}. Character sequences +that are not identical, but match under character folding are known as +@dfn{equivalent character sequences}. @kindex M-s ' @r{(Incremental Search)} @findex isearch-toggle-char-fold commit 7478d1cbf64b4a45e047bc0fc9a27ee43d5663c1 Author: Michael Albinus Date: Mon Jul 25 11:47:43 2022 +0200 ; Instrument tramp-tests.el diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index e2abb77591..f2ef520162 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5357,6 +5357,7 @@ INPUT, if non-nil, is a string sent to the process." (when (tramp--test-adb-p) (skip-unless (tramp--test-emacs27-p))) + (tramp--test-instrument-test-case (if (getenv "EMACS_EMBA_CI") 10 0) (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) (let ((tmp-name (tramp--test-make-temp-name nil quoted)) (default-directory ert-remote-temporary-file-directory) @@ -5445,7 +5446,7 @@ INPUT, if non-nil, is a string sent to the process." (read (tramp--test-shell-command-to-string-asynchronously "tput cols"))))) (when (natnump cols) - (should (= cols async-shell-command-width)))))) + (should (= cols async-shell-command-width))))))) (tramp--test-deftest-direct-async-process tramp-test32-shell-command 'unstable) commit bc3e9f4f6d3224af84a28eb6bb4fd1e0a4688ed1 Author: Po Lu Date: Mon Jul 25 09:38:06 2022 +0000 Fix mouse face handling during frame reentry on Haiku * src/haikuterm.c (haiku_read_socket): Clear last_mouse_glyph_frame like on X. diff --git a/src/haikuterm.c b/src/haikuterm.c index 7630d9c103..f2bee1263d 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3365,6 +3365,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) if (b->just_exited_p) { Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); + if (f == hlinfo->mouse_face_mouse_frame) { /* If we move outside the frame, then we're @@ -3375,6 +3376,9 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) haiku_flush_dirty_back_buffer_on (f); } + if (f == x_display_list->last_mouse_glyph_frame) + x_display_list->last_mouse_glyph_frame = NULL; + if (f->auto_lower && !popup_activated_p /* Don't do this if the mouse entered a scroll bar. */ && !BView_inside_scroll_bar (FRAME_HAIKU_VIEW (f),