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 ;; TODO this breaks compilation when we don't have xwidgets.
  29 ;;(require 'xwidget-internal)
  30
  31 ;;; Code:
  32
  33 (require 'cl-lib)
  34 (require 'bookmark)
  35
  36 (defcustom xwidget-webkit-scroll-behaviour 'native
  37   "Scroll behaviour of the webkit instance.
  38 'native or 'image."
  39   :version "25.1"
  40   :group 'frames   ; TODO add xwidgets group if more options are added
  41   :type '(choice (const native) (const image)))
  42
  43 (declare-function make-xwidget "xwidget.c"
  44                   (beg end type title width height arguments &optional buffer))
  45 (declare-function xwidget-set-adjustment "xwidget.c"
  46                   (xwidget axis relative value))
  47 (declare-function xwidget-buffer "xwidget.c" (xwidget))
  48 (declare-function xwidget-webkit-get-title "xwidget.c" (xwidget))
  49 (declare-function xwidget-size-request "xwidget.c" (xwidget))
  50 (declare-function xwidget-resize "xwidget.c" (xwidget new-width new-height))
  51 (declare-function xwidget-webkit-execute-script "xwidget.c" (xwidget script))
  52 (declare-function xwidget-webkit-goto-uri "xwidget.c" (xwidget uri))
  53 (declare-function xwidget-plist "xwidget.c" (xwidget))
  54 (declare-function set-xwidget-plist "xwidget.c" (xwidget plist))
  55 (declare-function xwidget-view-window "xwidget.c" (xwidget-view))
  56 (declare-function xwidget-view-model "xwidget.c" (xwidget-view))
  57 (declare-function delete-xwidget-view "xwidget.c" (xwidget-view))
  58 (declare-function get-buffer-xwidgets "xwidget.c" (buffer))
  59
  60 (defun xwidget-insert (pos type title width height &optional args)
  61   "Insert an xwidget at POS.
  62 given ID, TYPE, TITLE WIDTH and
  63 HEIGHT in the current buffer.
  64
  65 Return ID
  66
  67 see `make-xwidget' for types suitable for TYPE.
  68 Optional argument ARGS usage depends on the xwidget."
  69   (goto-char pos)
  70   (let ((id (make-xwidget (point) (point)
  71                           type title width height args)))
  72     (put-text-property (point) (+ 1 (point))
  73                        'display (list 'xwidget ':xwidget id))
  74     id))
  75
  76 (defun xwidget-at (pos)
  77   "Return xwidget at POS."
  78   ;; TODO this function is a bit tedious because the C layer isn't well
  79   ;; protected yet and xwidgetp apparently doesn't work yet.
  80   (let* ((disp (get-text-property pos 'display))
  81          (xw (car (cdr (cdr  disp)))))
  82     ;;(if ( xwidgetp  xw) xw nil)
  83     (if (equal 'xwidget (car disp)) xw)))
  84
  85
  86
  87 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  88 ;;; webkit support
  89 (require 'browse-url)
  90 (require 'image-mode);;for some image-mode alike functionality
  91
  92 ;;;###autoload
  93 (defun xwidget-webkit-browse-url (url &optional new-session)
  94   "Ask xwidget-webkit to browse URL.
  95 NEW-SESSION specifies whether to create a new xwidget-webkit session.  URL
  96 defaults to the string looking like a url around the cursor position."
  97   (interactive (progn
  98                  (require 'browse-url)
  99                  (browse-url-interactive-arg "xwidget-webkit URL: "
 100                                              ;;( xwidget-webkit-current-url)
 101                                              )))
 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")) )
 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,either native or like image mode."
 145   (interactive)
 146   (if (eq xwidget-webkit-scroll-behaviour 'native)
 147       (xwidget-set-adjustment (xwidget-webkit-last-session) 'vertical t 50)
 148     (image-scroll-up)))
 149
 150 (defun xwidget-webkit-scroll-down ()
 151   "Scroll webkit down,either native or like image mode."
 152   (interactive)
 153   (if (eq xwidget-webkit-scroll-behaviour 'native)
 154       (xwidget-set-adjustment (xwidget-webkit-last-session) 'vertical t -50)
 155     (image-scroll-down)))
 156
 157 (defun xwidget-webkit-scroll-forward ()
 158   "Scroll webkit forward,either native or like image mode."
 159   (interactive)
 160   (if (eq xwidget-webkit-scroll-behaviour 'native)
 161       (xwidget-set-adjustment (xwidget-webkit-last-session) 'horizontal t 50)
 162     (xwidget-webkit-scroll-forward)))
 163
 164 (defun xwidget-webkit-scroll-backward ()
 165   "Scroll webkit backward,either native or like image mode."
 166   (interactive)
 167   (if (eq xwidget-webkit-scroll-behaviour 'native)
 168       (xwidget-set-adjustment (xwidget-webkit-last-session) 'horizontal t -50)
 169     (xwidget-webkit-scroll-backward)))
 170
 171
 172 ;; The xwidget event needs to go into a higher level handler
 173 ;; since the xwidget can generate an event even if it's offscreen.
 174 ;; TODO this needs to use callbacks and consider different xwidget event types.
 175 (define-key (current-global-map) [xwidget-event] 'xwidget-event-handler)
 176 (defun xwidget-log ( &rest msg)
 177   "Log MSG to a buffer."
 178   (let ( (buf  (get-buffer-create "*xwidget-log*")))
 179     (save-excursion
 180       (buffer-disable-undo buf)
 181       (set-buffer buf)
 182       (insert (apply  'format msg))
 183       (insert "\n"))))
 184
 185 (defun xwidget-event-handler ()
 186   "Receive xwidget event."
 187   (interactive)
 188   (xwidget-log "stuff happened to xwidget %S" last-input-event)
 189   (let*
 190       ((xwidget-event-type (nth 1 last-input-event))
 191        (xwidget (nth 2 last-input-event))
 192        ;;(xwidget-callback (xwidget-get xwidget 'callback))
 193        ;;TODO stopped working for some reason
 194        )
 195     ;;(funcall  xwidget-callback xwidget xwidget-event-type)
 196     (message "xw callback %s" xwidget)
 197     (funcall  'xwidget-webkit-callback xwidget xwidget-event-type)))
 198
 199 (defun xwidget-webkit-callback (xwidget xwidget-event-type)
 200   "Callback for xwidgets.
 201 XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget."
 202   (save-excursion
 203     (cond ((buffer-live-p (xwidget-buffer xwidget))
 204            (set-buffer (xwidget-buffer xwidget))
 205            (let* ((strarg  (nth 3 last-input-event)))
 206              (cond ((eq xwidget-event-type 'document-load-finished)
 207                     (xwidget-log "webkit finished loading: '%s'"
 208                                  (xwidget-webkit-get-title xwidget))
 209                     ;;TODO - check the native/internal scroll
 210                     ;;(xwidget-adjust-size-to-content xwidget)
 211                     (xwidget-webkit-adjust-size-dispatch) ;;TODO xwidget arg
 212                     (rename-buffer (format "*xwidget webkit: %s *"
 213                                            (xwidget-webkit-get-title xwidget)))
 214                     (pop-to-buffer (current-buffer)))
 215                    ((eq xwidget-event-type
 216                         'navigation-policy-decision-requested)
 217                     (if (string-match ".*#\\(.*\\)" strarg)
 218                         (xwidget-webkit-show-id-or-named-element
 219                          xwidget
 220                          (match-string 1 strarg))))
 221                    (t (xwidget-log "unhandled event:%s" xwidget-event-type)))))
 222           (t (xwidget-log
 223               "error: callback called for xwidget with dead buffer")))))
 224
 225 (defvar bookmark-make-record-function)
 226 (define-derived-mode xwidget-webkit-mode
 227   special-mode "xwidget-webkit" "xwidget webkit view mode"
 228   (setq buffer-read-only t)
 229   (setq-local bookmark-make-record-function
 230               #'xwidget-webkit-bookmark-make-record)
 231   ;; Keep track of [vh]scroll when switching buffers
 232   (image-mode-setup-winprops))
 233
 234 (defun xwidget-webkit-bookmark-make-record ()
 235 "Integrate Emacs bookmarks with the webkit xwidget."
 236   (nconc (bookmark-make-record-default t t)
 237          `((page     . ,(xwidget-webkit-current-url))
 238            (handler  . (lambda (bmk) (browse-url
 239                                       (bookmark-prop-get bmk 'page)))))))
 240
 241
 242 (defvar xwidget-webkit-last-session-buffer nil)
 243
 244 (defun xwidget-webkit-last-session ()
 245   "Last active webkit, or nil."
 246   (if (buffer-live-p xwidget-webkit-last-session-buffer)
 247       (with-current-buffer xwidget-webkit-last-session-buffer
 248         (xwidget-at (point-min)))
 249     nil))
 250
 251 (defun xwidget-webkit-current-session ()
 252   "Either the webkit in the current buffer, or the last one used.
 253 The latter might be nil."
 254   (or (xwidget-at (point-min)) (xwidget-webkit-last-session)))
 255
 256 (defun xwidget-adjust-size-to-content (xw)
 257   "Resize XW to content."
 258   ;; xwidgets doesn't 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))))
 263
 264
 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;
 270    }else{
 271         // recurse over the child documents:
 272         var frames = doc.getElementsByTagName('frame');
 273         for (var i = 0; i < frames.length; i++)
 274         {
 275                 var d = frames[i].contentDocument;
 276                  var rv = findactiveelement(d);
 277                  if(rv != undefined){
 278                     return rv;
 279                  }
 280         }
 281     }
 282     return undefined;
 283 };
 284
 285
 286 "
 287
 288   "javascript that finds the active element."
 289   ;; Yes it's ugly, because:
 290   ;; - there is apparently no way to find the active frame other than recursion
 291   ;; - the js "for each" construct misbehaved 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.
 295   )
 296
 297 (defun xwidget-webkit-insert-string (xw str)
 298   "Insert string in the active field in the webkit.
 299 Argument XW webkit.
 300 Argument STR string."
 301   ;; Read out the string in the field first and provide for edit.
 302   (interactive
 303    (let* ((xww (xwidget-webkit-current-session))
 304
 305           (field-value
 306            (progn
 307              (xwidget-webkit-execute-script xww xwidget-webkit-activeelement-js)
 308              (xwidget-webkit-execute-script-rv
 309               xww
 310               "findactiveelement(document).value;" )))
 311           (field-type (xwidget-webkit-execute-script-rv
 312                        xww
 313                        "findactiveelement(document).type;" )))
 314      (list xww
 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
 322    xw
 323    (format "findactiveelement(document).value='%s'" str)))
 324
 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."
 329   (switch-to-buffer
 330    (generate-new-buffer "textarea"))
 331
 332   (set (make-local-variable 'xwidget-xwbl) xw)
 333   (insert text))
 334
 335 (defun xwidget-webkit-end-edit-textarea ()
 336     "End editing of a webkit text area."
 337   (interactive)
 338   (goto-char (point-min))
 339   (while (search-forward "\n" nil t)
 340     (replace-match "\\n" nil t))
 341   (xwidget-webkit-execute-script
 342    xwidget-xwbl
 343    (format "findactiveelement(document).value='%s'"
 344            (buffer-substring (point-min) (point-max))))
 345   ;;TODO convert linefeed to \n
 346   )
 347
 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
 363
 364   ;; This part figures out the Y coordinate of the element
 365   (let ((y (string-to-number
 366             (xwidget-webkit-execute-script-rv
 367              xw
 368              (format
 369               "document.getElementsByName('%s')[0].getBoundingClientRect().top"
 370               element-name)
 371              0))))
 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)))
 375
 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
 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 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
 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-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 don't get
 426   ;; the glitch, so silence errors.
 427   (ignore-errors
 428     (recenter-top-bottom))
 429   )
 430
 431 (defun xwidget-webkit-adjust-size-to-window ()
 432   "Adjust webkit to window."
 433   (interactive)
 434   (xwidget-resize ( xwidget-webkit-current-session) (window-pixel-width)
 435                   (window-pixel-height)))
 436
 437 (defun xwidget-webkit-adjust-size (w h)
 438   "Manually set webkit size.
 439 Argument W width.
 440 Argument H height."
 441   ;; TODO shouldn't be tied to the webkit xwidget
 442   (interactive "nWidth:\nnHeight:\n")
 443   (xwidget-resize ( xwidget-webkit-current-session) w h))
 444
 445 (defun xwidget-webkit-fit-width ()
 446   "Adjust width of webkit to window width."
 447   (interactive)
 448   (xwidget-webkit-adjust-size (- (nth 2 (window-inside-pixel-edges))
 449                                  (car (window-inside-pixel-edges)))
 450                               1000))
 451
 452 (defun xwidget-webkit-new-session (url)
 453   "Create a new webkit session buffer with URL."
 454   (let*
 455       ((bufname (generate-new-buffer-name "*xwidget-webkit*"))
 456        xw)
 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 )))
 464
 465
 466 (defun xwidget-webkit-goto-url (url)
 467   "Goto URL."
 468   (if (xwidget-webkit-current-session)
 469       (progn
 470         (xwidget-webkit-goto-uri (xwidget-webkit-current-session) url))
 471     (xwidget-webkit-new-session url)))
 472
 473 (defun xwidget-webkit-back ()
 474   "Back in history."
 475   (interactive)
 476   (xwidget-webkit-execute-script (xwidget-webkit-current-session)
 477                                  "history.go(-1);"))
 478
 479 (defun xwidget-webkit-reload ()
 480   "Reload current url."
 481   (interactive)
 482   (xwidget-webkit-execute-script (xwidget-webkit-current-session)
 483                                  "history.go(0);"))
 484
 485 (defun xwidget-webkit-current-url ()
 486   "Get the webkit url.  place it on kill ring."
 487   (interactive)
 488   (let* ((rv (xwidget-webkit-execute-script-rv (xwidget-webkit-current-session)
 489                                                "document.URL"))
 490          (url (kill-new (or rv ""))))
 491     (message "url: %s" url )
 492     url))
 493
 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 execute.
 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 it's easy to remove should
 501   ;; Webkit someday support JS return values or we find some other way
 502   ;; to access the DOM.
 503
 504   ;; Reset webkit title.  Not very nice.
 505   (let* ((emptytag "titlecantbewhitespaceohthehorror")
 506          title)
 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)
 512         (setq title ""))
 513     (unless title
 514       (setq title default))
 515     title))
 516
 517 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 518 (defun xwidget-webkit-get-selection ()
 519   "Get the webkit selection."
 520   (xwidget-webkit-execute-script-rv (xwidget-webkit-current-session)
 521                                     "window.getSelection().toString();"))
 522
 523 (defun xwidget-webkit-copy-selection-as-kill ()
 524   "Get the webkit selection and put it on the kill ring."
 525   (interactive)
 526   (kill-new (xwidget-webkit-get-selection)))
 527
 528
 529 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 530 ;; Xwidget plist management (similar to the process plist functions)
 531
 532 (defun xwidget-get (xwidget propname)
 533   "Return the value of XWIDGET' PROPNAME property.
 534 This is the last value stored with `(xwidget-put XWIDGET PROPNAME VALUE)'."
 535   (plist-get (xwidget-plist xwidget) propname))
 536
 537 (defun xwidget-put (xwidget propname value)
 538   "Change XWIDGET' PROPNAME property to VALUE.
 539 It can be retrieved with `(xwidget-get XWIDGET PROPNAME)'."
 540   (set-xwidget-plist xwidget
 541                      (plist-put (xwidget-plist xwidget) propname value)))
 542
 543
 544 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 545
 546 (defvar xwidget-view-list)              ; xwidget.c
 547 (defvar xwidget-list)                   ; xwidget.c
 548
 549 (defun xwidget-delete-zombies ()
 550   "Helper for `xwidget-cleanup'."
 551   (dolist (xwidget-view xwidget-view-list)
 552     (when (or (not (window-live-p (xwidget-view-window xwidget-view)))
 553               (not (memq (xwidget-view-model xwidget-view)
 554                          xwidget-list)))
 555       (delete-xwidget-view xwidget-view))))
 556
 557 (defun xwidget-cleanup ()
 558   "Delete zombie xwidgets."
 559   ;; During development it was sometimes easy to wind up with zombie
 560   ;; xwidget instances.
 561   ;; This function tries to implement a workaround should it occur again.
 562   (interactive)
 563   ;; Kill xviews that should have been deleted but still linger.
 564   (xwidget-delete-zombies)
 565   ;; Redraw display otherwise ghost of zombies will remain to haunt the screen
 566   (redraw-display))
 567
 568 ;; This would have felt better in C, but this seems to work well in
 569 ;; practice though.
 570 (if (featurep 'xwidget-internal)
 571     (add-hook 'window-configuration-change-hook 'xwidget-delete-zombies))
 572
 573 (defun xwidget-kill-buffer-query-function ()
 574   "Ask before killing a buffer that has xwidgets."
 575   (let ((xwidgets (get-buffer-xwidgets (current-buffer))))
 576     (or (not xwidgets)
 577         (not (memq t (mapcar 'xwidget-query-on-exit-flag xwidgets)))
 578         (yes-or-no-p
 579          (format "Buffer %S has xwidgets; kill it? "
 580                  (buffer-name (current-buffer)))))))
 581
 582 (if (featurep 'xwidget-internal)
 583     (add-hook 'kill-buffer-query-functions 'xwidget-kill-buffer-query-function))
 584
 585 (provide 'xwidget)
 586
 587 ;;; xwidget.el ends here