(eval-when-compile (require 'cl))
(require 'reporter)
+(defcustom xwidget-webkit-scroll-behaviour 'native
+ "Scroll behaviour of the webkit instance.
+'native or 'image."
+ :group 'xwidgets)
+
(defun xwidget-insert (pos type title width height)
- "Insert an xwidget at POS, given ID, TYPE, TITLE WIDTH and
+ "Insert an xwidget at POS.
+given ID, TYPE, TITLE WIDTH and
HEIGHT in the current buffer.
Return ID
;; )))))
(defun xwidget-display (xwidget)
- "Force xwidget to be displayed to create a xwidget_view. Return
-the window displaying XWIDGET."
+ "Force XWIDGET to be displayed to create a xwidget_view.
+Return the window displaying XWIDGET."
(let* ((buffer (xwidget-buffer xwidget))
(window (display-buffer buffer))
(frame (window-frame window)))
(defadvice image-display-size (around image-display-size-for-xwidget
(spec &optional pixels frame)
activate)
+ "Advice for re-using image mode for xwidget."
(if (eq (car spec) 'xwidget)
(setq ad-return-value (xwidget-image-display-size spec pixels frame))
ad-do-it))
(defvar xwidget-webkit-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "g" 'xwidget-webkit-browse-url)
- (define-key map "a" 'xwidget-webkit-adjust-size-to-content)
+ (define-key map "a" 'xwidget-webkit-adjust-size-dispatch)
(define-key map "b" 'xwidget-webkit-back )
(define-key map "r" 'xwidget-webkit-reload )
(define-key map "t" (lambda () (interactive) (message "o")) )
(define-key map "w" 'xwidget-webkit-current-url)
;;similar to image mode bindings
- (define-key map (kbd "SPC") 'image-scroll-up)
- (define-key map (kbd "DEL") 'image-scroll-down)
-
- (define-key map [remap scroll-up] 'image-scroll-up)
- (define-key map [remap scroll-up-command] 'image-scroll-up)
-
- (define-key map [remap scroll-down] 'image-scroll-down)
- (define-key map [remap scroll-down-command] 'image-scroll-down)
-
- (define-key map [remap forward-char] 'image-forward-hscroll)
- (define-key map [remap backward-char] 'image-backward-hscroll)
- (define-key map [remap right-char] 'image-forward-hscroll)
- (define-key map [remap left-char] 'image-backward-hscroll)
- (define-key map [remap previous-line] 'image-previous-line)
- (define-key map [remap next-line] 'image-next-line)
-
- (define-key map [remap move-beginning-of-line] 'image-bol)
- (define-key map [remap move-end-of-line] 'image-eol)
- (define-key map [remap beginning-of-buffer] 'image-bob)
- (define-key map [remap end-of-buffer] 'image-eob)
+ (define-key map (kbd "SPC") 'xwidget-webkit-scroll-up)
+ (define-key map (kbd "DEL") 'xwidget-webkit-scroll-down)
+
+ (define-key map [remap scroll-up] 'xwidget-webkit-scroll-up)
+ (define-key map [remap scroll-up-command] 'xwidget-webkit-scroll-up)
+
+ (define-key map [remap scroll-down] 'xwidget-webkit-scroll-down)
+ (define-key map [remap scroll-down-command] 'xwidget-webkit-scroll-down)
+
+ (define-key map [remap forward-char] 'xwidget-webkit-scroll-forward)
+ (define-key map [remap backward-char] 'xwidget-webkit-scroll-backward)
+ (define-key map [remap right-char] 'xwidget-webkit-scroll-forward)
+ (define-key map [remap left-char] 'xwidget-webkit-scroll-backward)
+ ;; (define-key map [remap previous-line] 'image-previous-line)
+ ;; (define-key map [remap next-line] 'image-next-line)
+
+ ;; (define-key map [remap move-beginning-of-line] 'image-bol)
+ ;; (define-key map [remap move-end-of-line] 'image-eol)
+ ;; (define-key map [remap beginning-of-buffer] 'image-bob)
+ ;; (define-key map [remap end-of-buffer] 'image-eob)
map)
"Keymap for `xwidget-webkit-mode'.")
+(defun xwidget-webkit-scroll-up ()
+ "Scroll webkit up,either native or like image mode."
+ (interactive)
+ (if (eq xwidget-webkit-scroll-behaviour 'native)
+ (xwidget-set-adjustment (xwidget-webkit-last-session) 'vertical t 50)
+ (image-scroll-up)))
+
+(defun xwidget-webkit-scroll-down ()
+ "Scroll webkit down,either native or like image mode."
+ (interactive)
+ (if (eq xwidget-webkit-scroll-behaviour 'native)
+ (xwidget-set-adjustment (xwidget-webkit-last-session) 'vertical t -50)
+ (image-scroll-down)))
+
+(defun xwidget-webkit-scroll-forward ()
+ (interactive)
+ (if (eq xwidget-webkit-scroll-behaviour 'native)
+ (xwidget-set-adjustment (xwidget-webkit-last-session) 'horizontal t 50)
+ (xwidget-webkit-scroll-forward)))
+
+(defun xwidget-webkit-scroll-backward ()
+ (interactive)
+ (if (eq xwidget-webkit-scroll-behaviour 'native)
+ (xwidget-set-adjustment (xwidget-webkit-last-session) 'horizontal t -50)
+ (xwidget-webkit-scroll-backward)))
+
+
;;the xwidget event needs to go into a higher level handler
;;since the xwidget can generate an event even if its offscreen
;;TODO this needs to use callbacks and consider different xw ev types
(define-key (current-global-map) [xwidget-event] 'xwidget-event-handler)
(defun xwidget-log ( &rest msg)
+ "Log MSG to a buffer."
(let ( (buf (get-buffer-create "*xwidget-log*")))
(save-excursion
(buffer-disable-undo buf)
(funcall 'xwidget-webkit-callback xwidget xwidget-event-type)))
(defun xwidget-webkit-callback (xwidget xwidget-event-type)
+ "Callback for xwidgets.
+XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget."
(save-excursion
(cond ((buffer-live-p (xwidget-buffer xwidget))
(set-buffer (xwidget-buffer xwidget))
(let* ((strarg (nth 3 last-input-event)))
(cond ((eq xwidget-event-type 'document-load-finished)
(xwidget-log "webkit finished loading: '%s'" (xwidget-webkit-get-title xwidget))
- (xwidget-adjust-size-to-content xwidget)
+ ;;TODO - check the native/internal scroll
+ ;;(xwidget-adjust-size-to-content xwidget)
+ (xwidget-webkit-adjust-size-dispatch) ;;TODO send xwidget here
(rename-buffer (format "*xwidget webkit: %s *" (xwidget-webkit-get-title xwidget)))
(pop-to-buffer (current-buffer)))
((eq xwidget-event-type 'navigation-policy-decision-requested)
(interactive)
(xwidget-adjust-size-to-content (xwidget-webkit-current-session)))
+(defun xwidget-webkit-adjust-size-dispatch ()
+ "Adjust size according to mode."
+ (interactive)
+ (if (eq xwidget-webkit-scroll-behaviour 'native)
+ (xwidget-webkit-adjust-size-to-window)
+ (xwidget-webkit-adjust-size-to-content)))
+
+(defun xwidget-webkit-adjust-size-to-window ()
+ "Adjust webkit to window."
+ (interactive)
+ (xwidget-resize ( xwidget-webkit-current-session) (window-pixel-width) (window-pixel-height)))
+
(defun xwidget-webkit-adjust-size (w h)
"Manualy set webkit size.
Argument W width.
(xwidget-resize ( xwidget-webkit-current-session) w h))
(defun xwidget-webkit-fit-width ()
+ "Adjust width of webkit to window width."
(interactive)
(xwidget-webkit-adjust-size (- (caddr (window-inside-pixel-edges))
(car (window-inside-pixel-edges)))
(xwidget-webkit-execute-script (xwidget-webkit-current-session) "history.go(0);"))
(defun xwidget-webkit-current-url ()
- "Get the webkit url. place it on kill ring."
+ "Get the webkit url. place it on kill ring."
(interactive)
(let* ((rv (xwidget-webkit-execute-script-rv (xwidget-webkit-current-session)
"document.URL"))
url))
(defun xwidget-webkit-execute-script-rv (xw script &optional default)
- "same as xwidget-webkit-execute-script but also wraps an ugly hack to return a value"
- ;;notice the fugly "title" hack. it is needed because the webkit api doesnt support returning values.
- ;;this is a wrapper for the title hack so its easy to remove should webkit someday support JS return values
- ;;or we find some other way to access the DOM
+ "Same as 'xwidget-webkit-execute-script' but but with return value.
+XW is the webkit instance. SCRIPT is the script to execut.
+DEFAULT is the defaultreturn value."
+ ;;notice the fugly "title" hack. it is needed because the webkit api
+ ;;doesnt support returning values. this is a wrapper for the title
+ ;;hack so its easy to remove should webkit someday support JS return
+ ;;values or we find some other way to access the DOM
;;reset webkit title. fugly.
(let* ((emptytag "titlecantbewhitespaceohthehorror")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun xwidget-webkit-get-selection ()
+ "Get the webkit selection."
(xwidget-webkit-execute-script-rv (xwidget-webkit-current-session)
"window.getSelection().toString();"))
(defun xwidget-webkit-copy-selection-as-kill ()
+ "Get the webkit selection and put it on the kill ring."
(interactive)
(kill-new (xwidget-webkit-get-selection)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun xwidget-delete-zombies ()
+ "Helper for xwidget-cleanup."
(dolist (xwidget-view xwidget-view-list)
(when (or (not (window-live-p (xwidget-view-window xwidget-view)))
(not (memq (xwidget-view-model xwidget-view)