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