master 0be966f 30/35: Make "open in new window" from an xwidget's context menu work

[Lars Ingebrigtsen]

branch: master
commit 0be966f97e3bda057318d971d022515cfa6eb37b
Author: Po Lu <luangruo@yahoo.com>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Make "open in new window" from an xwidget's context menu work
    
    * doc/lispref/commands.texi (Xwidget Events): Document new event type.
    * doc/lisprefdisplay.texi (Xwidgets): Document new argument to
    make-xwidget, and new function.
    * etc/NEWS: Document changes.
    * lisp/xwidget.el: Bind xwidget-display-event to
    xwidget-webkit-display-event.
    
    (xwidget-webkit-import-widget): New function.
    (xwidget-webkit-display-event): New command.
    * src/keyboard.c (kbd_buffer_get_event): New event type.
    (make_lispy_event): Handle XWIDGET_DISPLAY_EVENTs.
    (syms_f_keyboard): Define new symbol.
    * src/termhooks.h (enum event_kind): New enum XWIDGET_DISPLAY_EVENT.
    
    * src/xwidget.c (webkit_create_cb)
    (store_xwidget_display_event)
    (webkit_ready_to_show)
    (webkit_create_cb_1, webkit_create_cb)
    (Fset_xwidget_buffer): New functions.
    
    (Fmake_xwidget): Add internal argument RELATED and connect create
    signal.
    (syms_of_xwidget): Define now subrs.
---
 doc/lispref/commands.texi |   9 +++
 doc/lispref/display.texi  |  10 ++-
 etc/NEWS                  |  12 ++++
 lisp/xwidget.el           |  24 ++++++++
 src/keyboard.c            |   7 +++
 src/termhooks.h           |   2 +
 src/xwidget.c             | 154 ++++++++++++++++++++++++++++++++++++++++------
 7 files changed, 196 insertions(+), 22 deletions(-)

diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index ca59475..832b570 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -1931,6 +1931,15 @@ An event with @var{kind} set to 
@code{javascript-callback} contains
 JavaScript callback data.  These events are used internally by
 @code{xwidget-webkit-execute-script}.
 
+@cindex @code{xwidget-display-event} event
+@item (xwidget-display-event @var{xwidget})
+This event is sent whenever an xwidget requests that another xwidget
+be displayed.  @var{xwidget} is the xwidget that should be displayed.
+
+@var{xwidget}'s buffer will be set to a temporary buffer.  When
+displaying the widget, care should be taken to replace the buffer with
+the buffer in which the xwidget will be displayed, using
+@code{set-xwidget-buffer}  (@pxref{Xwidgets}).
 @end table
 
 @node Misc Events
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index b780263..37f07c4 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -6787,7 +6787,7 @@ Property}).
   Embedded widgets can send events notifying Lisp code about changes
 occurring within them.  (@pxref{Xwidget Events}).
 
-@defun make-xwidget type title width height arguments &optional buffer
+@defun make-xwidget type title width height arguments &optional buffer related
 This creates and returns an xwidget object.  If
 @var{buffer} is omitted or @code{nil}, it defaults to the current
 buffer.  If @var{buffer} names a buffer that doesn't exist, it will be
@@ -6800,7 +6800,9 @@ The WebKit component.
 @end table
 
 The @var{width} and @var{height} arguments specify the widget size in
-pixels, and @var{title}, a string, specifies its title.
+pixels, and @var{title}, a string, specifies its title.  @var{related}
+is used internally by the WebKit widget, and is not of interest to the
+programmer.
 @end defun
 
 @defun xwidgetp object
@@ -6821,6 +6823,10 @@ property list given by @var{plist}.
 This function returns the buffer of @var{xwidget}.
 @end defun
 
+@defun set-xwidget-buffer xwidget buffer
+This function sets the buffer of @var{xwidget} to @var{buffer}.
+@end defun
+
 @defun get-buffer-xwidgets buffer
 This function returns a list of xwidget objects associated with the
 @var{buffer}, which can be specified as a buffer object or a name of
diff --git a/etc/NEWS b/etc/NEWS
index 0cbddeb..0e5caa4 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -514,6 +514,12 @@ to `C-s' and `C-r'.
 To access the inspector, right click on the widget and select "Inspect
 Element".
 
+---
+*** "Open in New Window" in a WebKit widget's context menu now works.
+The newly created buffer will be displayed via display-buffer, which
+can be customized through the usual mechanism of display-buffer-alist
+and friends.
+
 
 * New Modes and Packages in Emacs 29.1
 
@@ -759,6 +765,12 @@ completed, `load-started' when a load first starts, 
`load-redirected'
 after a redirect, and `load-committed' when the WebKit widget first
 commits to the load.
 
++++
+** New event type `xwidget-display-event'.
+These events are sent whenever an xwidget requests that Emacs display
+another.  The only argument to this event is the xwidget that should
+be displayed.
+
 
 * Changes in Emacs 29.1 on Non-Free Operating Systems
 
diff --git a/lisp/xwidget.el b/lisp/xwidget.el
index bd3c087..d427e70 100644
--- a/lisp/xwidget.el
+++ b/lisp/xwidget.el
@@ -37,6 +37,7 @@
 (declare-function make-xwidget "xwidget.c"
                   (type title width height arguments &optional buffer))
 (declare-function xwidget-buffer "xwidget.c" (xwidget))
+(declare-function set-xwidget-buffer "xwidget.c" (xwidget buffer))
 (declare-function xwidget-size-request "xwidget.c" (xwidget))
 (declare-function xwidget-resize "xwidget.c" (xwidget new-width new-height))
 (declare-function xwidget-webkit-execute-script "xwidget.c"
@@ -701,6 +702,29 @@ For example, use this to display an anchor."
     (xwidget-webkit-mode)
     (xwidget-webkit-goto-uri (xwidget-webkit-last-session) url)))
 
+(defun xwidget-webkit-import-widget (xwidget)
+  "Create a new webkit session buffer from XWIDGET, an existing xwidget.
+Return the buffer."
+  (let* ((bufname (generate-new-buffer-name "*xwidget-webkit*"))
+         (callback #'xwidget-webkit-callback)
+         (buffer (get-buffer-create bufname)))
+    (with-current-buffer buffer
+      (save-excursion
+        (erase-buffer)
+        (insert ".")
+        (put-text-property (point-min) (point-max)
+                           'display (list 'xwidget :xwidget xwidget)))
+      (xwidget-put xwidget 'callback callback)
+      (set-xwidget-buffer xwidget buffer)
+      (xwidget-webkit-mode))
+    buffer))
+
+(defun xwidget-webkit-display-event (event)
+  "Import the xwidget inside EVENT and display it."
+  (interactive "e")
+  (display-buffer (xwidget-webkit-import-widget (nth 1 event))))
+
+(global-set-key [xwidget-display-event] 'xwidget-webkit-display-event)
 
 (defun xwidget-webkit-goto-url (url)
   "Goto URL with xwidget webkit."
diff --git a/src/keyboard.c b/src/keyboard.c
index 46dce57..c4a5671 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -3993,6 +3993,7 @@ kbd_buffer_get_event (KBOARD **kbp,
 #endif
 #ifdef HAVE_XWIDGETS
       case XWIDGET_EVENT:
+      case XWIDGET_DISPLAY_EVENT:
 #endif
       case SAVE_SESSION_EVENT:
       case NO_EVENT:
@@ -6139,6 +6140,11 @@ make_lispy_event (struct input_event *event)
       {
         return Fcons (Qxwidget_event, event->arg);
       }
+
+    case XWIDGET_DISPLAY_EVENT:
+      {
+       return list2 (Qxwidget_display_event, event->arg);
+      }
 #endif
 
 #ifdef USE_FILE_NOTIFY
@@ -11732,6 +11738,7 @@ syms_of_keyboard (void)
 
 #ifdef HAVE_XWIDGETS
   DEFSYM (Qxwidget_event, "xwidget-event");
+  DEFSYM (Qxwidget_display_event, "xwidget-display-event");
 #endif
 
 #ifdef USE_FILE_NOTIFY
diff --git a/src/termhooks.h b/src/termhooks.h
index 1d3cdc8..e7539bb 100644
--- a/src/termhooks.h
+++ b/src/termhooks.h
@@ -255,6 +255,8 @@ enum event_kind
 #ifdef HAVE_XWIDGETS
   /* events generated by xwidgets*/
    , XWIDGET_EVENT
+   /* Event generated when WebKit asks us to display another widget.  */
+   , XWIDGET_DISPLAY_EVENT
 #endif
 
 #ifdef USE_FILE_NOTIFY
diff --git a/src/xwidget.c b/src/xwidget.c
index 10bb4ac..0a6d95a 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -19,6 +19,7 @@ along with GNU Emacs.  If not, see 
<https://www.gnu.org/licenses/>.  */
 
 #include <config.h>
 
+#include "buffer.h"
 #include "xwidget.h"
 
 #include "lisp.h"
@@ -76,7 +77,7 @@ static void webkit_javascript_finished_cb (GObject *,
                                            GAsyncResult *,
                                            gpointer);
 static gboolean webkit_download_cb (WebKitWebContext *, WebKitDownload *, 
gpointer);
-
+static GtkWidget *webkit_create_cb (WebKitWebView *, WebKitNavigationAction *, 
gpointer);
 static gboolean
 webkit_decide_policy_cb (WebKitWebView *,
                          WebKitPolicyDecision *,
@@ -101,7 +102,7 @@ static void mouse_target_changed (WebKitWebView *, 
WebKitHitTestResult *, guint,
 
 DEFUN ("make-xwidget",
        Fmake_xwidget, Smake_xwidget,
-       5, 6, 0,
+       5, 7, 0,
        doc: /* Make an xwidget of TYPE.
 If BUFFER is nil, use the current buffer.
 If BUFFER is a string and no such buffer exists, create it.
@@ -109,10 +110,12 @@ TYPE is a symbol which can take one of the following 
values:
 
 - webkit
 
-Returns the newly constructed xwidget, or nil if construction fails.  */)
+RELATED is nil, or an xwidget.  This argument is used internally.
+Returns the newly constructed xwidget, or nil if construction
+fails.  */)
   (Lisp_Object type,
    Lisp_Object title, Lisp_Object width, Lisp_Object height,
-   Lisp_Object arguments, Lisp_Object buffer)
+   Lisp_Object arguments, Lisp_Object buffer, Lisp_Object related)
 {
 #ifdef USE_GTK
   if (!xg_gtk_initialized)
@@ -160,22 +163,33 @@ Returns the newly constructed xwidget, or nil if 
construction fails.  */)
 
       if (EQ (xw->type, Qwebkit))
         {
-          xw->widget_osr = webkit_web_view_new ();
-
-         /* Enable the developer extras */
-         settings = webkit_web_view_get_settings (WEBKIT_WEB_VIEW 
(xw->widget_osr));
-         g_object_set (G_OBJECT (settings), "enable-developer-extras", TRUE, 
NULL);
-
-          /* webkitgtk uses GSubprocess which sets sigaction causing
-             Emacs to not catch SIGCHLD with its usual handle setup in
-             catch_child_signal().  This resets the SIGCHLD
-             sigaction.  */
-          struct sigaction old_action;
-          sigaction (SIGCHLD, NULL, &old_action);
-          webkit_web_view_load_uri(WEBKIT_WEB_VIEW (xw->widget_osr),
-                                   "about:blank");
-          sigaction (SIGCHLD, &old_action, NULL);
-        }
+         WebKitWebView *related_view;
+
+         if (NILP (related)
+             || !XWIDGETP (related)
+             || !EQ (XXWIDGET (related)->type, Qwebkit))
+           {
+             /* Enable the developer extras */
+             settings = webkit_web_view_get_settings (WEBKIT_WEB_VIEW 
(xw->widget_osr));
+             g_object_set (G_OBJECT (settings), "enable-developer-extras", 
TRUE, NULL);
+             xw->widget_osr = webkit_web_view_new ();
+
+             /* webkitgtk uses GSubprocess which sets sigaction causing
+                Emacs to not catch SIGCHLD with its usual handle setup in
+                catch_child_signal().  This resets the SIGCHLD
+                sigaction.  */
+             struct sigaction old_action;
+             sigaction (SIGCHLD, NULL, &old_action);
+             webkit_web_view_load_uri (WEBKIT_WEB_VIEW (xw->widget_osr),
+                                       "about:blank");
+             sigaction (SIGCHLD, &old_action, NULL);
+           }
+         else
+           {
+             related_view = WEBKIT_WEB_VIEW (XXWIDGET (related)->widget_osr);
+             xw->widget_osr = webkit_web_view_new_with_related_view 
(related_view);
+           }
+       }
 
       gtk_widget_set_size_request (GTK_WIDGET (xw->widget_osr), xw->width,
                                    xw->height);
@@ -221,6 +235,10 @@ Returns the newly constructed xwidget, or nil if 
construction fails.  */)
                            "mouse-target-changed",
                            G_CALLBACK (mouse_target_changed),
                            xw);
+         g_signal_connect (G_OBJECT (xw->widget_osr),
+                           "create",
+                           G_CALLBACK (webkit_create_cb),
+                           xw);
         }
 
       g_signal_connect (G_OBJECT (xw->widgetwindow_osr), "damage-event",
@@ -927,6 +945,88 @@ store_xwidget_js_callback_event (struct xwidget *xw,
 
 
 #ifdef USE_GTK
+static void
+store_xwidget_display_event (struct xwidget *xw)
+{
+  struct input_event evt;
+  Lisp_Object val;
+
+  XSETXWIDGET (val, xw);
+  EVENT_INIT (evt);
+  evt.kind = XWIDGET_DISPLAY_EVENT;
+  evt.frame_or_window = Qnil;
+  evt.arg = val;
+  kbd_buffer_store_event (&evt);
+}
+
+static void
+webkit_ready_to_show (WebKitWebView *new_view,
+                     gpointer user_data)
+{
+  Lisp_Object tem;
+  struct xwidget *xw;
+
+  for (tem = Vxwidget_list; CONSP (tem); tem = XCDR (tem))
+    {
+      if (XWIDGETP (XCAR (tem)))
+       {
+         xw = XXWIDGET (XCAR (tem));
+
+         if (EQ (xw->type, Qwebkit)
+             && WEBKIT_WEB_VIEW (xw->widget_osr) == new_view)
+           store_xwidget_display_event (xw);
+       }
+    }
+}
+
+static GtkWidget *
+webkit_create_cb_1 (WebKitWebView *webview,
+                   struct xwidget_view *xv)
+{
+  Lisp_Object related;
+  Lisp_Object xwidget;
+  GtkWidget *widget;
+
+  XSETXWIDGET (related, xv);
+  xwidget = Fmake_xwidget (Qwebkit, Qnil, make_fixnum (0),
+                          make_fixnum (0), Qnil,
+                          build_string (" *detached xwidget buffer*"),
+                          related);
+
+  if (NILP (xwidget))
+    return NULL;
+
+  widget = XXWIDGET (xwidget)->widget_osr;
+
+  g_signal_connect (G_OBJECT (widget), "ready-to-show",
+                   G_CALLBACK (webkit_ready_to_show), NULL);
+
+  return widget;
+}
+
+static GtkWidget *
+webkit_create_cb (WebKitWebView *webview,
+                 WebKitNavigationAction *nav_action,
+                 gpointer user_data)
+{
+  switch (webkit_navigation_action_get_navigation_type (nav_action))
+    {
+    case WEBKIT_NAVIGATION_TYPE_OTHER:
+      if (webkit_navigation_action_is_user_gesture (nav_action))
+       return NULL;
+
+      return webkit_create_cb_1 (webview, user_data);
+    case WEBKIT_NAVIGATION_TYPE_LINK_CLICKED:
+    case WEBKIT_NAVIGATION_TYPE_FORM_SUBMITTED:
+    case WEBKIT_NAVIGATION_TYPE_BACK_FORWARD:
+    case WEBKIT_NAVIGATION_TYPE_RELOAD:
+    case WEBKIT_NAVIGATION_TYPE_FORM_RESUBMITTED:
+      return webkit_create_cb_1 (webview, user_data);
+    default:
+      return NULL;
+    }
+}
+
 void
 webkit_view_load_changed_cb (WebKitWebView *webkitwebview,
                              WebKitLoadEvent load_event,
@@ -1722,6 +1822,19 @@ DEFUN ("xwidget-buffer",
   return XXWIDGET (xwidget)->buffer;
 }
 
+DEFUN ("set-xwidget-buffer",
+       Fset_xwidget_buffer, Sset_xwidget_buffer,
+       2, 2, 0,
+       doc: /* Set XWIDGET's buffer to BUFFER.  */)
+  (Lisp_Object xwidget, Lisp_Object buffer)
+{
+  CHECK_XWIDGET (xwidget);
+  CHECK_BUFFER (buffer);
+
+  XXWIDGET (xwidget)->buffer = buffer;
+  return Qnil;
+}
+
 DEFUN ("set-xwidget-plist",
        Fset_xwidget_plist, Sset_xwidget_plist,
        2, 2, 0,
@@ -1957,6 +2070,7 @@ syms_of_xwidget (void)
   defsubr (&Sxwidget_webkit_finish_search);
   defsubr (&Sxwidget_webkit_next_result);
   defsubr (&Sxwidget_webkit_previous_result);
+  defsubr (&Sset_xwidget_buffer);
 
   DEFSYM (QCxwidget, ":xwidget");
   DEFSYM (QCtitle, ":title");