commit fc281e0df3d6f3ea359eae440cdae7e65412c06d (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Mon Feb 21 07:42:01 2022 +0000 Prevent Haiku display from being opened multiple times * src/haikufns.c (Fx_open_connection): Return if display connection already exists. diff --git a/src/haikufns.c b/src/haikufns.c index ea42dd0daa..69f502fb01 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -1844,16 +1844,29 @@ DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed) { - struct haiku_display_info *dpy_info; + struct haiku_display_info *dpyinfo; CHECK_STRING (display); if (NILP (Fstring_equal (display, build_string ("be")))) - !NILP (must_succeed) ? fatal ("Bad display") : error ("Bad display"); - dpy_info = haiku_term_init (); + { + if (!NILP (must_succeed)) + fatal ("Bad display"); + else + error ("Bad display"); + } + + if (x_display_list) + return Qnil; + + dpyinfo = haiku_term_init (); - if (!dpy_info) - !NILP (must_succeed) ? fatal ("Display not responding") : - error ("Display not responding"); + if (!dpyinfo) + { + if (!NILP (must_succeed)) + fatal ("Display not responding"); + else + error ("Display not responding"); + } return Qnil; } commit e087c89b1e243bbd941a4a50b4bf99613e13d016 Author: Po Lu Date: Mon Feb 21 14:29:58 2022 +0800 Prevent GTK from setting unreasonable size hints with large menu bars * src/gtkutil.c (struct _EmacsMenuBar): New struct. (emacs_menu_bar_init): (emacs_menu_bar_class_init): (emacs_menu_bar_get_preferred_width): (emacs_menu_bar_new): New functions. (xg_update_menu_item): Use our own menu bar class on GTK 3. * src/gtkutil.h (EmacsMenuBar): New class. diff --git a/src/gtkutil.c b/src/gtkutil.c index 158c29272f..72eb7ef2bb 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -76,6 +76,17 @@ typedef struct pgtk_output xp_output; #define XG_TEXT_OPEN GTK_STOCK_OPEN #endif +#ifdef HAVE_GTK3 +static void emacs_menu_bar_get_preferred_width (GtkWidget *, gint *, gint *); + +struct _EmacsMenuBar +{ + GtkMenuBar parent; +}; + +G_DEFINE_TYPE (EmacsMenuBar, emacs_menu_bar, GTK_TYPE_MENU_BAR) +#endif + #ifndef HAVE_PGTK static void xg_im_context_commit (GtkIMContext *, gchar *, gpointer); static void xg_im_context_preedit_changed (GtkIMContext *, gpointer); @@ -127,6 +138,45 @@ bool xg_gtk_initialized; /* Used to make sure xwidget calls are possible static GtkWidget * xg_get_widget_from_map (ptrdiff_t idx); + + +#ifdef HAVE_GTK3 +static void +emacs_menu_bar_init (EmacsMenuBar *menu_bar) +{ + return; +} + +static void +emacs_menu_bar_class_init (EmacsMenuBarClass *klass) +{ + GtkWidgetClass *widget_class; + + widget_class = GTK_WIDGET_CLASS (klass); + widget_class->get_preferred_width = emacs_menu_bar_get_preferred_width; +} + +static void +emacs_menu_bar_get_preferred_width (GtkWidget *widget, + gint *minimum, gint *natural) +{ + GtkWidgetClass *widget_class; + + widget_class = GTK_WIDGET_CLASS (emacs_menu_bar_parent_class); + widget_class->get_preferred_width (widget, minimum, natural); + + if (minimum) + *minimum = 0; +} + +static GtkWidget * +emacs_menu_bar_new (void) +{ + return GTK_WIDGET (g_object_new (emacs_menu_bar_get_type (), NULL)); +} + +#endif + /*********************************************************************** Display handling functions @@ -3287,7 +3337,12 @@ create_menus (widget_value *data, } else { +#ifndef HAVE_GTK3 wmenu = gtk_menu_bar_new (); +#else + wmenu = emacs_menu_bar_new (); +#endif + #ifdef HAVE_PGTK g_signal_connect (G_OBJECT (wmenu), "button-press-event", G_CALLBACK (menu_bar_button_pressed_cb), f); diff --git a/src/gtkutil.h b/src/gtkutil.h index b74244d84d..f850ecc421 100644 --- a/src/gtkutil.h +++ b/src/gtkutil.h @@ -83,6 +83,10 @@ typedef struct xg_menu_item_cb_data_ } xg_menu_item_cb_data; +#ifdef HAVE_GTK3 +G_DECLARE_FINAL_TYPE (EmacsMenuBar, emacs_menu_bar, EMACS, MENU_BAR, GtkMenuBar) +#endif + extern bool xg_uses_old_file_dialog (void); extern char *xg_get_file_name (struct frame *f, commit 816cf19a3a4a2697392d58516c73374d7aaa1533 Author: Po Lu Date: Mon Feb 21 03:27:48 2022 +0000 Implement left-right separators for dialog boxes on Haiku * src/haiku_support.cc (BAlert_set_offset_spacing): New function. * src/haiku_support.h: Update prototypes. * src/haikumenu.c (struct submenu_stack_cell): Remove unused struct. (haiku_dialog_show): Use offset spacing if a left-right boundary was seen and make sure the user can always quit a dialog if no enabled items exist. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 0f4ed169fb..4f6a96568c 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -2686,6 +2686,16 @@ BAlert_add_button (void *alert, const char *text) return al->ButtonAt (al->CountButtons () - 1); } +/* Make sure the leftmost button is grouped to the left hand side of + the alert. */ +void +BAlert_set_offset_spacing (void *alert) +{ + BAlert *al = (BAlert *) alert; + + al->SetButtonSpacing (B_OFFSET_SPACING); +} + static int32 be_alert_thread_entry (void *thread_data) { diff --git a/src/haiku_support.h b/src/haiku_support.h index 9fc81c2875..ef433514fe 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -754,6 +754,9 @@ extern "C" extern void * BAlert_add_button (void *alert, const char *text); + extern void + BAlert_set_offset_spacing (void *alert); + extern int32 BAlert_go (void *alert, void (*block_input_function) (void), diff --git a/src/haikumenu.c b/src/haikumenu.c index 11a76217a9..41db0d414d 100644 --- a/src/haikumenu.c +++ b/src/haikumenu.c @@ -32,12 +32,6 @@ static Lisp_Object *volatile menu_item_selection; int popup_activated_p = 0; -struct submenu_stack_cell -{ - void *parent_menu; - void *pane; -}; - static void digest_menu_items (void *first_menu, int start, int menu_items_used, int mbar_p) @@ -190,6 +184,11 @@ haiku_dialog_show (struct frame *f, Lisp_Object title, Lisp_Object header, const char **error_name) { int i, nb_buttons = 0; + bool boundary_seen = false; + Lisp_Object pane_name, vals[10]; + void *alert, *button; + bool enabled_item_seen_p = false; + int32 val; *error_name = NULL; @@ -199,17 +198,15 @@ haiku_dialog_show (struct frame *f, Lisp_Object title, return Qnil; } - Lisp_Object pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME); + pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME); i = MENU_ITEMS_PANE_LENGTH; if (STRING_MULTIBYTE (pane_name)) pane_name = ENCODE_UTF_8 (pane_name); block_input (); - void *alert = BAlert_new (SSDATA (pane_name), NILP (header) ? HAIKU_INFO_ALERT : - HAIKU_IDEA_ALERT); - - Lisp_Object vals[10]; + alert = BAlert_new (SSDATA (pane_name), NILP (header) ? HAIKU_INFO_ALERT : + HAIKU_IDEA_ALERT); while (i < menu_items_used) { @@ -229,7 +226,11 @@ haiku_dialog_show (struct frame *f, Lisp_Object title, if (EQ (item_name, Qquote)) { + if (nb_buttons) + boundary_seen = true; + i++; + continue; } if (nb_buttons >= 9) @@ -245,9 +246,11 @@ haiku_dialog_show (struct frame *f, Lisp_Object title, if (!NILP (descrip) && STRING_MULTIBYTE (descrip)) descrip = ENCODE_UTF_8 (descrip); - void *button = BAlert_add_button (alert, SSDATA (item_name)); + button = BAlert_add_button (alert, SSDATA (item_name)); BButton_set_enabled (button, !NILP (enable)); + enabled_item_seen_p |= !NILP (enable); + if (!NILP (descrip)) BView_set_tooltip (button, SSDATA (descrip)); @@ -255,21 +258,40 @@ haiku_dialog_show (struct frame *f, Lisp_Object title, ++nb_buttons; i += MENU_ITEMS_ITEM_LENGTH; } + + /* Haiku only lets us specify a single button to place on the + left. */ + if (boundary_seen) + BAlert_set_offset_spacing (alert); + + /* If there isn't a single enabled item, add an "Ok" button so the + popup can be dismissed. */ + if (!enabled_item_seen_p) + BAlert_add_button (alert, "Ok"); unblock_input (); unrequest_sigio (); ++popup_activated_p; - int32_t val = BAlert_go (alert, block_input, unblock_input, - process_pending_signals); + val = BAlert_go (alert, block_input, unblock_input, + process_pending_signals); --popup_activated_p; request_sigio (); if (val < 0) quit (); - else + else if (val < nb_buttons) return vals[val]; - return Qnil; + /* The dialog was dismissed via the button appended to dismiss popup + dialogs without a single enabled item. */ + if (nb_buttons) + quit (); + /* Otherwise, the Ok button was added because no buttons were seen + at all. */ + else + return Qt; + + emacs_abort (); } Lisp_Object commit f0ac4b7797fb16833a7a0c49593f36d88c69d2d5 Author: Dmitry Gutov Date: Mon Feb 21 04:15:39 2022 +0200 Bump xref.el version. * lisp/progmodes/xref.el: Bump version to 1.4.0. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 784c745477..3374ab2e84 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1,7 +1,7 @@ ;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*- ;; Copyright (C) 2014-2022 Free Software Foundation, Inc. -;; Version: 1.3.2 +;; Version: 1.4.0 ;; Package-Requires: ((emacs "26.1")) ;; This is a GNU ELPA :core package. Avoid functionality that is not commit 3d106897fdd5546797b2fb5bb5a7704f327c4da3 Author: Dmitry Gutov Date: Mon Feb 21 03:09:32 2022 +0200 Public-ize xref-show-xrefs * lisp/progmodes/xref.el (xref-show-xrefs): New function (wrapper for an older, private one, bug#42967). diff --git a/etc/NEWS b/etc/NEWS index b7ceb1c2fb..b08bdc6451 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -747,6 +747,8 @@ replacing entire matches. *** New variable 'xref-current-item' (renamed from a private version). +*** New function 'xref-show-xrefs'. + ** File notifications +++ diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 2449d11c07..56897826cb 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -3252,7 +3252,6 @@ with the command \\[tags-loop-continue]." delimited) (fileloop-continue)) -(declare-function xref--show-xrefs "xref") (declare-function xref-query-replace-in-results "xref") (declare-function project--files-in-directory "project") @@ -3296,7 +3295,7 @@ REGEXP should use constructs supported by your local `grep' command." (user-error "No matches for: %s" regexp)) (message "Searching...done") xrefs)))) - (xref--show-xrefs fetcher nil))) + (xref-show-xrefs fetcher nil))) ;;;###autoload (defun dired-do-find-regexp-and-replace (from to) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index f606a25575..880c5b5517 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2015-2022 Free Software Foundation, Inc. ;; Version: 0.8.1 -;; Package-Requires: ((emacs "26.1") (xref "1.0.2")) +;; Package-Requires: ((emacs "26.1") (xref "1.4.0")) ;; This is a GNU ELPA :core package. Avoid using functionality that ;; not compatible with the version of Emacs recorded above. @@ -776,7 +776,6 @@ The following commands are available: (define-key tab-prefix-map "p" #'project-other-tab-command)) (declare-function grep-read-files "grep") -(declare-function xref--show-xrefs "xref") (declare-function xref--find-ignores-arguments "xref") ;;;###autoload @@ -802,7 +801,7 @@ requires quoting, e.g. `\\[quoted-insert]'." (project--files-in-directory dir nil (grep-read-files regexp)))))) - (xref--show-xrefs + (xref-show-xrefs (apply-partially #'project--find-regexp-in-files regexp files) nil))) @@ -830,7 +829,7 @@ pattern to search for." (project-files pr (cons (project-root pr) (project-external-roots pr))))) - (xref--show-xrefs + (xref-show-xrefs (apply-partially #'project--find-regexp-in-files regexp files) nil))) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 747151cd94..784c745477 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1340,6 +1340,13 @@ definitions." (defvar xref--read-pattern-history nil) +;;;###autoload +(defun xref-show-xrefs (fetcher display-action) + "Display some Xref values produced by FETCHER using DISPLAY-ACTION. +The meanings of both arguments are the same as documented in +`xref-show-xrefs-function'." + (xref--show-xrefs fetcher display-action)) + (defun xref--show-xrefs (fetcher display-action &optional _always-show-list) (xref--push-markers) (unless (functionp fetcher) commit 7159c1af08dfd8c5da8bfe01ff55aded9553793e Author: Po Lu Date: Mon Feb 21 01:40:01 2022 +0000 ; * src/haikuterm.c (haiku_read_socket): Add extra keyboard modifiers. diff --git a/src/haikuterm.c b/src/haikuterm.c index 1ff38b97bb..b5b61ec85f 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -2702,7 +2702,8 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) ASCII_KEYSTROKE_EVENT; inev.timestamp = b->time / 1000; - inev.modifiers = haiku_modifiers_to_emacs (b->modifiers); + inev.modifiers = (haiku_modifiers_to_emacs (b->modifiers) + | extra_keyboard_modifiers); XSETFRAME (inev.frame_or_window, f); break; } commit 9e6df01bf1bd393fc0e7aacbda7f56df10ecbe03 Author: Po Lu Date: Mon Feb 21 09:33:54 2022 +0800 Respect `extra-keyboard-modifiers' when handling XI2 keyboard input * src/xterm.c (handle_one_xevent): Add extra modifiers to XI2 keyboard state. diff --git a/src/xterm.c b/src/xterm.c index 22f27700f6..6d498ad381 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -11572,6 +11572,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, } #endif + state |= x_emacs_to_x_modifiers (dpyinfo, extra_keyboard_modifiers); + #ifdef HAVE_XKB if (FRAME_DISPLAY_INFO (f)->xkb_desc) { commit 3d2c213ce99fec54bfd5230405e6fde753794b09 Author: Dmitry Gutov Date: Mon Feb 21 02:59:50 2022 +0200 Public-ize xref-current-item * lisp/progmodes/xref.el (xref--current-item): Rename to 'xref-current-item' (bug#53956). Update all references. diff --git a/etc/NEWS b/etc/NEWS index dd9e822871..b7ceb1c2fb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -745,6 +745,8 @@ replacing entire matches. *** New command 'xref-find-references-and-replace' to rename one identifier. +*** New variable 'xref-current-item' (renamed from a private version). + ** File notifications +++ diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 6677b4f004..747151cd94 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -485,13 +485,18 @@ To undo, use \\[xref-go-forward]." (set-marker marker nil nil) (run-hooks 'xref-after-return-hook)))) -(defvar xref--current-item nil) +(define-obsolete-variable-alias + 'xref--current-item + 'xref-current-item + "29.1") + +(defvar xref-current-item nil) (defun xref-pulse-momentarily () (pcase-let ((`(,beg . ,end) (save-excursion (or - (let ((length (xref-match-length xref--current-item))) + (let ((length (xref-match-length xref-current-item))) (and length (cons (point) (+ (point) length)))) (back-to-indentation) (if (eolp) @@ -548,7 +553,7 @@ If SELECT is non-nil, select the target window." (window (pop-to-buffer buf t)) (frame (let ((pop-up-frames t)) (pop-to-buffer buf t)))) (xref--goto-char marker)) - (let ((xref--current-item item)) + (let ((xref-current-item item)) (run-hooks 'xref-after-jump-hook))) @@ -656,7 +661,7 @@ SELECT is `quit', also quit the *xref* window." "Display the source of xref at point in the appropriate window, if any." (interactive) (let* ((xref (xref--item-at-point)) - (xref--current-item xref)) + (xref-current-item xref)) (when xref (xref--set-arrow) (xref--show-location (xref-item-location xref))))) @@ -715,7 +720,7 @@ quit the *xref* buffer." (let* ((buffer (current-buffer)) (xref (or (xref--item-at-point) (user-error "Choose a reference to visit"))) - (xref--current-item xref)) + (xref-current-item xref)) (xref--set-arrow) (xref--show-location (xref-item-location xref) (if quit 'quit t)) (if (fboundp 'next-error-found) @@ -945,7 +950,7 @@ beginning of the line." (let ((win (get-buffer-window (current-buffer)))) (and win (set-window-point win (point)))) (xref--set-arrow) - (let ((xref--current-item xref)) + (let ((xref-current-item xref)) (xref--show-location (xref-item-location xref) t))) (t (error "No %s xref" (if backward "previous" "next")))))) commit 0b755ee6951147f40fdf0b6ff4b78835f4e54bf9 Author: Lars Ingebrigtsen Date: Sun Feb 20 22:36:46 2022 +0100 Further fixes for eww-open-url on Tramp files * lisp/url/url-file.el (url-file-asynch-callback): Simplify slightly (bug#40425). * lisp/url/url-queue.el (url-queue-start-retrieve): Allow non-local files here, too. diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el index 60a79425a3..3863ac9914 100644 --- a/lisp/url/url-file.el +++ b/lisp/url/url-file.el @@ -76,18 +76,15 @@ to them." buff func func args args efs)) - (let ((size (file-attribute-size (file-attributes name)))) - (with-current-buffer buff - (goto-char (point-max)) - (if (/= -1 size) - (insert (format "Content-length: %d\n" size))) - (insert "\n") - (insert-file-contents-literally name) - (if (not (url-file-host-is-local-p (url-host url-current-object))) - (condition-case () - (delete-file name) - (error nil))) - (apply func args)))) + (with-current-buffer buff + (goto-char (point-max)) + (insert-file-contents-literally name) + (insert (format "Content-length: %d\n\n" (buffer-size))) + (if (not (url-file-host-is-local-p (url-host url-current-object))) + (condition-case () + (delete-file name) + (error nil))) + (apply func args))) (declare-function ange-ftp-set-passwd "ange-ftp" (host user passwd)) (declare-function ange-ftp-copy-file-internal "ange-ftp" diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el index d353f0c011..152300bda5 100644 --- a/lisp/url/url-queue.el +++ b/lisp/url/url-queue.el @@ -31,6 +31,7 @@ (eval-when-compile (require 'cl-lib)) (require 'browse-url) (require 'url-parse) +(require 'url-file) (defcustom url-queue-parallel-processes 6 "The number of concurrent processes." @@ -160,6 +161,7 @@ The variable `url-queue-timeout' sets a timeout." (url-queue-context-buffer job) (current-buffer)) (let ((url-request-noninteractive t) + (url-allow-non-local-files t) ;; This will disable querying the user for ;; credentials if one of the things we're fetching ;; in the background return a header requesting it. commit 17c75146a400ddd95d6e49de32ff9018a9052115 Author: Juri Linkov Date: Sun Feb 20 20:56:06 2022 +0200 * lisp/mouse.el (context-menu-entry): Remove help-buffer-under-preparation. (bug#53910) diff --git a/lisp/mouse.el b/lisp/mouse.el index da2ca1c036..1e205283de 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -541,9 +541,7 @@ Some context functions add menu items below the separator." (defvar context-menu-entry `(menu-item ,(purecopy "Context Menu") ,(make-sparse-keymap) - :filter ,(lambda (_) (unless help-buffer-under-preparation - ;; No need to build menu to describe keys - (context-menu-map)))) + :filter ,(lambda (_) (context-menu-map))) "Menu item that creates the context menu and can be bound to a mouse key.") (defvar context-menu-mode-map commit 4450ae0f7801182723a514cb02a1667a3dbcfc8e Author: Lars Ingebrigtsen Date: Sun Feb 20 19:17:37 2022 +0100 Fix a compilation warning in cus-edit-tests.el diff --git a/test/lisp/cus-edit-tests.el b/test/lisp/cus-edit-tests.el index 7a597ccf34..0ef5168109 100644 --- a/test/lisp/cus-edit-tests.el +++ b/test/lisp/cus-edit-tests.el @@ -76,10 +76,11 @@ (customize-saved) (should (search-forward cus-edit-tests--obsolete-option-tag nil t))))) +(defcustom cus-edit-test-foo1 0 + "" + :type 'number) + (ert-deftest test-setopt () - (defcustom cus-edit-test-foo1 0 - "" - :type 'number) (should (= (setopt cus-edit-test-foo1 1) 1)) (should (= cus-edit-test-foo1 1)) (should-error (setopt cus-edit-test-foo1 :foo))) commit 48c65f219dcf2c9004fe995c79a132935b7d183a Author: Stefan Monnier Date: Sun Feb 20 13:16:35 2022 -0500 (loadhist_initialize): Fix regression test failure * src/lread.c (loadhist_initialize): Adjust assertion for the nil case. (readevalloop): Signal an error for non-string `sourcename`. diff --git a/src/lread.c b/src/lread.c index d225403b20..0486a98883 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1172,7 +1172,7 @@ compute_found_effective (Lisp_Object found) static void loadhist_initialize (Lisp_Object filename) { - eassert (STRINGP (filename)); + eassert (STRINGP (filename) || NILP (filename)); specbind (Qcurrent_load_list, Fcons (filename, Qnil)); } @@ -2179,6 +2179,9 @@ readevalloop (Lisp_Object readcharfun, bool first_sexp = 1; Lisp_Object macroexpand = intern ("internal-macroexpand-for-load"); + if (!NILP (sourcename)) + CHECK_STRING (sourcename); + if (NILP (Ffboundp (macroexpand)) || (STRINGP (sourcename) && suffix_p (sourcename, ".elc"))) /* Don't macroexpand before the corresponding function is defined commit e6f541f2383cf860c6a2d6c8d366c21a3b8de2d0 Merge: 92ce3b5d54 c52ef7ec4b Author: Eli Zaretskii Date: Sun Feb 20 18:43:43 2022 +0200 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit 92ce3b5d548df5640a2eae053e03e13350727c50 Author: Eli Zaretskii Date: Sun Feb 20 18:42:33 2022 +0200 ; Fix compilation warnings * src/keyboard.c (kbd_buffer_get_event): * src/xterm.c (handle_one_xevent): Fix compiler warnings. diff --git a/src/keyboard.c b/src/keyboard.c index 2aff0f1011..da8c6c54d8 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -3893,6 +3893,8 @@ kbd_buffer_get_event (KBOARD **kbp, } #endif /* !defined HAVE_DBUS && !defined USE_FILE_NOTIFY && !defined THREADS_ENABLED */ + *kbp = current_kboard; + /* Wait until there is input available. */ for (;;) { diff --git a/src/xterm.c b/src/xterm.c index 01de3e27b9..22f27700f6 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10123,7 +10123,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, ptrdiff_t i; for (i = 0; i < nbytes; i++) - STORE_KEYSYM_FOR_DEBUG (copy_bufptr[i]); + { + STORE_KEYSYM_FOR_DEBUG (copy_bufptr[i]); + } inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT; inev.ie.arg = make_unibyte_string ((char *) copy_bufptr, nbytes); @@ -11834,7 +11836,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, } for (i = 0; i < nbytes; i++) - STORE_KEYSYM_FOR_DEBUG (copy_bufptr[i]); + { + STORE_KEYSYM_FOR_DEBUG (copy_bufptr[i]); + } inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT; inev.ie.arg = make_unibyte_string (copy_bufptr, nbytes); commit c52ef7ec4ba26fde796e96124dffcc57aa6445b1 Author: Lars Ingebrigtsen Date: Sun Feb 20 17:42:21 2022 +0100 Adjust doc-tests-documentation/autoloaded-macro * test/src/doc-tests.el (doc-tests-documentation/autoloaded-macro): Adjust test -- rx is loaded in nativecomp Emacsen when the tests are run, apparently. diff --git a/test/src/doc-tests.el b/test/src/doc-tests.el index 8dabba9035..ee4f02347e 100644 --- a/test/src/doc-tests.el +++ b/test/src/doc-tests.el @@ -29,8 +29,8 @@ (ert-deftest doc-tests-documentation/autoloaded-macro () (skip-unless noninteractive) - (should (autoloadp (symbol-function 'rx))) - (should (stringp (documentation 'rx)))) ; See Bug#52969. + (should (autoloadp (symbol-function 'benchmark-run))) + (should (stringp (documentation 'benchmark-run)))) ; See Bug#52969. (ert-deftest doc-tests-documentation/autoloaded-defun () (skip-unless noninteractive) commit b8f430747291d77e27a7b86977a07327f96b072c Author: Lars Ingebrigtsen Date: Sun Feb 20 16:57:21 2022 +0100 Simplify Minibuffer Edit example * doc/emacs/mini.texi (Minibuffer Edit): Say how to disable SPC and ? completion (bug#36745). diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi index 7c4a78a7b6..13d9269c68 100644 --- a/doc/emacs/mini.texi +++ b/doc/emacs/mini.texi @@ -200,8 +200,8 @@ As with @key{RET}, you can use @kbd{C-q} to insert a @key{TAB}, the following in your init file: @lisp -(keymap-set minibuffer-local-completion-map "SPC" #'self-insert-command) -(keymap-set minibuffer-local-completion-map "?" #'self-insert-command) +(keymap-unset minibuffer-local-completion-map "SPC") +(keymap-unset minibuffer-local-completion-map "?") @end lisp For convenience, @kbd{C-a} (@code{move-beginning-of-line}) in a commit 8be576286de4239ff145b8697c6bcbfeac527013 Author: Lars Ingebrigtsen Date: Sun Feb 20 16:23:01 2022 +0100 Add instructions on disabling SPC completion to Minibuffer Edit * doc/emacs/mini.texi (Minibuffer Edit): Say how to disable SPC and ? completion (bug#36745). diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi index 979be34fac..7c4a78a7b6 100644 --- a/doc/emacs/mini.texi +++ b/doc/emacs/mini.texi @@ -195,7 +195,14 @@ use the @kbd{C-o} (@code{open-line}) command (@pxref{Blank Lines}). often bound to @dfn{completion commands}, which allow you to easily fill in the desired text without typing all of it. @xref{Completion}. As with @key{RET}, you can use @kbd{C-q} to insert a @key{TAB}, -@key{SPC}, or @samp{?} character. +@key{SPC}, or @samp{?} character. If you want to make @key{SPC} and +@key{?} insert normally instead of starting completion, you can put +the following in your init file: + +@lisp +(keymap-set minibuffer-local-completion-map "SPC" #'self-insert-command) +(keymap-set minibuffer-local-completion-map "?" #'self-insert-command) +@end lisp For convenience, @kbd{C-a} (@code{move-beginning-of-line}) in a minibuffer moves point to the beginning of the argument text, not the commit 5649b45323a63be27470ddf215853bf0460db6b4 Author: Lars Ingebrigtsen Date: Sun Feb 20 16:14:49 2022 +0100 Fix compilation warning introduced by previous shr.el change * lisp/net/shr.el (url-file): Fix compilation warning. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 2a4fa9ceb0..386f1d6095 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -40,6 +40,7 @@ (require 'image) (require 'puny) (require 'url-cookie) +(require 'url-file) (require 'pixel-fill) (require 'text-property-search) commit 3a6129e723943e499009a7d40b38ee9eec17c8ad Author: Lars Ingebrigtsen Date: Sun Feb 20 16:08:45 2022 +0100 Make eww work better on Tramp HTML * lisp/net/eww.el (eww-open-file): Use it. (eww-browse-url): Ditto. * lisp/net/shr.el (shr-expand-url): Allow loading relative Tramp files if we're reading from a file:// document. * lisp/url/url-file.el (url-allow-non-local-files): New user option (bug#40425). diff --git a/lisp/net/eww.el b/lisp/net/eww.el index cfebb108a5..700a6c3e82 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -32,6 +32,7 @@ (require 'thingatpt) (require 'url) (require 'url-queue) +(require 'url-file) (require 'xdg) (eval-when-compile (require 'subr-x)) @@ -487,15 +488,11 @@ killed after rendering." (defun eww-open-file (file) "Render FILE using EWW." (interactive "fFile: ") - (eww (concat "file://" - (and (memq system-type '(windows-nt ms-dos)) - "/") - (expand-file-name file)) - nil - ;; The file name may be a non-local Tramp file. The URL - ;; library doesn't understand these file names, so use the - ;; normal Emacs machinery to load the file. - (eww--file-buffer file))) + (let ((url-allow-non-local-files t)) + (eww (concat "file://" + (and (memq system-type '(windows-nt ms-dos)) + "/") + (expand-file-name file))))) (defun eww--file-buffer (file) (with-current-buffer (generate-new-buffer " *eww file*") @@ -1207,7 +1204,8 @@ instead of `browse-url-new-window-flag'." (format "*eww-%s*" (url-host (url-generic-parse-url (eww--dwim-expand-url url)))))) (eww-mode)) - (eww url)) + (let ((url-allow-non-local-files t)) + (eww url))) (defun eww-back-url () "Go to the previously displayed page." diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 6e0af06bed..2a4fa9ceb0 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -877,8 +877,10 @@ size, and full-buffer size." ;; A link to an anchor. (concat (nth 3 base) url)) (t - ;; Totally relative. - (url-expand-file-name url (concat (car base) (cadr base)))))) + ;; Totally relative. Allow Tramp file names if we're + ;; rendering a file:// URL. + (let ((url-allow-non-local-files (equal (nth 2 base) "file"))) + (url-expand-file-name url (concat (car base) (cadr base))))))) (defun shr-ensure-newline () (unless (bobp) diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el index 31e5c07234..60a79425a3 100644 --- a/lisp/url/url-file.el +++ b/lisp/url/url-file.el @@ -29,6 +29,12 @@ (require 'url-dired) (declare-function mm-disable-multibyte "mm-util" ()) +(defvar url-allow-non-local-files nil + "If non-nil, allow URL to fetch non-local files. +By default, this is not allowed, since that would allow rendering +HTML to fetch files on other systems if given a element, which can be disturbing.") + (defconst url-file-default-port 21 "Default FTP port.") (defconst url-file-asynchronous-p t "FTP transfers are asynchronous.") (defalias 'url-file-expand-file-name 'url-default-expander) @@ -111,7 +117,8 @@ to them." (memq system-type '(ms-dos windows-nt))) (substring file 1)) ;; file: URL with a file:/bar:/foo-like spec. - ((string-match "\\`/[^/]+:/" file) + ((and (not url-allow-non-local-files) + (string-match "\\`/[^/]+:/" file)) (concat "/:" file)) (t file)))) commit aa6d1027ce08f9827dcf7d3a2286f94ea1a283cb Author: Lars Ingebrigtsen Date: Sun Feb 20 15:52:10 2022 +0100 Make `g' work in eww buffers displaying Tramp files * lisp/net/eww.el (eww--file-buffer): Refactored out. (eww-open-file): From here. (eww-reload): Make reloading work in Tramp files. diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 9db07b51db..cfebb108a5 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -495,14 +495,17 @@ killed after rendering." ;; The file name may be a non-local Tramp file. The URL ;; library doesn't understand these file names, so use the ;; normal Emacs machinery to load the file. - (with-current-buffer (generate-new-buffer " *eww file*") - (set-buffer-multibyte nil) - (insert "Content-type: " (or (mailcap-extension-to-mime - (url-file-extension file)) - "application/octet-stream") - "\n\n") - (insert-file-contents file) - (current-buffer)))) + (eww--file-buffer file))) + +(defun eww--file-buffer (file) + (with-current-buffer (generate-new-buffer " *eww file*") + (set-buffer-multibyte nil) + (insert "Content-type: " (or (mailcap-extension-to-mime + (url-file-extension file)) + "application/octet-stream") + "\n\n") + (insert-file-contents file) + (current-buffer))) ;;;###autoload (defun eww-search-words () @@ -1291,9 +1294,16 @@ just re-display the HTML already fetched." (error "No current HTML data") (eww-display-html 'utf-8 url (plist-get eww-data :dom) (point) (current-buffer))) - (let ((url-mime-accept-string eww-accept-content-types)) - (eww-retrieve url #'eww-render - (list url (point) (current-buffer) encode)))))) + (let ((parsed (url-generic-parse-url url))) + (if (equal (url-type parsed) "file") + ;; Use Tramp instead of url.el for files (since url.el + ;; doesn't work well with Tramp files). + (let ((eww-buffer (current-buffer))) + (with-current-buffer (eww--file-buffer (url-filename parsed)) + (eww-render nil url nil eww-buffer))) + (let ((url-mime-accept-string eww-accept-content-types)) + (eww-retrieve url #'eww-render + (list url (point) (current-buffer) encode)))))))) ;; Form support. commit d710b8422547cf7c0e222408a2ca660cd6ce40b6 Author: Lars Ingebrigtsen Date: Sun Feb 20 15:24:47 2022 +0100 Make string-pixel-width about 40% faster * lisp/emacs-lisp/subr-x.el (string-pixel-width): Speed up. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 647397e7f7..7ad4e9ba2a 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -446,7 +446,10 @@ is inserted before adjusting the number of empty lines." "Return the width of STRING in pixels." (if (zerop (length string)) 0 - (with-temp-buffer + ;; Keeping a work buffer around is more efficient than creating a + ;; new temporary buffer. + (with-current-buffer (get-buffer-create " *string-pixel-width*") + (delete-region (point-min) (point-max)) (insert string) (car (buffer-text-pixel-size nil nil t))))) commit 277b49d7a3241fcba1391f7c200c1195dfa1900c Author: Michael Albinus Date: Sun Feb 20 15:24:31 2022 +0100 * doc/misc/tramp.texi (Customizing Methods): Add tramp-nspawn. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 25ff2796bd..ce377e1223 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1808,6 +1808,17 @@ Access of a hadoop/hdfs file system. A file is accessed via the user that you want to use, and @samp{node} is the name of the hadoop server. +@item tramp-nspawn +@cindex method @option{nspawn} +@cindex @option{nspawn} method +Access to environments provided by systemd-nspawn. A file is accessed +via @file{@trampfn{nspawn,user@@container,/path/to/file}}, where +@samp{user} is the (optional) user that you want to use, and +@samp{container} is the container to connect to. systemd-nspawn and +its container utilities often require super user access to run, use +multi-hop file names with @option{doas} or @option{sudo} to raise your +privileges. + @item vagrant-tramp @cindex method @option{vagrant} @cindex @option{vagrant} method commit 8d1dfb2af38de590244e30d3a9553679b47b3dd0 Author: Lars Ingebrigtsen Date: Sun Feb 20 14:49:41 2022 +0100 Quote files that start with - in dired * lisp/dired-aux.el (dired-shell-stuff-it): Add ./ to file names that start with - (bug#10458). diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 41c45b4e51..2449d11c07 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -954,6 +954,13 @@ prompted for the shell command to use interactively." (setq retval (replace-match x t t retval 2))) retval)) (lambda (x) (concat cmd-prefix command dired-mark-separator x))))) + ;; If a file name starts with "-", add a "./" to avoid the command + ;; interpreting it as a command line switch. + (setq file-list (mapcar (lambda (file) + (if (string-match "\\`-" file) + (concat "./" file) + file)) + file-list)) (concat (cond (on-each commit f462620847b5736274533b4a91c46a80cd1279b0 Author: Michael Albinus Date: Sun Feb 20 14:04:24 2022 +0100 * lisp/net/tramp.el (tramp-read-passwd): Adapt for empty user names. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 7b558aec11..932dfb3691 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -5755,12 +5755,15 @@ Consults the auth-source package." ;; adapt `default-directory'. (Bug#39389, Bug#39489) (default-directory tramp-compat-temporary-file-directory) (case-fold-search t) - (key (tramp-make-tramp-file-name - ;; In tramp-sh.el, we must use "password-vector" due to - ;; multi-hop. - (tramp-get-connection-property - proc "password-vector" (process-get proc 'vector)) - 'noloc)) + ;; In tramp-sh.el, we must use "password-vector" due to + ;; multi-hop. + (vec (tramp-get-connection-property + proc "password-vector" (process-get proc 'vector))) + (key (tramp-make-tramp-file-name vec 'noloc)) + (method (tramp-file-name-method vec)) + (user (or (tramp-file-name-user-domain vec) + (tramp-get-connection-property key "login-as" nil))) + (host (tramp-file-name-host-port vec)) (pw-prompt (or prompt (with-current-buffer (process-buffer proc) @@ -5776,51 +5779,40 @@ Consults the auth-source package." auth-info auth-passwd) (unwind-protect - (with-parsed-tramp-file-name key nil - (setq tramp-password-save-function nil - user - (or user (tramp-get-connection-property key "login-as" nil))) - (prog1 - (or - ;; See if auth-sources contains something useful. - (ignore-errors - (and (tramp-get-connection-property - v "first-password-request" nil) - ;; Try with Tramp's current method. - (setq auth-info - (car - (auth-source-search - :max 1 - (and user :user) - (if domain - (concat - user tramp-prefix-domain-format domain) - user) - :host - (if port - (concat - host tramp-prefix-port-format port) - host) - :port method - :require (cons :secret (and user '(:user))) - :create t)) - tramp-password-save-function - (plist-get auth-info :save-function) - auth-passwd - (tramp-compat-auth-info-password auth-info)))) - - ;; Try the password cache. - (progn - (setq auth-passwd (password-read pw-prompt key) - tramp-password-save-function - (lambda () (password-cache-add key auth-passwd))) - auth-passwd)) - - ;; Workaround. Prior Emacs 28.1, auth-source has saved - ;; empty passwords. See discussion in Bug#50399. - (when (zerop (length auth-passwd)) - (setq tramp-password-save-function nil)) - (tramp-set-connection-property v "first-password-request" nil))) + ;; We cannot use `with-parsed-tramp-file-name', because it + ;; expands the file name. + (or + (setq tramp-password-save-function nil) + ;; See if auth-sources contains something useful. + (ignore-errors + (and (tramp-get-connection-property + vec "first-password-request" nil) + ;; Try with Tramp's current method. If there is no + ;; user name, `:create' triggers to ask for. We + ;; suppress it. + (setq auth-info + (car + (auth-source-search + :max 1 :user user :host host :port method + :require (cons :secret (and user '(:user))) + :create (and user t))) + tramp-password-save-function + (plist-get auth-info :save-function) + auth-passwd + (tramp-compat-auth-info-password auth-info)))) + + ;; Try the password cache. + (progn + (setq auth-passwd (password-read pw-prompt key) + tramp-password-save-function + (lambda () (password-cache-add key auth-passwd))) + auth-passwd)) + + ;; Workaround. Prior Emacs 28.1, auth-source has saved empty + ;; passwords. See discussion in Bug#50399. + (when (zerop (length auth-passwd)) + (setq tramp-password-save-function nil)) + (tramp-set-connection-property vec "first-password-request" nil) ;; Reenable the timers. (with-timeout-unsuspend stimers)))) commit 84fe4866605ae47cdfe7059fad0c3ace7d324a68 Author: Lars Ingebrigtsen Date: Sun Feb 20 13:45:56 2022 +0100 Fix compilation warning in previous sendmail.el change * lisp/mail/sendmail.el (mm-long-lines-p): Fix compilation warning. diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index 0d3eeecd8c..c55cdc8412 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -877,7 +877,7 @@ The variable is used to trigger insertion of the \"Mail-Followup-To\" header when sending a message to a mailing list." :type '(repeat string)) -(declare-function mml-to-mime "mml" ()) +(declare-function mm-long-lines-p "mm-bodies" (length)) (defun mail-send () "Send the message in the current buffer. @@ -955,6 +955,7 @@ the user from the mailer." (error "Invalid header line (maybe a continuation line lacks initial whitespace)")) (forward-line 1))) (goto-char opoint) + (require 'mml) (when (or mail-encode-mml ;; When we have long lines, we have to MIME encode ;; to get line folding. commit f0b4f2ee6bbef2ea4596568703e1f267eb4a46aa Author: Lars Ingebrigtsen Date: Sun Feb 20 13:41:57 2022 +0100 Ensure that `mail-send' breaks too-long lines * lisp/mail/sendmail.el (mail-send): Ensure that we fold too-long lines when using `sendmail-user-agent' (bug#53412). diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index 76c3baf472..0d3eeecd8c 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -955,7 +955,10 @@ the user from the mailer." (error "Invalid header line (maybe a continuation line lacks initial whitespace)")) (forward-line 1))) (goto-char opoint) - (when mail-encode-mml + (when (or mail-encode-mml + ;; When we have long lines, we have to MIME encode + ;; to get line folding. + (mm-long-lines-p 1000)) (mml-to-mime) (setq mail-encode-mml nil)) (run-hooks 'mail-send-hook) commit 06b7c53927b983764a7174b7edbb51832b21fbc8 Author: Matthias Meulien Date: Sun Feb 20 13:23:03 2022 +0100 Add more bookmark types * lisp/gnus/gnus-sum.el (gnus-summary-bookmark-jump): * lisp/man.el (Man-bookmark-jump): Mark the bookmark type (bug#54030). diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 8fb07d5905..1be5a48068 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -13278,6 +13278,8 @@ BOOKMARK is a bookmark name or a bookmark record." (buffer . ,(current-buffer)) . ,(bookmark-get-bookmark-record bookmark))))) +(put 'gnus-summary-bookmark-jump 'bookmark-handler-type "Gnus") + (gnus-summary-make-all-marking-commands) (provide 'gnus-sum) diff --git a/lisp/man.el b/lisp/man.el index a53a696c31..951e0ef9ad 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1976,6 +1976,8 @@ Uses `Man-name-local-regexp'." (bookmark-default-handler `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bookmark))))) +(put 'Man-bookmark-jump 'bookmark-handler-type "Man") + ;;; Mouse support (defun Man-at-mouse (e) "Open man manual at point." commit 7a6e229a2e7eeb57a3dd00295bf1d0e76c092e9e Author: Po Lu Date: Sun Feb 20 20:00:28 2022 +0800 Fix font panel on NS * src/nsterm.m ([EmacsView changeFont:]): Don't use emacs_event, instead placing events directly into the keyboard buffer. diff --git a/src/nsterm.m b/src/nsterm.m index 1d7788e3e5..aba26ef758 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -5974,17 +5974,15 @@ - (void)dealloc /* Called on font panel selection. */ - (void)changeFont: (id)sender { - NSEvent *e = [[self window] currentEvent]; struct face *face = FACE_FROM_ID (emacsframe, DEFAULT_FACE_ID); struct font *font = face->font; id newFont; CGFloat size; NSFont *nsfont; + struct input_event ie; NSTRACE ("[EmacsView changeFont:]"); - - if (!emacs_event) - return; + EVENT_INIT (ie); #ifdef NS_IMPL_GNUSTEP nsfont = ((struct nsfont_info *)font)->nsfont; @@ -5995,16 +5993,16 @@ - (void)changeFont: (id)sender if ((newFont = [sender convertFont: nsfont])) { - SET_FRAME_GARBAGED (emacsframe); /* now needed as of 2008/10 */ - - emacs_event->kind = NS_NONKEY_EVENT; - emacs_event->modifiers = 0; - emacs_event->code = KEY_NS_CHANGE_FONT; + ie.kind = NS_NONKEY_EVENT; + ie.modifiers = 0; + ie.code = KEY_NS_CHANGE_FONT; + XSETFRAME (ie.frame_or_window, emacsframe); size = [newFont pointSize]; ns_input_fontsize = make_fixnum (lrint (size)); ns_input_font = [[newFont familyName] lispString]; - EV_TRAILER (e); + + kbd_buffer_store_event (&ie); } } commit 7b7c09c5612b20c277ae5b78514858e9805c3f35 Author: Po Lu Date: Sun Feb 20 10:42:41 2022 +0000 * src/haikumenu.c (haiku_dialog_show): Set `popup_activated_p'. Author: diff --git a/src/haikumenu.c b/src/haikumenu.c index 61c48a5e10..11a76217a9 100644 --- a/src/haikumenu.c +++ b/src/haikumenu.c @@ -258,8 +258,10 @@ haiku_dialog_show (struct frame *f, Lisp_Object title, unblock_input (); unrequest_sigio (); + ++popup_activated_p; int32_t val = BAlert_go (alert, block_input, unblock_input, process_pending_signals); + --popup_activated_p; request_sigio (); if (val < 0) commit dad7ee23539176561be99f3e124871d893e7c600 Author: Po Lu Date: Sun Feb 20 10:38:38 2022 +0000 Handle GUI input while inside popup dialog on Haiku * src/haiku_support.cc (alert_popup_value): New variable. (be_alert_thread_entry): New function. (BAlert_go): Complete rewrite that allows async input to be handled while the popup is active. * src/haiku_support.h: Update prototypes. * src/haikumenu.c (haiku_dialog_show, haiku_popup_dialog): Stop blocking input and pass required callbacks to `BAlert_go'. * src/haikuterm.c (haiku_term_init): Set interrupt input mode to t. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index f867e775f8..0f4ed169fb 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -115,6 +115,7 @@ static BLocker child_frame_lock; static BLocker movement_locker; static BMessage volatile *popup_track_message; +static int32 volatile alert_popup_value; /* This could be a private API, but it's used by (at least) the Qt port, so it's probably here to stay. */ @@ -2685,12 +2686,73 @@ BAlert_add_button (void *alert, const char *text) return al->ButtonAt (al->CountButtons () - 1); } +static int32 +be_alert_thread_entry (void *thread_data) +{ + BAlert *alert = (BAlert *) thread_data; + int32 value; + + if (alert->LockLooper ()) + value = alert->Go (); + else + value = -1; + + alert_popup_value = value; + return 0; +} + /* Run ALERT, returning the number of the button that was selected, or -1 if no button was selected before the alert was closed. */ -int32_t -BAlert_go (void *alert) +int32 +BAlert_go (void *alert, + void (*block_input_function) (void), + void (*unblock_input_function) (void), + void (*process_pending_signals_function) (void)) { - return ((BAlert *) alert)->Go (); + struct object_wait_info infos[2]; + ssize_t stat; + BAlert *alert_object = (BAlert *) alert; + + infos[0].object = port_application_to_emacs; + infos[0].type = B_OBJECT_TYPE_PORT; + infos[0].events = B_EVENT_READ; + + block_input_function (); + /* Alerts are created locked, just like other windows. */ + alert_object->UnlockLooper (); + infos[1].object = spawn_thread (be_alert_thread_entry, + "Popup tracker", + B_DEFAULT_MEDIA_PRIORITY, + alert); + infos[1].type = B_OBJECT_TYPE_THREAD; + infos[1].events = B_EVENT_INVALID; + unblock_input_function (); + + if (infos[1].object < B_OK) + return -1; + + block_input_function (); + resume_thread (infos[1].object); + unblock_input_function (); + + while (true) + { + stat = wait_for_objects ((object_wait_info *) &infos, 2); + + if (stat == B_INTERRUPTED) + continue; + else if (stat < B_OK) + gui_abort ("Failed to wait for popup dialog"); + + if (infos[1].events & B_EVENT_INVALID) + return alert_popup_value; + + if (infos[0].events & B_EVENT_READ) + process_pending_signals_function (); + + infos[0].events = B_EVENT_READ; + infos[1].events = B_EVENT_INVALID; + } } /* Enable or disable BUTTON depending on ENABLED_P. */ diff --git a/src/haiku_support.h b/src/haiku_support.h index 67fbd8c5e0..9fc81c2875 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -754,8 +754,11 @@ extern "C" extern void * BAlert_add_button (void *alert, const char *text); - extern int32_t - BAlert_go (void *alert); + extern int32 + BAlert_go (void *alert, + void (*block_input_function) (void), + void (*unblock_input_function) (void), + void (*process_pending_signals_function) (void)); extern void BButton_set_enabled (void *button, int enabled_p); diff --git a/src/haikumenu.c b/src/haikumenu.c index 002898de7a..61c48a5e10 100644 --- a/src/haikumenu.c +++ b/src/haikumenu.c @@ -255,10 +255,13 @@ haiku_dialog_show (struct frame *f, Lisp_Object title, ++nb_buttons; i += MENU_ITEMS_ITEM_LENGTH; } - - int32_t val = BAlert_go (alert); unblock_input (); + unrequest_sigio (); + int32_t val = BAlert_go (alert, block_input, unblock_input, + process_pending_signals); + request_sigio (); + if (val < 0) quit (); else @@ -291,9 +294,7 @@ haiku_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) list_of_panes (list1 (contents)); /* Display them in a dialog box. */ - block_input (); selection = haiku_dialog_show (f, title, header, &error_name); - unblock_input (); unbind_to (specpdl_count, Qnil); discard_menu_items (); diff --git a/src/haikuterm.c b/src/haikuterm.c index f0361c9dbe..1ff38b97bb 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3615,7 +3615,7 @@ haiku_term_init (void) Lisp_Object color_file, color_map; block_input (); - Fset_input_interrupt_mode (Qnil); + Fset_input_interrupt_mode (Qt); baud_rate = 19200;