1 ;;; xwidget.el --- api functions for xwidgets -*- lexical-binding: t -*-
3 ;; Copyright (C) 2011-2016 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 <http://www.gnu.org/licenses/>.
22 ;; --------------------------------------------------------------------
26 ;; See xwidget.c for more api functions
28 ;;TODO this breaks compilation when we dont have xwidgets
29 ;;(require 'xwidget-internal)
36 (defcustom xwidget-webkit-scroll-behaviour 'native
37 "Scroll behaviour of the webkit instance.
41 (defun xwidget-insert (pos type title width height &optional args)
42 "Insert an xwidget at POS.
43 given ID, TYPE, TITLE WIDTH and
44 HEIGHT in the current buffer.
48 see `make-xwidget' for types suitable for TYPE.
49 Optional argument ARGS usage depends on the xwidget."
51 (let ((id (make-xwidget (point) (point)
52 type title width height args)))
53 (put-text-property (point) (+ 1 (point))
54 'display (list 'xwidget ':xwidget id))
57 (defun xwidget-at (pos)
58 "Return xwidget at POS."
59 ;;TODO this function is a bit tedious because the C layer isnt well
60 ;;protected yet and xwidgetp aparently doesnt work yet
61 (let* ((disp (get-text-property pos 'display))
62 (xw (car (cdr (cdr disp)))))
63 ;;(if ( xwidgetp xw) xw nil)
64 (if (equal 'xwidget (car disp)) xw)))
68 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
71 (require 'image-mode);;for some image-mode alike functionality
74 (defun xwidget-webkit-browse-url (url &optional new-session)
75 "Ask xwidget-webkit to browse URL.
76 NEW-SESSION specifies whether to create a new xwidget-webkit session. URL
77 defaults to the string looking like a url around the cursor position."
80 (browse-url-interactive-arg "xwidget-webkit URL: "
81 ;;( xwidget-webkit-current-url)
85 (xwidget-webkit-new-session url)
86 (xwidget-webkit-goto-url url))))
89 ;;shims for adapting image mode code to the webkit browser window
90 (defun xwidget-image-display-size (spec &optional pixels frame)
91 "Image code adaptor. SPEC PIXELS FRAME like the corresponding
93 (let ((xwi (xwidget-info (xwidget-at 1))))
97 (defadvice image-display-size (around image-display-size-for-xwidget
98 (spec &optional pixels frame)
100 "Advice for re-using image mode for xwidget."
101 (if (eq (car spec) 'xwidget)
102 (setq ad-return-value (xwidget-image-display-size spec pixels frame))
106 ;; - check that the webkit support is compiled in
107 (defvar xwidget-webkit-mode-map
108 (let ((map (make-sparse-keymap)))
109 (define-key map "g" 'xwidget-webkit-browse-url)
110 (define-key map "a" 'xwidget-webkit-adjust-size-dispatch)
111 (define-key map "b" 'xwidget-webkit-back )
112 (define-key map "r" 'xwidget-webkit-reload )
113 (define-key map "t" (lambda () (interactive) (message "o")) )
114 (define-key map "\C-m" 'xwidget-webkit-insert-string)
115 (define-key map "w" 'xwidget-webkit-current-url)
117 ;;similar to image mode bindings
118 (define-key map (kbd "SPC") 'xwidget-webkit-scroll-up)
119 (define-key map (kbd "DEL") 'xwidget-webkit-scroll-down)
121 (define-key map [remap scroll-up] 'xwidget-webkit-scroll-up)
122 (define-key map [remap scroll-up-command] 'xwidget-webkit-scroll-up)
124 (define-key map [remap scroll-down] 'xwidget-webkit-scroll-down)
125 (define-key map [remap scroll-down-command] 'xwidget-webkit-scroll-down)
127 (define-key map [remap forward-char] 'xwidget-webkit-scroll-forward)
128 (define-key map [remap backward-char] 'xwidget-webkit-scroll-backward)
129 (define-key map [remap right-char] 'xwidget-webkit-scroll-forward)
130 (define-key map [remap left-char] 'xwidget-webkit-scroll-backward)
131 ;; (define-key map [remap previous-line] 'image-previous-line)
132 ;; (define-key map [remap next-line] 'image-next-line)
134 ;; (define-key map [remap move-beginning-of-line] 'image-bol)
135 ;; (define-key map [remap move-end-of-line] 'image-eol)
136 ;; (define-key map [remap beginning-of-buffer] 'image-bob)
137 ;; (define-key map [remap end-of-buffer] 'image-eob)
139 "Keymap for `xwidget-webkit-mode'.")
141 (defun xwidget-webkit-scroll-up ()
142 "Scroll webkit up,either native or like image mode."
144 (if (eq xwidget-webkit-scroll-behaviour 'native)
145 (xwidget-set-adjustment (xwidget-webkit-last-session) 'vertical t 50)
148 (defun xwidget-webkit-scroll-down ()
149 "Scroll webkit down,either native or like image mode."
151 (if (eq xwidget-webkit-scroll-behaviour 'native)
152 (xwidget-set-adjustment (xwidget-webkit-last-session) 'vertical t -50)
153 (image-scroll-down)))
155 (defun xwidget-webkit-scroll-forward ()
156 "Scroll webkit forward,either native or like image mode."
158 (if (eq xwidget-webkit-scroll-behaviour 'native)
159 (xwidget-set-adjustment (xwidget-webkit-last-session) 'horizontal t 50)
160 (xwidget-webkit-scroll-forward)))
162 (defun xwidget-webkit-scroll-backward ()
163 "Scroll webkit backward,either native or like image mode."
165 (if (eq xwidget-webkit-scroll-behaviour 'native)
166 (xwidget-set-adjustment (xwidget-webkit-last-session) 'horizontal t -50)
167 (xwidget-webkit-scroll-backward)))
170 ;;the xwidget event needs to go into a higher level handler
171 ;;since the xwidget can generate an event even if its offscreen
172 ;;TODO this needs to use callbacks and consider different xw ev types
173 (define-key (current-global-map) [xwidget-event] 'xwidget-event-handler)
174 (defun xwidget-log ( &rest msg)
175 "Log MSG to a buffer."
176 (let ( (buf (get-buffer-create "*xwidget-log*")))
178 (buffer-disable-undo buf)
180 (insert (apply 'format msg))
183 (defun xwidget-event-handler ()
184 "Receive xwidget event."
186 (xwidget-log "stuff happened to xwidget %S" last-input-event)
188 ((xwidget-event-type (nth 1 last-input-event))
189 (xwidget (nth 2 last-input-event))
190 ;;(xwidget-callback (xwidget-get xwidget 'callback))
191 ;;TODO stopped working for some reason
193 ;;(funcall xwidget-callback xwidget xwidget-event-type)
194 (message "xw callback %s" xwidget)
195 (funcall 'xwidget-webkit-callback xwidget xwidget-event-type)))
197 (defun xwidget-webkit-callback (xwidget xwidget-event-type)
198 "Callback for xwidgets.
199 XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget."
201 (cond ((buffer-live-p (xwidget-buffer xwidget))
202 (set-buffer (xwidget-buffer xwidget))
203 (let* ((strarg (nth 3 last-input-event)))
204 (cond ((eq xwidget-event-type 'document-load-finished)
205 (xwidget-log "webkit finished loading: '%s'"
206 (xwidget-webkit-get-title xwidget))
207 ;;TODO - check the native/internal scroll
208 ;;(xwidget-adjust-size-to-content xwidget)
209 (xwidget-webkit-adjust-size-dispatch) ;;TODO xwidget arg
210 (rename-buffer (format "*xwidget webkit: %s *"
211 (xwidget-webkit-get-title xwidget)))
212 (pop-to-buffer (current-buffer)))
213 ((eq xwidget-event-type
214 'navigation-policy-decision-requested)
215 (if (string-match ".*#\\(.*\\)" strarg)
216 (xwidget-webkit-show-id-or-named-element
218 (match-string 1 strarg))))
219 (t (xwidget-log "unhandled event:%s" xwidget-event-type)))))
221 "error: callback called for xwidget with dead buffer")))))
223 (defvar bookmark-make-record-function)
224 (define-derived-mode xwidget-webkit-mode
225 special-mode "xwidget-webkit" "xwidget webkit view mode"
226 (setq buffer-read-only t)
227 (setq-local bookmark-make-record-function
228 #'xwidget-webkit-bookmark-make-record)
229 ;; Keep track of [vh]scroll when switching buffers
230 (image-mode-setup-winprops))
232 (defun xwidget-webkit-bookmark-make-record ()
233 "Integrate Emacs bookmarks with the webkit xwidget."
234 (nconc (bookmark-make-record-default t t)
235 `((page . ,(xwidget-webkit-current-url))
236 (handler . (lambda (bmk) (browse-url
237 (bookmark-prop-get bmk 'page)))))))
240 (defvar xwidget-webkit-last-session-buffer nil)
242 (defun xwidget-webkit-last-session ()
243 "Last active webkit, or nil."
244 (if (buffer-live-p xwidget-webkit-last-session-buffer)
245 (with-current-buffer xwidget-webkit-last-session-buffer
249 (defun xwidget-webkit-current-session ()
250 "Either the webkit in the current buffer, or the last one used,
254 (xwidget-webkit-last-session)))
256 (defun xwidget-adjust-size-to-content (xw)
257 "Resize XW to content."
258 ;;xwidgets doesnt support widgets that have their own opinions about
259 ;;size well yet this reads the desired size and resizes the emacs
260 ;;allocated area accordingly
261 (let ((size (xwidget-size-request xw)))
262 (xwidget-resize xw (car size) (cadr size))))
265 (defvar xwidget-webkit-activeelement-js"
266 function findactiveelement(doc){
267 //alert(doc.activeElement.value);
268 if(doc.activeElement.value != undefined){
269 return doc.activeElement;
271 // recurse over the child documents:
272 var frames = doc.getElementsByTagName('frame');
273 for (var i = 0; i < frames.length; i++)
275 var d = frames[i].contentDocument;
276 var rv = findactiveelement(d);
288 "javascript that finds the active element."
289 ;;yes its ugly. because:
290 ;; - there is aparently no way to find the active frame other than recursion
291 ;; - the js "for each" construct missbehaved on the "frames" collection
292 ;; - a window with no frameset still has frames.length == 1, but
293 ;; frames[0].document.activeElement != document.activeElement
294 ;;TODO the activeelement type needs to be examined, for iframe, etc.
297 (defun xwidget-webkit-insert-string (xw str)
298 "Insert string in the active field in the webkit.
300 Argument STR string."
301 ;;read out the string in the field first and provide for edit
303 (let* ((xww (xwidget-webkit-current-session))
307 (xwidget-webkit-execute-script xww xwidget-webkit-activeelement-js)
308 (xwidget-webkit-execute-script-rv
310 "findactiveelement(document).value;" )))
311 (field-type (xwidget-webkit-execute-script-rv
313 "findactiveelement(document).type;" )))
315 (cond ((equal "text" field-type)
316 (read-string "text:" field-value))
317 ((equal "password" field-type)
318 (read-passwd "password:" nil field-value))
319 ((equal "textarea" field-type)
320 (xwidget-webkit-begin-edit-textarea xww field-value))))))
321 (xwidget-webkit-execute-script
323 (format "findactiveelement(document).value='%s'" str)))
325 (defvar xwidget-xwbl)
326 (defun xwidget-webkit-begin-edit-textarea (xw text)
327 "Start editing of a webkit text area.
328 XW is the xwidget identifier, TEXT is retrieved from the webkit."
330 (generate-new-buffer "textarea"))
332 (set (make-local-variable 'xwidget-xwbl) xw)
335 (defun xwidget-webkit-end-edit-textarea ()
336 "End editing of a webkit text area."
338 (goto-char (point-min))
339 (while (search-forward "\n" nil t)
340 (replace-match "\\n" nil t))
341 (xwidget-webkit-execute-script
343 (format "findactiveelement(document).value='%s'"
344 (buffer-substring (point-min) (point-max))))
345 ;;TODO convert linefeed to \n
348 (defun xwidget-webkit-show-named-element (xw element-name)
349 "Make named-element show. for instance an anchor.
350 Argument XW is the xwidget.
351 Argument ELEMENT-NAME is the element name to display in the webkit xwidget."
352 (interactive (list (xwidget-webkit-current-session)
353 (read-string "element name:")))
354 ;;TODO since an xwidget is an Emacs object, it is not trivial to do
355 ;; some things that are taken for granted in a normal browser.
356 ;; scrolling an anchor/named-element into view is one such thing.
357 ;; This function implements a proof-of-concept for this. Problems
358 ;; remaining: - The selected window is scrolled but this is not
359 ;; always correct - This needs to be interfaced into browse-url
360 ;; somehow. the tricky part is that we need to do this in two steps:
361 ;; A: load the base url, wait for load signal to arrive B: navigate
362 ;; to the anchor when the base url is finished rendering
364 ;; This part figures out the Y coordinate of the element
365 (let ((y (string-to-number
366 (xwidget-webkit-execute-script-rv
369 "document.getElementsByName('%s')[0].getBoundingClientRect().top"
372 ;; Now we need to tell emacs to scroll the element into view.
373 (xwidget-log "scroll: %d" y)
374 (set-window-vscroll (selected-window) y t)))
376 (defun xwidget-webkit-show-id-element (xw element-id)
377 "Make id-element show. for instance an anchor.
378 Argument XW is the webkit xwidget.
379 Argument ELEMENT-ID is the id of the element to show."
380 (interactive (list (xwidget-webkit-current-session)
381 (read-string "element id:")))
382 (let ((y (string-to-number
383 (xwidget-webkit-execute-script-rv
385 (format "document.getElementById('%s').getBoundingClientRect().top"
388 ;; Now we need to tell emacs to scroll the element into view.
389 (xwidget-log "scroll: %d" y)
390 (set-window-vscroll (selected-window) y t)))
392 (defun xwidget-webkit-show-id-or-named-element (xw element-id)
393 "Make id-element show. for instance an anchor.
394 Argument XW is the webkit xwidget.
395 Argument ELEMENT-ID is either a name or an element id."
396 (interactive (list (xwidget-webkit-current-session)
397 (read-string "element id:")))
398 (let* ((y1 (string-to-number
399 (xwidget-webkit-execute-script-rv
401 (format "document.getElementsByName('%s')[0].getBoundingClientRect().top" element-id)
403 (y2 (string-to-number
404 (xwidget-webkit-execute-script-rv
406 (format "document.getElementById('%s').getBoundingClientRect().top" element-id)
409 ;; Now we need to tell emacs to scroll the element into view.
410 (xwidget-log "scroll: %d" y3)
411 (set-window-vscroll (selected-window) y3 t)))
413 (defun xwidget-webkit-adjust-size-to-content ()
414 "Adjust webkit to content size."
416 (xwidget-adjust-size-to-content (xwidget-webkit-current-session)))
418 (defun xwidget-webkit-adjust-size-dispatch ()
419 "Adjust size according to mode."
421 (if (eq xwidget-webkit-scroll-behaviour 'native)
422 (xwidget-webkit-adjust-size-to-window)
423 (xwidget-webkit-adjust-size-to-content))
424 ;; The recenter is intended to correct a visual glitch.
425 ;; It errors out if the buffer isn't visible, but then we dont get the glitch,
428 (recenter-top-bottom))
431 (defun xwidget-webkit-adjust-size-to-window ()
432 "Adjust webkit to window."
434 (xwidget-resize ( xwidget-webkit-current-session) (window-pixel-width)
435 (window-pixel-height)))
437 (defun xwidget-webkit-adjust-size (w h)
438 "Manualy set webkit size.
441 ;; TODO shouldn't be tied to the webkit xwidget
442 (interactive "nWidth:\nnHeight:\n")
443 (xwidget-resize ( xwidget-webkit-current-session) w h))
445 (defun xwidget-webkit-fit-width ()
446 "Adjust width of webkit to window width."
448 (xwidget-webkit-adjust-size (- (nth 2 (window-inside-pixel-edges))
449 (car (window-inside-pixel-edges)))
452 (defun xwidget-webkit-new-session (url)
453 "Create a new webkit session buffer with URL."
455 ((bufname (generate-new-buffer-name "*xwidget-webkit*"))
457 (setq xwidget-webkit-last-session-buffer (switch-to-buffer
458 (get-buffer-create bufname)))
459 (insert " 'a' adjusts the xwidget size.")
460 (setq xw (xwidget-insert 1 'webkit-osr bufname 1000 1000))
461 (xwidget-put xw 'callback 'xwidget-webkit-callback)
462 (xwidget-webkit-mode)
463 (xwidget-webkit-goto-uri (xwidget-webkit-last-session) url )))
466 (defun xwidget-webkit-goto-url (url)
468 (if (xwidget-webkit-current-session)
470 (xwidget-webkit-goto-uri (xwidget-webkit-current-session) url))
471 (xwidget-webkit-new-session url)))
473 (defun xwidget-webkit-back ()
476 (xwidget-webkit-execute-script (xwidget-webkit-current-session)
479 (defun xwidget-webkit-reload ()
480 "Reload current url."
482 (xwidget-webkit-execute-script (xwidget-webkit-current-session)
485 (defun xwidget-webkit-current-url ()
486 "Get the webkit url. place it on kill ring."
488 (let* ((rv (xwidget-webkit-execute-script-rv (xwidget-webkit-current-session)
490 (url (kill-new (or rv ""))))
491 (message "url: %s" url )
494 (defun xwidget-webkit-execute-script-rv (xw script &optional default)
495 "Same as 'xwidget-webkit-execute-script' but but with return value.
496 XW is the webkit instance. SCRIPT is the script to execut.
497 DEFAULT is the defaultreturn value."
498 ;; Notice the ugly "title" hack. It is needed because the Webkit
499 ;; API at the time of writing didn't support returning values. This
500 ;; is a wrapper for the title hack so its easy to remove should
501 ;; Webkit someday support JS return values or we find some other way
502 ;; to access the DOM.
504 ;; Reset webkit title. Not very nice.
505 (let* ((emptytag "titlecantbewhitespaceohthehorror")
507 (xwidget-webkit-execute-script xw (format "document.title=\"%s\";"
508 (or default emptytag)))
509 (xwidget-webkit-execute-script xw (format "document.title=%s;" script))
510 (setq title (xwidget-webkit-get-title xw))
511 (if (equal emptytag title)
514 (setq title default))
519 ;; (declare-function xwidget-resize-internal "xwidget.c" )
520 ;; check-declare-function?
522 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
523 (defun xwidget-webkit-get-selection ()
524 "Get the webkit selection."
525 (xwidget-webkit-execute-script-rv (xwidget-webkit-current-session)
526 "window.getSelection().toString();"))
528 (defun xwidget-webkit-copy-selection-as-kill ()
529 "Get the webkit selection and put it on the kill ring."
531 (kill-new (xwidget-webkit-get-selection)))
534 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
535 ;; Xwidget plist management(similar to the process plist functions)
537 (defun xwidget-get (xwidget propname)
538 "Return the value of XWIDGET' PROPNAME property.
539 This is the last value stored with `(xwidget-put XWIDGET PROPNAME VALUE)'."
540 (plist-get (xwidget-plist xwidget) propname))
542 (defun xwidget-put (xwidget propname value)
543 "Change XWIDGET' PROPNAME property to VALUE.
544 It can be retrieved with `(xwidget-get XWIDGET PROPNAME)'."
545 (set-xwidget-plist xwidget
546 (plist-put (xwidget-plist xwidget) propname value)))
549 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
551 (defun xwidget-delete-zombies ()
552 "Helper for `xwidget-cleanup'."
553 (dolist (xwidget-view xwidget-view-list)
554 (when (or (not (window-live-p (xwidget-view-window xwidget-view)))
555 (not (memq (xwidget-view-model xwidget-view)
557 (delete-xwidget-view xwidget-view))))
559 (defun xwidget-cleanup ()
560 "Delete zombie xwidgets."
561 ;; During development it was sometimes easy to wind up with zombie
562 ;; xwidget instances.
563 ;; This function tries to implement a workaround should it occur again.
565 ;; Kill xviews who should have been deleted but stull linger.
566 (xwidget-delete-zombies)
567 ;; Redraw display otherwise ghost of zombies will remain to haunt the screen
570 ;; This would have felt better in C, but this seems to work well in
572 (add-hook 'window-configuration-change-hook 'xwidget-delete-zombies)
574 (defun xwidget-kill-buffer-query-function ()
575 "Ask beforek illing a buffer that has xwidgets."
576 (let ((xwidgets (get-buffer-xwidgets (current-buffer))))
578 (not (memq t (mapcar 'xwidget-query-on-exit-flag xwidgets)))
580 (format "Buffer %S has xwidgets; kill it? "
581 (buffer-name (current-buffer)))))))
583 (add-hook 'kill-buffer-query-functions 'xwidget-kill-buffer-query-function)
587 ;;; xwidget.el ends here