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