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   (when (stringp url)
  77     (if new-session
  78         (xwidget-webkit-new-session url)
  79       (xwidget-webkit-goto-url url))))
  80
  81
  82 ;;shims for adapting image mode code to the webkit browser window
  83 (defun xwidget-image-display-size  (spec &optional pixels frame)
  84   "Image code adaptor.  SPEC PIXELS FRAME like the corresponding `image-mode' fn."
  85   (let ((xwi (xwidget-info  (xwidget-at 1))))
  86     (cons (aref xwi 2)
  87           (aref xwi 3))))
  88
  89 (defmacro xwidget-image-mode-navigation-adaptor (fn)
  90   "Image code adaptor.  `image-mode' FN is called."
  91   `(lambda () (interactive)
  92      (flet ((image-display-size (spec) (xwidget-image-display-size spec)))
  93        (funcall ,fn ))))
  94
  95 (defmacro xwidget-image-mode-navigation-adaptor-p (fn)
  96     "Image code adaptor.  `image-mode' FN is called with interactive arg."
  97   `(lambda (n) (interactive "p")
  98      (flet ((image-display-size (spec) (xwidget-image-display-size spec)))
  99        (funcall ,fn n))))
 100
 101
 102 ;;todo.
 103 ;; - check that the webkit support is compiled in
 104 (defvar xwidget-webkit-mode-map
 105   (let ((map (make-sparse-keymap)))
 106     (define-key map "g" 'xwidget-webkit-browse-url)
 107     (define-key map "a" 'xwidget-webkit-adjust-size-to-content)
 108     (define-key map "b" 'xwidget-webkit-back )
 109     (define-key map "r" 'xwidget-webkit-reload )
 110     (define-key map "t" (lambda () (interactive) (message "o")) )
 111     (define-key map "\C-m" 'xwidget-webkit-insert-string)
 112     (define-key map "w" 'xwidget-webkit-current-url)
 113
 114     ;;similar to image mode bindings
 115     (define-key map (kbd "SPC")       (xwidget-image-mode-navigation-adaptor   'image-scroll-up))
 116     (define-key map (kbd "DEL")       (xwidget-image-mode-navigation-adaptor   'image-scroll-down))
 117
 118     (define-key map [remap scroll-up]          (xwidget-image-mode-navigation-adaptor 'image-scroll-up))
 119     (define-key map [remap scroll-up-command]  (xwidget-image-mode-navigation-adaptor 'image-scroll-up))
 120
 121     (define-key map [remap scroll-down]       (xwidget-image-mode-navigation-adaptor  'image-scroll-down))
 122     (define-key map [remap scroll-down-command]       (xwidget-image-mode-navigation-adaptor  'image-scroll-down))
 123
 124     (define-key map [remap forward-char]       (xwidget-image-mode-navigation-adaptor-p  'image-forward-hscroll))
 125     (define-key map [remap backward-char]       (xwidget-image-mode-navigation-adaptor-p  'image-backward-hscroll))
 126     (define-key map [remap right-char]       (xwidget-image-mode-navigation-adaptor-p  'image-forward-hscroll))
 127     (define-key map [remap left-char]       (xwidget-image-mode-navigation-adaptor-p  'image-backward-hscroll))
 128     (define-key map [remap previous-line]       (xwidget-image-mode-navigation-adaptor-p  'image-previous-line))
 129     (define-key map [remap next-line]       (xwidget-image-mode-navigation-adaptor-p  'image-next-line))
 130
 131     (define-key map [remap move-beginning-of-line]       (xwidget-image-mode-navigation-adaptor-p  'image-bol))
 132     (define-key map [remap move-end-of-line]       (xwidget-image-mode-navigation-adaptor-p  'image-eol))
 133     (define-key map [remap beginning-of-buffer]       (xwidget-image-mode-navigation-adaptor  'image-bob))
 134     (define-key map [remap end-of-buffer]       (xwidget-image-mode-navigation-adaptor  'image-eob))
 135     map)
 136   "Keymap for `xwidget-webkit-mode'.")
 137
 138 ;;the xwidget event needs to go into a higher level handler
 139 ;;since the xwidget can generate an event even if its offscreen
 140 ;;TODO this needs to use callbacks and consider different xw ev types
 141 (define-key (current-global-map) [xwidget-event] 'xwidget-event-handler)
 142
 143 (defun xwidget-event-handler ()
 144   "Receive xwidget event."
 145   (interactive)
 146   (message "stuff happened to xwidget %S" last-input-event)
 147   (let*
 148       ((xwidget-event-type (nth 1 last-input-event))
 149        (xwidget (nth 2 last-input-event))
 150        (xwidget-callback (xwidget-get xwidget 'callback)))
 151     (funcall  xwidget-callback xwidget xwidget-event-type)))
 152
 153 (defun xwidget-webkit-callback (xwidget xwidget-event-type)
 154   (save-excursion
 155     (set-buffer (xwidget-buffer xwidget))
 156     (cond ((eq xwidget-event-type 'document-load-finished)
 157            (message "webkit finished loading: '%s'" (xwidget-webkit-get-title xwidget))
 158            (xwidget-adjust-size-to-content xwidget)
 159            (rename-buffer (format "*xwidget webkit: %s *" (xwidget-webkit-get-title xwidget)))
 160            (pop-to-buffer (current-buffer))
 161            )
 162           )))
 163
 164 (define-derived-mode xwidget-webkit-mode
 165   special-mode "xwidget-webkit" "xwidget webkit view mode"
 166   (setq buffer-read-only t)
 167   ;; Keep track of [vh]scroll when switching buffers
 168   (image-mode-setup-winprops)
 169
 170   )
 171
 172 (defvar xwidget-webkit-last-session-buffer nil)
 173
 174 (defun  xwidget-webkit-last-session ()
 175   "Last active webkit, or a new one."
 176   (if (buffer-live-p xwidget-webkit-last-session-buffer)
 177       (save-excursion
 178         (set-buffer xwidget-webkit-last-session-buffer)
 179         (xwidget-at 1))
 180     nil))
 181
 182 (defun xwidget-webkit-current-session ()
 183   "Either the webkit in the current buffer, or the last one used, which might be nil."
 184   (if (xwidget-at 1)
 185       (xwidget-at 1)
 186     (xwidget-webkit-last-session)))
 187
 188 (defun xwidget-adjust-size-to-content (xw)
 189   "Resize XW to content."
 190   ;;xwidgets doesnt support widgets that have their own opinions about size well yet
 191   ;;this reads the desired size and resizes the emacs allocated area accordingly
 192   (let ((size (xwidget-size-request xw)))
 193     (xwidget-resize xw (car size) (cadr size))))
 194
 195
 196 (defvar xwidget-webkit-activeelement-js
 197 "
 198 function findactiveelement(myframes){
 199 if(document.activeElement.value != undefined)
 200       return document.activeElement;
 201   for(i=0;i<myframes.length;i++){
 202     if(myframes[i].document.activeElement.value != undefined)
 203       return myframes[i].document.activeElement;
 204     else{
 205       if(myframes[i].frames.length > 0)
 206         findactiveelement(myframes[i].frames);
 207       else
 208         return;
 209     }
 210   }
 211 }
 212
 213 "
 214
 215 "javascript that finds the active element."
 216 ;;yes its ugly. because:
 217 ;; - there is aparently no way to find the active frame other than recursion
 218 ;; - the js "for each" construct missbehaved on the "frames" collection
 219 ;; - a window with no frameset still has frames.length == 1, but frames[0].document.activeElement != document.activeElement
 220 ;;TODO the activeelement type needs to be examined, for iframe, etc. sucks.
 221 )
 222
 223 (defun xwidget-webkit-insert-string (xw str)
 224   "Insert string in the active field in the webkit.
 225 Argument XW webkit.
 226 Argument STR string."
 227   ;;read out the string in the field first and provide for edit
 228   (interactive
 229    (let* ((xww (xwidget-webkit-current-session))
 230           (field-value
 231            (progn
 232              (xwidget-webkit-execute-script xww xwidget-webkit-activeelement-js)
 233              (xwidget-webkit-execute-script-rv xww "findactiveelement(frames).value" ""))))
 234      (list xww
 235            (read-string "string:" field-value))))
 236   (xwidget-webkit-execute-script xw (format "findactiveelement(frames).value='%s'" str)))
 237
 238
 239 (defun xwidget-webkit-show-named-element (xw element-name)
 240   "make named-element show. for instance an anchor."
 241   ;;TODO
 242   ;;this part figures out the Y coordinate of the element
 243   (let ((y
 244          (string-to-number (xwidget-webkit-execute-script-rv xw (format "document.getElementsByName('%s')[0].getBoundingClientRect().top" element-name) 0))))
 245     ;;now we need to tell emacs to scroll it into view.
 246     ;;hmm. the "y" seems not to be in screen coords?
 247     (message "scroll: %d" y)
 248     (set-window-vscroll (selected-window) y t))
 249   )
 250
 251 (defun xwidget-webkit-adjust-size-to-content ()
 252   "Adjust webkit to content size."
 253   (interactive)
 254   ( xwidget-adjust-size-to-content ( xwidget-webkit-current-session)))
 255
 256 (defun xwidget-webkit-adjust-size (w h)
 257   "Manualy set webkit size.
 258 Argument W width.
 259 Argument H height."
 260   ;;TODO shouldnt be tied to the webkit xwidget
 261   (interactive "nWidth:\nnHeight:\n")
 262   ( xwidget-resize ( xwidget-webkit-current-session) w h))
 263
 264
 265 (defun xwidget-webkit-new-session (url)
 266 "Create a new webkit session buffer with URL."
 267   (let*
 268       ((bufname (generate-new-buffer-name "*xwidget-webkit*"))
 269        xw)
 270     (setq xwidget-webkit-last-session-buffer (switch-to-buffer (get-buffer-create bufname)))
 271     (insert " ")
 272     (setq xw (xwidget-insert 1 'webkit-osr  bufname 1000 1000))
 273     (xwidget-put xw 'callback 'xwidget-webkit-callback)
 274     (xwidget-webkit-mode)
 275     (xwidget-webkit-goto-uri ( xwidget-webkit-last-session) url )))
 276
 277
 278 (defun xwidget-webkit-goto-url (url)
 279   "Goto URL."
 280   (if ( xwidget-webkit-current-session)
 281       (progn
 282         (xwidget-webkit-goto-uri ( xwidget-webkit-current-session) url))
 283     ( xwidget-webkit-new-session url)))
 284
 285 (defun xwidget-webkit-back ()
 286   "Back in history."
 287   (interactive)
 288   (xwidget-webkit-execute-script ( xwidget-webkit-current-session)  "history.go(-1);"))
 289
 290 (defun xwidget-webkit-reload ()
 291   "Reload current url."
 292   (interactive)
 293   (xwidget-webkit-execute-script ( xwidget-webkit-current-session)  "history.go(0);"))
 294
 295 (defun xwidget-webkit-current-url ()
 296   "Get the webkit url. place it on kill ring."
 297   (interactive)
 298   (message "url: %s" (kill-new   (xwidget-webkit-execute-script-rv (xwidget-webkit-current-session) "document.URL"))))
 299
 300 (defun xwidget-webkit-execute-script-rv (xw script &optional default)
 301   "same as xwidget-webkit-execute-script but also wraps an ugly hack to return a value"
 302   ;;notice the fugly "title" hack. it is needed because the webkit api doesnt support returning values.
 303   ;;this is a wrapper for the title hack so its easy to remove should webkit someday support JS return values
 304   ;;or we find some other way to access the DOM
 305
 306   (xwidget-webkit-execute-script xw (format "document.title='%s';" (if default default "")))
 307   (xwidget-webkit-execute-script xw (format "document.title=%s;" script))
 308   (xwidget-webkit-get-title xw))
 309
 310
 311 ;; use declare here?
 312 ;; (declare-function xwidget-resize-internal "xwidget.c" )
 313 ;; check-declare-function?
 314
 315 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 316 ;; xwidget plist management(similar to the process plist functions)
 317
 318 (defun xwidget-get (xwidget propname)
 319   "Return the value of XWIDGET' PROPNAME property.
 320 This is the last value stored with `(xwidget-put XWIDGET PROPNAME VALUE)'."
 321   (plist-get (xwidget-plist xwidget) propname))
 322
 323 (defun xwidget-put (xwidget propname value)
 324   "Change XWIDGET' PROPNAME property to VALUE.
 325 It can be retrieved with `(xwidget-get XWIDGET PROPNAME)'."
 326   (set-xwidget-plist xwidget
 327                      (plist-put (xwidget-plist xwidget) propname value)))
 328
 329
 330 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 331 (defun xwidget-cleanup ()
 332   "Delete zombie xwidgets."
 333   ;;its still pretty easy to trigger bugs with xwidgets.
 334   ;;this function tries to implement a workaround
 335   (interactive)
 336   (xwidget-delete-zombies) ;;kill xviews who should have been deleted but stull linger
 337   (redraw-display);;redraw display otherwise ghost of zombies  will remain to haunt the screen
 338   )
 339
 340
 341
 342 ;;this is a workaround because I cant find the right place to put it in C
 343 ;;seems to work well in practice though
 344 ;;(add-hook 'window-configuration-change-hook 'xwidget-cleanup)
 345 (add-hook 'window-configuration-change-hook 'xwidget-delete-zombies)
 346
 347 ;;killflash is sadly not reliable yet.
 348 (defvar xwidget-webkit-kill-flash-oneshot t)
 349 (defun xwidget-webkit-kill-flash ()
 350   "Disable the flash plugin in webkit.
 351 This is needed because Flash is non-free and doesnt work reliably
 352 on 64 bit systems and offscreen rendering.  Sadly not reliable
 353 yet, so deinstall Flash instead for now."
 354   ;;you can only call this once or webkit crashes and takes emacs with it. odd.
 355   (unless xwidget-webkit-kill-flash-oneshot
 356     (xwidget-disable-plugin-for-mime "application/x-shockwave-flash")
 357     (setq xwidget-webkit-kill-flash-oneshot t)))
 358
 359 (xwidget-webkit-kill-flash)
 360
 361 (provide 'xwidget)
 362
 363 (provide 'xwidget)
 364
 365 ;;; xwidget.el ends here