diff options
Diffstat (limited to 'lisp/xwidget.el')
| -rw-r--r-- | lisp/xwidget.el | 580 |
1 files changed, 580 insertions, 0 deletions
diff --git a/lisp/xwidget.el b/lisp/xwidget.el new file mode 100644 index 00000000000..f184eb31dbb --- /dev/null +++ b/lisp/xwidget.el | |||
| @@ -0,0 +1,580 @@ | |||
| 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"))) ;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,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 | (with-current-buffer buf | ||
| 180 | (insert (apply #'format msg)) | ||
| 181 | (insert "\n")))) | ||
| 182 | |||
| 183 | (defun xwidget-event-handler () | ||
| 184 | "Receive xwidget event." | ||
| 185 | (interactive) | ||
| 186 | (xwidget-log "stuff happened to xwidget %S" last-input-event) | ||
| 187 | (let* | ||
| 188 | ((xwidget-event-type (nth 1 last-input-event)) | ||
| 189 | (xwidget (nth 2 last-input-event)) | ||
| 190 | ;;(xwidget-callback (xwidget-get xwidget 'callback)) | ||
| 191 | ;;TODO stopped working for some reason | ||
| 192 | ) | ||
| 193 | ;;(funcall xwidget-callback xwidget xwidget-event-type) | ||
| 194 | (message "xw callback %s" xwidget) | ||
| 195 | (funcall 'xwidget-webkit-callback xwidget xwidget-event-type))) | ||
| 196 | |||
| 197 | (defun xwidget-webkit-callback (xwidget xwidget-event-type) | ||
| 198 | "Callback for xwidgets. | ||
| 199 | XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." | ||
| 200 | (if (not (buffer-live-p (xwidget-buffer xwidget))) | ||
| 201 | (xwidget-log | ||
| 202 | "error: callback called for xwidget with dead buffer") | ||
| 203 | (with-current-buffer (xwidget-buffer xwidget) | ||
| 204 | (let* ((strarg (nth 3 last-input-event))) | ||
| 205 | (cond ((eq xwidget-event-type 'document-load-finished) | ||
| 206 | (xwidget-log "webkit finished loading: '%s'" | ||
| 207 | (xwidget-webkit-get-title xwidget)) | ||
| 208 | ;;TODO - check the native/internal scroll | ||
| 209 | ;;(xwidget-adjust-size-to-content xwidget) | ||
| 210 | (xwidget-webkit-adjust-size-dispatch) ;;TODO xwidget arg | ||
| 211 | (rename-buffer (format "*xwidget webkit: %s *" | ||
| 212 | (xwidget-webkit-get-title xwidget))) | ||
| 213 | (pop-to-buffer (current-buffer))) | ||
| 214 | ((eq xwidget-event-type | ||
| 215 | 'navigation-policy-decision-requested) | ||
| 216 | (if (string-match ".*#\\(.*\\)" strarg) | ||
| 217 | (xwidget-webkit-show-id-or-named-element | ||
| 218 | xwidget | ||
| 219 | (match-string 1 strarg)))) | ||
| 220 | (t (xwidget-log "unhandled event:%s" xwidget-event-type))))))) | ||
| 221 | |||
| 222 | (defvar bookmark-make-record-function) | ||
| 223 | (define-derived-mode xwidget-webkit-mode | ||
| 224 | special-mode "xwidget-webkit" "Xwidget webkit view mode." | ||
| 225 | (setq buffer-read-only t) | ||
| 226 | (setq-local bookmark-make-record-function | ||
| 227 | #'xwidget-webkit-bookmark-make-record) | ||
| 228 | ;; Keep track of [vh]scroll when switching buffers | ||
| 229 | (image-mode-setup-winprops)) | ||
| 230 | |||
| 231 | (defun xwidget-webkit-bookmark-make-record () | ||
| 232 | "Integrate Emacs bookmarks with the webkit xwidget." | ||
| 233 | (nconc (bookmark-make-record-default t t) | ||
| 234 | `((page . ,(xwidget-webkit-current-url)) | ||
| 235 | (handler . (lambda (bmk) (browse-url | ||
| 236 | (bookmark-prop-get bmk 'page))))))) | ||
| 237 | |||
| 238 | |||
| 239 | (defvar xwidget-webkit-last-session-buffer nil) | ||
| 240 | |||
| 241 | (defun xwidget-webkit-last-session () | ||
| 242 | "Last active webkit, or nil." | ||
| 243 | (if (buffer-live-p xwidget-webkit-last-session-buffer) | ||
| 244 | (with-current-buffer xwidget-webkit-last-session-buffer | ||
| 245 | (xwidget-at (point-min))) | ||
| 246 | nil)) | ||
| 247 | |||
| 248 | (defun xwidget-webkit-current-session () | ||
| 249 | "Either the webkit in the current buffer, or the last one used. | ||
| 250 | The latter might be nil." | ||
| 251 | (or (xwidget-at (point-min)) (xwidget-webkit-last-session))) | ||
| 252 | |||
| 253 | (defun xwidget-adjust-size-to-content (xw) | ||
| 254 | "Resize XW to content." | ||
| 255 | ;; xwidgets doesn't support widgets that have their own opinions about | ||
| 256 | ;; size well, yet this reads the desired size and resizes the Emacs | ||
| 257 | ;; allocated area accordingly. | ||
| 258 | (let ((size (xwidget-size-request xw))) | ||
| 259 | (xwidget-resize xw (car size) (cadr size)))) | ||
| 260 | |||
| 261 | |||
| 262 | (defvar xwidget-webkit-activeelement-js" | ||
| 263 | function findactiveelement(doc){ | ||
| 264 | //alert(doc.activeElement.value); | ||
| 265 | if(doc.activeElement.value != undefined){ | ||
| 266 | return doc.activeElement; | ||
| 267 | }else{ | ||
| 268 | // recurse over the child documents: | ||
| 269 | var frames = doc.getElementsByTagName('frame'); | ||
| 270 | for (var i = 0; i < frames.length; i++) | ||
| 271 | { | ||
| 272 | var d = frames[i].contentDocument; | ||
| 273 | var rv = findactiveelement(d); | ||
| 274 | if(rv != undefined){ | ||
| 275 | return rv; | ||
| 276 | } | ||
| 277 | } | ||
| 278 | } | ||
| 279 | return undefined; | ||
| 280 | }; | ||
| 281 | |||
| 282 | |||
| 283 | " | ||
| 284 | |||
| 285 | "javascript that finds the active element." | ||
| 286 | ;; Yes it's ugly, because: | ||
| 287 | ;; - there is apparently no way to find the active frame other than recursion | ||
| 288 | ;; - the js "for each" construct misbehaved on the "frames" collection | ||
| 289 | ;; - a window with no frameset still has frames.length == 1, but | ||
| 290 | ;; frames[0].document.activeElement != document.activeElement | ||
| 291 | ;;TODO the activeelement type needs to be examined, for iframe, etc. | ||
| 292 | ) | ||
| 293 | |||
| 294 | (defun xwidget-webkit-insert-string (xw str) | ||
| 295 | "Insert string in the active field in the webkit. | ||
| 296 | Argument XW webkit. | ||
| 297 | Argument STR string." | ||
| 298 | ;; Read out the string in the field first and provide for edit. | ||
| 299 | (interactive | ||
| 300 | (let* ((xww (xwidget-webkit-current-session)) | ||
| 301 | |||
| 302 | (field-value | ||
| 303 | (progn | ||
| 304 | (xwidget-webkit-execute-script xww xwidget-webkit-activeelement-js) | ||
| 305 | (xwidget-webkit-execute-script-rv | ||
| 306 | xww | ||
| 307 | "findactiveelement(document).value;"))) | ||
| 308 | (field-type (xwidget-webkit-execute-script-rv | ||
| 309 | xww | ||
| 310 | "findactiveelement(document).type;"))) | ||
| 311 | (list xww | ||
| 312 | (cond ((equal "text" field-type) | ||
| 313 | (read-string "text:" field-value)) | ||
| 314 | ((equal "password" field-type) | ||
| 315 | (read-passwd "password:" nil field-value)) | ||
| 316 | ((equal "textarea" field-type) | ||
| 317 | (xwidget-webkit-begin-edit-textarea xww field-value)))))) | ||
| 318 | (xwidget-webkit-execute-script | ||
| 319 | xw | ||
| 320 | (format "findactiveelement(document).value='%s'" str))) | ||
| 321 | |||
| 322 | (defvar xwidget-xwbl) | ||
| 323 | (defun xwidget-webkit-begin-edit-textarea (xw text) | ||
| 324 | "Start editing of a webkit text area. | ||
| 325 | XW is the xwidget identifier, TEXT is retrieved from the webkit." | ||
| 326 | (switch-to-buffer | ||
| 327 | (generate-new-buffer "textarea")) | ||
| 328 | |||
| 329 | (set (make-local-variable 'xwidget-xwbl) xw) | ||
| 330 | (insert text)) | ||
| 331 | |||
| 332 | (defun xwidget-webkit-end-edit-textarea () | ||
| 333 | "End editing of a webkit text area." | ||
| 334 | (interactive) | ||
| 335 | (goto-char (point-min)) | ||
| 336 | (while (search-forward "\n" nil t) | ||
| 337 | (replace-match "\\n" nil t)) | ||
| 338 | (xwidget-webkit-execute-script | ||
| 339 | xwidget-xwbl | ||
| 340 | (format "findactiveelement(document).value='%s'" | ||
| 341 | (buffer-substring (point-min) (point-max)))) | ||
| 342 | ;;TODO convert linefeed to \n | ||
| 343 | ) | ||
| 344 | |||
| 345 | (defun xwidget-webkit-show-named-element (xw element-name) | ||
| 346 | "Make named-element show. for instance an anchor. | ||
| 347 | Argument XW is the xwidget. | ||
| 348 | Argument ELEMENT-NAME is the element name to display in the webkit xwidget." | ||
| 349 | (interactive (list (xwidget-webkit-current-session) | ||
| 350 | (read-string "element name:"))) | ||
| 351 | ;;TODO since an xwidget is an Emacs object, it is not trivial to do | ||
| 352 | ;; some things that are taken for granted in a normal browser. | ||
| 353 | ;; scrolling an anchor/named-element into view is one such thing. | ||
| 354 | ;; This function implements a proof-of-concept for this. Problems | ||
| 355 | ;; remaining: - The selected window is scrolled but this is not | ||
| 356 | ;; always correct - This needs to be interfaced into browse-url | ||
| 357 | ;; somehow. The tricky part is that we need to do this in two steps: | ||
| 358 | ;; A: load the base url, wait for load signal to arrive B: navigate | ||
| 359 | ;; to the anchor when the base url is finished rendering | ||
| 360 | |||
| 361 | ;; This part figures out the Y coordinate of the element | ||
| 362 | (let ((y (string-to-number | ||
| 363 | (xwidget-webkit-execute-script-rv | ||
| 364 | xw | ||
| 365 | (format | ||
| 366 | "document.getElementsByName('%s')[0].getBoundingClientRect().top" | ||
| 367 | element-name) | ||
| 368 | 0)))) | ||
| 369 | ;; Now we need to tell Emacs to scroll the element into view. | ||
| 370 | (xwidget-log "scroll: %d" y) | ||
| 371 | (set-window-vscroll (selected-window) y t))) | ||
| 372 | |||
| 373 | (defun xwidget-webkit-show-id-element (xw element-id) | ||
| 374 | "Make id-element show. for instance an anchor. | ||
| 375 | Argument XW is the webkit xwidget. | ||
| 376 | Argument ELEMENT-ID is the id of the element to show." | ||
| 377 | (interactive (list (xwidget-webkit-current-session) | ||
| 378 | (read-string "element id:"))) | ||
| 379 | (let ((y (string-to-number | ||
| 380 | (xwidget-webkit-execute-script-rv | ||
| 381 | xw | ||
| 382 | (format "document.getElementById('%s').getBoundingClientRect().top" | ||
| 383 | element-id) | ||
| 384 | 0)))) | ||
| 385 | ;; Now we need to tell Emacs to scroll the element into view. | ||
| 386 | (xwidget-log "scroll: %d" y) | ||
| 387 | (set-window-vscroll (selected-window) y t))) | ||
| 388 | |||
| 389 | (defun xwidget-webkit-show-id-or-named-element (xw element-id) | ||
| 390 | "Make id-element show. for instance an anchor. | ||
| 391 | Argument XW is the webkit xwidget. | ||
| 392 | Argument ELEMENT-ID is either a name or an element id." | ||
| 393 | (interactive (list (xwidget-webkit-current-session) | ||
| 394 | (read-string "element id:"))) | ||
| 395 | (let* ((y1 (string-to-number | ||
| 396 | (xwidget-webkit-execute-script-rv | ||
| 397 | xw | ||
| 398 | (format "document.getElementsByName('%s')[0].getBoundingClientRect().top" element-id) | ||
| 399 | "0"))) | ||
| 400 | (y2 (string-to-number | ||
| 401 | (xwidget-webkit-execute-script-rv | ||
| 402 | xw | ||
| 403 | (format "document.getElementById('%s').getBoundingClientRect().top" element-id) | ||
| 404 | "0"))) | ||
| 405 | (y3 (max y1 y2))) | ||
| 406 | ;; Now we need to tell Emacs to scroll the element into view. | ||
| 407 | (xwidget-log "scroll: %d" y3) | ||
| 408 | (set-window-vscroll (selected-window) y3 t))) | ||
| 409 | |||
| 410 | (defun xwidget-webkit-adjust-size-to-content () | ||
| 411 | "Adjust webkit to content size." | ||
| 412 | (interactive) | ||
| 413 | (xwidget-adjust-size-to-content (xwidget-webkit-current-session))) | ||
| 414 | |||
| 415 | (defun xwidget-webkit-adjust-size-dispatch () | ||
| 416 | "Adjust size according to mode." | ||
| 417 | (interactive) | ||
| 418 | (if (eq xwidget-webkit-scroll-behaviour 'native) | ||
| 419 | (xwidget-webkit-adjust-size-to-window) | ||
| 420 | (xwidget-webkit-adjust-size-to-content)) | ||
| 421 | ;; The recenter is intended to correct a visual glitch. | ||
| 422 | ;; It errors out if the buffer isn't visible, but then we don't get | ||
| 423 | ;; the glitch, so silence errors. | ||
| 424 | (ignore-errors | ||
| 425 | (recenter-top-bottom)) | ||
| 426 | ) | ||
| 427 | |||
| 428 | (defun xwidget-webkit-adjust-size-to-window () | ||
| 429 | "Adjust webkit to window." | ||
| 430 | (interactive) | ||
| 431 | (xwidget-resize (xwidget-webkit-current-session) (window-pixel-width) | ||
| 432 | (window-pixel-height))) | ||
| 433 | |||
| 434 | (defun xwidget-webkit-adjust-size (w h) | ||
| 435 | "Manually set webkit size. | ||
| 436 | Argument W width. | ||
| 437 | Argument H height." | ||
| 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 | "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. place it on 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 but with return value. | ||
| 493 | XW is the webkit instance. SCRIPT is the script to execute. | ||
| 494 | DEFAULT is the defaultreturn 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 | "Return the value of XWIDGET' PROPNAME property. | ||
| 531 | This is the last value stored with `(xwidget-put XWIDGET PROPNAME VALUE)'." | ||
| 532 | (plist-get (xwidget-plist xwidget) propname)) | ||
| 533 | |||
| 534 | (defun xwidget-put (xwidget propname value) | ||
| 535 | "Change XWIDGET' PROPNAME property to VALUE. | ||
| 536 | It can be retrieved with `(xwidget-get XWIDGET PROPNAME)'." | ||
| 537 | (set-xwidget-plist xwidget | ||
| 538 | (plist-put (xwidget-plist xwidget) propname value))) | ||
| 539 | |||
| 540 | |||
| 541 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 542 | |||
| 543 | (defvar xwidget-view-list) ; xwidget.c | ||
| 544 | (defvar xwidget-list) ; xwidget.c | ||
| 545 | |||
| 546 | (defun xwidget-delete-zombies () | ||
| 547 | "Helper for `xwidget-cleanup'." | ||
| 548 | (dolist (xwidget-view xwidget-view-list) | ||
| 549 | (when (or (not (window-live-p (xwidget-view-window xwidget-view))) | ||
| 550 | (not (memq (xwidget-view-model xwidget-view) | ||
| 551 | xwidget-list))) | ||
| 552 | (delete-xwidget-view xwidget-view)))) | ||
| 553 | |||
| 554 | (defun xwidget-cleanup () | ||
| 555 | "Delete zombie xwidgets." | ||
| 556 | ;; During development it was sometimes easy to wind up with zombie | ||
| 557 | ;; xwidget instances. | ||
| 558 | ;; This function tries to implement a workaround should it occur again. | ||
| 559 | (interactive) | ||
| 560 | ;; Kill xviews that should have been deleted but still linger. | ||
| 561 | (xwidget-delete-zombies) | ||
| 562 | ;; Redraw display otherwise ghost of zombies will remain to haunt the screen | ||
| 563 | (redraw-display)) | ||
| 564 | |||
| 565 | (defun xwidget-kill-buffer-query-function () | ||
| 566 | "Ask before killing a buffer that has xwidgets." | ||
| 567 | (let ((xwidgets (get-buffer-xwidgets (current-buffer)))) | ||
| 568 | (or (not xwidgets) | ||
| 569 | (not (memq t (mapcar #'xwidget-query-on-exit-flag xwidgets))) | ||
| 570 | (yes-or-no-p | ||
| 571 | (format "Buffer %S has xwidgets; kill it? " (buffer-name)))))) | ||
| 572 | |||
| 573 | (when (featurep 'xwidget-internal) | ||
| 574 | (add-hook 'kill-buffer-query-functions #'xwidget-kill-buffer-query-function) | ||
| 575 | ;; This would have felt better in C, but this seems to work well in | ||
| 576 | ;; practice though. | ||
| 577 | (add-hook 'window-configuration-change-hook #'xwidget-delete-zombies)) | ||
| 578 | |||
| 579 | (provide 'xwidget) | ||
| 580 | ;;; xwidget.el ends here | ||