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