1 ;;; xwidget.el --- api functions for xwidgets
2 ;; see xwidget.c for more api functions
8 ;;TODO this breaks compilation when we dont have xwidgets
9 ;;(require 'xwidget-internal)
11 ;;TODO model after make-text-button instead!
14 (eval-when-compile (require 'cl))
17 (defcustom xwidget-webkit-scroll-behaviour 'native
18 "Scroll behaviour of the webkit instance.
22 (defun xwidget-insert (pos type title width height)
23 "Insert an xwidget at POS.
24 given ID, TYPE, TITLE WIDTH and
25 HEIGHT in the current buffer.
29 see `make-xwidget' for types suitable for TYPE."
31 (let ((id (make-xwidget (point) (point)
32 type title width height nil)))
33 (put-text-property (point) (+ 1 (point))
34 'display (list 'xwidget ':xwidget id))
37 (defun xwidget-at (pos)
38 "Return xwidget at POS."
39 ;;TODO this function is a bit tedious because the C layer isnt well protected yet and
40 ;;xwidgetp aparently doesnt work yet
41 (let* ((disp (get-text-property pos 'display))
42 (xw (car (cdr (cdr disp)))))
43 ;;(if ( xwidgetp xw) xw nil)
44 (if (equal 'xwidget (car disp)) xw)))
47 ;; (defun xwidget-socket-handler ()
48 ;; "Create plug for socket. TODO."
50 ;; (message "socket handler xwidget %S" last-input-event)
52 ;; ((xwidget-event-type (nth 2 last-input-event))
53 ;; (xwidget-id (nth 1 last-input-event)))
54 ;; (cond ( (eq xwidget-event-type 'xembed-ready)
56 ;; ((xembed-id (nth 3 last-input-event)))
57 ;; (message "xembed ready event: %S xw-id:%s" xembed-id xwidget-id)
58 ;; ;;TODO fetch process data from the xwidget. create it, store process info
59 ;; ;;will start emacs/uzbl in a xembed socket when its ready
61 ;; ;; ((eq 3 xwidget-id)
62 ;; ;; (start-process "xembed" "*xembed*" (format "%ssrc/emacs" default-directory) "-q" "--parent-id" (number-to-string xembed-id) ) )
63 ;; ;; ((eq 5 xwidget-id)
64 ;; ;; (start-process "xembed2" "*xembed2*" "uzbl-core" "-s" (number-to-string xembed-id) "http://www.fsf.org" ) )
67 (defun xwidget-display (xwidget)
68 "Force XWIDGET to be displayed to create a xwidget_view.
69 Return the window displaying XWIDGET."
70 (let* ((buffer (xwidget-buffer xwidget))
71 (window (display-buffer buffer))
72 (frame (window-frame window)))
73 (set-frame-visible frame t)
78 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
81 (require 'image-mode);;for some image-mode alike functionality
82 (require 'cl-macs);;for flet
85 (defun xwidget-webkit-browse-url (url &optional new-session)
86 "Ask xwidget-webkit to browse URL.
87 NEW-SESSION specifies whether to create a new xwidget-webkit session. URL
88 defaults to the string looking like a url around the cursor position."
91 (browse-url-interactive-arg "xwidget-webkit URL: "
92 ;;( xwidget-webkit-current-url)
95 (setq url (url-tidy url))
97 (xwidget-webkit-new-session url)
98 (xwidget-webkit-goto-url url))))
101 ;;shims for adapting image mode code to the webkit browser window
102 (defun xwidget-image-display-size (spec &optional pixels frame)
103 "Image code adaptor. SPEC PIXELS FRAME like the corresponding `image-mode' fn."
104 (let ((xwi (xwidget-info (xwidget-at 1))))
108 (defadvice image-display-size (around image-display-size-for-xwidget
109 (spec &optional pixels frame)
111 "Advice for re-using image mode for xwidget."
112 (if (eq (car spec) 'xwidget)
113 (setq ad-return-value (xwidget-image-display-size spec pixels frame))
117 ;; - check that the webkit support is compiled in
118 (defvar xwidget-webkit-mode-map
119 (let ((map (make-sparse-keymap)))
120 (define-key map "g" 'xwidget-webkit-browse-url)
121 (define-key map "a" 'xwidget-webkit-adjust-size-dispatch)
122 (define-key map "b" 'xwidget-webkit-back )
123 (define-key map "r" 'xwidget-webkit-reload )
124 (define-key map "t" (lambda () (interactive) (message "o")) )
125 (define-key map "\C-m" 'xwidget-webkit-insert-string)
126 (define-key map "w" 'xwidget-webkit-current-url)
128 ;;similar to image mode bindings
129 (define-key map (kbd "SPC") 'xwidget-webkit-scroll-up)
130 (define-key map (kbd "DEL") 'xwidget-webkit-scroll-down)
132 (define-key map [remap scroll-up] 'xwidget-webkit-scroll-up)
133 (define-key map [remap scroll-up-command] 'xwidget-webkit-scroll-up)
135 (define-key map [remap scroll-down] 'xwidget-webkit-scroll-down)
136 (define-key map [remap scroll-down-command] 'xwidget-webkit-scroll-down)
138 (define-key map [remap forward-char] 'xwidget-webkit-scroll-forward)
139 (define-key map [remap backward-char] 'xwidget-webkit-scroll-backward)
140 (define-key map [remap right-char] 'xwidget-webkit-scroll-forward)
141 (define-key map [remap left-char] 'xwidget-webkit-scroll-backward)
142 ;; (define-key map [remap previous-line] 'image-previous-line)
143 ;; (define-key map [remap next-line] 'image-next-line)
145 ;; (define-key map [remap move-beginning-of-line] 'image-bol)
146 ;; (define-key map [remap move-end-of-line] 'image-eol)
147 ;; (define-key map [remap beginning-of-buffer] 'image-bob)
148 ;; (define-key map [remap end-of-buffer] 'image-eob)
150 "Keymap for `xwidget-webkit-mode'.")
152 (defun xwidget-webkit-scroll-up ()
153 "Scroll webkit up,either native or like image mode."
155 (if (eq xwidget-webkit-scroll-behaviour 'native)
156 (xwidget-set-adjustment (xwidget-webkit-last-session) 'vertical t 50)
159 (defun xwidget-webkit-scroll-down ()
160 "Scroll webkit down,either native or like image mode."
162 (if (eq xwidget-webkit-scroll-behaviour 'native)
163 (xwidget-set-adjustment (xwidget-webkit-last-session) 'vertical t -50)
164 (image-scroll-down)))
166 (defun xwidget-webkit-scroll-forward ()
167 "Scroll webkit forward,either native or like image mode."
169 (if (eq xwidget-webkit-scroll-behaviour 'native)
170 (xwidget-set-adjustment (xwidget-webkit-last-session) 'horizontal t 50)
171 (xwidget-webkit-scroll-forward)))
173 (defun xwidget-webkit-scroll-backward ()
174 "Scroll webkit backward,either native or like image mode."
176 (if (eq xwidget-webkit-scroll-behaviour 'native)
177 (xwidget-set-adjustment (xwidget-webkit-last-session) 'horizontal t -50)
178 (xwidget-webkit-scroll-backward)))
181 ;;the xwidget event needs to go into a higher level handler
182 ;;since the xwidget can generate an event even if its offscreen
183 ;;TODO this needs to use callbacks and consider different xw ev types
184 (define-key (current-global-map) [xwidget-event] 'xwidget-event-handler)
185 (defun xwidget-log ( &rest msg)
186 "Log MSG to a buffer."
187 (let ( (buf (get-buffer-create "*xwidget-log*")))
189 (buffer-disable-undo buf)
191 (insert (apply 'format msg))
194 (defun xwidget-event-handler ()
195 "Receive xwidget event."
197 (xwidget-log "stuff happened to xwidget %S" last-input-event)
199 ((xwidget-event-type (nth 1 last-input-event))
200 (xwidget (nth 2 last-input-event))
201 ;(xwidget-callback (xwidget-get xwidget 'callback));;TODO stopped working for some reason
203 ;(funcall xwidget-callback xwidget xwidget-event-type)
204 (message "xw callback %s" xwidget)
205 (funcall 'xwidget-webkit-callback xwidget xwidget-event-type)))
207 (defun xwidget-webkit-callback (xwidget xwidget-event-type)
208 "Callback for xwidgets.
209 XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget."
211 (cond ((buffer-live-p (xwidget-buffer xwidget))
212 (set-buffer (xwidget-buffer xwidget))
213 (let* ((strarg (nth 3 last-input-event)))
214 (cond ((eq xwidget-event-type 'document-load-finished)
215 (xwidget-log "webkit finished loading: '%s'" (xwidget-webkit-get-title xwidget))
216 ;;TODO - check the native/internal scroll
217 ;;(xwidget-adjust-size-to-content xwidget)
218 (xwidget-webkit-adjust-size-dispatch) ;;TODO send xwidget here
219 (rename-buffer (format "*xwidget webkit: %s *" (xwidget-webkit-get-title xwidget)))
220 (pop-to-buffer (current-buffer)))
221 ((eq xwidget-event-type 'navigation-policy-decision-requested)
222 (if (string-match ".*#\\(.*\\)" strarg)
223 (xwidget-webkit-show-id-or-named-element xwidget (match-string 1 strarg))))
224 (t (xwidget-log "unhandled event:%s" xwidget-event-type)))))
225 (t (xwidget-log "error: callback called for xwidget with dead buffer")))))
227 (define-derived-mode xwidget-webkit-mode
228 special-mode "xwidget-webkit" "xwidget webkit view mode"
229 (setq buffer-read-only t)
230 ;; Keep track of [vh]scroll when switching buffers
231 (image-mode-setup-winprops))
233 (defvar xwidget-webkit-last-session-buffer nil)
235 (defun xwidget-webkit-last-session ()
236 "Last active webkit, or nil."
237 (if (buffer-live-p xwidget-webkit-last-session-buffer)
238 (with-current-buffer xwidget-webkit-last-session-buffer
242 (defun xwidget-webkit-current-session ()
243 "Either the webkit in the current buffer, or the last one used, which might be nil."
246 (xwidget-webkit-last-session)))
248 (defun xwidget-adjust-size-to-content (xw)
249 "Resize XW to content."
250 ;;xwidgets doesnt support widgets that have their own opinions about size well yet
251 ;;this reads the desired size and resizes the emacs allocated area accordingly
252 (let ((size (xwidget-size-request xw)))
253 (xwidget-resize xw (car size) (cadr size))))
256 (defvar xwidget-webkit-activeelement-js"
257 function findactiveelement(doc){
258 //alert(doc.activeElement.value);
259 if(doc.activeElement.value != undefined){
260 return doc.activeElement;
262 // recurse over the child documents:
263 var frames = doc.getElementsByTagName('frame');
264 for (var i = 0; i < frames.length; i++)
266 var d = frames[i].contentDocument;
267 var rv = findactiveelement(d);
279 "javascript that finds the active element."
280 ;;yes its ugly. because:
281 ;; - there is aparently no way to find the active frame other than recursion
282 ;; - the js "for each" construct missbehaved on the "frames" collection
283 ;; - a window with no frameset still has frames.length == 1, but frames[0].document.activeElement != document.activeElement
284 ;;TODO the activeelement type needs to be examined, for iframe, etc. sucks.
287 (defun xwidget-webkit-insert-string (xw str)
288 "Insert string in the active field in the webkit.
290 Argument STR string."
291 ;;read out the string in the field first and provide for edit
293 (let* ((xww (xwidget-webkit-current-session))
297 (xwidget-webkit-execute-script xww xwidget-webkit-activeelement-js)
298 (xwidget-webkit-execute-script-rv xww "findactiveelement(document).value;" )))
299 (field-type (xwidget-webkit-execute-script-rv xww "findactiveelement(document).type;" )))
301 (cond ((equal "text" field-type)
302 (read-string "text:" field-value))
303 ((equal "password" field-type)
304 (read-passwd "password:" nil field-value))
305 ((equal "textarea" field-type)
306 (xwidget-webkit-begin-edit-textarea xww field-value))))))
307 (xwidget-webkit-execute-script xw (format "findactiveelement(document).value='%s'" str)))
310 (defun xwidget-webkit-begin-edit-textarea (xw text)
311 "Start editing of a webkit text area.
312 XW is the xwidget identifier, TEXT is retrieved from the webkit."
314 (generate-new-buffer "textarea"))
316 (set (make-local-variable 'xwbl) xw)
319 (defun xwidget-webkit-end-edit-textarea ()
320 "End editing of a webkit text area."
322 (goto-char (point-min))
323 (while (search-forward "\n" nil t)
324 (replace-match "\\n" nil t))
325 (xwidget-webkit-execute-script xwbl (format "findactiveelement(document).value='%s'"
326 (buffer-substring (point-min) (point-max))))
327 ;;TODO convert linefeed to \n
330 (defun xwidget-webkit-show-named-element (xw element-name)
331 "Make named-element show. for instance an anchor."
332 (interactive (list (xwidget-webkit-current-session) (read-string "element name:")))
334 ;; since an xwidget is an Emacs object, it is not trivial to do some things that are taken for granted in a normal browser.
335 ;; scrolling an anchor/named-element into view is one such thing.
336 ;; this function implements a proof-of-concept for this.
337 ;; problems remaining:
338 ;; - the selected window is scrolled but this is not always correct
339 ;; - this needs to be interfaced into browse-url somehow. the tricky part is that we need to do this in two steps:
340 ;; A: load the base url, wait for load signal to arrive B: navigate to the anchor when the base url is finished rendering
342 ;;this part figures out the Y coordinate of the element
343 (let ((y (string-to-number
344 (xwidget-webkit-execute-script-rv xw
345 (format "document.getElementsByName('%s')[0].getBoundingClientRect().top" element-name)
347 ;;now we need to tell emacs to scroll the element into view.
348 (xwidget-log "scroll: %d" y)
349 (set-window-vscroll (selected-window) y t)))
351 (defun xwidget-webkit-show-id-element (xw element-id)
352 "make id-element show. for instance an anchor."
353 (interactive (list (xwidget-webkit-current-session)
354 (read-string "element id:")))
355 (let ((y (string-to-number
356 (xwidget-webkit-execute-script-rv xw
357 (format "document.getElementById('%s').getBoundingClientRect().top" element-id)
359 ;;now we need to tell emacs to scroll the element into view.
360 (xwidget-log "scroll: %d" y)
361 (set-window-vscroll (selected-window) y t)))
363 (defun xwidget-webkit-show-id-or-named-element (xw element-id)
364 "make id-element show. for instance an anchor."
365 (interactive (list (xwidget-webkit-current-session)
366 (read-string "element id:")))
367 (let* ((y1 (string-to-number
368 (xwidget-webkit-execute-script-rv xw
369 (format "document.getElementsByName('%s')[0].getBoundingClientRect().top" element-id)
371 (y2 (string-to-number
372 (xwidget-webkit-execute-script-rv xw
373 (format "document.getElementById('%s').getBoundingClientRect().top" element-id)
376 ;;now we need to tell emacs to scroll the element into view.
377 (xwidget-log "scroll: %d" y3)
378 (set-window-vscroll (selected-window) y3 t)))
380 (defun xwidget-webkit-adjust-size-to-content ()
381 "Adjust webkit to content size."
383 (xwidget-adjust-size-to-content (xwidget-webkit-current-session)))
385 (defun xwidget-webkit-adjust-size-dispatch ()
386 "Adjust size according to mode."
388 (if (eq xwidget-webkit-scroll-behaviour 'native)
389 (xwidget-webkit-adjust-size-to-window)
390 (xwidget-webkit-adjust-size-to-content))
391 ;;the recenter is intended to correct a visual glitch
392 ;;it errors out if the buffer isnt visible, but then we dont get the glitch,
395 (recenter-top-bottom))
398 (defun xwidget-webkit-adjust-size-to-window ()
399 "Adjust webkit to window."
401 (xwidget-resize ( xwidget-webkit-current-session) (window-pixel-width) (window-pixel-height)))
403 (defun xwidget-webkit-adjust-size (w h)
404 "Manualy set webkit size.
407 ;;TODO shouldnt be tied to the webkit xwidget
408 (interactive "nWidth:\nnHeight:\n")
409 (xwidget-resize ( xwidget-webkit-current-session) w h))
411 (defun xwidget-webkit-fit-width ()
412 "Adjust width of webkit to window width."
414 (xwidget-webkit-adjust-size (- (caddr (window-inside-pixel-edges))
415 (car (window-inside-pixel-edges)))
418 (defun xwidget-webkit-new-session (url)
419 "Create a new webkit session buffer with URL."
421 ((bufname (generate-new-buffer-name "*xwidget-webkit*"))
423 (setq xwidget-webkit-last-session-buffer (switch-to-buffer (get-buffer-create bufname)))
424 (insert " 'a' adjusts the xwidget size.")
425 (setq xw (xwidget-insert 1 'webkit-osr bufname 1000 1000))
426 (xwidget-put xw 'callback 'xwidget-webkit-callback)
427 (xwidget-webkit-mode)
428 (xwidget-webkit-goto-uri (xwidget-webkit-last-session) url )))
431 (defun xwidget-webkit-goto-url (url)
433 (if (xwidget-webkit-current-session)
435 (xwidget-webkit-goto-uri (xwidget-webkit-current-session) url))
436 (xwidget-webkit-new-session url)))
438 (defun xwidget-webkit-back ()
441 (xwidget-webkit-execute-script (xwidget-webkit-current-session) "history.go(-1);"))
443 (defun xwidget-webkit-reload ()
444 "Reload current url."
446 (xwidget-webkit-execute-script (xwidget-webkit-current-session) "history.go(0);"))
448 (defun xwidget-webkit-current-url ()
449 "Get the webkit url. place it on kill ring."
451 (let* ((rv (xwidget-webkit-execute-script-rv (xwidget-webkit-current-session)
453 (url (kill-new (or rv ""))))
454 (message "url: %s" url )
457 (defun xwidget-webkit-execute-script-rv (xw script &optional default)
458 "Same as 'xwidget-webkit-execute-script' but but with return value.
459 XW is the webkit instance. SCRIPT is the script to execut.
460 DEFAULT is the defaultreturn value."
461 ;;notice the fugly "title" hack. it is needed because the webkit api
462 ;;doesnt support returning values. this is a wrapper for the title
463 ;;hack so its easy to remove should webkit someday support JS return
464 ;;values or we find some other way to access the DOM
466 ;;reset webkit title. fugly.
467 (let* ((emptytag "titlecantbewhitespaceohthehorror")
469 (xwidget-webkit-execute-script xw (format "document.title=\"%s\";" (or default emptytag)))
470 (xwidget-webkit-execute-script xw (format "document.title=%s;" script))
471 (setq title (xwidget-webkit-get-title xw))
472 (if (equal emptytag title)
475 (setq title default))
480 ;; (declare-function xwidget-resize-internal "xwidget.c" )
481 ;; check-declare-function?
483 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
484 (defun xwidget-webkit-get-selection ()
485 "Get the webkit selection."
486 (xwidget-webkit-execute-script-rv (xwidget-webkit-current-session)
487 "window.getSelection().toString();"))
489 (defun xwidget-webkit-copy-selection-as-kill ()
490 "Get the webkit selection and put it on the kill ring."
492 (kill-new (xwidget-webkit-get-selection)))
495 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
496 ;; xwidget plist management(similar to the process plist functions)
498 (defun xwidget-get (xwidget propname)
499 "Return the value of XWIDGET' PROPNAME property.
500 This is the last value stored with `(xwidget-put XWIDGET PROPNAME VALUE)'."
501 (plist-get (xwidget-plist xwidget) propname))
503 (defun xwidget-put (xwidget propname value)
504 "Change XWIDGET' PROPNAME property to VALUE.
505 It can be retrieved with `(xwidget-get XWIDGET PROPNAME)'."
506 (set-xwidget-plist xwidget
507 (plist-put (xwidget-plist xwidget) propname value)))
510 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
512 (defun xwidget-delete-zombies ()
513 "Helper for xwidget-cleanup."
514 (dolist (xwidget-view xwidget-view-list)
515 (when (or (not (window-live-p (xwidget-view-window xwidget-view)))
516 (not (memq (xwidget-view-model xwidget-view)
518 (delete-xwidget-view xwidget-view))))
520 (defun xwidget-cleanup ()
521 "Delete zombie xwidgets."
522 ;;its still pretty easy to trigger bugs with xwidgets.
523 ;;this function tries to implement a workaround
525 ;; kill xviews who should have been deleted but stull linger
526 (xwidget-delete-zombies)
527 ;; redraw display otherwise ghost of zombies will remain to haunt the screen
530 ;;this is a workaround because I cant find the right place to put it in C
531 ;;seems to work well in practice though
532 ;;(add-hook 'window-configuration-change-hook 'xwidget-cleanup)
533 (add-hook 'window-configuration-change-hook 'xwidget-delete-zombies)
535 (defun xwidget-kill-buffer-query-function ()
536 "Ask beforek illing a buffer that has xwidgets."
537 (let ((xwidgets (get-buffer-xwidgets (current-buffer))))
539 (not (memq t (mapcar 'xwidget-query-on-exit-flag xwidgets)))
541 (format "Buffer %S has xwidgets; kill it? "
542 (buffer-name (current-buffer)))))))
544 (add-hook 'kill-buffer-query-functions 'xwidget-kill-buffer-query-function)
546 ;;killflash is sadly not reliable yet.
547 (defvar xwidget-webkit-kill-flash-oneshot t)
548 (defun xwidget-webkit-kill-flash ()
549 "Disable the flash plugin in webkit.
550 This is needed because Flash is non-free and doesnt work reliably
551 on 64 bit systems and offscreen rendering. Sadly not reliable
552 yet, so deinstall Flash instead for now."
553 ;;you can only call this once or webkit crashes and takes emacs with it. odd.
554 (unless xwidget-webkit-kill-flash-oneshot
555 (xwidget-disable-plugin-for-mime "application/x-shockwave-flash")
556 (setq xwidget-webkit-kill-flash-oneshot t)))
558 (xwidget-webkit-kill-flash)
560 (defun report-xwidget-bug ()
561 "Report a bug in GNU Emacs about the XWidget branch.
562 Prompts for bug subject. Leaves you in a mail buffer."
564 (let ((reporter-prompt-for-summary-p t))
565 (reporter-submit-bug-report "submit@debbugs.gnu.org" nil nil nil nil
566 (format "Package: emacs-xwidgets
568 Please describee xactly whata ctions triggered the bug, and the
569 precise symptoms of the bug. If you can, give a recipe starting
572 If Emacs crashed, and you have the Emacs process in the gdb
573 deubbger, please include the output from the following gdb
575 `bt full' and `xbacktrace'.
577 For information about debugging Emacs, please read the file
578 %s" (expand-file-name "DEBUG" data-directory)))))
582 ;;; xwidget.el ends here