commit 5edf76ba15fb012e9cb3112ee4a2c9ef4b02f20e (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Tue Oct 25 23:04:21 2016 -0700 * src/xwidget.c (webkit_js_to_lisp): Now static. diff --git a/src/xwidget.c b/src/xwidget.c index 8105b3d..0be2845 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -273,7 +273,7 @@ webkit_view_load_changed_cb (WebKitWebView *webkitwebview, } /* Recursively convert a JavaScript value to a Lisp value. */ -Lisp_Object +static Lisp_Object webkit_js_to_lisp (JSContextRef context, JSValueRef value) { switch (JSValueGetType (context, value)) commit ca479f9e75c62c07178b75df5f64aa7b81a32618 Author: Ricardo Wurmus Date: Tue Oct 25 23:00:35 2016 -0700 xwidget: Map "previous-line" and "next-line" to scroll * lisp/xwidget.el: Map "previous-line" and "next-line" to scrolling procedures. diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 8aa0584..6443954 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -124,8 +124,8 @@ Interactively, URL defaults to the string looking like a url around point." (define-key map [remap backward-char] 'xwidget-webkit-scroll-backward) (define-key map [remap right-char] 'xwidget-webkit-scroll-forward) (define-key map [remap left-char] 'xwidget-webkit-scroll-backward) - ;; (define-key map [remap previous-line] 'image-previous-line) - ;; (define-key map [remap next-line] 'image-next-line) + (define-key map [remap previous-line] 'xwidget-webkit-scroll-down) + (define-key map [remap next-line] 'xwidget-webkit-scroll-up) ;; (define-key map [remap move-beginning-of-line] 'image-bol) ;; (define-key map [remap move-end-of-line] 'image-eol) commit 01c2fba677728a7dd7e89ed92aff044831f4ca27 Author: Ricardo Wurmus Date: Tue Oct 25 23:00:35 2016 -0700 xwidget: Bind "beginning-of-buffer" and "end-of-buffer" * lisp/xwidget.el: Rebind "beginning-of-buffer" and "end-of-buffer" to "xwidget-webkit-scroll-top" and "xwidget-webkit-scroll-bottom", respectively. (xwidget-webkit-scroll-top, xwidget-webkit-scroll-bottom): New procedures. diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 871b729..8aa0584 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -129,8 +129,8 @@ Interactively, URL defaults to the string looking like a url around point." ;; (define-key map [remap move-beginning-of-line] 'image-bol) ;; (define-key map [remap move-end-of-line] 'image-eol) - ;; (define-key map [remap beginning-of-buffer] 'image-bob) - ;; (define-key map [remap end-of-buffer] 'image-eob) + (define-key map [remap beginning-of-buffer] 'xwidget-webkit-scroll-top) + (define-key map [remap end-of-buffer] 'xwidget-webkit-scroll-bottom) map) "Keymap for `xwidget-webkit-mode'.") @@ -172,6 +172,19 @@ Interactively, URL defaults to the string looking like a url around point." (xwidget-webkit-current-session) "window.scrollBy(-50, 0);")) +(defun xwidget-webkit-scroll-top () + "Scroll webkit to the very top." + (interactive) + (xwidget-webkit-execute-script + (xwidget-webkit-current-session) + "window.scrollTo(pageXOffset, 0);")) + +(defun xwidget-webkit-scroll-bottom () + "Scroll webkit to the very bottom." + (interactive) + (xwidget-webkit-execute-script + (xwidget-webkit-current-session) + "window.scrollTo(pageXOffset, window.document.body.clientHeight);")) ;; The xwidget event needs to go into a higher level handler ;; since the xwidget can generate an event even if it's offscreen. commit e443eab6bf2b7b6e2f6a9ab06b1c5618b19ae653 Author: Ricardo Wurmus Date: Tue Oct 25 23:00:35 2016 -0700 Implement zoom for WebKit widget. * src/xwidget.c (xwidget-webkit-zoom): New procedure. * lisp/xwidget.el: Bind "+" and "-" to zoom in and out, respectively. (xwidget-webkit-zoom): Declare procedure. (xwidget-webkit-zoom-in, xwidget-webkit-zoom-out): New procedures. diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 13e3fdf2..871b729 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -42,6 +42,7 @@ (declare-function xwidget-webkit-execute-script "xwidget.c" (xwidget script &optional callback)) (declare-function xwidget-webkit-goto-uri "xwidget.c" (xwidget uri)) +(declare-function xwidget-webkit-zoom "xwidget.c" (xwidget factor)) (declare-function xwidget-plist "xwidget.c" (xwidget)) (declare-function set-xwidget-plist "xwidget.c" (xwidget plist)) (declare-function xwidget-view-window "xwidget.c" (xwidget-view)) @@ -106,6 +107,8 @@ Interactively, URL defaults to the string looking like a url around point." (define-key map "t" (lambda () (interactive) (message "o"))) ;FIXME: ?!? (define-key map "\C-m" 'xwidget-webkit-insert-string) (define-key map "w" 'xwidget-webkit-current-url) + (define-key map "+" 'xwidget-webkit-zoom-in) + (define-key map "-" 'xwidget-webkit-zoom-out) ;;similar to image mode bindings (define-key map (kbd "SPC") 'xwidget-webkit-scroll-up) @@ -131,6 +134,16 @@ Interactively, URL defaults to the string looking like a url around point." map) "Keymap for `xwidget-webkit-mode'.") +(defun xwidget-webkit-zoom-in () + "Increase webkit view zoom factor." + (interactive) + (xwidget-webkit-zoom (xwidget-webkit-current-session) 0.1)) + +(defun xwidget-webkit-zoom-out () + "Decrease webkit view zoom factor." + (interactive) + (xwidget-webkit-zoom (xwidget-webkit-current-session) -0.1)) + (defun xwidget-webkit-scroll-up () "Scroll webkit up." (interactive) diff --git a/src/xwidget.c b/src/xwidget.c index dbd8fc1..8105b3d 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -681,6 +681,25 @@ DEFUN ("xwidget-webkit-goto-uri", return Qnil; } +DEFUN ("xwidget-webkit-zoom", + Fxwidget_webkit_zoom, Sxwidget_webkit_zoom, + 2, 2, 0, + doc: /* Change the zoom factor of the xwidget webkit instance +referenced by XWIDGET. */) + (Lisp_Object xwidget, Lisp_Object factor) +{ + WEBKIT_FN_INIT (); + if (FLOATP (factor)) + { + double zoom_change = XFLOAT_DATA (factor); + webkit_web_view_set_zoom_level + (WEBKIT_WEB_VIEW (xw->widget_osr), + webkit_web_view_get_zoom_level + (WEBKIT_WEB_VIEW (xw->widget_osr)) + zoom_change); + } + return Qnil; +} + DEFUN ("xwidget-webkit-execute-script", Fxwidget_webkit_execute_script, Sxwidget_webkit_execute_script, @@ -953,6 +972,7 @@ syms_of_xwidget (void) defsubr (&Sset_xwidget_query_on_exit_flag); defsubr (&Sxwidget_webkit_goto_uri); + defsubr (&Sxwidget_webkit_zoom); defsubr (&Sxwidget_webkit_execute_script); DEFSYM (Qwebkit, "webkit"); commit a9785bd5c2e27e949040342e441c1a65a5b650d0 Author: Ricardo Wurmus Date: Tue Oct 25 23:00:35 2016 -0700 Dynamically resize WebKit widget. * lisp/xwidget.el (xwidget-webkit-auto-adjust-size, xwidget-webkit-adjust-size-in-frame): New procedures. (xwidget-webkit-new-session): Remove hint to resize widget with `a'. (xwidget-webkit-adjust-size-dispatch): Resize current webkit widget. (xwidget-webkit-adjust-size-to-window): Make non-interactive, add widget and window as arguments. (xwidget-webkit-callback): Use xwidget-webkit-adjust-size-to-window. diff --git a/lisp/xwidget.el b/lisp/xwidget.el index e5b51ce..13e3fdf2 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -199,7 +199,7 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." (xwidget-log "webkit finished loading: '%s'" title) ;;TODO - check the native/internal scroll ;;(xwidget-adjust-size-to-content xwidget) - (xwidget-webkit-adjust-size-dispatch) ;;TODO xwidget arg + (xwidget-webkit-adjust-size-to-window xwidget) (rename-buffer (format "*xwidget webkit: %s *" title)))) (pop-to-buffer (current-buffer))) ((eq xwidget-event-type 'decide-policy) @@ -411,18 +411,18 @@ For example, use this to display an anchor." (defun xwidget-webkit-adjust-size-dispatch () "Adjust size according to mode." (interactive) - (xwidget-webkit-adjust-size-to-window) + (xwidget-webkit-adjust-size-to-window (xwidget-webkit-current-session)) ;; The recenter is intended to correct a visual glitch. ;; It errors out if the buffer isn't visible, but then we don't get ;; the glitch, so silence errors. (ignore-errors (recenter-top-bottom))) -(defun xwidget-webkit-adjust-size-to-window () - "Adjust webkit to window." - (interactive) - (xwidget-resize (xwidget-webkit-current-session) (window-pixel-width) - (window-pixel-height))) +(defun xwidget-webkit-adjust-size-to-window (xwidget &optional window) + "Adjust the size of the webkit XWIDGET to fit the WINDOW." + (xwidget-resize xwidget + (window-pixel-width window) + (window-pixel-height window))) (defun xwidget-webkit-adjust-size (w h) "Manually set webkit size to width W, height H." @@ -437,6 +437,21 @@ For example, use this to display an anchor." (car (window-inside-pixel-edges))) 1000)) +(defun xwidget-webkit-auto-adjust-size (window) + "Adjust the size of the webkit widget in the given WINDOW." + (with-current-buffer (window-buffer window) + (when (eq major-mode 'xwidget-webkit-mode) + (let ((xwidget (xwidget-webkit-current-session))) + (xwidget-webkit-adjust-size-to-window xwidget window))))) + +(defun xwidget-webkit-adjust-size-in-frame (frame) + "Dynamically adjust webkit widget for all windows of the FRAME." + (walk-windows 'xwidget-webkit-auto-adjust-size 'no-minibuf frame)) + +(eval-after-load 'xwidget-webkit-mode + (add-to-list 'window-size-change-functions + 'xwidget-webkit-adjust-size-in-frame)) + (defun xwidget-webkit-new-session (url) "Create a new webkit session buffer with URL." (let* @@ -444,7 +459,9 @@ For example, use this to display an anchor." xw) (setq xwidget-webkit-last-session-buffer (switch-to-buffer (get-buffer-create bufname))) - (insert " 'a' adjusts the xwidget size.") + ;; The xwidget id is stored in a text property, so we need to have + ;; at least character in this buffer. + (insert " ") (setq xw (xwidget-insert 1 'webkit bufname (window-pixel-width) (window-pixel-height))) commit c483fa6ef212365c6e8fd77118d80e8f3df86ca0 Author: Ricardo Wurmus Date: Tue Oct 25 23:00:35 2016 -0700 Let initial WebKit view fill window * lisp/xwidget.el (xwidget-webkit-new-session): Change default size of WebKit widget to window size. diff --git a/lisp/xwidget.el b/lisp/xwidget.el index a1b9b50..e5b51ce 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -445,7 +445,9 @@ For example, use this to display an anchor." (setq xwidget-webkit-last-session-buffer (switch-to-buffer (get-buffer-create bufname))) (insert " 'a' adjusts the xwidget size.") - (setq xw (xwidget-insert 1 'webkit bufname 1000 1000)) + (setq xw (xwidget-insert 1 'webkit bufname + (window-pixel-width) + (window-pixel-height))) (xwidget-put xw 'callback 'xwidget-webkit-callback) (xwidget-webkit-mode) (xwidget-webkit-goto-uri (xwidget-webkit-last-session) url))) commit 67e03311a0b9091fe98a2cca86c6a6a933fc6e05 Author: Ricardo Wurmus Date: Tue Oct 25 23:00:35 2016 -0700 xwidget: Remove title hack. * src/xwidget.c (xwidget-webkit-get-title): Remove procedure. * lisp/xwidget.el (xwidget-webkit-get-title, xwidget-webkit-execute-script-rv): Remove procedures. diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 37edd52..a1b9b50 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -37,7 +37,6 @@ (declare-function make-xwidget "xwidget.c" (type title width height arguments &optional buffer)) (declare-function xwidget-buffer "xwidget.c" (xwidget)) -(declare-function xwidget-webkit-get-title "xwidget.c" (xwidget)) (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" @@ -480,29 +479,6 @@ For example, use this to display an anchor." (let ((url (kill-new (or rv "")))) (message "url: %s" url))))) -(defun xwidget-webkit-execute-script-rv (xw script &optional default) - "Same as `xwidget-webkit-execute-script' but with return value. -XW is the webkit instance. SCRIPT is the script to execute. -DEFAULT is the default return value." - ;; Notice the ugly "title" hack. It is needed because the Webkit - ;; API at the time of writing didn't support returning values. This - ;; is a wrapper for the title hack so it's easy to remove should - ;; Webkit someday support JS return values or we find some other way - ;; to access the DOM. - - ;; Reset webkit title. Not very nice. - (let* ((emptytag "titlecantbewhitespaceohthehorror") - title) - (xwidget-webkit-execute-script xw (format "document.title=\"%s\";" - (or default emptytag))) - (xwidget-webkit-execute-script xw (format "document.title=%s;" script)) - (setq title (xwidget-webkit-get-title xw)) - (if (equal emptytag title) - (setq title "")) - (unless title - (setq title default)) - title)) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun xwidget-webkit-get-selection (proc) "Get the webkit selection and pass it to PROC." diff --git a/src/xwidget.c b/src/xwidget.c index 8552810..dbd8fc1 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -709,27 +709,6 @@ argument procedure FUN.*/) return Qnil; } -DEFUN ("xwidget-webkit-get-title", - Fxwidget_webkit_get_title, Sxwidget_webkit_get_title, - 1, 1, 0, - doc: /* Return the title from the Webkit instance in XWIDGET. -This can be used to work around the lack of a return value from the -exec method. */ ) - (Lisp_Object xwidget) -{ - /* TODO support multibyte strings. */ - WEBKIT_FN_INIT (); - const gchar *str = - webkit_web_view_get_title (WEBKIT_WEB_VIEW (xw->widget_osr)); - if (str == 0) - { - /* TODO maybe return Qnil instead. I suppose webkit returns - null pointer when doc is not properly loaded or something. */ - return build_string (""); - } - return build_string (str); -} - DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0, doc: /* Resize XWIDGET. NEW_WIDTH, NEW_HEIGHT define the new size. */ ) (Lisp_Object xwidget, Lisp_Object new_width, Lisp_Object new_height) @@ -975,7 +954,6 @@ syms_of_xwidget (void) defsubr (&Sxwidget_webkit_goto_uri); defsubr (&Sxwidget_webkit_execute_script); - defsubr (&Sxwidget_webkit_get_title); DEFSYM (Qwebkit, "webkit"); defsubr (&Sxwidget_size_request); commit 8809002052c1154d38ce392198525945da674777 Author: Ricardo Wurmus Date: Tue Oct 25 23:00:35 2016 -0700 xwidget: Get URL asynchronously. * lisp/xwidget.el (xwidget-webkit-current-url): Kill URL in callback. diff --git a/lisp/xwidget.el b/lisp/xwidget.el index dc31b85..37edd52 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -474,11 +474,11 @@ For example, use this to display an anchor." (defun xwidget-webkit-current-url () "Get the webkit url and place it on the kill-ring." (interactive) - (let* ((rv (xwidget-webkit-execute-script-rv (xwidget-webkit-current-session) - "document.URL")) - (url (kill-new (or rv "")))) - (message "url: %s" url) - url)) + (xwidget-webkit-execute-script + (xwidget-webkit-current-session) + "document.URL" (lambda (rv) + (let ((url (kill-new (or rv "")))) + (message "url: %s" url))))) (defun xwidget-webkit-execute-script-rv (xw script &optional default) "Same as `xwidget-webkit-execute-script' but with return value. commit 4aa7c4b4aa2cedbc401b624846285905fb9f8a43 Author: Ricardo Wurmus Date: Tue Oct 25 23:00:35 2016 -0700 xwidget: Get selection with asynchronous JavaScript * lisp/xwidget.el (xwidget-webkit-get-selection): Add PROC argument to process selection. (xwidget-webkit-copy-selection-as-kill): Kill selection in callback. diff --git a/lisp/xwidget.el b/lisp/xwidget.el index d7ef44d..dc31b85 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -504,15 +504,17 @@ DEFAULT is the default return value." title)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun xwidget-webkit-get-selection () - "Get the webkit selection." - (xwidget-webkit-execute-script-rv (xwidget-webkit-current-session) - "window.getSelection().toString();")) +(defun xwidget-webkit-get-selection (proc) + "Get the webkit selection and pass it to PROC." + (xwidget-webkit-execute-script + (xwidget-webkit-current-session) + "window.getSelection().toString();" + proc)) (defun xwidget-webkit-copy-selection-as-kill () "Get the webkit selection and put it on the kill-ring." (interactive) - (kill-new (xwidget-webkit-get-selection))) + (xwidget-webkit-get-selection (lambda (selection) (kill-new selection)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; commit efa269d14685042912cfed96b617d4824a78a1cb Author: Ricardo Wurmus Date: Tue Oct 25 23:00:35 2016 -0700 xwidget: Add function to find element by CSS selector * lisp/xwidget.el (xwidget-webkit-show-element): New procedure. diff --git a/lisp/xwidget.el b/lisp/xwidget.el index e54d1f8..d7ef44d 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -334,6 +334,23 @@ XW is the xwidget identifier, TEXT is retrieved from the webkit." ;;TODO convert linefeed to \n ) +(defun xwidget-webkit-show-element (xw element-selector) + "Make webkit xwidget XW show a named element ELEMENT-SELECTOR. +The ELEMENT-SELECTOR must be a valid CSS selector. For example, +use this to display an anchor." + (interactive (list (xwidget-webkit-current-session) + (read-string "Element selector: "))) + (xwidget-webkit-execute-script + xw + (format " +(function (query) { + var el = document.querySelector(query); + if (el !== null) { + window.scrollTo(0, el.offsetTop); + } +})('%s');" + element-selector))) + (defun xwidget-webkit-show-named-element (xw element-name) "Make webkit xwidget XW show a named element ELEMENT-NAME. For example, use this to display an anchor." commit 74576447b969adc430144d9a3ce57b590f2a2dcc Author: Ricardo Wurmus Date: Tue Oct 25 23:00:35 2016 -0700 xwidget: Simplify functions to scroll to elements * lisp/xwidget.el (xwidget-webkit-show-named-element, xwidget-webkit-show-id-element, xwidget-webkit-show-id-or-named-element): Simplify functions by scrolling exclusively with JavaScript. diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 1333365..e54d1f8 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -339,62 +339,53 @@ XW is the xwidget identifier, TEXT is retrieved from the webkit." For example, use this to display an anchor." (interactive (list (xwidget-webkit-current-session) (read-string "Element name: "))) - ;;TODO since an xwidget is an Emacs object, it is not trivial to do - ;; some things that are taken for granted in a normal browser. - ;; scrolling an anchor/named-element into view is one such thing. - ;; This function implements a proof-of-concept for this. Problems - ;; remaining: - The selected window is scrolled but this is not - ;; always correct - This needs to be interfaced into browse-url - ;; somehow. The tricky part is that we need to do this in two steps: - ;; A: load the base url, wait for load signal to arrive B: navigate - ;; to the anchor when the base url is finished rendering - - ;; This part figures out the Y coordinate of the element - (let ((y (string-to-number - (xwidget-webkit-execute-script-rv - xw - (format - "document.getElementsByName('%s')[0].getBoundingClientRect().top" - element-name) - 0)))) - ;; Now we need to tell Emacs to scroll the element into view. - (xwidget-log "scroll: %d" y) - (set-window-vscroll (selected-window) y t))) + ;; TODO: This needs to be interfaced into browse-url somehow. The + ;; tricky part is that we need to do this in two steps: A: load the + ;; base url, wait for load signal to arrive B: navigate to the + ;; anchor when the base url is finished rendering + (xwidget-webkit-execute-script + xw + (format " +(function (query) { + var el = document.getElementsByName(query)[0]; + if (el !== undefined) { + window.scrollTo(0, el.offsetTop); + } +})('%s');" + element-name))) (defun xwidget-webkit-show-id-element (xw element-id) "Make webkit xwidget XW show an id-element ELEMENT-ID. For example, use this to display an anchor." (interactive (list (xwidget-webkit-current-session) (read-string "Element id: "))) - (let ((y (string-to-number - (xwidget-webkit-execute-script-rv - xw - (format "document.getElementById('%s').getBoundingClientRect().top" - element-id) - 0)))) - ;; Now we need to tell Emacs to scroll the element into view. - (xwidget-log "scroll: %d" y) - (set-window-vscroll (selected-window) y t))) + (xwidget-webkit-execute-script + xw + (format " +(function (query) { + var el = document.getElementById(query); + if (el !== null) { + window.scrollTo(0, el.offsetTop); + } +})('%s');" + element-id))) (defun xwidget-webkit-show-id-or-named-element (xw element-id) "Make webkit xwidget XW show a name or element id ELEMENT-ID. For example, use this to display an anchor." (interactive (list (xwidget-webkit-current-session) (read-string "Name or element id: "))) - (let* ((y1 (string-to-number - (xwidget-webkit-execute-script-rv - xw - (format "document.getElementsByName('%s')[0].getBoundingClientRect().top" element-id) - "0"))) - (y2 (string-to-number - (xwidget-webkit-execute-script-rv - xw - (format "document.getElementById('%s').getBoundingClientRect().top" element-id) - "0"))) - (y3 (max y1 y2))) - ;; Now we need to tell Emacs to scroll the element into view. - (xwidget-log "scroll: %d" y3) - (set-window-vscroll (selected-window) y3 t))) + (xwidget-webkit-execute-script + xw + (format " +(function (query) { + var el = document.getElementById(query) || + document.getElementsByName(query)[0]; + if (el !== undefined) { + window.scrollTo(0, el.offsetTop); + } +})('%s');" + element-id))) (defun xwidget-webkit-adjust-size-to-content () "Adjust webkit to content size." commit cc3b868fbf471b54491ed81f01f2235d50bb5fee Author: Ricardo Wurmus Date: Tue Oct 25 23:00:35 2016 -0700 xwidget: Get title via asynchronous JavaScript. * lisp/xwidget.el (xwidget-webkit-callback): Get document title asynchronously. diff --git a/lisp/xwidget.el b/lisp/xwidget.el index a252fd7..1333365 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -194,13 +194,14 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." "error: callback called for xwidget with dead buffer") (with-current-buffer (xwidget-buffer xwidget) (cond ((eq xwidget-event-type 'load-changed) - (xwidget-log "webkit finished loading: '%s'" - (xwidget-webkit-get-title xwidget)) - ;;TODO - check the native/internal scroll - ;;(xwidget-adjust-size-to-content xwidget) - (xwidget-webkit-adjust-size-dispatch) ;;TODO xwidget arg - (rename-buffer (format "*xwidget webkit: %s *" - (xwidget-webkit-get-title xwidget))) + (xwidget-webkit-execute-script + xwidget "document.title" + (lambda (title) + (xwidget-log "webkit finished loading: '%s'" title) + ;;TODO - check the native/internal scroll + ;;(xwidget-adjust-size-to-content xwidget) + (xwidget-webkit-adjust-size-dispatch) ;;TODO xwidget arg + (rename-buffer (format "*xwidget webkit: %s *" title)))) (pop-to-buffer (current-buffer))) ((eq xwidget-event-type 'decide-policy) (let ((strarg (nth 3 last-input-event))) commit ff80a9c8376d5c14e37fbbfde08706492327836a Author: Ricardo Wurmus Date: Tue Oct 25 23:00:35 2016 -0700 xwidget: Do not use `xwidget-execute-script-rv' to insert string * lisp/xwidget.el (xwidget-webkit-insert-string): Obtain JavaScript return value via callback instead of using `xwidget-webkit-execute-script-rv'. diff --git a/lisp/xwidget.el b/lisp/xwidget.el index d2b9a09..a252fd7 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -286,31 +286,30 @@ function findactiveelement(doc){ ;;TODO the activeelement type needs to be examined, for iframe, etc. ) -(defun xwidget-webkit-insert-string (xw str) - "Insert string STR in the active field in the webkit XW." +(defun xwidget-webkit-insert-string () + "Prompt for a string and insert it in the active field in the +current webkit widget." ;; Read out the string in the field first and provide for edit. - (interactive - (let* ((xww (xwidget-webkit-current-session)) - - (field-value - (progn - (xwidget-webkit-execute-script xww xwidget-webkit-activeelement-js) - (xwidget-webkit-execute-script-rv - xww - "findactiveelement(document).value;"))) - (field-type (xwidget-webkit-execute-script-rv - xww - "findactiveelement(document).type;"))) - (list xww - (cond ((equal "text" field-type) - (read-string "Text: " field-value)) - ((equal "password" field-type) - (read-passwd "Password: " nil field-value)) - ((equal "textarea" field-type) - (xwidget-webkit-begin-edit-textarea xww field-value)))))) - (xwidget-webkit-execute-script - xw - (format "findactiveelement(document).value='%s'" str))) + (interactive) + (let ((xww (xwidget-webkit-current-session))) + (xwidget-webkit-execute-script + xww + (concat xwidget-webkit-activeelement-js " +(function () { + var res = findactiveelement(document); + return [res.value, res.type]; +})();") + (lambda (field) + (let ((str (pcase field + (`[,val "text"] + (read-string "Text: " val)) + (`[,val "password"] + (read-passwd "Password: " nil val)) + (`[,val "textarea"] + (xwidget-webkit-begin-edit-textarea xww val))))) + (xwidget-webkit-execute-script + xww + (format "findactiveelement(document).value='%s'" str))))))) (defvar xwidget-xwbl) (defun xwidget-webkit-begin-edit-textarea (xw text) commit 7ee870e87c6332c0d2430faf71349f939b59e162 Author: Ricardo Wurmus Date: Tue Oct 25 23:00:35 2016 -0700 Remove scrolled window container around WebKit widget The WebKit widget can scroll on its own and does not need to wrapped with a scrolled window container. * src/xwidget.h: Remove struct member widgetscrolledwindow_osr. * src/xwidget.c: Remove widgetscrolledwindow_osr. (xwidget-set-adjustment): Remove. (xwidget-resize): Resize Webkit widget last. * lisp/xwidget.el (xwidget-set-adjustment): Remove. (xwidget-webkit-scroll-up, xwidget-webkit-scroll-down, xwidget-webkit-scroll-forward, xwidget-webkit-scroll-backward): Implement scrolling via JavaScript. diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 69b1002..d2b9a09 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -36,8 +36,6 @@ (declare-function make-xwidget "xwidget.c" (type title width height arguments &optional buffer)) -(declare-function xwidget-set-adjustment "xwidget.c" - (xwidget axis relative value)) (declare-function xwidget-buffer "xwidget.c" (xwidget)) (declare-function xwidget-webkit-get-title "xwidget.c" (xwidget)) (declare-function xwidget-size-request "xwidget.c" (xwidget)) @@ -137,22 +135,30 @@ Interactively, URL defaults to the string looking like a url around point." (defun xwidget-webkit-scroll-up () "Scroll webkit up." (interactive) - (xwidget-set-adjustment (xwidget-webkit-last-session) 'vertical t 50)) + (xwidget-webkit-execute-script + (xwidget-webkit-current-session) + "window.scrollBy(0, 50);")) (defun xwidget-webkit-scroll-down () "Scroll webkit down." (interactive) - (xwidget-set-adjustment (xwidget-webkit-last-session) 'vertical t -50)) + (xwidget-webkit-execute-script + (xwidget-webkit-current-session) + "window.scrollBy(0, -50);")) (defun xwidget-webkit-scroll-forward () "Scroll webkit forwards." (interactive) - (xwidget-set-adjustment (xwidget-webkit-last-session) 'horizontal t 50)) + (xwidget-webkit-execute-script + (xwidget-webkit-current-session) + "window.scrollBy(50, 0);")) (defun xwidget-webkit-scroll-backward () "Scroll webkit backwards." (interactive) - (xwidget-set-adjustment (xwidget-webkit-last-session) 'horizontal t -50)) + (xwidget-webkit-execute-script + (xwidget-webkit-current-session) + "window.scrollBy(-50, 0);")) ;; The xwidget event needs to go into a higher level handler diff --git a/src/xwidget.c b/src/xwidget.c index 4f53b93..8552810 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -103,25 +103,9 @@ Returns the newly constructed xwidget, or nil if construction fails. */) gtk_window_resize (GTK_WINDOW (xw->widgetwindow_osr), xw->width, xw->height); - /* WebKit OSR is the only scrolled component at the moment. */ - xw->widgetscrolledwindow_osr = NULL; - if (EQ (xw->type, Qwebkit)) { - xw->widgetscrolledwindow_osr = gtk_scrolled_window_new (NULL, NULL); - gtk_scrolled_window_set_min_content_height - (GTK_SCROLLED_WINDOW (xw->widgetscrolledwindow_osr), - xw->height); - gtk_scrolled_window_set_min_content_width - (GTK_SCROLLED_WINDOW (xw->widgetscrolledwindow_osr), - xw->width); - gtk_scrolled_window_set_policy - (GTK_SCROLLED_WINDOW (xw->widgetscrolledwindow_osr), - GTK_POLICY_ALWAYS, GTK_POLICY_ALWAYS); - xw->widget_osr = webkit_web_view_new (); - gtk_container_add (GTK_CONTAINER (xw->widgetscrolledwindow_osr), - GTK_WIDGET (WEBKIT_WEB_VIEW (xw->widget_osr))); } gtk_widget_set_size_request (GTK_WIDGET (xw->widget_osr), xw->width, @@ -130,7 +114,7 @@ Returns the newly constructed xwidget, or nil if construction fails. */) if (EQ (xw->type, Qwebkit)) { gtk_container_add (GTK_CONTAINER (xw->widgetwindow_osr), - xw->widgetscrolledwindow_osr); + GTK_WIDGET (WEBKIT_WEB_VIEW (xw->widget_osr))); } else { @@ -140,7 +124,6 @@ Returns the newly constructed xwidget, or nil if construction fails. */) gtk_widget_show (xw->widget_osr); gtk_widget_show (xw->widgetwindow_osr); - gtk_widget_show (xw->widgetscrolledwindow_osr); /* Store some xwidget data in the gtk widgets for convenient retrieval in the event handlers. */ @@ -482,10 +465,7 @@ xwidget_osr_draw_cb (GtkWidget *widget, cairo_t *cr, gpointer data) cairo_rectangle (cr, 0, 0, xv->clip_right, xv->clip_bottom); cairo_clip (cr); - if (xw->widgetscrolledwindow_osr != NULL) - gtk_widget_draw (xw->widgetscrolledwindow_osr, cr); - else - gtk_widget_draw (xw->widget_osr, cr); + gtk_widget_draw (xw->widget_osr, cr); return FALSE; } @@ -767,21 +747,11 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0, /* If there is an offscreen widget resize it first. */ if (xw->widget_osr) { - /* Use minimum size. */ - gtk_widget_set_size_request (GTK_WIDGET (xw->widget_osr), - xw->width, xw->height); - gtk_window_resize (GTK_WINDOW (xw->widgetwindow_osr), xw->width, xw->height); - gtk_scrolled_window_set_min_content_height - (GTK_SCROLLED_WINDOW (xw->widgetscrolledwindow_osr), - xw->height); - gtk_scrolled_window_set_min_content_width - (GTK_SCROLLED_WINDOW (xw->widgetscrolledwindow_osr), - xw->width); - gtk_container_resize_children (GTK_CONTAINER (xw->widgetwindow_osr)); - + gtk_widget_set_size_request (GTK_WIDGET (xw->widget_osr), xw->width, + xw->height); } for (Lisp_Object tail = Vxwidget_view_list; CONSP (tail); tail = XCDR (tail)) @@ -800,30 +770,6 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0, -DEFUN ("xwidget-set-adjustment", - Fxwidget_set_adjustment, Sxwidget_set_adjustment, 4, 4, 0, - doc: /* Set native scrolling for XWIDGET. -AXIS can be `vertical' or `horizontal'. -If RELATIVE is t, scroll relative, otherwise absolutely. -VALUE is the amount to scroll, either relatively or absolutely. */) - (Lisp_Object xwidget, Lisp_Object axis, Lisp_Object relative, - Lisp_Object value) -{ - CHECK_XWIDGET (xwidget); - CHECK_NUMBER (value); - struct xwidget *xw = XXWIDGET (xwidget); - GtkAdjustment *adjustment - = ((EQ (Qhorizontal, axis) - ? gtk_scrolled_window_get_hadjustment - : gtk_scrolled_window_get_vadjustment) - (GTK_SCROLLED_WINDOW (xw->widgetscrolledwindow_osr))); - double final_value = XINT (value); - if (EQ (Qt, relative)) - final_value += gtk_adjustment_get_value (adjustment); - gtk_adjustment_set_value (adjustment, final_value); - return Qnil; -} - DEFUN ("xwidget-size-request", Fxwidget_size_request, Sxwidget_size_request, @@ -1039,8 +985,6 @@ syms_of_xwidget (void) defsubr (&Sxwidget_buffer); defsubr (&Sset_xwidget_plist); - defsubr (&Sxwidget_set_adjustment); - DEFSYM (Qxwidget, "xwidget"); DEFSYM (QCxwidget, ":xwidget"); diff --git a/src/xwidget.h b/src/xwidget.h index 8fc3821..4447abb 100644 --- a/src/xwidget.h +++ b/src/xwidget.h @@ -56,9 +56,6 @@ struct xwidget GtkWidget *widget_osr; GtkWidget *widgetwindow_osr; - /* Used if the widget (webkit) is to be wrapped in a scrolled window. */ - GtkWidget *widgetscrolledwindow_osr; - /* Kill silently if Emacs is exited. */ bool_bf kill_without_query : 1; }; commit 623deaf406a85d8262bc1735009b3ee0535cc688 Author: Ricardo Wurmus Date: Tue Oct 25 23:00:35 2016 -0700 xwidget: Pass JavaScript return value to optional callback procedure * lisp/xwidget.el (xwidget-webkit-execute-script): Accept optional callback argument. (xwidget-webkit-callback): Handle "javascript-callback" event type. * src/xwidget.c (xwidget-webkit-execute-script): Accept optional argument FUN, a Lisp procedure to execute on the JavaScript return value. (store_xwidget_js_callback_event, webkit_javascript_finished_cb, webkit_js_to_lisp): New procedures. diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 1bae6bb..69b1002 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -42,7 +42,8 @@ (declare-function xwidget-webkit-get-title "xwidget.c" (xwidget)) (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" (xwidget script)) +(declare-function xwidget-webkit-execute-script "xwidget.c" + (xwidget script &optional callback)) (declare-function xwidget-webkit-goto-uri "xwidget.c" (xwidget uri)) (declare-function xwidget-plist "xwidget.c" (xwidget)) (declare-function set-xwidget-plist "xwidget.c" (xwidget plist)) @@ -186,22 +187,26 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." (xwidget-log "error: callback called for xwidget with dead buffer") (with-current-buffer (xwidget-buffer xwidget) - (let* ((strarg (nth 3 last-input-event))) - (cond ((eq xwidget-event-type 'load-changed) - (xwidget-log "webkit finished loading: '%s'" - (xwidget-webkit-get-title xwidget)) - ;;TODO - check the native/internal scroll - ;;(xwidget-adjust-size-to-content xwidget) - (xwidget-webkit-adjust-size-dispatch) ;;TODO xwidget arg - (rename-buffer (format "*xwidget webkit: %s *" - (xwidget-webkit-get-title xwidget))) - (pop-to-buffer (current-buffer))) - ((eq xwidget-event-type 'decide-policy) + (cond ((eq xwidget-event-type 'load-changed) + (xwidget-log "webkit finished loading: '%s'" + (xwidget-webkit-get-title xwidget)) + ;;TODO - check the native/internal scroll + ;;(xwidget-adjust-size-to-content xwidget) + (xwidget-webkit-adjust-size-dispatch) ;;TODO xwidget arg + (rename-buffer (format "*xwidget webkit: %s *" + (xwidget-webkit-get-title xwidget))) + (pop-to-buffer (current-buffer))) + ((eq xwidget-event-type 'decide-policy) + (let ((strarg (nth 3 last-input-event))) (if (string-match ".*#\\(.*\\)" strarg) (xwidget-webkit-show-id-or-named-element xwidget - (match-string 1 strarg)))) - (t (xwidget-log "unhandled event:%s" xwidget-event-type))))))) + (match-string 1 strarg))))) + ((eq xwidget-event-type 'javascript-callback) + (let ((proc (nth 3 last-input-event)) + (arg (nth 4 last-input-event))) + (funcall proc arg))) + (t (xwidget-log "unhandled event:%s" xwidget-event-type)))))) (defvar bookmark-make-record-function) (define-derived-mode xwidget-webkit-mode diff --git a/src/xwidget.c b/src/xwidget.c index 78349a8..4f53b93 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -28,6 +28,7 @@ along with GNU Emacs. If not, see . */ #include "gtkutil.h" #include +#include static struct xwidget * allocate_xwidget (void) @@ -50,6 +51,9 @@ static struct xwidget_view *xwidget_view_lookup (struct xwidget *, static void webkit_view_load_changed_cb (WebKitWebView *, WebKitLoadEvent, gpointer); +static void webkit_javascript_finished_cb (GObject *, + GAsyncResult *, + gpointer); static gboolean webkit_download_cb (WebKitWebContext *, WebKitDownload *, gpointer); static gboolean @@ -251,6 +255,22 @@ store_xwidget_event_string (struct xwidget *xw, const char *eventname, kbd_buffer_store_event (&event); } +static void +store_xwidget_js_callback_event (struct xwidget *xw, + Lisp_Object proc, + Lisp_Object argument) +{ + struct input_event event; + Lisp_Object xwl; + XSETXWIDGET (xwl, xw); + EVENT_INIT (event); + event.kind = XWIDGET_EVENT; + event.frame_or_window = Qnil; + event.arg = list4 (intern ("javascript-callback"), xwl, proc, argument); + kbd_buffer_store_event (&event); +} + + void webkit_view_load_changed_cb (WebKitWebView *webkitwebview, WebKitLoadEvent load_event, @@ -269,6 +289,128 @@ webkit_view_load_changed_cb (WebKitWebView *webkitwebview, } } +/* Recursively convert a JavaScript value to a Lisp value. */ +Lisp_Object +webkit_js_to_lisp (JSContextRef context, JSValueRef value) +{ + switch (JSValueGetType (context, value)) + { + case kJSTypeString: + { + JSStringRef js_str_value; + gchar *str_value; + gsize str_length; + + js_str_value = JSValueToStringCopy (context, value, NULL); + str_length = JSStringGetMaximumUTF8CStringSize (js_str_value); + str_value = (gchar *)g_malloc (str_length); + JSStringGetUTF8CString (js_str_value, str_value, str_length); + JSStringRelease (js_str_value); + return build_string (str_value); + } + case kJSTypeBoolean: + return (JSValueToBoolean (context, value)) ? Qt : Qnil; + case kJSTypeNumber: + return make_number (JSValueToNumber (context, value, NULL)); + case kJSTypeObject: + { + if (JSValueIsArray (context, value)) + { + JSStringRef pname = JSStringCreateWithUTF8CString("length"); + JSValueRef len = JSObjectGetProperty (context, (JSObjectRef) value, pname, NULL); + int n = JSValueToNumber (context, len, NULL); + JSStringRelease(pname); + + Lisp_Object obj; + struct Lisp_Vector *p = allocate_vector (n); + + for (int i = 0; i < n; ++i) + { + p->contents[i] = + webkit_js_to_lisp (context, + JSObjectGetPropertyAtIndex (context, + (JSObjectRef) value, + i, NULL)); + } + XSETVECTOR (obj, p); + return obj; + } + else + { + JSPropertyNameArrayRef properties = + JSObjectCopyPropertyNames (context, (JSObjectRef) value); + + int n = JSPropertyNameArrayGetCount (properties); + Lisp_Object obj; + + // TODO: can we use a regular list here? + struct Lisp_Vector *p = allocate_vector (n); + + for (int i = 0; i < n; ++i) + { + JSStringRef name = JSPropertyNameArrayGetNameAtIndex (properties, i); + JSValueRef property = JSObjectGetProperty (context, + (JSObjectRef) value, + name, NULL); + gchar *str_name; + gsize str_length; + str_length = JSStringGetMaximumUTF8CStringSize (name); + str_name = (gchar *)g_malloc (str_length); + JSStringGetUTF8CString (name, str_name, str_length); + JSStringRelease (name); + + p->contents[i] = + Fcons (build_string (str_name), + webkit_js_to_lisp (context, property)); + } + + JSPropertyNameArrayRelease (properties); + XSETVECTOR (obj, p); + return obj; + } + } + case kJSTypeUndefined: + case kJSTypeNull: + default: + return Qnil; + } +} + +static void +webkit_javascript_finished_cb (GObject *webview, + GAsyncResult *result, + gpointer lisp_callback) +{ + WebKitJavascriptResult *js_result; + JSValueRef value; + JSGlobalContextRef context; + GError *error = NULL; + struct xwidget *xw = g_object_get_data (G_OBJECT (webview), + XG_XWIDGET); + + js_result = webkit_web_view_run_javascript_finish + (WEBKIT_WEB_VIEW (webview), result, &error); + + if (!js_result) + { + g_warning ("Error running javascript: %s", error->message); + g_error_free (error); + return; + } + + context = webkit_javascript_result_get_global_context (js_result); + value = webkit_javascript_result_get_value (js_result); + Lisp_Object lisp_value = webkit_js_to_lisp (context, value); + webkit_javascript_result_unref (js_result); + + // Register an xwidget event here, which then runs the callback. + // This ensures that the callback runs in sync with the Emacs + // event loop. + store_xwidget_js_callback_event (xw, (Lisp_Object)lisp_callback, + lisp_value); +} + + gboolean webkit_download_cb (WebKitWebContext *webkitwebcontext, WebKitDownload *arg1, @@ -562,19 +704,28 @@ DEFUN ("xwidget-webkit-goto-uri", DEFUN ("xwidget-webkit-execute-script", Fxwidget_webkit_execute_script, Sxwidget_webkit_execute_script, - 2, 2, 0, - doc: /* Make the Webkit XWIDGET execute JavaScript SCRIPT. */) - (Lisp_Object xwidget, Lisp_Object script) + 2, 3, 0, + doc: /* Make the Webkit XWIDGET execute JavaScript SCRIPT. If +FUN is provided, feed the JavaScript return value to the single +argument procedure FUN.*/) + (Lisp_Object xwidget, Lisp_Object script, Lisp_Object fun) { WEBKIT_FN_INIT (); CHECK_STRING (script); - // TODO: provide callback function to do something with the return - // value! This allows us to get rid of the title hack. + if (!NILP (fun) && (!FUNCTIONP (fun))) + wrong_type_argument (Qinvalid_function, fun); + + void *callback = (FUNCTIONP (fun)) ? + &webkit_javascript_finished_cb : NULL; + + // JavaScript execution happens asynchronously. If an elisp + // callback function is provided we pass it to the C callback + // procedure that retrieves the return value. webkit_web_view_run_javascript (WEBKIT_WEB_VIEW (xw->widget_osr), SSDATA (script), NULL, /*cancellable*/ - NULL, /*callback*/ - NULL /*user data*/); + callback, + (gpointer) fun); return Qnil; } commit d781662873f228b110a128f7a2b6583a4d5e0a3a Author: Ricardo Wurmus Date: Tue Oct 25 23:00:35 2016 -0700 xwidget: Use WebKit2 API * configure.ac: Check for webkit2gtk-4.0. * src/xwidget.c: Adjust to use WebKit2 API. * lisp/xwidget.el (xwidget-webkit-callback): Adjust matches for `xwidget-event-type'. diff --git a/configure.ac b/configure.ac index 998ff52..46fd434 100644 --- a/configure.ac +++ b/configure.ac @@ -2630,8 +2630,8 @@ if test "$with_xwidgets" != "no"; then test "$USE_GTK_TOOLKIT" = "GTK3" && test "$window_system" != "none" || AC_MSG_ERROR([xwidgets requested but gtk3 not used.]) - WEBKIT_REQUIRED=1.4.0 - WEBKIT_MODULES="webkitgtk-3.0 >= $WEBKIT_REQUIRED" + WEBKIT_REQUIRED=2.12 + WEBKIT_MODULES="webkit2gtk-4.0 >= $WEBKIT_REQUIRED" EMACS_CHECK_MODULES([WEBKIT], [$WEBKIT_MODULES]) HAVE_XWIDGETS=$HAVE_WEBKIT test $HAVE_XWIDGETS = yes || diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 7a0ca8b..1bae6bb 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -187,7 +187,7 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." "error: callback called for xwidget with dead buffer") (with-current-buffer (xwidget-buffer xwidget) (let* ((strarg (nth 3 last-input-event))) - (cond ((eq xwidget-event-type 'document-load-finished) + (cond ((eq xwidget-event-type 'load-changed) (xwidget-log "webkit finished loading: '%s'" (xwidget-webkit-get-title xwidget)) ;;TODO - check the native/internal scroll @@ -196,8 +196,7 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." (rename-buffer (format "*xwidget webkit: %s *" (xwidget-webkit-get-title xwidget))) (pop-to-buffer (current-buffer))) - ((eq xwidget-event-type - 'navigation-policy-decision-requested) + ((eq xwidget-event-type 'decide-policy) (if (string-match ".*#\\(.*\\)" strarg) (xwidget-webkit-show-id-or-named-element xwidget diff --git a/src/xwidget.c b/src/xwidget.c index f5f4da0..78349a8 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -27,10 +27,7 @@ along with GNU Emacs. If not, see . */ #include "keyboard.h" #include "gtkutil.h" -#include -#include -#include -#include +#include static struct xwidget * allocate_xwidget (void) @@ -50,34 +47,16 @@ allocate_xwidget_view (void) static struct xwidget_view *xwidget_view_lookup (struct xwidget *, struct window *); -static void webkit_document_load_finished_cb (WebKitWebView *, WebKitWebFrame *, - gpointer); -static gboolean webkit_download_cb (WebKitWebView *, WebKitDownload *, gpointer); +static void webkit_view_load_changed_cb (WebKitWebView *, + WebKitLoadEvent, + gpointer); +static gboolean webkit_download_cb (WebKitWebContext *, WebKitDownload *, gpointer); static gboolean -webkit_mime_type_policy_typedecision_requested_cb (WebKitWebView *, - WebKitWebFrame *, - WebKitNetworkRequest *, - gchar *, - WebKitWebPolicyDecision *, - gpointer); - -static gboolean -webkit_new_window_policy_decision_requested_cb (WebKitWebView *, - WebKitWebFrame *, - WebKitNetworkRequest *, - WebKitWebNavigationAction *, - WebKitWebPolicyDecision *, - gpointer); - -static gboolean -webkit_navigation_policy_decision_requested_cb (WebKitWebView *, - WebKitWebFrame *, - WebKitNetworkRequest *, - WebKitWebNavigationAction *, - WebKitWebPolicyDecision *, - gpointer); - +webkit_decide_policy_cb (WebKitWebView *, + WebKitPolicyDecision *, + WebKitPolicyDecisionType, + gpointer); DEFUN ("make-xwidget", @@ -168,29 +147,17 @@ Returns the newly constructed xwidget, or nil if construction fails. */) if (EQ (xw->type, Qwebkit)) { g_signal_connect (G_OBJECT (xw->widget_osr), - "document-load-finished", - G_CALLBACK (webkit_document_load_finished_cb), xw); + "load-changed", + G_CALLBACK (webkit_view_load_changed_cb), xw); - g_signal_connect (G_OBJECT (xw->widget_osr), - "download-requested", + g_signal_connect (G_OBJECT (webkit_web_context_get_default ()), + "download-started", G_CALLBACK (webkit_download_cb), xw); g_signal_connect (G_OBJECT (xw->widget_osr), - "mime-type-policy-decision-requested", - G_CALLBACK - (webkit_mime_type_policy_typedecision_requested_cb), - xw); - - g_signal_connect (G_OBJECT (xw->widget_osr), - "new-window-policy-decision-requested", - G_CALLBACK - (webkit_new_window_policy_decision_requested_cb), - xw); - - g_signal_connect (G_OBJECT (xw->widget_osr), - "navigation-policy-decision-requested", + "decide-policy", G_CALLBACK - (webkit_navigation_policy_decision_requested_cb), + (webkit_decide_policy_cb), xw); } @@ -284,81 +251,83 @@ store_xwidget_event_string (struct xwidget *xw, const char *eventname, kbd_buffer_store_event (&event); } -/* TODO deprecated, use load-status. */ void -webkit_document_load_finished_cb (WebKitWebView *webkitwebview, - WebKitWebFrame *arg1, - gpointer data) +webkit_view_load_changed_cb (WebKitWebView *webkitwebview, + WebKitLoadEvent load_event, + gpointer data) { - struct xwidget *xw = g_object_get_data (G_OBJECT (webkitwebview), - XG_XWIDGET); - - store_xwidget_event_string (xw, "document-load-finished", ""); + switch (load_event) { + case WEBKIT_LOAD_FINISHED: + { + struct xwidget *xw = g_object_get_data (G_OBJECT (webkitwebview), + XG_XWIDGET); + store_xwidget_event_string (xw, "load-changed", ""); + break; + } + default: + break; + } } gboolean -webkit_download_cb (WebKitWebView *webkitwebview, +webkit_download_cb (WebKitWebContext *webkitwebcontext, WebKitDownload *arg1, gpointer data) { - struct xwidget *xw = g_object_get_data (G_OBJECT (webkitwebview), + WebKitWebView *view = webkit_download_get_web_view(arg1); + WebKitURIRequest *request = webkit_download_get_request(arg1); + struct xwidget *xw = g_object_get_data (G_OBJECT (view), XG_XWIDGET); - store_xwidget_event_string (xw, "download-requested", - webkit_download_get_uri (arg1)); + + store_xwidget_event_string (xw, "download-started", + webkit_uri_request_get_uri(request)); return FALSE; } static gboolean -webkit_mime_type_policy_typedecision_requested_cb (WebKitWebView *webView, - WebKitWebFrame *frame, - WebKitNetworkRequest *request, - gchar *mimetype, - WebKitWebPolicyDecision *policy_decision, - gpointer user_data) +webkit_decide_policy_cb (WebKitWebView *webView, + WebKitPolicyDecision *decision, + WebKitPolicyDecisionType type, + gpointer user_data) { - /* This function makes webkit send a download signal for all unknown - mime types. TODO: Defer the decision to Lisp, so that it's - possible to make Emacs handle mime text for instance. */ - if (!webkit_web_view_can_show_mime_type (webView, mimetype)) + switch (type) { + case WEBKIT_POLICY_DECISION_TYPE_RESPONSE: + /* This function makes webkit send a download signal for all unknown + mime types. TODO: Defer the decision to Lisp, so that it's + possible to make Emacs handle mime text for instance. */ { - webkit_web_policy_decision_download (policy_decision); - return TRUE; + WebKitResponsePolicyDecision *response = + WEBKIT_RESPONSE_POLICY_DECISION (decision); + if (!webkit_response_policy_decision_is_mime_type_supported (response)) + { + webkit_policy_decision_download (decision); + return TRUE; + } + else + return FALSE; + break; } - else + case WEBKIT_POLICY_DECISION_TYPE_NEW_WINDOW_ACTION: + case WEBKIT_POLICY_DECISION_TYPE_NAVIGATION_ACTION: + { + WebKitNavigationPolicyDecision *navigation_decision = + WEBKIT_NAVIGATION_POLICY_DECISION (decision); + WebKitNavigationAction *navigation_action = + webkit_navigation_policy_decision_get_navigation_action (navigation_decision); + WebKitURIRequest *request = + webkit_navigation_action_get_request (navigation_action); + + struct xwidget *xw = g_object_get_data (G_OBJECT (webView), XG_XWIDGET); + store_xwidget_event_string (xw, "decide-policy", + webkit_uri_request_get_uri (request)); + return FALSE; + break; + } + default: return FALSE; + } } -static gboolean -webkit_new_window_policy_decision_requested_cb (WebKitWebView *webView, - WebKitWebFrame *frame, - WebKitNetworkRequest *request, - WebKitWebNavigationAction *navigation_action, - WebKitWebPolicyDecision *policy_decision, - gpointer user_data) -{ - struct xwidget *xw = g_object_get_data (G_OBJECT (webView), XG_XWIDGET); - webkit_web_navigation_action_get_original_uri (navigation_action); - - store_xwidget_event_string (xw, "new-window-policy-decision-requested", - webkit_web_navigation_action_get_original_uri - (navigation_action)); - return FALSE; -} - -static gboolean -webkit_navigation_policy_decision_requested_cb (WebKitWebView *webView, - WebKitWebFrame *frame, - WebKitNetworkRequest *request, - WebKitWebNavigationAction *navigation_action, - WebKitWebPolicyDecision *policy_decision, - gpointer user_data) -{ - struct xwidget *xw = g_object_get_data (G_OBJECT (webView), XG_XWIDGET); - store_xwidget_event_string (xw, "navigation-policy-decision-requested", - webkit_web_navigation_action_get_original_uri - (navigation_action)); - return FALSE; -} /* For gtk3 offscreen rendered widgets. */ static gboolean @@ -599,8 +568,13 @@ DEFUN ("xwidget-webkit-execute-script", { WEBKIT_FN_INIT (); CHECK_STRING (script); - webkit_web_view_execute_script (WEBKIT_WEB_VIEW (xw->widget_osr), - SSDATA (script)); + // TODO: provide callback function to do something with the return + // value! This allows us to get rid of the title hack. + webkit_web_view_run_javascript (WEBKIT_WEB_VIEW (xw->widget_osr), + SSDATA (script), + NULL, /*cancellable*/ + NULL, /*callback*/ + NULL /*user data*/); return Qnil; } commit 1ea669d6f0269784b3e69238fd2813f55340d53a Merge: b0eecfc 4c3f738 Author: Paul Eggert Date: Tue Oct 25 12:50:31 2016 -0700 Merge from origin/emacs-25 4c3f738 Comment for bug#24793 commit b0eecfca560737787496ba3294bc7605a0922a2a Merge: f8eecb1 32827b3 Author: Paul Eggert Date: Tue Oct 25 12:50:31 2016 -0700 ; Merge from origin/emacs-25 The following commit was skipped: 32827b3 Default REL_ALLOC to 'no' commit f8eecb1c6c8a3646d65112843c7f813fe639d57f Merge: 43645b4 96ac0c3 Author: Paul Eggert Date: Tue Oct 25 12:50:31 2016 -0700 Merge from origin/emacs-25 96ac0c3 Yet another fix for using pointers into buffer text 1047496 Another fix for using pointer to buffer text 3121992 Fix Bug#24478 commit 43645b4dc4eb4611127dc8931a723e872824ecaf Merge: a37820a 7bb5c4f Author: Paul Eggert Date: Tue Oct 25 12:50:30 2016 -0700 ; Merge from origin/emacs-25 The following commit was skipped: 7bb5c4f Port --enable-gcc-warnings to bleeding-edge glibc commit a37820aef918cfaffbd1a74649e2a929f12c453b Merge: 630f535 ee04aed Author: Paul Eggert Date: Tue Oct 25 12:50:30 2016 -0700 Merge from origin/emacs-25 ee04aed Fix handling of buffer relocation in regex.c functions 71ca4f6 Avoid relocating buffers while libxml2 reads its text 1b3fc8a ; Remove redundant code in gmalloc.c 9afea93 Attempt to catch reads from a buffer that is relocated commit 630f535ad6fbaa5e67df6fa5207e49b1728e08f9 Merge: eca10c1 b8e8e15 Author: Paul Eggert Date: Tue Oct 25 12:50:29 2016 -0700 ; Merge from origin/emacs-25 The following commits were skipped: b8e8e15 Revert "* lisp/simple.el (process-menu-mode, list-processes--... d784e75 Revert "* lisp/ibuf-ext.el (ibuffer-do-shell-command-file):" 1dd7b54 Revert "* lisp/ibuffer.el (ibuffer): Improve 'other-window' c... commit 4c3f7387df339176a94f49895c92fa6a5f526bae Author: Eli Zaretskii Date: Tue Oct 25 22:33:14 2016 +0300 Comment for bug#24793 * lisp/info.el (Info-mode-font-lock-keywords): Add a comment explaining why `..' quoting is not fontified using the 'Info-quoted' face. (Bug#24793) diff --git a/lisp/info.el b/lisp/info.el index ae46fba..1689af9 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -4239,6 +4239,9 @@ With a zero prefix arg, put the name inside a function call to `info'." '((t :inherit fixed-pitch-serif)) "Face used for quoted elements.") +;; We deliberately fontify only ‘..’ quoting, and not `..', because +;; the former can be done much more reliably, i.e. without risking +;; false positives. (defvar Info-mode-font-lock-keywords '(("‘\\([^’]*\\)’" (1 'Info-quoted)))) commit eca10c1e68af0cc86ebba1f13b5ba41d20fb0d56 Author: Nicolas Petton Date: Tue Oct 25 21:28:36 2016 +0200 Minor fix in the documentation of seq-random-elt * doc/lispref/sequences.texi (Sequence Functions): Remove false sentence. diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index fc26aa2..e879b82 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -1039,7 +1039,6 @@ followed by a variable name to be bound to the rest of @defun seq-random-elt sequence This function returns an element of @var{sequence} taken at random. -If @var{sequence} is @code{nil}, the function returns @code{nil}. @example @group commit 32827b374da7b085fc8a45bd35bf57a1afa325f9 Author: Paul Eggert Date: Tue Oct 25 12:13:20 2016 -0700 Default REL_ALLOC to 'no' This should make ralloc-related bugs less likely on GNU/Linux systems with bleeding-edge glibc. See the email thread containing: http://lists.gnu.org/archive/html/emacs-devel/2016-10/msg00801.html Do not merge to master. * configure.ac (REL_ALLOC): Default to 'no' on all platforms, not merely on platforms with Doug Lea malloc. Although bleeding-edge glibc no longer exports __malloc_initialize_hook and so longer passes the configure-time test for Doug Lea malloc, ralloc tickles longstanding bugs like Bug#24358 and Bug#24764 and Emacs is likely to be more reliable without it. This patch is not needed on master, which uses hybrid malloc in this situation. diff --git a/configure.ac b/configure.ac index ae7dfe5..19b44bd 100644 --- a/configure.ac +++ b/configure.ac @@ -2189,18 +2189,10 @@ if test "$doug_lea_malloc" = "yes" ; then AC_DEFINE(DOUG_LEA_MALLOC, 1, [Define to 1 if the system memory allocator is Doug Lea style, with malloc hooks and malloc_set_state.]) - - ## Use mmap directly for allocating larger buffers. - ## FIXME this comes from src/s/{gnu,gnu-linux}.h: - ## #ifdef DOUG_LEA_MALLOC; #undef REL_ALLOC; #endif - ## Does the AC_FUNC_MMAP test below make this check unnecessary? - case "$opsys" in - mingw32|gnu*) REL_ALLOC=no ;; - esac fi if test x"${REL_ALLOC}" = x; then - REL_ALLOC=${GNU_MALLOC} + REL_ALLOC=no fi use_mmap_for_buffers=no commit 8cdbc50118e4276a0ceac08b701ae6e0fb1b49af Author: Eli Zaretskii Date: Tue Oct 25 21:56:16 2016 +0300 Minor copyedits in documentation of 'seq-random-elt' * doc/lispref/sequences.texi (Sequence Functions): Fix markup in last change. Use 2 spaces between sentences. diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index b6874bf..fc26aa2 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -1038,7 +1038,8 @@ followed by a variable name to be bound to the rest of @end defmac @defun seq-random-elt sequence - This function returns an element of @var{sequence} taken at random. If @var{sequence} is nil, the function returns nil. + This function returns an element of @var{sequence} taken at random. +If @var{sequence} is @code{nil}, the function returns @code{nil}. @example @group @@ -1055,7 +1056,7 @@ followed by a variable name to be bound to the rest of @end group @end example - If @var{sequence} is empty, the function signals an error. + If @var{sequence} is empty, this function signals an error. @end defun @node Arrays commit b4f09b92bc09d66d01206ec0f5e20b1d2701cd86 Author: Nicolas Petton Date: Tue Oct 25 17:06:03 2016 +0200 * lisp/emacs-lisp/seq.el (seq-random-elt): Fix docstring. diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 5c89d2b..2b4330c 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -479,7 +479,7 @@ If no element is found, return nil." (cl-defgeneric seq-random-elt (sequence) "Return a random element from SEQUENCE. -Return nil if SEQUENCE is nil." +Signal an error if SEQUENCE is empty." (if (seq-empty-p sequence) (error "Sequence cannot be empty") (seq-elt sequence (random (seq-length sequence))))) commit 4722db6c96da5d9e8f307db7a385fd3d0ab48158 Author: Philipp Stephani Date: Tue Oct 25 13:29:17 2016 +0200 ; Add missing `require' diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index ea31ee8..faf8991 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -24,6 +24,8 @@ ;;; Code: +(require 'cl-lib) + (defgroup xterm nil "XTerm support." :version "24.1" commit bd22beb6e4054c659e8c31931c421f60e9719c65 Author: Damien Cassou Date: Fri Oct 21 07:53:08 2016 +0200 Add seq-random-elt to seq.el * lisp/emacs-lisp/seq.el (seq-random-elt): Add function to return a random element from it's sequence parameter. * test/lisp/emacs-lisp/seq-tests.el (test-seq-random-elt-take-all test-seq-random-elt-return-nil): Test the new function * doc/lispref/sequences.texi: Document the new function diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 08e5e3a..b6874bf 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -1037,6 +1037,26 @@ followed by a variable name to be bound to the rest of @end example @end defmac +@defun seq-random-elt sequence + This function returns an element of @var{sequence} taken at random. If @var{sequence} is nil, the function returns nil. + +@example +@group +(seq-random-elt [1 2 3 4]) +@result{} 3 +(seq-random-elt [1 2 3 4]) +@result{} 2 +(seq-random-elt [1 2 3 4]) +@result{} 4 +(seq-random-elt [1 2 3 4]) +@result{} 2 +(seq-random-elt [1 2 3 4]) +@result{} 1 +@end group +@end example + + If @var{sequence} is empty, the function signals an error. +@end defun @node Arrays @section Arrays diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 85702f4..5c89d2b 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -4,7 +4,7 @@ ;; Author: Nicolas Petton ;; Keywords: sequences -;; Version: 2.18 +;; Version: 2.19 ;; Package: seq ;; Maintainer: emacs-devel@gnu.org @@ -476,6 +476,13 @@ SEQUENCE must be a sequence of numbers or markers." "Return element of SEQUENCE at the index N. If no element is found, return nil." (ignore-errors (seq-elt sequence n))) + +(cl-defgeneric seq-random-elt (sequence) + "Return a random element from SEQUENCE. +Return nil if SEQUENCE is nil." + (if (seq-empty-p sequence) + (error "Sequence cannot be empty") + (seq-elt sequence (random (seq-length sequence))))) ;;; Optimized implementations for lists diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el index c2065c6..6d17b7c 100644 --- a/test/lisp/emacs-lisp/seq-tests.el +++ b/test/lisp/emacs-lisp/seq-tests.el @@ -28,6 +28,7 @@ (require 'ert) (require 'seq) +(require 'map) (defmacro with-test-sequences (spec &rest body) "Successively bind VAR to a list, vector, and string built from SEQ. @@ -371,5 +372,21 @@ Evaluate BODY for each created sequence. (should (equal (seq-sort-by #'seq-length #'> seq) ["xxx" "xx" "x"])))) +(ert-deftest test-seq-random-elt-take-all () + (let ((seq '(a b c d e)) + (count '())) + (should (= 0 (map-length count))) + (dotimes (_ 1000) + (let ((random-elt (seq-random-elt seq))) + (map-put count + random-elt + (map-elt count random-elt 0)))) + (should (= 5 (map-length count))))) + +(ert-deftest test-seq-random-elt-signal-on-empty () + (should-error (seq-random-elt nil)) + (should-error (seq-random-elt [])) + (should-error (seq-random-elt ""))) + (provide 'seq-tests) ;;; seq-tests.el ends here commit 96ac0c3ebce825e60595794f99e703ec8302e240 Author: Eli Zaretskii Date: Mon Oct 24 21:37:20 2016 +0300 Yet another fix for using pointers into buffer text * src/search.c (boyer_moore): Update pointers to buffer text after call to set_search_regs. (Bug#24358) diff --git a/src/search.c b/src/search.c index f8acd40..b50e7f0 100644 --- a/src/search.c +++ b/src/search.c @@ -2014,13 +2014,20 @@ boyer_moore (EMACS_INT n, unsigned char *base_pat, cursor += dirlen - i - direction; /* fix cursor */ if (i + direction == 0) { - ptrdiff_t position, start, end; + ptrdiff_t position, start, end, cursor_off; cursor -= direction; position = pos_byte + cursor - p2 + ((direction > 0) ? 1 - len_byte : 0); + /* set_search_regs might call malloc, which could + cause ralloc.c relocate buffer text. We need to + update pointers into buffer text due to that. */ + cursor_off = cursor - p2; set_search_regs (position, len_byte); + p_limit = BYTE_POS_ADDR (limit); + p2 = BYTE_POS_ADDR (pos_byte); + cursor = p2 + cursor_off; if (NILP (Vinhibit_changing_match_data)) { commit 1047496722a58ef5b736dae64d32adeb58c5055c Author: Eli Zaretskii Date: Mon Oct 24 16:59:34 2016 +0300 Another fix for using pointer to buffer text * src/search.c (Freplace_match): Move the call to BYTE_POS_ADDR after the call to xpalloc, to avoid the danger of buffer text relocation after its address was taken. (Bug#24358) diff --git a/src/search.c b/src/search.c index 5c04916..f8acd40 100644 --- a/src/search.c +++ b/src/search.c @@ -2640,6 +2640,7 @@ since only regular expressions have distinguished subexpressions. */) const unsigned char *add_stuff = NULL; ptrdiff_t add_len = 0; ptrdiff_t idx = -1; + ptrdiff_t begbyte; if (str_multibyte) { @@ -2702,11 +2703,10 @@ since only regular expressions have distinguished subexpressions. */) set up ADD_STUFF and ADD_LEN to point to it. */ if (idx >= 0) { - ptrdiff_t begbyte = CHAR_TO_BYTE (search_regs.start[idx]); + begbyte = CHAR_TO_BYTE (search_regs.start[idx]); add_len = CHAR_TO_BYTE (search_regs.end[idx]) - begbyte; if (search_regs.start[idx] < GPT && GPT < search_regs.end[idx]) move_gap_both (search_regs.start[idx], begbyte); - add_stuff = BYTE_POS_ADDR (begbyte); } /* Now the stuff we want to add to SUBSTED @@ -2719,6 +2719,11 @@ since only regular expressions have distinguished subexpressions. */) add_len - (substed_alloc_size - substed_len), STRING_BYTES_BOUND, 1); + /* We compute this after the call to xpalloc, because that + could cause buffer text be relocated when ralloc.c is used. */ + if (idx >= 0) + add_stuff = BYTE_POS_ADDR (begbyte); + /* Now add to the end of SUBSTED. */ if (add_stuff) { commit 31219927a9b2c5ef2f702bda245ffc306be7b1a2 Author: Michael Albinus Date: Mon Oct 24 15:04:25 2016 +0200 Fix Bug#24478 * lisp/net/tramp-sh.el (tramp-histfile-override): Change default value to "~/.tramp_history". (tramp-open-shell): Check proper HISTFILE setting. (tramp-maybe-open-connection): Cleanup also for errors. (Bug#24478) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 166bc88..2983d40 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -67,19 +67,18 @@ files conditionalize this setup based on the TERM environment variable." :type 'string) ;;;###tramp-autoload -(defcustom tramp-histfile-override ".tramp_history" +(defcustom tramp-histfile-override "~/.tramp_history" "When invoking a shell, override the HISTFILE with this value. When setting to a string, it redirects the shell history to that file. Be careful when setting to \"/dev/null\"; this might result in undesired results when using \"bash\" as shell. -The value t, the default value, unsets any setting of HISTFILE, -and sets both HISTFILESIZE and HISTSIZE to 0. If you set this -variable to nil, however, the *override* is disabled, so the -history will go to the default storage location, -e.g. \"$HOME/.sh_history\"." +The value t unsets any setting of HISTFILE, and sets both +HISTFILESIZE and HISTSIZE to 0. If you set this variable to nil, +however, the *override* is disabled, so the history will go to +the default storage location, e.g. \"$HOME/.sh_history\"." :group 'tramp - :version "25.1" + :version "25.2" :type '(choice (const :tag "Do not override HISTFILE" nil) (const :tag "Unset HISTFILE" t) (string :tag "Redirect to a file"))) @@ -4117,7 +4116,19 @@ file exists and nonzero exit status otherwise." "")) (tramp-shell-quote-argument tramp-end-of-output) shell (or extra-args "")) - t)) + t) + ;; Check proper HISTFILE setting. We give up when not working. + (when (and (stringp tramp-histfile-override) + (file-name-directory tramp-histfile-override)) + (tramp-barf-unless-okay + vec + (format + "(cd %s)" + (tramp-shell-quote-argument + (file-name-directory tramp-histfile-override))) + "`tramp-histfile-override' uses invalid file `%s'" + tramp-histfile-override))) + (tramp-set-connection-property (tramp-get-connection-process vec) "remote-shell" shell))) @@ -5057,10 +5068,9 @@ connection if a previous connection has died for some reason." ;; Mark it as connected. (tramp-set-connection-property p "connected" t))))) - ;; When the user did interrupt, we must cleanup. - (quit + ;; Cleanup, and propagate the signal. + ((error quit) (tramp-cleanup-connection vec t) - ;; Propagate the quit signal. (signal (car err) (cdr err)))))) (defun tramp-send-command (vec command &optional neveropen nooutput) commit 7bb5c4f206bfbe46b5f4a376633437f8999d956a Author: Paul Eggert Date: Sun Oct 23 21:54:13 2016 -0700 Port --enable-gcc-warnings to bleeding-edge glibc Bleeding-edge glibc sets emacs_cv_var_doug_lea_malloc to 'no'. Do not merge to master. * configure.ac: Check for valloc decl when compiling gmalloc.c. * src/gmalloc.c (emacs_abort) [emacs]: Adjust decl to match what is in lisp.h. Remove duplicate decl. (aligned_alloc): #undef before defining. (aligned_alloc, memalign) [!MSDOS]: Declare. (valloc) [HAVE_DECL_VALLOC]: Remove duplicate decl. diff --git a/configure.ac b/configure.ac index 7c115a0..ae7dfe5 100644 --- a/configure.ac +++ b/configure.ac @@ -2158,7 +2158,10 @@ elif test "$hybrid_malloc" = yes; then GMALLOC_OBJ=gmalloc.o VMLIMIT_OBJ= else - test "$doug_lea_malloc" != "yes" && GMALLOC_OBJ=gmalloc.o + if test "$doug_lea_malloc" != "yes"; then + GMALLOC_OBJ=gmalloc.o + AC_CHECK_DECLS([valloc]) + fi VMLIMIT_OBJ=vm-limit.o AC_CHECK_HEADERS([sys/vlimit.h]) diff --git a/src/gmalloc.c b/src/gmalloc.c index d2762d7..fb2861c 100644 --- a/src/gmalloc.c +++ b/src/gmalloc.c @@ -40,7 +40,7 @@ License along with this library. If not, see . #endif #ifdef emacs -extern void emacs_abort (void); +extern _Noreturn void emacs_abort (void) NO_INLINE; #endif /* If HYBRID_MALLOC is defined, then temacs will use malloc, @@ -59,6 +59,7 @@ extern void emacs_abort (void); #undef malloc #undef realloc #undef calloc +#undef aligned_alloc #undef free #define malloc gmalloc #define realloc grealloc @@ -95,9 +96,9 @@ extern void *calloc (size_t nmemb, size_t size) ATTRIBUTE_MALLOC_SIZE ((1,2)); extern void free (void *ptr); /* Allocate SIZE bytes allocated to ALIGNMENT bytes. */ -#ifdef MSDOS extern void *aligned_alloc (size_t, size_t); extern void *memalign (size_t, size_t); +#ifdef MSDOS extern int posix_memalign (void **, size_t, size_t); #endif @@ -106,10 +107,6 @@ extern int posix_memalign (void **, size_t, size_t); extern void malloc_enable_thread (void); #endif -#ifdef emacs -extern void emacs_abort (void); -#endif - /* The allocator divides the heap into blocks of fixed size; large requests receive one or more whole blocks, and small requests receive a fragment of a block. Fragment sizes are powers of two, @@ -1686,7 +1683,9 @@ License along with this library. If not, see . or (US mail) as Mike Haertel c/o Free Software Foundation. */ /* Allocate SIZE bytes on a page boundary. */ +#ifndef HAVE_DECL_VALLOC extern void *valloc (size_t); +#endif #if defined _SC_PAGESIZE || !defined HAVE_GETPAGESIZE # include "getpagesize.h" @@ -1769,7 +1768,7 @@ hybrid_aligned_alloc (size_t alignment, size_t size) #endif } #endif - + void * hybrid_realloc (void *ptr, size_t size) { commit ee04aedc723b035eedaf975422d4eb242894121b Author: Eli Zaretskii Date: Sun Oct 23 22:09:43 2016 +0300 Fix handling of buffer relocation in regex.c functions * src/search.c (search_buffer): Updated the base pointer to buffer text after the call to re_search_2. (Bug#24358) diff --git a/src/search.c b/src/search.c index ec5a1d7..5c04916 100644 --- a/src/search.c +++ b/src/search.c @@ -1233,6 +1233,8 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, ? &search_regs : &search_regs_1), /* Don't allow match past current point */ pos_byte - BEGV_BYTE); + /* Update 'base' due to possible relocation inside re_search_2. */ + base = current_buffer->text->beg; if (val == -2) { matcher_overflow (); @@ -1279,6 +1281,8 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, (NILP (Vinhibit_changing_match_data) ? &search_regs : &search_regs_1), lim_byte - BEGV_BYTE); + /* Update 'base' due to possible relocation inside re_search_2. */ + base = current_buffer->text->beg; if (val == -2) { matcher_overflow (); commit 71ca4f6a43bad06192cbc4bb8c7a2d69c179b7b0 Author: Eli Zaretskii Date: Sun Oct 23 19:52:56 2016 +0300 Avoid relocating buffers while libxml2 reads its text * src/xml.c (parse_region) [REL_ALLOC]: Freeze the ralloc arena while libxml2 reads the current buffer's text. (Bug#24764) diff --git a/src/xml.c b/src/xml.c index 1ef84bd..612b16c 100644 --- a/src/xml.c +++ b/src/xml.c @@ -202,6 +202,11 @@ parse_region (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, } buftext = BYTE_POS_ADDR (istart_byte); +#ifdef REL_ALLOC + /* Prevent ralloc.c from relocating the current buffer while libxml2 + functions below read its text. */ + r_alloc_inhibit_buffer_relocation (1); +#endif if (htmlp) doc = htmlReadMemory ((char *)buftext, iend_byte - istart_byte, burl, "utf-8", @@ -214,6 +219,9 @@ parse_region (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, XML_PARSE_NONET|XML_PARSE_NOWARNING| XML_PARSE_NOBLANKS |XML_PARSE_NOERROR); +#ifdef REL_ALLOC + r_alloc_inhibit_buffer_relocation (0); +#endif /* If the assertion below fails, malloc was called inside the above libxml2 functions, and ralloc.c caused relocation of buffer text, so we could have read from unrelated memory. */ commit 1b3fc8ab4960a1e6cb8d614953f2ba252155ade0 Author: Eli Zaretskii Date: Sun Oct 23 18:05:48 2016 +0300 ; Remove redundant code in gmalloc.c * src/gmalloc.c [WINDOWSNT]: Remove MS-Windows only inclusion of w32heap.h, as the MS-Windows build no longer uses gmalloc.c. diff --git a/src/gmalloc.c b/src/gmalloc.c index 00b8364..d2762d7 100644 --- a/src/gmalloc.c +++ b/src/gmalloc.c @@ -39,10 +39,6 @@ License along with this library. If not, see . #include #endif -#ifdef WINDOWSNT -#include /* for sbrk */ -#endif - #ifdef emacs extern void emacs_abort (void); #endif commit 9afea93ed536fb9110ac62b413604cf4c4302199 Author: Eli Zaretskii Date: Sun Oct 23 16:54:00 2016 +0300 Attempt to catch reads from a buffer that is relocated * src/xml.c (parse_region): Add assertion to ensure buffer text is not relocated while libxml2 is reading it. (Bug#24764) diff --git a/src/xml.c b/src/xml.c index b1175d1..1ef84bd 100644 --- a/src/xml.c +++ b/src/xml.c @@ -181,6 +181,7 @@ parse_region (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, Lisp_Object result = Qnil; const char *burl = ""; ptrdiff_t istart, iend, istart_byte, iend_byte; + unsigned char *buftext; xmlCheckVersion (LIBXML_VERSION); @@ -200,18 +201,24 @@ parse_region (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, burl = SSDATA (base_url); } + buftext = BYTE_POS_ADDR (istart_byte); if (htmlp) - doc = htmlReadMemory ((char *) BYTE_POS_ADDR (istart_byte), + doc = htmlReadMemory ((char *)buftext, iend_byte - istart_byte, burl, "utf-8", HTML_PARSE_RECOVER|HTML_PARSE_NONET| HTML_PARSE_NOWARNING|HTML_PARSE_NOERROR| HTML_PARSE_NOBLANKS); else - doc = xmlReadMemory ((char *) BYTE_POS_ADDR (istart_byte), + doc = xmlReadMemory ((char *)buftext, iend_byte - istart_byte, burl, "utf-8", XML_PARSE_NONET|XML_PARSE_NOWARNING| XML_PARSE_NOBLANKS |XML_PARSE_NOERROR); + /* If the assertion below fails, malloc was called inside the above + libxml2 functions, and ralloc.c caused relocation of buffer text, + so we could have read from unrelated memory. */ + eassert (buftext == BYTE_POS_ADDR (istart_byte)); + if (doc != NULL) { Lisp_Object r = Qnil; commit b8e8e1528829516ccce5ce0be8b97cdce0a86999 Author: Eli Zaretskii Date: Sun Oct 23 16:04:20 2016 +0300 Revert "* lisp/simple.el (process-menu-mode, list-processes--refresh):" This reverts commit a4285bcb1114e29200001f33af9b4802167d6140. Do not merge to master! diff --git a/lisp/simple.el b/lisp/simple.el index 6d36a88..8f5324f 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3749,7 +3749,6 @@ support pty association, if PROGRAM is nil." (define-derived-mode process-menu-mode tabulated-list-mode "Process Menu" "Major mode for listing the processes called by Emacs." (setq tabulated-list-format [("Process" 15 t) - ("PID" 7 t) ("Status" 7 t) ("Buffer" 15 t) ("TTY" 12 t) @@ -3776,7 +3775,6 @@ Also, delete any process that is exited or signaled." (process-query-on-exit-flag p)) (let* ((buf (process-buffer p)) (type (process-type p)) - (pid (if (process-id p) (format "%d" (process-id p)) "--")) (name (process-name p)) (status (symbol-name (process-status p))) (buf-label (if (buffer-live-p buf) @@ -3812,7 +3810,7 @@ Also, delete any process that is exited or signaled." (format " at %s b/s" speed) ""))))) (mapconcat 'identity (process-command p) " ")))) - (push (list p (vector name pid status buf-label tty cmd)) + (push (list p (vector name status buf-label tty cmd)) tabulated-list-entries)))))) (defun process-menu-visit-buffer (button) commit d784e75776795fbbe88c00819fe3551d3c50e0a0 Author: Eli Zaretskii Date: Sun Oct 23 16:03:25 2016 +0300 Revert "* lisp/ibuf-ext.el (ibuffer-do-shell-command-file):" This reverts commit b0c447e4668116cecfda91d0203cb7cac2486d92. Do not merge to master! diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 4443383..f537561 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -347,14 +347,10 @@ the mode if ARG is omitted or nil." :modifier-p nil) (shell-command (concat command " " (shell-quote-argument - (or buffer-file-name - (let ((file - (make-temp-file - (substring - (buffer-name) 0 - (min 10 (length (buffer-name))))))) - (write-region nil nil file nil 0) - file)))))) + (if buffer-file-name + buffer-file-name + (make-temp-file + (substring (buffer-name) 0 (min 10 (length (buffer-name)))))))))) ;;;###autoload (autoload 'ibuffer-do-eval "ibuf-ext") (define-ibuffer-op eval (form) commit 1dd7b54a7e7a0b2b4f3391f09960acc9866b7190 Author: Eli Zaretskii Date: Sun Oct 23 16:02:11 2016 +0300 Revert "* lisp/ibuffer.el (ibuffer): Improve 'other-window' case. (Bug#23617)" This reverts commit cf3c19b0298236293d9c56d5ba425af4f42c1f8e. Do not merge to master! diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 1295ed7..9d23e64 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -2336,8 +2336,7 @@ FORMATS is the value to use for `ibuffer-formats'. (setq other-window-p t)) (let ((buf (get-buffer-create (or name "*Ibuffer*")))) (if other-window-p - (or (and noselect (display-buffer buf t)) - (pop-to-buffer buf t)) + (funcall (if noselect (lambda (buf) (display-buffer buf t)) #'pop-to-buffer) buf) (funcall (if noselect #'display-buffer #'switch-to-buffer) buf)) (with-current-buffer buf (save-selected-window