code.delx.au - gnu-emacs/blob - lisp/xwidget.el

   1 ;;; xwidget.el --- api functions for xwidgets
   2 ;;  see xwidget.c for more api functions
   3
   4
   5 ;;; Commentary:
   6 ;;
   7
   8 ;;TODO this breaks compilation when we dont have xwidgets
   9 ;;(require 'xwidget-internal)
  10
  11 ;;TODO model after make-text-button instead!
  12 ;;; Code:
  13
  14 (eval-when-compile (require 'cl))
  15 (require 'reporter)
  16
  17 (defun xwidget-insert (pos type title width height)
  18   "Insert an xwidget at POS, given ID, TYPE, TITLE WIDTH and
  19 HEIGHT in the current buffer.
  20
  21 Return ID
  22
  23 see `make-xwidget' for types suitable for TYPE."
  24   (goto-char pos)
  25   (let ((id (make-xwidget (point) (point)
  26                           type title width height nil)))
  27     (put-text-property (point) (+ 1 (point))
  28                        'display (list 'xwidget ':xwidget id))
  29     id))
  30
  31 (defun xwidget-at (pos)
  32   "Return xwidget at POS."
  33   ;;TODO this function is a bit tedious because the C layer isnt well protected yet and
  34   ;;xwidgetp aparently doesnt work yet
  35   (let* ((disp (get-text-property pos 'display))
  36          (xw (car (cdr (cdr  disp)))))
  37     ;;(if ( xwidgetp  xw) xw nil)
  38     (if (equal 'xwidget (car disp)) xw)))
  39
  40
  41 ;; (defun xwidget-socket-handler ()
  42 ;;   "Create plug for socket.  TODO."
  43 ;;   (interactive)
  44 ;;   (message "socket handler xwidget %S" last-input-event)
  45 ;;   (let*
  46 ;;       ((xwidget-event-type (nth 2 last-input-event))
  47 ;;        (xwidget-id (nth 1 last-input-event)))
  48 ;;     (cond ( (eq xwidget-event-type 'xembed-ready)
  49 ;;             (let*
  50 ;;                 ((xembed-id (nth 3 last-input-event)))
  51 ;;               (message "xembed ready  event: %S xw-id:%s" xembed-id xwidget-id)
  52 ;;               ;;TODO fetch process data from the xwidget. create it, store process info
  53 ;;               ;;will start emacs/uzbl in a xembed socket when its ready
  54 ;;               ;; (cond
  55 ;;               ;;  ((eq 3 xwidget-id)
  56 ;;               ;;   (start-process "xembed" "*xembed*" (format "%ssrc/emacs" default-directory) "-q" "--parent-id" (number-to-string xembed-id) ) )
  57 ;;               ;;  ((eq 5 xwidget-id)
  58 ;;               ;;   (start-process "xembed2" "*xembed2*" "uzbl-core"  "-s" (number-to-string xembed-id)  "http://www.fsf.org" )  )
  59 ;;               )))))
  60
  61 (defun xwidget-display (xwidget)
  62   "Force xwidget to be displayed to create a xwidget_view. Return
  63 the window displaying XWIDGET."
  64   (let* ((buffer (xwidget-buffer xwidget))
  65          (window (display-buffer buffer))
  66          (frame (window-frame window)))
  67     (set-frame-visible frame t)
  68     (redisplay t)
  69     window))
  70
  71
  72 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  73 ;;; webkit support
  74 (require 'browse-url)
  75 (require 'image-mode);;for some image-mode alike functionality
  76 (require 'cl-macs);;for flet
  77
  78 ;;;###autoload
  79 (defun xwidget-webkit-browse-url (url &optional new-session)
  80   "Ask xwidget-webkit to browse URL.
  81 NEW-SESSION specifies whether to create a new xwidget-webkit session.  URL
  82 defaults to the string looking like a url around the cursor position."
  83   (interactive (progn
  84                  (require 'browse-url)
  85                  (browse-url-interactive-arg "xwidget-webkit URL: "
  86                                              ;;( xwidget-webkit-current-url)
  87                                              )))
  88   (when (stringp url)
  89     (setq url (url-tidy url))
  90     (if new-session
  91         (xwidget-webkit-new-session url)
  92       (xwidget-webkit-goto-url url))))
  93
  94
  95 ;;shims for adapting image mode code to the webkit browser window
  96 (defun xwidget-image-display-size  (spec &optional pixels frame)
  97   "Image code adaptor.  SPEC PIXELS FRAME like the corresponding `image-mode' fn."
  98   (let ((xwi (xwidget-info  (xwidget-at 1))))
  99     (cons (aref xwi 2)
 100           (aref xwi 3))))
 101
 102 (defadvice image-display-size (around image-display-size-for-xwidget
 103                                       (spec &optional pixels frame)
 104                                       activate)
 105   (if (eq (car spec) 'xwidget)
 106       (setq ad-return-value (xwidget-image-display-size spec pixels frame))
 107     ad-do-it))
 108
 109 ;;todo.
 110 ;; - check that the webkit support is compiled in
 111 (defvar xwidget-webkit-mode-map
 112   (let ((map (make-sparse-keymap)))
 113     (define-key map "g" 'xwidget-webkit-browse-url)
 114     (define-key map "a" 'xwidget-webkit-adjust-size-to-content)
 115     (define-key map "b" 'xwidget-webkit-back )
 116     (define-key map "r" 'xwidget-webkit-reload )
 117     (define-key map "t" (lambda () (interactive) (message "o")) )
 118     (define-key map "\C-m" 'xwidget-webkit-insert-string)
 119     (define-key map "w" 'xwidget-webkit-current-url)
 120
 121     ;;similar to image mode bindings
 122     (define-key map (kbd "SPC")                    'image-scroll-up)
 123     (define-key map (kbd "DEL")                    'image-scroll-down)
 124
 125     (define-key map [remap scroll-up]              'image-scroll-up)
 126     (define-key map [remap scroll-up-command]      'image-scroll-up)
 127
 128     (define-key map [remap scroll-down]            'image-scroll-down)
 129     (define-key map [remap scroll-down-command]    'image-scroll-down)
 130
 131     (define-key map [remap forward-char]           'image-forward-hscroll)
 132     (define-key map [remap backward-char]          'image-backward-hscroll)
 133     (define-key map [remap right-char]             'image-forward-hscroll)
 134     (define-key map [remap left-char]              'image-backward-hscroll)
 135     (define-key map [remap previous-line]          'image-previous-line)
 136     (define-key map [remap next-line]              'image-next-line)
 137
 138     (define-key map [remap move-beginning-of-line] 'image-bol)
 139     (define-key map [remap move-end-of-line]       'image-eol)
 140     (define-key map [remap beginning-of-buffer]    'image-bob)
 141     (define-key map [remap end-of-buffer]          'image-eob)
 142     map)
 143   "Keymap for `xwidget-webkit-mode'.")
 144
 145 ;;the xwidget event needs to go into a higher level handler
 146 ;;since the xwidget can generate an event even if its offscreen
 147 ;;TODO this needs to use callbacks and consider different xw ev types
 148 (define-key (current-global-map) [xwidget-event] 'xwidget-event-handler)
 149 (defun xwidget-log ( &rest msg)
 150   (let ( (buf  (get-buffer-create "*xwidget-log*")))
 151     (save-excursion
 152       (buffer-disable-undo buf)
 153       (set-buffer buf)
 154       (insert (apply  'format msg))
 155       (insert "\n"))))
 156
 157 (defun xwidget-event-handler ()
 158   "Receive xwidget event."
 159   (interactive)
 160   (xwidget-log "stuff happened to xwidget %S" last-input-event)
 161   (let*
 162       ((xwidget-event-type (nth 1 last-input-event))
 163        (xwidget (nth 2 last-input-event))
 164                                         ;(xwidget-callback (xwidget-get xwidget 'callback));;TODO stopped working for some reason
 165        )
 166                                         ;(funcall  xwidget-callback xwidget xwidget-event-type)
 167     (message "xw callback %s" xwidget)
 168     (funcall  'xwidget-webkit-callback xwidget xwidget-event-type)))
 169
 170 (defun xwidget-webkit-callback (xwidget xwidget-event-type)
 171   (save-excursion
 172     (cond ((buffer-live-p (xwidget-buffer xwidget))
 173            (set-buffer (xwidget-buffer xwidget))
 174            (let* ((strarg  (nth 3 last-input-event)))
 175              (cond ((eq xwidget-event-type 'document-load-finished)
 176                     (xwidget-log "webkit finished loading: '%s'" (xwidget-webkit-get-title xwidget))
 177                     (xwidget-adjust-size-to-content xwidget)
 178                     (rename-buffer (format "*xwidget webkit: %s *" (xwidget-webkit-get-title xwidget)))
 179                     (pop-to-buffer (current-buffer)))
 180                    ((eq xwidget-event-type 'navigation-policy-decision-requested)
 181                     (if (string-match ".*#\\(.*\\)" strarg)
 182                         (xwidget-webkit-show-id-or-named-element xwidget (match-string 1 strarg))))
 183                    (t (xwidget-log "unhandled event:%s" xwidget-event-type)))))
 184           (t (xwidget-log "error: callback called for xwidget with dead buffer")))))
 185
 186 (define-derived-mode xwidget-webkit-mode
 187   special-mode "xwidget-webkit" "xwidget webkit view mode"
 188   (setq buffer-read-only t)
 189   ;; Keep track of [vh]scroll when switching buffers
 190   (image-mode-setup-winprops))
 191
 192 (defvar xwidget-webkit-last-session-buffer nil)
 193
 194 (defun  xwidget-webkit-last-session ()
 195   "Last active webkit, or nil."
 196   (if (buffer-live-p xwidget-webkit-last-session-buffer)
 197       (with-current-buffer xwidget-webkit-last-session-buffer
 198         (xwidget-at 1))
 199     nil))
 200
 201 (defun xwidget-webkit-current-session ()
 202   "Either the webkit in the current buffer, or the last one used, which might be nil."
 203   (if (xwidget-at 1)
 204       (xwidget-at 1)
 205     (xwidget-webkit-last-session)))
 206
 207 (defun xwidget-adjust-size-to-content (xw)
 208   "Resize XW to content."
 209   ;;xwidgets doesnt support widgets that have their own opinions about size well yet
 210   ;;this reads the desired size and resizes the emacs allocated area accordingly
 211   (let ((size (xwidget-size-request xw)))
 212     (xwidget-resize xw (car size) (cadr size))))
 213
 214
 215 (defvar xwidget-webkit-activeelement-js"
 216 function findactiveelement(doc){
 217 //alert(doc.activeElement.value);
 218    if(doc.activeElement.value != undefined){
 219       return doc.activeElement;
 220    }else{
 221         // recurse over the child documents:
 222         var frames = doc.getElementsByTagName('frame');
 223         for (var i = 0; i < frames.length; i++)
 224         {
 225                 var d = frames[i].contentDocument;
 226                  var rv = findactiveelement(d);
 227                  if(rv != undefined){
 228                     return rv;
 229                  }
 230         }
 231     }
 232     return undefined;
 233 };
 234
 235
 236 "
 237
 238   "javascript that finds the active element."
 239   ;;yes its ugly. because:
 240   ;; - there is aparently no way to find the active frame other than recursion
 241   ;; - the js "for each" construct missbehaved on the "frames" collection
 242   ;; - a window with no frameset still has frames.length == 1, but frames[0].document.activeElement != document.activeElement
 243   ;;TODO the activeelement type needs to be examined, for iframe, etc. sucks.
 244   )
 245
 246 (defun xwidget-webkit-insert-string (xw str)
 247   "Insert string in the active field in the webkit.
 248 Argument XW webkit.
 249 Argument STR string."
 250   ;;read out the string in the field first and provide for edit
 251   (interactive
 252    (let* ((xww (xwidget-webkit-current-session))
 253
 254           (field-value
 255            (progn
 256              (xwidget-webkit-execute-script xww xwidget-webkit-activeelement-js)
 257              (xwidget-webkit-execute-script-rv xww "findactiveelement(document).value;" )))
 258           (field-type (xwidget-webkit-execute-script-rv xww "findactiveelement(document).type;" )))
 259      (list xww
 260            (cond ((equal "text" field-type)
 261                   (read-string "text:" field-value))
 262                  ((equal "password" field-type)
 263                   (read-passwd "password:" nil field-value))
 264                  ((equal "textarea" field-type)
 265                   (xwidget-webkit-begin-edit-textarea xww field-value))))))
 266   (xwidget-webkit-execute-script xw (format "findactiveelement(document).value='%s'" str)))
 267
 268
 269 (defun xwidget-webkit-begin-edit-textarea (xw text)
 270   (switch-to-buffer
 271    (generate-new-buffer "textarea"))
 272
 273   (set (make-local-variable 'xwbl) xw)
 274   (insert text))
 275
 276 (defun xwidget-webkit-end-edit-textarea ()
 277   (interactive)
 278   (goto-char (point-min))
 279   (while (search-forward "\n" nil t)
 280     (replace-match "\\n" nil t))
 281   (xwidget-webkit-execute-script xwbl (format "findactiveelement(document).value='%s'"
 282                                               (buffer-substring (point-min) (point-max))))
 283   ;;TODO convert linefeed to \n
 284   )
 285
 286 (defun xwidget-webkit-show-named-element (xw element-name)
 287   "make named-element show. for instance an anchor."
 288   (interactive (list (xwidget-webkit-current-session) (read-string "element name:")))
 289   ;;TODO
 290   ;; since an xwidget is an Emacs object, it is not trivial to do some things that are taken for granted in a normal browser.
 291   ;; scrolling an anchor/named-element into view is one such thing.
 292   ;; this function implements a proof-of-concept for this.
 293   ;; problems remaining:
 294   ;; - the selected window is scrolled but this is not always correct
 295   ;; - this needs to be interfaced into browse-url somehow. the tricky part is that we need to do this in two steps:
 296   ;;   A: load the base url, wait for load signal to arrive B: navigate to the anchor when the base url is finished rendering
 297
 298   ;;this part figures out the Y coordinate of the element
 299   (let ((y (string-to-number
 300             (xwidget-webkit-execute-script-rv xw
 301                                               (format "document.getElementsByName('%s')[0].getBoundingClientRect().top" element-name)
 302                                               0))))
 303     ;;now we need to tell emacs to scroll the element into view.
 304     (xwidget-log "scroll: %d" y)
 305     (set-window-vscroll (selected-window) y t)))
 306
 307 (defun xwidget-webkit-show-id-element (xw element-id)
 308   "make id-element show. for instance an anchor."
 309   (interactive (list (xwidget-webkit-current-session)
 310                      (read-string "element id:")))
 311   (let ((y (string-to-number
 312             (xwidget-webkit-execute-script-rv xw
 313                                               (format "document.getElementById('%s').getBoundingClientRect().top" element-id)
 314                                               0))))
 315     ;;now we need to tell emacs to scroll the element into view.
 316     (xwidget-log "scroll: %d" y)
 317     (set-window-vscroll (selected-window) y t)))
 318
 319 (defun xwidget-webkit-show-id-or-named-element (xw element-id)
 320   "make id-element show. for instance an anchor."
 321   (interactive (list (xwidget-webkit-current-session)
 322                      (read-string "element id:")))
 323   (let* ((y1 (string-to-number
 324               (xwidget-webkit-execute-script-rv xw
 325                                                 (format "document.getElementsByName('%s')[0].getBoundingClientRect().top" element-id)
 326                                                 "0")))
 327          (y2 (string-to-number
 328               (xwidget-webkit-execute-script-rv xw
 329                                                 (format "document.getElementById('%s').getBoundingClientRect().top" element-id)
 330                                                 "0")))
 331          (y3 (max y1 y2)))
 332     ;;now we need to tell emacs to scroll the element into view.
 333     (xwidget-log "scroll: %d" y3)
 334     (set-window-vscroll (selected-window) y3 t)))
 335
 336 (defun xwidget-webkit-adjust-size-to-content ()
 337   "Adjust webkit to content size."
 338   (interactive)
 339   (xwidget-adjust-size-to-content (xwidget-webkit-current-session)))
 340
 341 (defun xwidget-webkit-adjust-size (w h)
 342   "Manualy set webkit size.
 343 Argument W width.
 344 Argument H height."
 345   ;;TODO shouldnt be tied to the webkit xwidget
 346   (interactive "nWidth:\nnHeight:\n")
 347   (xwidget-resize ( xwidget-webkit-current-session) w h))
 348
 349 (defun xwidget-webkit-fit-width ()
 350   (interactive)
 351   (xwidget-webkit-adjust-size (- (caddr (window-inside-pixel-edges))
 352                                  (car (window-inside-pixel-edges)))
 353                               1000))
 354
 355 (defun xwidget-webkit-new-session (url)
 356   "Create a new webkit session buffer with URL."
 357   (let*
 358       ((bufname (generate-new-buffer-name "*xwidget-webkit*"))
 359        xw)
 360     (setq xwidget-webkit-last-session-buffer (switch-to-buffer (get-buffer-create bufname)))
 361     (insert " ")
 362     (setq xw (xwidget-insert 1 'webkit-osr  bufname 1000 1000))
 363     (xwidget-put xw 'callback 'xwidget-webkit-callback)
 364     (xwidget-webkit-mode)
 365     (xwidget-webkit-goto-uri (xwidget-webkit-last-session) url )))
 366
 367
 368 (defun xwidget-webkit-goto-url (url)
 369   "Goto URL."
 370   (if (xwidget-webkit-current-session)
 371       (progn
 372         (xwidget-webkit-goto-uri (xwidget-webkit-current-session) url))
 373     (xwidget-webkit-new-session url)))
 374
 375 (defun xwidget-webkit-back ()
 376   "Back in history."
 377   (interactive)
 378   (xwidget-webkit-execute-script (xwidget-webkit-current-session)  "history.go(-1);"))
 379
 380 (defun xwidget-webkit-reload ()
 381   "Reload current url."
 382   (interactive)
 383   (xwidget-webkit-execute-script (xwidget-webkit-current-session)  "history.go(0);"))
 384
 385 (defun xwidget-webkit-current-url ()
 386   "Get the webkit url. place it on kill ring."
 387   (interactive)
 388   (let* ((rv (xwidget-webkit-execute-script-rv (xwidget-webkit-current-session)
 389                                                "document.URL"))
 390          (url (kill-new (or rv ""))))
 391     (message "url: %s" url )
 392     url))
 393
 394 (defun xwidget-webkit-execute-script-rv (xw script &optional default)
 395   "same as xwidget-webkit-execute-script but also wraps an ugly hack to return a value"
 396   ;;notice the fugly "title" hack. it is needed because the webkit api doesnt support returning values.
 397   ;;this is a wrapper for the title hack so its easy to remove should webkit someday support JS return values
 398   ;;or we find some other way to access the DOM
 399
 400   ;;reset webkit title. fugly.
 401   (let* ((emptytag "titlecantbewhitespaceohthehorror")
 402          title)
 403     (xwidget-webkit-execute-script xw (format "document.title=\"%s\";" (or default emptytag)))
 404     (xwidget-webkit-execute-script xw (format "document.title=%s;" script))
 405     (setq title (xwidget-webkit-get-title xw))
 406     (if (equal emptytag title)
 407         (setq title ""))
 408     (unless title
 409       (setq title default))
 410     title))
 411
 412
 413 ;; use declare here?
 414 ;; (declare-function xwidget-resize-internal "xwidget.c" )
 415 ;; check-declare-function?
 416
 417 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 418 (defun xwidget-webkit-get-selection ()
 419   (xwidget-webkit-execute-script-rv (xwidget-webkit-current-session)
 420                                     "window.getSelection().toString();"))
 421
 422 (defun xwidget-webkit-copy-selection-as-kill ()
 423   (interactive)
 424   (kill-new (xwidget-webkit-get-selection)))
 425
 426
 427 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 428 ;; xwidget plist management(similar to the process plist functions)
 429
 430 (defun xwidget-get (xwidget propname)
 431   "Return the value of XWIDGET' PROPNAME property.
 432 This is the last value stored with `(xwidget-put XWIDGET PROPNAME VALUE)'."
 433   (plist-get (xwidget-plist xwidget) propname))
 434
 435 (defun xwidget-put (xwidget propname value)
 436   "Change XWIDGET' PROPNAME property to VALUE.
 437 It can be retrieved with `(xwidget-get XWIDGET PROPNAME)'."
 438   (set-xwidget-plist xwidget
 439                      (plist-put (xwidget-plist xwidget) propname value)))
 440
 441
 442 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 443
 444 (defun xwidget-delete-zombies ()
 445   (dolist (xwidget-view xwidget-view-list)
 446     (when (or (not (window-live-p (xwidget-view-window xwidget-view)))
 447               (not (memq (xwidget-view-model xwidget-view)
 448                          xwidget-list)))
 449       (delete-xwidget-view xwidget-view))))
 450
 451 (defun xwidget-cleanup ()
 452   "Delete zombie xwidgets."
 453   ;;its still pretty easy to trigger bugs with xwidgets.
 454   ;;this function tries to implement a workaround
 455   (interactive)
 456   ;; kill xviews who should have been deleted but stull linger
 457   (xwidget-delete-zombies)
 458   ;; redraw display otherwise ghost of zombies  will remain to haunt the screen
 459   (redraw-display))
 460
 461 ;;this is a workaround because I cant find the right place to put it in C
 462 ;;seems to work well in practice though
 463 ;;(add-hook 'window-configuration-change-hook 'xwidget-cleanup)
 464 (add-hook 'window-configuration-change-hook 'xwidget-delete-zombies)
 465
 466 (defun xwidget-kill-buffer-query-function ()
 467   "Ask beforek illing a buffer that has xwidgets."
 468   (let ((xwidgets (get-buffer-xwidgets (current-buffer))))
 469     (or (not xwidgets)
 470         (not (memq t (mapcar 'xwidget-query-on-exit-flag xwidgets)))
 471         (yes-or-no-p
 472          (format "Buffer %S has xwidgets; kill it? "
 473                  (buffer-name (current-buffer)))))))
 474
 475 (add-hook 'kill-buffer-query-functions 'xwidget-kill-buffer-query-function)
 476
 477 ;;killflash is sadly not reliable yet.
 478 (defvar xwidget-webkit-kill-flash-oneshot t)
 479 (defun xwidget-webkit-kill-flash ()
 480   "Disable the flash plugin in webkit.
 481 This is needed because Flash is non-free and doesnt work reliably
 482 on 64 bit systems and offscreen rendering.  Sadly not reliable
 483 yet, so deinstall Flash instead for now."
 484   ;;you can only call this once or webkit crashes and takes emacs with it. odd.
 485   (unless xwidget-webkit-kill-flash-oneshot
 486     (xwidget-disable-plugin-for-mime "application/x-shockwave-flash")
 487     (setq xwidget-webkit-kill-flash-oneshot t)))
 488
 489 (xwidget-webkit-kill-flash)
 490
 491 (defun report-xwidget-bug ()
 492   "Report a bug in GNU Emacs about the XWidget branch.
 493 Prompts for bug subject.  Leaves you in a mail buffer."
 494   (interactive)
 495   (let ((reporter-prompt-for-summary-p t))
 496     (reporter-submit-bug-report "submit@debbugs.gnu.org" nil nil nil nil
 497                                 (format "Package: emacs-xwidgets
 498
 499 Please describee xactly whata ctions triggered the bug, and the
 500 precise symptoms of the bug.  If you can, give a recipe starting
 501 from `emacs -Q'.
 502
 503 If Emacs crashed, and you have the Emacs process in the gdb
 504 deubbger, please include the output from the following gdb
 505 commands:
 506     `bt full' and `xbacktrace'.
 507
 508 For information about debugging Emacs, please read the file
 509 %s" (expand-file-name "DEBUG" data-directory)))))
 510
 511 (provide 'xwidget)
 512
 513 ;;; xwidget.el ends here