]> code.delx.au - gnu-emacs/blob - lisp/xwidget.el
Do not prompt twice to save a buffer
[gnu-emacs] / lisp / xwidget.el
1 ;;; xwidget.el --- api functions for xwidgets -*- lexical-binding: t -*-
2 ;;
3 ;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
4 ;;
5 ;; Author: Joakim Verona (joakim@verona.se)
6 ;;
7 ;; This file is part of GNU Emacs.
8 ;;
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.
13
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.
18
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/>.
21 ;;
22 ;; --------------------------------------------------------------------
23
24 ;;; Commentary:
25 ;;
26 ;; See xwidget.c for more api functions.
27
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)
31
32 ;;; Code:
33
34 (require 'cl-lib)
35 (require 'bookmark)
36
37 (declare-function make-xwidget "xwidget.c"
38 (type title width height arguments &optional buffer))
39 (declare-function xwidget-set-adjustment "xwidget.c"
40 (xwidget axis relative value))
41 (declare-function xwidget-buffer "xwidget.c" (xwidget))
42 (declare-function xwidget-webkit-get-title "xwidget.c" (xwidget))
43 (declare-function xwidget-size-request "xwidget.c" (xwidget))
44 (declare-function xwidget-resize "xwidget.c" (xwidget new-width new-height))
45 (declare-function xwidget-webkit-execute-script "xwidget.c" (xwidget script))
46 (declare-function xwidget-webkit-goto-uri "xwidget.c" (xwidget uri))
47 (declare-function xwidget-plist "xwidget.c" (xwidget))
48 (declare-function set-xwidget-plist "xwidget.c" (xwidget plist))
49 (declare-function xwidget-view-window "xwidget.c" (xwidget-view))
50 (declare-function xwidget-view-model "xwidget.c" (xwidget-view))
51 (declare-function delete-xwidget-view "xwidget.c" (xwidget-view))
52 (declare-function get-buffer-xwidgets "xwidget.c" (buffer))
53 (declare-function xwidget-query-on-exit-flag "xwidget.c" (xwidget))
54
55 (defun xwidget-insert (pos type title width height &optional args)
56 "Insert an xwidget at position POS.
57 Supply the xwidget's TYPE, TITLE, WIDTH, and HEIGHT.
58 See `make-xwidget' for the possible TYPE values.
59 The usage of optional argument ARGS depends on the xwidget.
60 This returns the result of `make-xwidget'."
61 (goto-char pos)
62 (let ((id (make-xwidget type title width height args)))
63 (put-text-property (point) (+ 1 (point))
64 'display (list 'xwidget ':xwidget id))
65 id))
66
67 (defun xwidget-at (pos)
68 "Return xwidget at POS."
69 ;; TODO this function is a bit tedious because the C layer isn't well
70 ;; protected yet and xwidgetp apparently doesn't work yet.
71 (let* ((disp (get-text-property pos 'display))
72 (xw (car (cdr (cdr disp)))))
73 ;;(if (xwidgetp xw) xw nil)
74 (if (equal 'xwidget (car disp)) xw)))
75
76
77
78 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
79 ;;; webkit support
80 (require 'browse-url)
81 (require 'image-mode);;for some image-mode alike functionality
82
83 ;;;###autoload
84 (defun xwidget-webkit-browse-url (url &optional new-session)
85 "Ask xwidget-webkit to browse URL.
86 NEW-SESSION specifies whether to create a new xwidget-webkit session.
87 Interactively, URL defaults to the string looking like a url around point."
88 (interactive (progn
89 (require 'browse-url)
90 (browse-url-interactive-arg "xwidget-webkit URL: "
91 ;;(xwidget-webkit-current-url)
92 )))
93 (or (featurep 'xwidget-internal)
94 (user-error "Your Emacs was not compiled with xwidgets support"))
95 (when (stringp url)
96 (if new-session
97 (xwidget-webkit-new-session url)
98 (xwidget-webkit-goto-url url))))
99
100 ;;todo.
101 ;; - check that the webkit support is compiled in
102 (defvar xwidget-webkit-mode-map
103 (let ((map (make-sparse-keymap)))
104 (define-key map "g" 'xwidget-webkit-browse-url)
105 (define-key map "a" 'xwidget-webkit-adjust-size-dispatch)
106 (define-key map "b" 'xwidget-webkit-back)
107 (define-key map "r" 'xwidget-webkit-reload)
108 (define-key map "t" (lambda () (interactive) (message "o"))) ;FIXME: ?!?
109 (define-key map "\C-m" 'xwidget-webkit-insert-string)
110 (define-key map "w" 'xwidget-webkit-current-url)
111
112 ;;similar to image mode bindings
113 (define-key map (kbd "SPC") 'xwidget-webkit-scroll-up)
114 (define-key map (kbd "DEL") 'xwidget-webkit-scroll-down)
115
116 (define-key map [remap scroll-up] 'xwidget-webkit-scroll-up)
117 (define-key map [remap scroll-up-command] 'xwidget-webkit-scroll-up)
118
119 (define-key map [remap scroll-down] 'xwidget-webkit-scroll-down)
120 (define-key map [remap scroll-down-command] 'xwidget-webkit-scroll-down)
121
122 (define-key map [remap forward-char] 'xwidget-webkit-scroll-forward)
123 (define-key map [remap backward-char] 'xwidget-webkit-scroll-backward)
124 (define-key map [remap right-char] 'xwidget-webkit-scroll-forward)
125 (define-key map [remap left-char] 'xwidget-webkit-scroll-backward)
126 ;; (define-key map [remap previous-line] 'image-previous-line)
127 ;; (define-key map [remap next-line] 'image-next-line)
128
129 ;; (define-key map [remap move-beginning-of-line] 'image-bol)
130 ;; (define-key map [remap move-end-of-line] 'image-eol)
131 ;; (define-key map [remap beginning-of-buffer] 'image-bob)
132 ;; (define-key map [remap end-of-buffer] 'image-eob)
133 map)
134 "Keymap for `xwidget-webkit-mode'.")
135
136 (defun xwidget-webkit-scroll-up ()
137 "Scroll webkit up."
138 (interactive)
139 (xwidget-set-adjustment (xwidget-webkit-last-session) 'vertical t 50))
140
141 (defun xwidget-webkit-scroll-down ()
142 "Scroll webkit down."
143 (interactive)
144 (xwidget-set-adjustment (xwidget-webkit-last-session) 'vertical t -50))
145
146 (defun xwidget-webkit-scroll-forward ()
147 "Scroll webkit forwards."
148 (interactive)
149 (xwidget-set-adjustment (xwidget-webkit-last-session) 'horizontal t 50))
150
151 (defun xwidget-webkit-scroll-backward ()
152 "Scroll webkit backwards."
153 (interactive)
154 (xwidget-set-adjustment (xwidget-webkit-last-session) 'horizontal t -50))
155
156
157 ;; The xwidget event needs to go into a higher level handler
158 ;; since the xwidget can generate an event even if it's offscreen.
159 ;; TODO this needs to use callbacks and consider different xwidget event types.
160 (define-key (current-global-map) [xwidget-event] #'xwidget-event-handler)
161 (defun xwidget-log (&rest msg)
162 "Log MSG to a buffer."
163 (let ((buf (get-buffer-create " *xwidget-log*")))
164 (with-current-buffer buf
165 (insert (apply #'format msg))
166 (insert "\n"))))
167
168 (defun xwidget-event-handler ()
169 "Receive xwidget event."
170 (interactive)
171 (xwidget-log "stuff happened to xwidget %S" last-input-event)
172 (let*
173 ((xwidget-event-type (nth 1 last-input-event))
174 (xwidget (nth 2 last-input-event))
175 ;;(xwidget-callback (xwidget-get xwidget 'callback))
176 ;;TODO stopped working for some reason
177 )
178 ;;(funcall xwidget-callback xwidget xwidget-event-type)
179 (message "xw callback %s" xwidget)
180 (funcall 'xwidget-webkit-callback xwidget xwidget-event-type)))
181
182 (defun xwidget-webkit-callback (xwidget xwidget-event-type)
183 "Callback for xwidgets.
184 XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget."
185 (if (not (buffer-live-p (xwidget-buffer xwidget)))
186 (xwidget-log
187 "error: callback called for xwidget with dead buffer")
188 (with-current-buffer (xwidget-buffer xwidget)
189 (let* ((strarg (nth 3 last-input-event)))
190 (cond ((eq xwidget-event-type 'document-load-finished)
191 (xwidget-log "webkit finished loading: '%s'"
192 (xwidget-webkit-get-title xwidget))
193 ;;TODO - check the native/internal scroll
194 ;;(xwidget-adjust-size-to-content xwidget)
195 (xwidget-webkit-adjust-size-dispatch) ;;TODO xwidget arg
196 (rename-buffer (format "*xwidget webkit: %s *"
197 (xwidget-webkit-get-title xwidget)))
198 (pop-to-buffer (current-buffer)))
199 ((eq xwidget-event-type
200 'navigation-policy-decision-requested)
201 (if (string-match ".*#\\(.*\\)" strarg)
202 (xwidget-webkit-show-id-or-named-element
203 xwidget
204 (match-string 1 strarg))))
205 (t (xwidget-log "unhandled event:%s" xwidget-event-type)))))))
206
207 (defvar bookmark-make-record-function)
208 (define-derived-mode xwidget-webkit-mode
209 special-mode "xwidget-webkit" "Xwidget webkit view mode."
210 (setq buffer-read-only t)
211 (setq-local bookmark-make-record-function
212 #'xwidget-webkit-bookmark-make-record)
213 ;; Keep track of [vh]scroll when switching buffers
214 (image-mode-setup-winprops))
215
216 (defun xwidget-webkit-bookmark-make-record ()
217 "Integrate Emacs bookmarks with the webkit xwidget."
218 (nconc (bookmark-make-record-default t t)
219 `((page . ,(xwidget-webkit-current-url))
220 (handler . (lambda (bmk) (browse-url
221 (bookmark-prop-get bmk 'page)))))))
222
223
224 (defvar xwidget-webkit-last-session-buffer nil)
225
226 (defun xwidget-webkit-last-session ()
227 "Last active webkit, or nil."
228 (if (buffer-live-p xwidget-webkit-last-session-buffer)
229 (with-current-buffer xwidget-webkit-last-session-buffer
230 (xwidget-at (point-min)))
231 nil))
232
233 (defun xwidget-webkit-current-session ()
234 "Either the webkit in the current buffer, or the last one used.
235 The latter might be nil."
236 (or (xwidget-at (point-min)) (xwidget-webkit-last-session)))
237
238 (defun xwidget-adjust-size-to-content (xw)
239 "Resize XW to content."
240 ;; xwidgets doesn't support widgets that have their own opinions about
241 ;; size well, yet this reads the desired size and resizes the Emacs
242 ;; allocated area accordingly.
243 (let ((size (xwidget-size-request xw)))
244 (xwidget-resize xw (car size) (cadr size))))
245
246
247 (defvar xwidget-webkit-activeelement-js"
248 function findactiveelement(doc){
249 //alert(doc.activeElement.value);
250 if(doc.activeElement.value != undefined){
251 return doc.activeElement;
252 }else{
253 // recurse over the child documents:
254 var frames = doc.getElementsByTagName('frame');
255 for (var i = 0; i < frames.length; i++)
256 {
257 var d = frames[i].contentDocument;
258 var rv = findactiveelement(d);
259 if(rv != undefined){
260 return rv;
261 }
262 }
263 }
264 return undefined;
265 };
266
267
268 "
269
270 "javascript that finds the active element."
271 ;; Yes it's ugly, because:
272 ;; - there is apparently no way to find the active frame other than recursion
273 ;; - the js "for each" construct misbehaved on the "frames" collection
274 ;; - a window with no frameset still has frames.length == 1, but
275 ;; frames[0].document.activeElement != document.activeElement
276 ;;TODO the activeelement type needs to be examined, for iframe, etc.
277 )
278
279 (defun xwidget-webkit-insert-string (xw str)
280 "Insert string STR in the active field in the webkit XW."
281 ;; Read out the string in the field first and provide for edit.
282 (interactive
283 (let* ((xww (xwidget-webkit-current-session))
284
285 (field-value
286 (progn
287 (xwidget-webkit-execute-script xww xwidget-webkit-activeelement-js)
288 (xwidget-webkit-execute-script-rv
289 xww
290 "findactiveelement(document).value;")))
291 (field-type (xwidget-webkit-execute-script-rv
292 xww
293 "findactiveelement(document).type;")))
294 (list xww
295 (cond ((equal "text" field-type)
296 (read-string "Text: " field-value))
297 ((equal "password" field-type)
298 (read-passwd "Password: " nil field-value))
299 ((equal "textarea" field-type)
300 (xwidget-webkit-begin-edit-textarea xww field-value))))))
301 (xwidget-webkit-execute-script
302 xw
303 (format "findactiveelement(document).value='%s'" str)))
304
305 (defvar xwidget-xwbl)
306 (defun xwidget-webkit-begin-edit-textarea (xw text)
307 "Start editing of a webkit text area.
308 XW is the xwidget identifier, TEXT is retrieved from the webkit."
309 (switch-to-buffer
310 (generate-new-buffer "textarea"))
311 (set (make-local-variable 'xwidget-xwbl) xw)
312 (insert text))
313
314 (defun xwidget-webkit-end-edit-textarea ()
315 "End editing of a webkit text area."
316 (interactive)
317 (goto-char (point-min))
318 (while (search-forward "\n" nil t)
319 (replace-match "\\n" nil t))
320 (xwidget-webkit-execute-script
321 xwidget-xwbl
322 (format "findactiveelement(document).value='%s'"
323 (buffer-substring (point-min) (point-max))))
324 ;;TODO convert linefeed to \n
325 )
326
327 (defun xwidget-webkit-show-named-element (xw element-name)
328 "Make webkit xwidget XW show a named element ELEMENT-NAME.
329 For example, use this to display an anchor."
330 (interactive (list (xwidget-webkit-current-session)
331 (read-string "Element name: ")))
332 ;;TODO since an xwidget is an Emacs object, it is not trivial to do
333 ;; some things that are taken for granted in a normal browser.
334 ;; scrolling an anchor/named-element into view is one such thing.
335 ;; This function implements a proof-of-concept for this. Problems
336 ;; remaining: - The selected window is scrolled but this is not
337 ;; always correct - This needs to be interfaced into browse-url
338 ;; somehow. The tricky part is that we need to do this in two steps:
339 ;; A: load the base url, wait for load signal to arrive B: navigate
340 ;; to the anchor when the base url is finished rendering
341
342 ;; This part figures out the Y coordinate of the element
343 (let ((y (string-to-number
344 (xwidget-webkit-execute-script-rv
345 xw
346 (format
347 "document.getElementsByName('%s')[0].getBoundingClientRect().top"
348 element-name)
349 0))))
350 ;; Now we need to tell Emacs to scroll the element into view.
351 (xwidget-log "scroll: %d" y)
352 (set-window-vscroll (selected-window) y t)))
353
354 (defun xwidget-webkit-show-id-element (xw element-id)
355 "Make webkit xwidget XW show an id-element ELEMENT-ID.
356 For example, use this to display an anchor."
357 (interactive (list (xwidget-webkit-current-session)
358 (read-string "Element id: ")))
359 (let ((y (string-to-number
360 (xwidget-webkit-execute-script-rv
361 xw
362 (format "document.getElementById('%s').getBoundingClientRect().top"
363 element-id)
364 0))))
365 ;; Now we need to tell Emacs to scroll the element into view.
366 (xwidget-log "scroll: %d" y)
367 (set-window-vscroll (selected-window) y t)))
368
369 (defun xwidget-webkit-show-id-or-named-element (xw element-id)
370 "Make webkit xwidget XW show a name or element id ELEMENT-ID.
371 For example, use this to display an anchor."
372 (interactive (list (xwidget-webkit-current-session)
373 (read-string "Name or element id: ")))
374 (let* ((y1 (string-to-number
375 (xwidget-webkit-execute-script-rv
376 xw
377 (format "document.getElementsByName('%s')[0].getBoundingClientRect().top" element-id)
378 "0")))
379 (y2 (string-to-number
380 (xwidget-webkit-execute-script-rv
381 xw
382 (format "document.getElementById('%s').getBoundingClientRect().top" element-id)
383 "0")))
384 (y3 (max y1 y2)))
385 ;; Now we need to tell Emacs to scroll the element into view.
386 (xwidget-log "scroll: %d" y3)
387 (set-window-vscroll (selected-window) y3 t)))
388
389 (defun xwidget-webkit-adjust-size-to-content ()
390 "Adjust webkit to content size."
391 (interactive)
392 (xwidget-adjust-size-to-content (xwidget-webkit-current-session)))
393
394 (defun xwidget-webkit-adjust-size-dispatch ()
395 "Adjust size according to mode."
396 (interactive)
397 (xwidget-webkit-adjust-size-to-window)
398 ;; The recenter is intended to correct a visual glitch.
399 ;; It errors out if the buffer isn't visible, but then we don't get
400 ;; the glitch, so silence errors.
401 (ignore-errors
402 (recenter-top-bottom)))
403
404 (defun xwidget-webkit-adjust-size-to-window ()
405 "Adjust webkit to window."
406 (interactive)
407 (xwidget-resize (xwidget-webkit-current-session) (window-pixel-width)
408 (window-pixel-height)))
409
410 (defun xwidget-webkit-adjust-size (w h)
411 "Manually set webkit size to width W, height H."
412 ;; TODO shouldn't be tied to the webkit xwidget
413 (interactive "nWidth:\nnHeight:\n")
414 (xwidget-resize (xwidget-webkit-current-session) w h))
415
416 (defun xwidget-webkit-fit-width ()
417 "Adjust width of webkit to window width."
418 (interactive)
419 (xwidget-webkit-adjust-size (- (nth 2 (window-inside-pixel-edges))
420 (car (window-inside-pixel-edges)))
421 1000))
422
423 (defun xwidget-webkit-new-session (url)
424 "Create a new webkit session buffer with URL."
425 (let*
426 ((bufname (generate-new-buffer-name "*xwidget-webkit*"))
427 xw)
428 (setq xwidget-webkit-last-session-buffer (switch-to-buffer
429 (get-buffer-create bufname)))
430 (insert " 'a' adjusts the xwidget size.")
431 (setq xw (xwidget-insert 1 'webkit bufname 1000 1000))
432 (xwidget-put xw 'callback 'xwidget-webkit-callback)
433 (xwidget-webkit-mode)
434 (xwidget-webkit-goto-uri (xwidget-webkit-last-session) url)))
435
436
437 (defun xwidget-webkit-goto-url (url)
438 "Goto URL."
439 (if (xwidget-webkit-current-session)
440 (progn
441 (xwidget-webkit-goto-uri (xwidget-webkit-current-session) url))
442 (xwidget-webkit-new-session url)))
443
444 (defun xwidget-webkit-back ()
445 "Go back in history."
446 (interactive)
447 (xwidget-webkit-execute-script (xwidget-webkit-current-session)
448 "history.go(-1);"))
449
450 (defun xwidget-webkit-reload ()
451 "Reload current url."
452 (interactive)
453 (xwidget-webkit-execute-script (xwidget-webkit-current-session)
454 "history.go(0);"))
455
456 (defun xwidget-webkit-current-url ()
457 "Get the webkit url and place it on the kill-ring."
458 (interactive)
459 (let* ((rv (xwidget-webkit-execute-script-rv (xwidget-webkit-current-session)
460 "document.URL"))
461 (url (kill-new (or rv ""))))
462 (message "url: %s" url)
463 url))
464
465 (defun xwidget-webkit-execute-script-rv (xw script &optional default)
466 "Same as `xwidget-webkit-execute-script' but with return value.
467 XW is the webkit instance. SCRIPT is the script to execute.
468 DEFAULT is the default return value."
469 ;; Notice the ugly "title" hack. It is needed because the Webkit
470 ;; API at the time of writing didn't support returning values. This
471 ;; is a wrapper for the title hack so it's easy to remove should
472 ;; Webkit someday support JS return values or we find some other way
473 ;; to access the DOM.
474
475 ;; Reset webkit title. Not very nice.
476 (let* ((emptytag "titlecantbewhitespaceohthehorror")
477 title)
478 (xwidget-webkit-execute-script xw (format "document.title=\"%s\";"
479 (or default emptytag)))
480 (xwidget-webkit-execute-script xw (format "document.title=%s;" script))
481 (setq title (xwidget-webkit-get-title xw))
482 (if (equal emptytag title)
483 (setq title ""))
484 (unless title
485 (setq title default))
486 title))
487
488 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
489 (defun xwidget-webkit-get-selection ()
490 "Get the webkit selection."
491 (xwidget-webkit-execute-script-rv (xwidget-webkit-current-session)
492 "window.getSelection().toString();"))
493
494 (defun xwidget-webkit-copy-selection-as-kill ()
495 "Get the webkit selection and put it on the kill-ring."
496 (interactive)
497 (kill-new (xwidget-webkit-get-selection)))
498
499
500 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
501 ;; Xwidget plist management (similar to the process plist functions)
502
503 (defun xwidget-get (xwidget propname)
504 "Get an xwidget's property value.
505 XWIDGET is an xwidget, PROPNAME a property.
506 Returns the last value stored with `xwidget-put'."
507 (plist-get (xwidget-plist xwidget) propname))
508
509 (defun xwidget-put (xwidget propname value)
510 "Set an xwidget's property value.
511 XWIDGET is an xwidget, PROPNAME a property to be set to specified VALUE.
512 You can retrieve the value with `xwidget-get'."
513 (set-xwidget-plist xwidget
514 (plist-put (xwidget-plist xwidget) propname value)))
515
516
517 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
518
519 (defvar xwidget-view-list) ; xwidget.c
520 (defvar xwidget-list) ; xwidget.c
521
522 (defun xwidget-delete-zombies ()
523 "Helper for `xwidget-cleanup'."
524 (dolist (xwidget-view xwidget-view-list)
525 (when (or (not (window-live-p (xwidget-view-window xwidget-view)))
526 (not (memq (xwidget-view-model xwidget-view)
527 xwidget-list)))
528 (delete-xwidget-view xwidget-view))))
529
530 (defun xwidget-cleanup ()
531 "Delete zombie xwidgets."
532 ;; During development it was sometimes easy to wind up with zombie
533 ;; xwidget instances.
534 ;; This function tries to implement a workaround should it occur again.
535 (interactive)
536 ;; Kill xviews that should have been deleted but still linger.
537 (xwidget-delete-zombies)
538 ;; Redraw display otherwise ghost of zombies will remain to haunt the screen
539 (redraw-display))
540
541 (defun xwidget-kill-buffer-query-function ()
542 "Ask before killing a buffer that has xwidgets."
543 (let ((xwidgets (get-buffer-xwidgets (current-buffer))))
544 (or (not xwidgets)
545 (not (memq t (mapcar #'xwidget-query-on-exit-flag xwidgets)))
546 (yes-or-no-p
547 (format "Buffer %S has xwidgets; kill it? " (buffer-name))))))
548
549 (when (featurep 'xwidget-internal)
550 (add-hook 'kill-buffer-query-functions #'xwidget-kill-buffer-query-function)
551 ;; This would have felt better in C, but this seems to work well in
552 ;; practice though.
553 (add-hook 'window-configuration-change-hook #'xwidget-delete-zombies))
554
555 (provide 'xwidget)
556 ;;; xwidget.el ends here