1 ;;; xwidget.el --- api functions for xwidgets -*- lexical-binding: t -*-
3 ;; Copyright (C) 2011-2017 Free Software Foundation, Inc.
5 ;; Author: Joakim Verona (joakim@verona.se)
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software: you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
22 ;; --------------------------------------------------------------------
26 ;; See xwidget.c for more api functions.
28 ;; This breaks compilation when we don't have xwidgets.
29 ;; And is pointless when we do, since it's in C and so preloaded.
30 ;;(require 'xwidget-internal)
37 (declare-function make-xwidget
"xwidget.c"
38 (type title width height arguments
&optional buffer
))
39 (declare-function xwidget-buffer
"xwidget.c" (xwidget))
40 (declare-function xwidget-size-request
"xwidget.c" (xwidget))
41 (declare-function xwidget-resize
"xwidget.c" (xwidget new-width new-height
))
42 (declare-function xwidget-webkit-execute-script
"xwidget.c"
43 (xwidget script
&optional callback
))
44 (declare-function xwidget-webkit-goto-uri
"xwidget.c" (xwidget uri
))
45 (declare-function xwidget-webkit-zoom
"xwidget.c" (xwidget factor
))
46 (declare-function xwidget-plist
"xwidget.c" (xwidget))
47 (declare-function set-xwidget-plist
"xwidget.c" (xwidget plist
))
48 (declare-function xwidget-view-window
"xwidget.c" (xwidget-view))
49 (declare-function xwidget-view-model
"xwidget.c" (xwidget-view))
50 (declare-function delete-xwidget-view
"xwidget.c" (xwidget-view))
51 (declare-function get-buffer-xwidgets
"xwidget.c" (buffer))
52 (declare-function xwidget-query-on-exit-flag
"xwidget.c" (xwidget))
54 (defun xwidget-insert (pos type title width height
&optional args
)
55 "Insert an xwidget at position POS.
56 Supply the xwidget's TYPE, TITLE, WIDTH, and HEIGHT.
57 See `make-xwidget' for the possible TYPE values.
58 The usage of optional argument ARGS depends on the xwidget.
59 This returns the result of `make-xwidget'."
61 (let ((id (make-xwidget type title width height args
)))
62 (put-text-property (point) (+ 1 (point))
63 'display
(list 'xwidget
':xwidget id
))
66 (defun xwidget-at (pos)
67 "Return xwidget at POS."
68 ;; TODO this function is a bit tedious because the C layer isn't well
69 ;; protected yet and xwidgetp apparently doesn't work yet.
70 (let* ((disp (get-text-property pos
'display
))
71 (xw (car (cdr (cdr disp
)))))
72 ;;(if (xwidgetp xw) xw nil)
73 (if (equal 'xwidget
(car disp
)) xw
)))
77 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
80 (require 'image-mode
);;for some image-mode alike functionality
83 (defun xwidget-webkit-browse-url (url &optional new-session
)
84 "Ask xwidget-webkit to browse URL.
85 NEW-SESSION specifies whether to create a new xwidget-webkit session.
86 Interactively, URL defaults to the string looking like a url around point."
89 (browse-url-interactive-arg "xwidget-webkit URL: "
90 ;;(xwidget-webkit-current-url)
92 (or (featurep 'xwidget-internal
)
93 (user-error "Your Emacs was not compiled with xwidgets support"))
96 (xwidget-webkit-new-session url
)
97 (xwidget-webkit-goto-url url
))))
100 ;; - check that the webkit support is compiled in
101 (defvar xwidget-webkit-mode-map
102 (let ((map (make-sparse-keymap)))
103 (define-key map
"g" 'xwidget-webkit-browse-url
)
104 (define-key map
"a" 'xwidget-webkit-adjust-size-dispatch
)
105 (define-key map
"b" 'xwidget-webkit-back
)
106 (define-key map
"r" 'xwidget-webkit-reload
)
107 (define-key map
"t" (lambda () (interactive) (message "o"))) ;FIXME: ?!?
108 (define-key map
"\C-m" 'xwidget-webkit-insert-string
)
109 (define-key map
"w" 'xwidget-webkit-current-url
)
110 (define-key map
"+" 'xwidget-webkit-zoom-in
)
111 (define-key map
"-" 'xwidget-webkit-zoom-out
)
113 ;;similar to image mode bindings
114 (define-key map
(kbd "SPC") 'xwidget-webkit-scroll-up
)
115 (define-key map
(kbd "DEL") 'xwidget-webkit-scroll-down
)
117 (define-key map
[remap scroll-up
] 'xwidget-webkit-scroll-up
)
118 (define-key map
[remap scroll-up-command
] 'xwidget-webkit-scroll-up
)
120 (define-key map
[remap scroll-down
] 'xwidget-webkit-scroll-down
)
121 (define-key map
[remap scroll-down-command
] 'xwidget-webkit-scroll-down
)
123 (define-key map
[remap forward-char
] 'xwidget-webkit-scroll-forward
)
124 (define-key map
[remap backward-char
] 'xwidget-webkit-scroll-backward
)
125 (define-key map
[remap right-char
] 'xwidget-webkit-scroll-forward
)
126 (define-key map
[remap left-char
] 'xwidget-webkit-scroll-backward
)
127 (define-key map
[remap previous-line
] 'xwidget-webkit-scroll-down
)
128 (define-key map
[remap next-line
] 'xwidget-webkit-scroll-up
)
130 ;; (define-key map [remap move-beginning-of-line] 'image-bol)
131 ;; (define-key map [remap move-end-of-line] 'image-eol)
132 (define-key map
[remap beginning-of-buffer
] 'xwidget-webkit-scroll-top
)
133 (define-key map
[remap end-of-buffer
] 'xwidget-webkit-scroll-bottom
)
135 "Keymap for `xwidget-webkit-mode'.")
137 (defun xwidget-webkit-zoom-in ()
138 "Increase webkit view zoom factor."
140 (xwidget-webkit-zoom (xwidget-webkit-current-session) 0.1))
142 (defun xwidget-webkit-zoom-out ()
143 "Decrease webkit view zoom factor."
145 (xwidget-webkit-zoom (xwidget-webkit-current-session) -
0.1))
147 (defun xwidget-webkit-scroll-up ()
150 (xwidget-webkit-execute-script
151 (xwidget-webkit-current-session)
152 "window.scrollBy(0, 50);"))
154 (defun xwidget-webkit-scroll-down ()
155 "Scroll webkit down."
157 (xwidget-webkit-execute-script
158 (xwidget-webkit-current-session)
159 "window.scrollBy(0, -50);"))
161 (defun xwidget-webkit-scroll-forward ()
162 "Scroll webkit forwards."
164 (xwidget-webkit-execute-script
165 (xwidget-webkit-current-session)
166 "window.scrollBy(50, 0);"))
168 (defun xwidget-webkit-scroll-backward ()
169 "Scroll webkit backwards."
171 (xwidget-webkit-execute-script
172 (xwidget-webkit-current-session)
173 "window.scrollBy(-50, 0);"))
175 (defun xwidget-webkit-scroll-top ()
176 "Scroll webkit to the very top."
178 (xwidget-webkit-execute-script
179 (xwidget-webkit-current-session)
180 "window.scrollTo(pageXOffset, 0);"))
182 (defun xwidget-webkit-scroll-bottom ()
183 "Scroll webkit to the very bottom."
185 (xwidget-webkit-execute-script
186 (xwidget-webkit-current-session)
187 "window.scrollTo(pageXOffset, window.document.body.clientHeight);"))
189 ;; The xwidget event needs to go into a higher level handler
190 ;; since the xwidget can generate an event even if it's offscreen.
191 ;; TODO this needs to use callbacks and consider different xwidget event types.
192 (define-key (current-global-map) [xwidget-event
] #'xwidget-event-handler
)
193 (defun xwidget-log (&rest msg
)
194 "Log MSG to a buffer."
195 (let ((buf (get-buffer-create " *xwidget-log*")))
196 (with-current-buffer buf
197 (insert (apply #'format msg
))
200 (defun xwidget-event-handler ()
201 "Receive xwidget event."
203 (xwidget-log "stuff happened to xwidget %S" last-input-event
)
205 ((xwidget-event-type (nth 1 last-input-event
))
206 (xwidget (nth 2 last-input-event
))
207 ;;(xwidget-callback (xwidget-get xwidget 'callback))
208 ;;TODO stopped working for some reason
210 ;;(funcall xwidget-callback xwidget xwidget-event-type)
211 (message "xw callback %s" xwidget
)
212 (funcall 'xwidget-webkit-callback xwidget xwidget-event-type
)))
214 (defun xwidget-webkit-callback (xwidget xwidget-event-type
)
215 "Callback for xwidgets.
216 XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget."
217 (if (not (buffer-live-p (xwidget-buffer xwidget
)))
219 "error: callback called for xwidget with dead buffer")
220 (with-current-buffer (xwidget-buffer xwidget
)
221 (cond ((eq xwidget-event-type
'load-changed
)
222 (xwidget-webkit-execute-script
223 xwidget
"document.title"
225 (xwidget-log "webkit finished loading: '%s'" title
)
226 ;;TODO - check the native/internal scroll
227 ;;(xwidget-adjust-size-to-content xwidget)
228 (xwidget-webkit-adjust-size-to-window xwidget
)
229 (rename-buffer (format "*xwidget webkit: %s *" title
))))
230 (pop-to-buffer (current-buffer)))
231 ((eq xwidget-event-type
'decide-policy
)
232 (let ((strarg (nth 3 last-input-event
)))
233 (if (string-match ".*#\\(.*\\)" strarg
)
234 (xwidget-webkit-show-id-or-named-element
236 (match-string 1 strarg
)))))
237 ((eq xwidget-event-type
'javascript-callback
)
238 (let ((proc (nth 3 last-input-event
))
239 (arg (nth 4 last-input-event
)))
241 (t (xwidget-log "unhandled event:%s" xwidget-event-type
))))))
243 (defvar bookmark-make-record-function
)
244 (define-derived-mode xwidget-webkit-mode
245 special-mode
"xwidget-webkit" "Xwidget webkit view mode."
246 (setq buffer-read-only t
)
247 (setq-local bookmark-make-record-function
248 #'xwidget-webkit-bookmark-make-record
)
249 ;; Keep track of [vh]scroll when switching buffers
250 (image-mode-setup-winprops))
252 (defun xwidget-webkit-bookmark-make-record ()
253 "Integrate Emacs bookmarks with the webkit xwidget."
254 (nconc (bookmark-make-record-default t t
)
255 `((page .
,(xwidget-webkit-current-url))
256 (handler .
(lambda (bmk) (browse-url
257 (bookmark-prop-get bmk
'page
)))))))
260 (defvar xwidget-webkit-last-session-buffer nil
)
262 (defun xwidget-webkit-last-session ()
263 "Last active webkit, or nil."
264 (if (buffer-live-p xwidget-webkit-last-session-buffer
)
265 (with-current-buffer xwidget-webkit-last-session-buffer
266 (xwidget-at (point-min)))
269 (defun xwidget-webkit-current-session ()
270 "Either the webkit in the current buffer, or the last one used.
271 The latter might be nil."
272 (or (xwidget-at (point-min)) (xwidget-webkit-last-session)))
274 (defun xwidget-adjust-size-to-content (xw)
275 "Resize XW to content."
276 ;; xwidgets doesn't support widgets that have their own opinions about
277 ;; size well, yet this reads the desired size and resizes the Emacs
278 ;; allocated area accordingly.
279 (let ((size (xwidget-size-request xw
)))
280 (xwidget-resize xw
(car size
) (cadr size
))))
283 (defvar xwidget-webkit-activeelement-js
"
284 function findactiveelement(doc){
285 //alert(doc.activeElement.value);
286 if(doc.activeElement.value != undefined){
287 return doc.activeElement;
289 // recurse over the child documents:
290 var frames = doc.getElementsByTagName('frame');
291 for (var i = 0; i < frames.length; i++)
293 var d = frames[i].contentDocument;
294 var rv = findactiveelement(d);
306 "javascript that finds the active element."
307 ;; Yes it's ugly, because:
308 ;; - there is apparently no way to find the active frame other than recursion
309 ;; - the js "for each" construct misbehaved on the "frames" collection
310 ;; - a window with no frameset still has frames.length == 1, but
311 ;; frames[0].document.activeElement != document.activeElement
312 ;;TODO the activeelement type needs to be examined, for iframe, etc.
315 (defun xwidget-webkit-insert-string ()
316 "Prompt for a string and insert it in the active field in the
317 current webkit widget."
318 ;; Read out the string in the field first and provide for edit.
320 (let ((xww (xwidget-webkit-current-session)))
321 (xwidget-webkit-execute-script
323 (concat xwidget-webkit-activeelement-js
"
325 var res = findactiveelement(document);
326 return [res.value, res.type];
329 (let ((str (pcase field
331 (read-string "Text: " val
))
333 (read-passwd "Password: " nil val
))
335 (xwidget-webkit-begin-edit-textarea xww val
)))))
336 (xwidget-webkit-execute-script
338 (format "findactiveelement(document).value='%s'" str
)))))))
340 (defvar xwidget-xwbl
)
341 (defun xwidget-webkit-begin-edit-textarea (xw text
)
342 "Start editing of a webkit text area.
343 XW is the xwidget identifier, TEXT is retrieved from the webkit."
345 (generate-new-buffer "textarea"))
346 (set (make-local-variable 'xwidget-xwbl
) xw
)
349 (defun xwidget-webkit-end-edit-textarea ()
350 "End editing of a webkit text area."
352 (goto-char (point-min))
353 (while (search-forward "\n" nil t
)
354 (replace-match "\\n" nil t
))
355 (xwidget-webkit-execute-script
357 (format "findactiveelement(document).value='%s'"
358 (buffer-substring (point-min) (point-max))))
359 ;;TODO convert linefeed to \n
362 (defun xwidget-webkit-show-element (xw element-selector
)
363 "Make webkit xwidget XW show a named element ELEMENT-SELECTOR.
364 The ELEMENT-SELECTOR must be a valid CSS selector. For example,
365 use this to display an anchor."
366 (interactive (list (xwidget-webkit-current-session)
367 (read-string "Element selector: ")))
368 (xwidget-webkit-execute-script
372 var el = document.querySelector(query);
374 window.scrollTo(0, el.offsetTop);
379 (defun xwidget-webkit-show-named-element (xw element-name
)
380 "Make webkit xwidget XW show a named element ELEMENT-NAME.
381 For example, use this to display an anchor."
382 (interactive (list (xwidget-webkit-current-session)
383 (read-string "Element name: ")))
384 ;; TODO: This needs to be interfaced into browse-url somehow. The
385 ;; tricky part is that we need to do this in two steps: A: load the
386 ;; base url, wait for load signal to arrive B: navigate to the
387 ;; anchor when the base url is finished rendering
388 (xwidget-webkit-execute-script
392 var el = document.getElementsByName(query)[0];
393 if (el !== undefined) {
394 window.scrollTo(0, el.offsetTop);
399 (defun xwidget-webkit-show-id-element (xw element-id
)
400 "Make webkit xwidget XW show an id-element ELEMENT-ID.
401 For example, use this to display an anchor."
402 (interactive (list (xwidget-webkit-current-session)
403 (read-string "Element id: ")))
404 (xwidget-webkit-execute-script
408 var el = document.getElementById(query);
410 window.scrollTo(0, el.offsetTop);
415 (defun xwidget-webkit-show-id-or-named-element (xw element-id
)
416 "Make webkit xwidget XW show a name or element id ELEMENT-ID.
417 For example, use this to display an anchor."
418 (interactive (list (xwidget-webkit-current-session)
419 (read-string "Name or element id: ")))
420 (xwidget-webkit-execute-script
424 var el = document.getElementById(query) ||
425 document.getElementsByName(query)[0];
426 if (el !== undefined) {
427 window.scrollTo(0, el.offsetTop);
432 (defun xwidget-webkit-adjust-size-to-content ()
433 "Adjust webkit to content size."
435 (xwidget-adjust-size-to-content (xwidget-webkit-current-session)))
437 (defun xwidget-webkit-adjust-size-dispatch ()
438 "Adjust size according to mode."
440 (xwidget-webkit-adjust-size-to-window (xwidget-webkit-current-session))
441 ;; The recenter is intended to correct a visual glitch.
442 ;; It errors out if the buffer isn't visible, but then we don't get
443 ;; the glitch, so silence errors.
445 (recenter-top-bottom)))
447 (defun xwidget-webkit-adjust-size-to-window (xwidget &optional window
)
448 "Adjust the size of the webkit XWIDGET to fit the WINDOW."
449 (xwidget-resize xwidget
450 (window-pixel-width window
)
451 (window-pixel-height window
)))
453 (defun xwidget-webkit-adjust-size (w h
)
454 "Manually set webkit size to width W, height H."
455 ;; TODO shouldn't be tied to the webkit xwidget
456 (interactive "nWidth:\nnHeight:\n")
457 (xwidget-resize (xwidget-webkit-current-session) w h
))
459 (defun xwidget-webkit-fit-width ()
460 "Adjust width of webkit to window width."
462 (xwidget-webkit-adjust-size (- (nth 2 (window-inside-pixel-edges))
463 (car (window-inside-pixel-edges)))
466 (defun xwidget-webkit-auto-adjust-size (window)
467 "Adjust the size of the webkit widget in the given WINDOW."
468 (with-current-buffer (window-buffer window
)
469 (when (eq major-mode
'xwidget-webkit-mode
)
470 (let ((xwidget (xwidget-webkit-current-session)))
471 (xwidget-webkit-adjust-size-to-window xwidget window
)))))
473 (defun xwidget-webkit-adjust-size-in-frame (frame)
474 "Dynamically adjust webkit widget for all windows of the FRAME."
475 (walk-windows 'xwidget-webkit-auto-adjust-size
'no-minibuf frame
))
477 (eval-after-load 'xwidget-webkit-mode
478 (add-to-list 'window-size-change-functions
479 'xwidget-webkit-adjust-size-in-frame
))
481 (defun xwidget-webkit-new-session (url)
482 "Create a new webkit session buffer with URL."
484 ((bufname (generate-new-buffer-name "*xwidget-webkit*"))
486 (setq xwidget-webkit-last-session-buffer
(switch-to-buffer
487 (get-buffer-create bufname
)))
488 ;; The xwidget id is stored in a text property, so we need to have
489 ;; at least character in this buffer.
491 (setq xw
(xwidget-insert 1 'webkit bufname
493 (window-pixel-height)))
494 (xwidget-put xw
'callback
'xwidget-webkit-callback
)
495 (xwidget-webkit-mode)
496 (xwidget-webkit-goto-uri (xwidget-webkit-last-session) url
)))
499 (defun xwidget-webkit-goto-url (url)
501 (if (xwidget-webkit-current-session)
503 (xwidget-webkit-goto-uri (xwidget-webkit-current-session) url
))
504 (xwidget-webkit-new-session url
)))
506 (defun xwidget-webkit-back ()
507 "Go back in history."
509 (xwidget-webkit-execute-script (xwidget-webkit-current-session)
512 (defun xwidget-webkit-reload ()
513 "Reload current url."
515 (xwidget-webkit-execute-script (xwidget-webkit-current-session)
518 (defun xwidget-webkit-current-url ()
519 "Get the webkit url and place it on the kill-ring."
521 (xwidget-webkit-execute-script
522 (xwidget-webkit-current-session)
523 "document.URL" (lambda (rv)
524 (let ((url (kill-new (or rv
""))))
525 (message "url: %s" url
)))))
527 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
528 (defun xwidget-webkit-get-selection (proc)
529 "Get the webkit selection and pass it to PROC."
530 (xwidget-webkit-execute-script
531 (xwidget-webkit-current-session)
532 "window.getSelection().toString();"
535 (defun xwidget-webkit-copy-selection-as-kill ()
536 "Get the webkit selection and put it on the kill-ring."
538 (xwidget-webkit-get-selection (lambda (selection) (kill-new selection
))))
541 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
542 ;; Xwidget plist management (similar to the process plist functions)
544 (defun xwidget-get (xwidget propname
)
545 "Get an xwidget's property value.
546 XWIDGET is an xwidget, PROPNAME a property.
547 Returns the last value stored with `xwidget-put'."
548 (plist-get (xwidget-plist xwidget
) propname
))
550 (defun xwidget-put (xwidget propname value
)
551 "Set an xwidget's property value.
552 XWIDGET is an xwidget, PROPNAME a property to be set to specified VALUE.
553 You can retrieve the value with `xwidget-get'."
554 (set-xwidget-plist xwidget
555 (plist-put (xwidget-plist xwidget
) propname value
)))
558 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
560 (defvar xwidget-view-list
) ; xwidget.c
561 (defvar xwidget-list
) ; xwidget.c
563 (defun xwidget-delete-zombies ()
564 "Helper for `xwidget-cleanup'."
565 (dolist (xwidget-view xwidget-view-list
)
566 (when (or (not (window-live-p (xwidget-view-window xwidget-view
)))
567 (not (memq (xwidget-view-model xwidget-view
)
569 (delete-xwidget-view xwidget-view
))))
571 (defun xwidget-cleanup ()
572 "Delete zombie xwidgets."
573 ;; During development it was sometimes easy to wind up with zombie
574 ;; xwidget instances.
575 ;; This function tries to implement a workaround should it occur again.
577 ;; Kill xviews that should have been deleted but still linger.
578 (xwidget-delete-zombies)
579 ;; Redraw display otherwise ghost of zombies will remain to haunt the screen
582 (defun xwidget-kill-buffer-query-function ()
583 "Ask before killing a buffer that has xwidgets."
584 (let ((xwidgets (get-buffer-xwidgets (current-buffer))))
586 (not (memq t
(mapcar #'xwidget-query-on-exit-flag xwidgets
)))
588 (format "Buffer %S has xwidgets; kill it? " (buffer-name))))))
590 (when (featurep 'xwidget-internal
)
591 (add-hook 'kill-buffer-query-functions
#'xwidget-kill-buffer-query-function
)
592 ;; This would have felt better in C, but this seems to work well in
594 (add-hook 'window-configuration-change-hook
#'xwidget-delete-zombies
))
597 ;;; xwidget.el ends here