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