xwidget.el 22 KB
Newer Older
1 2
;;; xwidget.el --- api functions for xwidgets  -*- lexical-binding: t -*-
;;
Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2011-2019 Free Software Foundation, Inc.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
;;
;; Author: Joakim Verona (joakim@verona.se)
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
20
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
21 22 23 24 25
;;
;; --------------------------------------------------------------------

;;; Commentary:
;;
26
;; See xwidget.c for more api functions.
27

Glenn Morris's avatar
Glenn Morris committed
28 29
;; This breaks compilation when we don't have xwidgets.
;; And is pointless when we do, since it's in C and so preloaded.
30 31 32 33 34 35 36
;;(require 'xwidget-internal)

;;; Code:

(require 'cl-lib)
(require 'bookmark)

37
(declare-function make-xwidget "xwidget.c"
38
                  (type title width height arguments &optional buffer))
39 40 41
(declare-function xwidget-buffer "xwidget.c" (xwidget))
(declare-function xwidget-size-request "xwidget.c" (xwidget))
(declare-function xwidget-resize "xwidget.c" (xwidget new-width new-height))
42 43
(declare-function xwidget-webkit-execute-script "xwidget.c"
                  (xwidget script &optional callback))
44
(declare-function xwidget-webkit-goto-uri "xwidget.c" (xwidget uri))
45
(declare-function xwidget-webkit-zoom "xwidget.c" (xwidget factor))
46 47 48 49 50 51
(declare-function xwidget-plist "xwidget.c" (xwidget))
(declare-function set-xwidget-plist "xwidget.c" (xwidget plist))
(declare-function xwidget-view-window "xwidget.c" (xwidget-view))
(declare-function xwidget-view-model "xwidget.c" (xwidget-view))
(declare-function delete-xwidget-view "xwidget.c" (xwidget-view))
(declare-function get-buffer-xwidgets "xwidget.c" (buffer))
52
(declare-function xwidget-query-on-exit-flag "xwidget.c" (xwidget))
53

54
(defun xwidget-insert (pos type title width height &optional args)
Glenn Morris's avatar
Glenn Morris committed
55 56 57 58 59
  "Insert an xwidget at position POS.
Supply the xwidget's TYPE, TITLE, WIDTH, and HEIGHT.
See `make-xwidget' for the possible TYPE values.
The usage of optional argument ARGS depends on the xwidget.
This returns the result of `make-xwidget'."
60
  (goto-char pos)
61
  (let ((id (make-xwidget type title width height args)))
62 63 64 65 66 67
    (put-text-property (point) (+ 1 (point))
                       'display (list 'xwidget ':xwidget id))
    id))

(defun xwidget-at (pos)
  "Return xwidget at POS."
68 69
  ;; TODO this function is a bit tedious because the C layer isn't well
  ;; protected yet and xwidgetp apparently doesn't work yet.
70 71
  (let* ((disp (get-text-property pos 'display))
         (xw (car (cdr (cdr  disp)))))
Stefan Monnier's avatar
Stefan Monnier committed
72
    ;;(if (xwidgetp  xw) xw nil)
73 74 75 76 77 78 79 80 81 82 83 84
    (if (equal 'xwidget (car disp)) xw)))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; webkit support
(require 'browse-url)
(require 'image-mode);;for some image-mode alike functionality

;;;###autoload
(defun xwidget-webkit-browse-url (url &optional new-session)
  "Ask xwidget-webkit to browse URL.
Glenn Morris's avatar
Glenn Morris committed
85 86
NEW-SESSION specifies whether to create a new xwidget-webkit session.
Interactively, URL defaults to the string looking like a url around point."
87 88 89
  (interactive (progn
                 (require 'browse-url)
                 (browse-url-interactive-arg "xwidget-webkit URL: "
Stefan Monnier's avatar
Stefan Monnier committed
90
                                             ;;(xwidget-webkit-current-url)
91
                                             )))
92 93
  (or (featurep 'xwidget-internal)
      (user-error "Your Emacs was not compiled with xwidgets support"))
94 95 96 97 98 99 100 101 102 103 104
  (when (stringp url)
    (if new-session
        (xwidget-webkit-new-session url)
      (xwidget-webkit-goto-url url))))

;;todo.
;; - check that the webkit support is compiled in
(defvar xwidget-webkit-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "g" 'xwidget-webkit-browse-url)
    (define-key map "a" 'xwidget-webkit-adjust-size-dispatch)
Stefan Monnier's avatar
Stefan Monnier committed
105 106 107
    (define-key map "b" 'xwidget-webkit-back)
    (define-key map "r" 'xwidget-webkit-reload)
    (define-key map "t" (lambda () (interactive) (message "o"))) ;FIXME: ?!?
108 109
    (define-key map "\C-m" 'xwidget-webkit-insert-string)
    (define-key map "w" 'xwidget-webkit-current-url)
110 111
    (define-key map "+" 'xwidget-webkit-zoom-in)
    (define-key map "-" 'xwidget-webkit-zoom-out)
112 113 114 115 116 117 118 119 120 121 122 123 124 125 126

    ;;similar to image mode bindings
    (define-key map (kbd "SPC")                 'xwidget-webkit-scroll-up)
    (define-key map (kbd "DEL")                 'xwidget-webkit-scroll-down)

    (define-key map [remap scroll-up]           'xwidget-webkit-scroll-up)
    (define-key map [remap scroll-up-command]   'xwidget-webkit-scroll-up)

    (define-key map [remap scroll-down]         'xwidget-webkit-scroll-down)
    (define-key map [remap scroll-down-command] 'xwidget-webkit-scroll-down)

    (define-key map [remap forward-char]        'xwidget-webkit-scroll-forward)
    (define-key map [remap backward-char]       'xwidget-webkit-scroll-backward)
    (define-key map [remap right-char]          'xwidget-webkit-scroll-forward)
    (define-key map [remap left-char]           'xwidget-webkit-scroll-backward)
127 128
    (define-key map [remap previous-line]       'xwidget-webkit-scroll-down)
    (define-key map [remap next-line]           'xwidget-webkit-scroll-up)
129 130 131

    ;; (define-key map [remap move-beginning-of-line] 'image-bol)
    ;; (define-key map [remap move-end-of-line]       'image-eol)
132 133
    (define-key map [remap beginning-of-buffer] 'xwidget-webkit-scroll-top)
    (define-key map [remap end-of-buffer]       'xwidget-webkit-scroll-bottom)
134 135 136
    map)
  "Keymap for `xwidget-webkit-mode'.")

137 138 139 140 141 142 143 144 145 146
(defun xwidget-webkit-zoom-in ()
  "Increase webkit view zoom factor."
  (interactive)
  (xwidget-webkit-zoom (xwidget-webkit-current-session) 0.1))

(defun xwidget-webkit-zoom-out ()
  "Decrease webkit view zoom factor."
  (interactive)
  (xwidget-webkit-zoom (xwidget-webkit-current-session) -0.1))

147
(defun xwidget-webkit-scroll-up ()
148
  "Scroll webkit up."
149
  (interactive)
150 151 152
  (xwidget-webkit-execute-script
   (xwidget-webkit-current-session)
   "window.scrollBy(0, 50);"))
153 154

(defun xwidget-webkit-scroll-down ()
155
  "Scroll webkit down."
156
  (interactive)
157 158 159
  (xwidget-webkit-execute-script
   (xwidget-webkit-current-session)
   "window.scrollBy(0, -50);"))
160 161

(defun xwidget-webkit-scroll-forward ()
162
  "Scroll webkit forwards."
163
  (interactive)
164 165 166
  (xwidget-webkit-execute-script
   (xwidget-webkit-current-session)
   "window.scrollBy(50, 0);"))
167 168

(defun xwidget-webkit-scroll-backward ()
169
  "Scroll webkit backwards."
170
  (interactive)
171 172 173
  (xwidget-webkit-execute-script
   (xwidget-webkit-current-session)
   "window.scrollBy(-50, 0);"))
174

175 176 177 178 179 180 181 182 183 184 185 186 187
(defun xwidget-webkit-scroll-top ()
  "Scroll webkit to the very top."
  (interactive)
  (xwidget-webkit-execute-script
   (xwidget-webkit-current-session)
   "window.scrollTo(pageXOffset, 0);"))

(defun xwidget-webkit-scroll-bottom ()
  "Scroll webkit to the very bottom."
  (interactive)
  (xwidget-webkit-execute-script
   (xwidget-webkit-current-session)
   "window.scrollTo(pageXOffset, window.document.body.clientHeight);"))
188

189 190 191
;; The xwidget event needs to go into a higher level handler
;; since the xwidget can generate an event even if it's offscreen.
;; TODO this needs to use callbacks and consider different xwidget event types.
Stefan Monnier's avatar
Stefan Monnier committed
192 193
(define-key (current-global-map) [xwidget-event] #'xwidget-event-handler)
(defun xwidget-log (&rest msg)
194
  "Log MSG to a buffer."
Stefan Monnier's avatar
Stefan Monnier committed
195 196 197
  (let ((buf (get-buffer-create " *xwidget-log*")))
    (with-current-buffer buf
      (insert (apply #'format msg))
198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216
      (insert "\n"))))

(defun xwidget-event-handler ()
  "Receive xwidget event."
  (interactive)
  (xwidget-log "stuff happened to xwidget %S" last-input-event)
  (let*
      ((xwidget-event-type (nth 1 last-input-event))
       (xwidget (nth 2 last-input-event))
       ;;(xwidget-callback (xwidget-get xwidget 'callback))
       ;;TODO stopped working for some reason
       )
    ;;(funcall  xwidget-callback xwidget xwidget-event-type)
    (message "xw callback %s" xwidget)
    (funcall  'xwidget-webkit-callback xwidget xwidget-event-type)))

(defun xwidget-webkit-callback (xwidget xwidget-event-type)
  "Callback for xwidgets.
XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget."
Stefan Monnier's avatar
Stefan Monnier committed
217 218 219 220
  (if (not (buffer-live-p (xwidget-buffer xwidget)))
      (xwidget-log
       "error: callback called for xwidget with dead buffer")
    (with-current-buffer (xwidget-buffer xwidget)
221
      (cond ((eq xwidget-event-type 'load-changed)
222 223 224 225 226 227
             (xwidget-webkit-execute-script
              xwidget "document.title"
              (lambda (title)
                (xwidget-log "webkit finished loading: '%s'" title)
                ;;TODO - check the native/internal scroll
                ;;(xwidget-adjust-size-to-content xwidget)
228
                (xwidget-webkit-adjust-size-to-window xwidget)
229
                (rename-buffer (format "*xwidget webkit: %s *" title))))
230 231 232
             (pop-to-buffer (current-buffer)))
            ((eq xwidget-event-type 'decide-policy)
             (let ((strarg  (nth 3 last-input-event)))
Stefan Monnier's avatar
Stefan Monnier committed
233 234 235
               (if (string-match ".*#\\(.*\\)" strarg)
                   (xwidget-webkit-show-id-or-named-element
                    xwidget
236 237 238 239 240 241
                    (match-string 1 strarg)))))
            ((eq xwidget-event-type 'javascript-callback)
             (let ((proc (nth 3 last-input-event))
                   (arg  (nth 4 last-input-event)))
               (funcall proc arg)))
            (t (xwidget-log "unhandled event:%s" xwidget-event-type))))))
242 243 244

(defvar bookmark-make-record-function)
(define-derived-mode xwidget-webkit-mode
Stefan Monnier's avatar
Stefan Monnier committed
245 246 247 248 249 250
    special-mode "xwidget-webkit" "Xwidget webkit view mode."
    (setq buffer-read-only t)
    (setq-local bookmark-make-record-function
                #'xwidget-webkit-bookmark-make-record)
    ;; Keep track of [vh]scroll when switching buffers
    (image-mode-setup-winprops))
251 252

(defun xwidget-webkit-bookmark-make-record ()
Stefan Monnier's avatar
Stefan Monnier committed
253
  "Integrate Emacs bookmarks with the webkit xwidget."
254 255 256
  (nconc (bookmark-make-record-default t t)
         `((page     . ,(xwidget-webkit-current-url))
           (handler  . (lambda (bmk) (browse-url
Stefan Monnier's avatar
Stefan Monnier committed
257
                                 (bookmark-prop-get bmk 'page)))))))
258 259 260 261


(defvar xwidget-webkit-last-session-buffer nil)

262
(defun xwidget-webkit-last-session ()
263 264 265
  "Last active webkit, or nil."
  (if (buffer-live-p xwidget-webkit-last-session-buffer)
      (with-current-buffer xwidget-webkit-last-session-buffer
Glenn Morris's avatar
Glenn Morris committed
266
        (xwidget-at (point-min)))
267 268 269
    nil))

(defun xwidget-webkit-current-session ()
270 271
  "Either the webkit in the current buffer, or the last one used.
The latter might be nil."
Glenn Morris's avatar
Glenn Morris committed
272
  (or (xwidget-at (point-min)) (xwidget-webkit-last-session)))
273 274 275

(defun xwidget-adjust-size-to-content (xw)
  "Resize XW to content."
276
  ;; xwidgets doesn't support widgets that have their own opinions about
Stefan Monnier's avatar
Stefan Monnier committed
277
  ;; size well, yet this reads the desired size and resizes the Emacs
278
  ;; allocated area accordingly.
279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306
  (let ((size (xwidget-size-request xw)))
    (xwidget-resize xw (car size) (cadr size))))


(defvar xwidget-webkit-activeelement-js"
function findactiveelement(doc){
//alert(doc.activeElement.value);
   if(doc.activeElement.value != undefined){
      return doc.activeElement;
   }else{
        // recurse over the child documents:
        var frames = doc.getElementsByTagName('frame');
        for (var i = 0; i < frames.length; i++)
        {
                var d = frames[i].contentDocument;
                 var rv = findactiveelement(d);
                 if(rv != undefined){
                    return rv;
                 }
        }
    }
    return undefined;
};


"

  "javascript that finds the active element."
307 308 309
  ;; Yes it's ugly, because:
  ;; - there is apparently no way to find the active frame other than recursion
  ;; - the js "for each" construct misbehaved on the "frames" collection
310 311 312 313 314
  ;; - a window with no frameset still has frames.length == 1, but
  ;; frames[0].document.activeElement != document.activeElement
  ;;TODO the activeelement type needs to be examined, for iframe, etc.
  )

315 316 317
(defun xwidget-webkit-insert-string ()
  "Prompt for a string and insert it in the active field in the
current webkit widget."
318
  ;; Read out the string in the field first and provide for edit.
319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338
  (interactive)
  (let ((xww (xwidget-webkit-current-session)))
    (xwidget-webkit-execute-script
     xww
     (concat xwidget-webkit-activeelement-js "
(function () {
  var res = findactiveelement(document);
  return [res.value, res.type];
})();")
     (lambda (field)
       (let ((str (pcase field
                    (`[,val "text"]
                     (read-string "Text: " val))
                    (`[,val "password"]
                     (read-passwd "Password: " nil val))
                    (`[,val "textarea"]
                     (xwidget-webkit-begin-edit-textarea xww val)))))
         (xwidget-webkit-execute-script
          xww
          (format "findactiveelement(document).value='%s'" str)))))))
339 340 341 342 343 344 345 346 347 348 349

(defvar xwidget-xwbl)
(defun xwidget-webkit-begin-edit-textarea (xw text)
  "Start editing of a webkit text area.
XW is the xwidget identifier, TEXT is retrieved from the webkit."
  (switch-to-buffer
   (generate-new-buffer "textarea"))
  (set (make-local-variable 'xwidget-xwbl) xw)
  (insert text))

(defun xwidget-webkit-end-edit-textarea ()
Stefan Monnier's avatar
Stefan Monnier committed
350
  "End editing of a webkit text area."
351 352 353 354 355 356 357 358 359 360 361
  (interactive)
  (goto-char (point-min))
  (while (search-forward "\n" nil t)
    (replace-match "\\n" nil t))
  (xwidget-webkit-execute-script
   xwidget-xwbl
   (format "findactiveelement(document).value='%s'"
           (buffer-substring (point-min) (point-max))))
  ;;TODO convert linefeed to \n
  )

362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378
(defun xwidget-webkit-show-element (xw element-selector)
  "Make webkit xwidget XW show a named element ELEMENT-SELECTOR.
The ELEMENT-SELECTOR must be a valid CSS selector.  For example,
use this to display an anchor."
  (interactive (list (xwidget-webkit-current-session)
                     (read-string "Element selector: ")))
  (xwidget-webkit-execute-script
   xw
   (format "
(function (query) {
  var el = document.querySelector(query);
  if (el !== null) {
    window.scrollTo(0, el.offsetTop);
  }
})('%s');"
    element-selector)))

379
(defun xwidget-webkit-show-named-element (xw element-name)
Glenn Morris's avatar
Glenn Morris committed
380 381
  "Make webkit xwidget XW show a named element ELEMENT-NAME.
For example, use this to display an anchor."
382
  (interactive (list (xwidget-webkit-current-session)
Glenn Morris's avatar
Glenn Morris committed
383
                     (read-string "Element name: ")))
384 385 386 387 388 389 390 391 392 393 394 395 396 397
  ;; TODO: This needs to be interfaced into browse-url somehow.  The
  ;; tricky part is that we need to do this in two steps: A: load the
  ;; base url, wait for load signal to arrive B: navigate to the
  ;; anchor when the base url is finished rendering
  (xwidget-webkit-execute-script
   xw
   (format "
(function (query) {
  var el = document.getElementsByName(query)[0];
  if (el !== undefined) {
    window.scrollTo(0, el.offsetTop);
  }
})('%s');"
    element-name)))
398 399

(defun xwidget-webkit-show-id-element (xw element-id)
Glenn Morris's avatar
Glenn Morris committed
400 401
  "Make webkit xwidget XW show an id-element ELEMENT-ID.
For example, use this to display an anchor."
402
  (interactive (list (xwidget-webkit-current-session)
Glenn Morris's avatar
Glenn Morris committed
403
                     (read-string "Element id: ")))
404 405 406 407 408 409 410 411 412 413
  (xwidget-webkit-execute-script
   xw
   (format "
(function (query) {
  var el = document.getElementById(query);
  if (el !== null) {
    window.scrollTo(0, el.offsetTop);
  }
})('%s');"
    element-id)))
414 415

(defun xwidget-webkit-show-id-or-named-element (xw element-id)
Glenn Morris's avatar
Glenn Morris committed
416 417
   "Make webkit xwidget XW show a name or element id ELEMENT-ID.
For example, use this to display an anchor."
418
  (interactive (list (xwidget-webkit-current-session)
Glenn Morris's avatar
Glenn Morris committed
419
                     (read-string "Name or element id: ")))
420 421 422 423 424 425 426 427 428 429 430
  (xwidget-webkit-execute-script
   xw
   (format "
(function (query) {
  var el = document.getElementById(query) ||
           document.getElementsByName(query)[0];
  if (el !== undefined) {
    window.scrollTo(0, el.offsetTop);
  }
})('%s');"
    element-id)))
431 432 433 434 435 436 437 438 439

(defun xwidget-webkit-adjust-size-to-content ()
  "Adjust webkit to content size."
  (interactive)
  (xwidget-adjust-size-to-content (xwidget-webkit-current-session)))

(defun xwidget-webkit-adjust-size-dispatch ()
  "Adjust size according to mode."
  (interactive)
440
  (xwidget-webkit-adjust-size-to-window (xwidget-webkit-current-session))
441
  ;; The recenter is intended to correct a visual glitch.
442 443
  ;; It errors out if the buffer isn't visible, but then we don't get
  ;; the glitch, so silence errors.
444
  (ignore-errors
Glenn Morris's avatar
Glenn Morris committed
445
    (recenter-top-bottom)))
446

447 448 449 450 451
(defun xwidget-webkit-adjust-size-to-window (xwidget &optional window)
  "Adjust the size of the webkit XWIDGET to fit the WINDOW."
  (xwidget-resize xwidget
                  (window-pixel-width window)
                  (window-pixel-height window)))
452 453

(defun xwidget-webkit-adjust-size (w h)
Glenn Morris's avatar
Glenn Morris committed
454
  "Manually set webkit size to width W, height H."
455 456
  ;; TODO shouldn't be tied to the webkit xwidget
  (interactive "nWidth:\nnHeight:\n")
Stefan Monnier's avatar
Stefan Monnier committed
457
  (xwidget-resize (xwidget-webkit-current-session) w h))
458 459 460 461 462 463 464 465

(defun xwidget-webkit-fit-width ()
  "Adjust width of webkit to window width."
  (interactive)
  (xwidget-webkit-adjust-size (- (nth 2 (window-inside-pixel-edges))
                                 (car (window-inside-pixel-edges)))
                              1000))

466 467 468 469 470 471 472 473 474 475 476 477 478 479 480
(defun xwidget-webkit-auto-adjust-size (window)
  "Adjust the size of the webkit widget in the given WINDOW."
  (with-current-buffer (window-buffer window)
    (when (eq major-mode 'xwidget-webkit-mode)
      (let ((xwidget (xwidget-webkit-current-session)))
        (xwidget-webkit-adjust-size-to-window xwidget window)))))

(defun xwidget-webkit-adjust-size-in-frame (frame)
  "Dynamically adjust webkit widget for all windows of the FRAME."
  (walk-windows 'xwidget-webkit-auto-adjust-size 'no-minibuf frame))

(eval-after-load 'xwidget-webkit-mode
  (add-to-list 'window-size-change-functions
               'xwidget-webkit-adjust-size-in-frame))

481 482 483 484 485 486 487
(defun xwidget-webkit-new-session (url)
  "Create a new webkit session buffer with URL."
  (let*
      ((bufname (generate-new-buffer-name "*xwidget-webkit*"))
       xw)
    (setq xwidget-webkit-last-session-buffer (switch-to-buffer
                                              (get-buffer-create bufname)))
488 489 490
    ;; The xwidget id is stored in a text property, so we need to have
    ;; at least character in this buffer.
    (insert " ")
491 492 493
    (setq xw (xwidget-insert 1 'webkit bufname
                             (window-pixel-width)
                             (window-pixel-height)))
494 495
    (xwidget-put xw 'callback 'xwidget-webkit-callback)
    (xwidget-webkit-mode)
Stefan Monnier's avatar
Stefan Monnier committed
496
    (xwidget-webkit-goto-uri (xwidget-webkit-last-session) url)))
497 498 499 500 501 502 503 504 505 506


(defun xwidget-webkit-goto-url (url)
  "Goto URL."
  (if (xwidget-webkit-current-session)
      (progn
        (xwidget-webkit-goto-uri (xwidget-webkit-current-session) url))
    (xwidget-webkit-new-session url)))

(defun xwidget-webkit-back ()
Glenn Morris's avatar
Glenn Morris committed
507
  "Go back in history."
508 509 510 511 512 513 514 515 516 517 518
  (interactive)
  (xwidget-webkit-execute-script (xwidget-webkit-current-session)
                                 "history.go(-1);"))

(defun xwidget-webkit-reload ()
  "Reload current url."
  (interactive)
  (xwidget-webkit-execute-script (xwidget-webkit-current-session)
                                 "history.go(0);"))

(defun xwidget-webkit-current-url ()
Glenn Morris's avatar
Glenn Morris committed
519
  "Get the webkit url and place it on the kill-ring."
520
  (interactive)
521 522 523 524 525
  (xwidget-webkit-execute-script
   (xwidget-webkit-current-session)
   "document.URL" (lambda (rv)
                    (let ((url (kill-new (or rv ""))))
                      (message "url: %s" url)))))
526 527

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
528 529 530 531 532 533
(defun xwidget-webkit-get-selection (proc)
  "Get the webkit selection and pass it to PROC."
  (xwidget-webkit-execute-script
   (xwidget-webkit-current-session)
   "window.getSelection().toString();"
   proc))
534 535

(defun xwidget-webkit-copy-selection-as-kill ()
Glenn Morris's avatar
Glenn Morris committed
536
  "Get the webkit selection and put it on the kill-ring."
537
  (interactive)
538
  (xwidget-webkit-get-selection (lambda (selection) (kill-new selection))))
539 540 541


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
542
;; Xwidget plist management (similar to the process plist functions)
543 544

(defun xwidget-get (xwidget propname)
Glenn Morris's avatar
Glenn Morris committed
545 546 547
  "Get an xwidget's property value.
XWIDGET is an xwidget, PROPNAME a property.
Returns the last value stored with `xwidget-put'."
548 549 550
  (plist-get (xwidget-plist xwidget) propname))

(defun xwidget-put (xwidget propname value)
Glenn Morris's avatar
Glenn Morris committed
551 552 553
  "Set an xwidget's property value.
XWIDGET is an xwidget, PROPNAME a property to be set to specified VALUE.
You can retrieve the value with `xwidget-get'."
554 555 556 557 558 559
  (set-xwidget-plist xwidget
                     (plist-put (xwidget-plist xwidget) propname value)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

560 561 562
(defvar xwidget-view-list)              ; xwidget.c
(defvar xwidget-list)                   ; xwidget.c

563 564 565 566 567 568 569 570 571 572 573 574 575 576
(defun xwidget-delete-zombies ()
  "Helper for `xwidget-cleanup'."
  (dolist (xwidget-view xwidget-view-list)
    (when (or (not (window-live-p (xwidget-view-window xwidget-view)))
              (not (memq (xwidget-view-model xwidget-view)
                         xwidget-list)))
      (delete-xwidget-view xwidget-view))))

(defun xwidget-cleanup ()
  "Delete zombie xwidgets."
  ;; During development it was sometimes easy to wind up with zombie
  ;; xwidget instances.
  ;; This function tries to implement a workaround should it occur again.
  (interactive)
577
  ;; Kill xviews that should have been deleted but still linger.
578 579 580 581 582
  (xwidget-delete-zombies)
  ;; Redraw display otherwise ghost of zombies will remain to haunt the screen
  (redraw-display))

(defun xwidget-kill-buffer-query-function ()
583
  "Ask before killing a buffer that has xwidgets."
584 585
  (let ((xwidgets (get-buffer-xwidgets (current-buffer))))
    (or (not xwidgets)
Stefan Monnier's avatar
Stefan Monnier committed
586
        (not (memq t (mapcar #'xwidget-query-on-exit-flag xwidgets)))
587
        (yes-or-no-p
Stefan Monnier's avatar
Stefan Monnier committed
588
         (format "Buffer %S has xwidgets; kill it? " (buffer-name))))))
589

Stefan Monnier's avatar
Stefan Monnier committed
590 591 592 593 594
(when (featurep 'xwidget-internal)
  (add-hook 'kill-buffer-query-functions #'xwidget-kill-buffer-query-function)
  ;; This would have felt better in C, but this seems to work well in
  ;; practice though.
  (add-hook 'window-configuration-change-hook #'xwidget-delete-zombies))
595 596 597

(provide 'xwidget)
;;; xwidget.el ends here