;;; xwidget.el --- api functions for xwidgets -*- lexical-binding: t -*- ;; Copyright (C) 2011-2022 Free Software Foundation, Inc. ;; Author: Joakim Verona ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . ;;; Commentary: ;; ;; See xwidget.c for more api functions. ;; This breaks compilation when we don't have xwidgets. ;; And is pointless when we do, since it's in C and so preloaded. ;;(require 'xwidget-internal) ;;; Code: (require 'cl-lib) (require 'bookmark) (require 'format-spec) (declare-function make-xwidget "xwidget.c" (type title width height &optional arguments buffer related)) (declare-function xwidget-buffer "xwidget.c" (xwidget)) (declare-function set-xwidget-buffer "xwidget.c" (xwidget buffer)) (declare-function xwidget-size-request "xwidget.c" (xwidget)) (declare-function xwidget-resize "xwidget.c" (xwidget new-width new-height)) (declare-function xwidget-webkit-execute-script "xwidget.c" (xwidget script &optional callback)) (declare-function xwidget-webkit-uri "xwidget.c" (xwidget)) (declare-function xwidget-webkit-title "xwidget.c" (xwidget)) (declare-function xwidget-webkit-goto-uri "xwidget.c" (xwidget uri)) (declare-function xwidget-webkit-goto-history "xwidget.c" (xwidget rel-pos)) (declare-function xwidget-webkit-zoom "xwidget.c" (xwidget factor)) (declare-function xwidget-plist "xwidget.c" (xwidget)) (declare-function set-xwidget-plist "xwidget.c" (xwidget plist)) (declare-function xwidget-view-window "xwidget.c" (xwidget-view)) (declare-function xwidget-view-model "xwidget.c" (xwidget-view)) (declare-function delete-xwidget-view "xwidget.c" (xwidget-view)) (declare-function get-buffer-xwidgets "xwidget.c" (buffer)) (declare-function xwidget-query-on-exit-flag "xwidget.c" (xwidget)) (declare-function xwidget-webkit-back-forward-list "xwidget.c" (xwidget &optional limit)) (declare-function xwidget-webkit-estimated-load-progress "xwidget.c" (xwidget)) (declare-function xwidget-webkit-set-cookie-storage-file "xwidget.c" (xwidget file)) (declare-function xwidget-live-p "xwidget.c" (xwidget)) (declare-function xwidget-webkit-stop-loading "xwidget.c" (xwidget)) (declare-function xwidget-info "xwidget.c" (xwidget)) (defgroup xwidget nil "Displaying native widgets in Emacs buffers." :group 'widgets) (defun xwidget-insert (pos type title width height &optional args related) "Insert an xwidget at position POS. Supply the xwidget's TYPE, TITLE, WIDTH, HEIGHT, and RELATED. See `make-xwidget' for the possible TYPE values. The usage of optional argument ARGS depends on the xwidget. This returns the result of `make-xwidget'." (goto-char pos) (let ((id (make-xwidget type title width height args nil related))) (put-text-property (point) (+ 1 (point)) 'display (list 'xwidget ':xwidget id)) id)) (defun xwidget-at (pos) "Return xwidget at POS." (let* ((disp (get-text-property pos 'display)) (xw (car (cdr (cdr disp))))) (when (xwidget-live-p xw) xw))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; webkit support (require 'browse-url) (require 'image-mode);;for some image-mode alike functionality (require 'seq) (require 'url-handlers) (defgroup xwidget-webkit nil "Displaying webkit xwidgets in Emacs buffers." :version "29.1" :group 'web :prefix "xwidget-webkit-") (defcustom xwidget-webkit-buffer-name-format "*xwidget-webkit: %T*" "Template for naming `xwidget-webkit' buffers. It can use the following special constructs: %T -- the title of the Web page loaded by the xwidget. %U -- the URI of the Web page loaded by the xwidget." :type 'string :version "29.1") (defcustom xwidget-webkit-cookie-file nil "The name of the file where `xwidget-webkit-browse-url' will store cookies. They will be stored as plain text in Mozilla \"cookies.txt\" format. If nil, do not store cookies. You must kill all xwidget-webkit buffers for this setting to take effect after setting it to nil." :type '(choice (const :tag "Do not store cookies" nil) file) :version "29.1") ;;;###autoload (defun xwidget-webkit-browse-url (url &optional new-session) "Ask xwidget-webkit to browse URL. NEW-SESSION specifies whether to create a new xwidget-webkit session. Interactively, URL defaults to the string looking like a url around point." (interactive (progn (require 'browse-url) (browse-url-interactive-arg "xwidget-webkit URL: "))) (or (featurep 'xwidget-internal) (user-error "Your Emacs was not compiled with xwidgets support")) (when (stringp url) ;; If it's a "naked url", just try adding https: to it. (unless (string-match "\\`[A-Za-z]+:" url) (setq url (concat "https://" url))) (if new-session (xwidget-webkit-new-session url) (xwidget-webkit-goto-url url)))) (function-put 'xwidget-webkit-browse-url 'browse-url-browser-kind 'internal) (defun xwidget-webkit-clone-and-split-below () "Clone current URL into a new widget place in new window below. Get the URL of current session, then browse to the URL in `split-window-below' with a new xwidget webkit session." (interactive nil xwidget-webkit-mode) (let ((url (xwidget-webkit-uri (xwidget-webkit-current-session)))) (with-selected-window (split-window-below) (xwidget-webkit-new-session url)))) (defun xwidget-webkit-clone-and-split-right () "Clone current URL into a new widget place in new window right. Get the URL of current session, then browse to the URL in `split-window-right' with a new xwidget webkit session." (interactive nil xwidget-webkit-mode) (let ((url (xwidget-webkit-uri (xwidget-webkit-current-session)))) (with-selected-window (split-window-right) (xwidget-webkit-new-session url)))) (declare-function xwidget-perform-lispy-event "xwidget.c") (defvar xwidget-webkit--input-method-events nil "Internal variable used to store input method events.") (defvar-local xwidget-webkit--loading-p nil "Whether or not a page is being loaded.") (defvar-local xwidget-webkit--progress-update-timer nil "Timer that updates the display of page load progress in the header line.") (defun xwidget-webkit-pass-command-event-with-input-method () "Handle a `with-input-method' event." (interactive) (let ((key (pop unread-command-events))) (setq xwidget-webkit--input-method-events (funcall input-method-function key)) (exit-minibuffer))) (defun xwidget-webkit-pass-command-event () "Pass `last-command-event' to the current buffer's WebKit widget. If `current-input-method' is non-nil, consult `input-method-function' for the actual events that will be sent." (interactive) (if (and current-input-method (characterp last-command-event)) (let ((xwidget-webkit--input-method-events nil) (minibuffer-local-map (make-keymap))) (define-key minibuffer-local-map [with-input-method] 'xwidget-webkit-pass-command-event-with-input-method) (push last-command-event unread-command-events) (push 'with-input-method unread-command-events) (read-from-minibuffer "" nil nil nil nil nil t) (dolist (event xwidget-webkit--input-method-events) (xwidget-perform-lispy-event (xwidget-webkit-current-session) event))) (xwidget-perform-lispy-event (xwidget-webkit-current-session) last-command-event))) ;;todo. ;; - check that the webkit support is compiled in (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-dispatch) (define-key map "b" 'xwidget-webkit-back) (define-key map "f" 'xwidget-webkit-forward) (define-key map "r" 'xwidget-webkit-reload) (define-key map "\C-m" 'xwidget-webkit-insert-string) (define-key map "w" 'xwidget-webkit-current-url) (define-key map "+" 'xwidget-webkit-zoom-in) (define-key map "-" 'xwidget-webkit-zoom-out) (define-key map "e" 'xwidget-webkit-edit-mode) (define-key map "\C-r" 'xwidget-webkit-isearch-mode) (define-key map "\C-s" 'xwidget-webkit-isearch-mode) (define-key map "H" 'xwidget-webkit-browse-history) ;;similar to image mode bindings (define-key map (kbd "SPC") 'xwidget-webkit-scroll-up) (define-key map (kbd "S-SPC") 'xwidget-webkit-scroll-down) (define-key map (kbd "DEL") 'xwidget-webkit-scroll-down) (define-key map [remap scroll-up] 'xwidget-webkit-scroll-up-line) (define-key map [remap scroll-up-command] 'xwidget-webkit-scroll-up) (define-key map [remap scroll-down] 'xwidget-webkit-scroll-down-line) (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] 'xwidget-webkit-scroll-down-line) (define-key map [remap next-line] 'xwidget-webkit-scroll-up-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] 'xwidget-webkit-scroll-top) (define-key map [remap end-of-buffer] 'xwidget-webkit-scroll-bottom) map) "Keymap for `xwidget-webkit-mode'.") (easy-menu-define nil xwidget-webkit-mode-map "Xwidget WebKit menu." (list "Xwidget WebKit" ["Browse URL" xwidget-webkit-browse-url :active t :help "Prompt for a URL, then instruct WebKit to browse it"] ["Back" xwidget-webkit-back t] ["Forward" xwidget-webkit-forward t] ["Reload" xwidget-webkit-reload t] ["History" xwidget-webkit-browse-history t] ["Insert String" xwidget-webkit-insert-string :active t :help "Insert a string into the currently active field"] ["Zoom In" xwidget-webkit-zoom-in t] ["Zoom Out" xwidget-webkit-zoom-out t] ["Edit Mode" xwidget-webkit-edit-mode :active t :style toggle :selected xwidget-webkit-edit-mode :help "Send self inserting characters to the WebKit widget"] ["Save Selection" xwidget-webkit-copy-selection-as-kill :active t :help "Save the browser's selection in the kill ring"] ["Incremental Search" xwidget-webkit-isearch-mode :active (not xwidget-webkit-isearch-mode) :help "Perform incremental search inside the WebKit widget"] ["Stop Loading" xwidget-webkit-stop :active xwidget-webkit--loading-p])) (defvar xwidget-webkit-tool-bar-map (let ((map (make-sparse-keymap))) (prog1 map (tool-bar-local-item-from-menu 'xwidget-webkit-stop "cancel" map xwidget-webkit-mode-map) (tool-bar-local-item-from-menu 'xwidget-webkit-back "left-arrow" map xwidget-webkit-mode-map) (tool-bar-local-item-from-menu 'xwidget-webkit-forward "right-arrow" map xwidget-webkit-mode-map) (tool-bar-local-item-from-menu 'xwidget-webkit-reload "refresh" map xwidget-webkit-mode-map) (tool-bar-local-item-from-menu 'xwidget-webkit-zoom-in "zoom-in" map xwidget-webkit-mode-map) (tool-bar-local-item-from-menu 'xwidget-webkit-zoom-out "zoom-out" map xwidget-webkit-mode-map) (tool-bar-local-item-from-menu 'xwidget-webkit-browse-url "connect-to-url" map xwidget-webkit-mode-map) (tool-bar-local-item-from-menu 'xwidget-webkit-isearch-mode "search" map xwidget-webkit-mode-map)))) (defun xwidget-webkit-zoom-in () "Increase webkit view zoom factor." (interactive nil xwidget-webkit-mode) (xwidget-webkit-zoom (xwidget-webkit-current-session) 0.1)) (defun xwidget-webkit-zoom-out () "Decrease webkit view zoom factor." (interactive nil xwidget-webkit-mode) (xwidget-webkit-zoom (xwidget-webkit-current-session) -0.1)) (defun xwidget-webkit-scroll-up (&optional arg) "Scroll webkit up by ARG pixels; or full window height if no ARG. Stop if bottom of page is reached. Interactively, ARG is the prefix numeric argument. Negative ARG scrolls down." (interactive "P" xwidget-webkit-mode) (xwidget-webkit-execute-script (xwidget-webkit-current-session) (format "window.scrollBy(0, %d);" (or arg (xwidget-window-inside-pixel-height (selected-window)))))) (defun xwidget-webkit-scroll-down (&optional arg) "Scroll webkit down by ARG pixels; or full window height if no ARG. Stop if top of page is reached. Interactively, ARG is the prefix numeric argument. Negative ARG scrolls up." (interactive "P" xwidget-webkit-mode) (xwidget-webkit-execute-script (xwidget-webkit-current-session) (format "window.scrollBy(0, -%d);" (or arg (xwidget-window-inside-pixel-height (selected-window)))))) (defun xwidget-webkit-scroll-up-line (&optional n) "Scroll webkit up by N lines. The height of line is calculated with `window-font-height'. Stop if the bottom edge of the page is reached. If N is omitted or nil, scroll up by one line." (interactive "p" xwidget-webkit-mode) (xwidget-webkit-scroll-up (* n (window-font-height)))) (defun xwidget-webkit-scroll-down-line (&optional n) "Scroll webkit down by N lines. The height of line is calculated with `window-font-height'. Stop if the top edge of the page is reached. If N is omitted or nil, scroll down by one line." (interactive "p" xwidget-webkit-mode) (xwidget-webkit-scroll-down (* n (window-font-height)))) (defun xwidget-webkit-scroll-forward (&optional n) "Scroll webkit horizontally by N chars. If the widget is larger than the window, hscroll by N columns instead. The width of char is calculated with `window-font-width'. If N is omitted or nil, scroll forwards by one char." (interactive "p" xwidget-webkit-mode) (let ((session (xwidget-webkit-current-session))) (if (> (- (aref (xwidget-info session) 2) (window-text-width nil t)) (window-font-width)) (set-window-hscroll nil (+ (window-hscroll) n)) (xwidget-webkit-execute-script session (format "window.scrollBy(%d, 0);" (* n (window-font-width))))))) (defun xwidget-webkit-scroll-backward (&optional n) "Scroll webkit back by N chars. If the widget is larger than the window, hscroll backwards by N columns instead. The width of char is calculated with `window-font-width'. If N is omitted or nil, scroll backwards by one char." (interactive "p" xwidget-webkit-mode) (let ((session (xwidget-webkit-current-session))) (if (and (> (- (aref (xwidget-info session) 2) (window-text-width nil t)) (window-font-width)) (> (window-hscroll) 0)) (set-window-hscroll nil (- (window-hscroll) n)) (xwidget-webkit-execute-script session (format "window.scrollBy(%-d, 0);" (* n (window-font-width))))))) (defun xwidget-webkit-scroll-top () "Scroll webkit to the very top." (interactive nil xwidget-webkit-mode) (xwidget-webkit-execute-script (xwidget-webkit-current-session) "window.scrollTo(pageXOffset, 0);")) (defun xwidget-webkit-scroll-bottom () "Scroll webkit to the very bottom." (interactive nil xwidget-webkit-mode) (xwidget-webkit-execute-script (xwidget-webkit-current-session) "window.scrollTo(pageXOffset, window.document.body.scrollHeight);")) ;; The xwidget event needs to go in the special map. To receive ;; xwidget events, you should place a callback in the property list of ;; the xwidget, instead of handling these events manually. ;; ;; See `xwidget-webkit-new-session' for an example of how to do this. (define-key special-event-map [xwidget-event] #'xwidget-event-handler) (defun xwidget-log (&rest msg) "Log MSG to a buffer." (let ((buf (get-buffer-create " *xwidget-log*"))) (with-current-buffer buf (insert (apply #'format msg)) (insert "\n")))) (defun xwidget-event-handler () "Receive xwidget event." (interactive nil xwidget-webkit-mode) (xwidget-log "stuff happened to xwidget %S" last-input-event) (let* ((xwidget-event-type (nth 1 last-input-event)) (xwidget (nth 2 last-input-event)) (xwidget-callback (xwidget-get xwidget 'callback))) (when xwidget-callback (funcall xwidget-callback xwidget xwidget-event-type)))) (defun xwidget-webkit--update-progress-timer-function (xwidget) "Force an update of the header line of XWIDGET's buffer." (with-current-buffer (xwidget-buffer xwidget) (force-mode-line-update))) (defun xwidget-webkit-buffer-kill () "Clean up an xwidget-webkit buffer before it is killed." (when (timerp xwidget-webkit--progress-update-timer) (cancel-timer xwidget-webkit--progress-update-timer))) (defun xwidget-webkit-callback (xwidget xwidget-event-type) "Callback for xwidgets. XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." (if (not (buffer-live-p (xwidget-buffer xwidget))) (xwidget-log "error: callback called for xwidget with dead buffer") (cond ((eq xwidget-event-type 'load-changed) (let ((title (xwidget-webkit-title xwidget)) (uri (xwidget-webkit-uri xwidget))) (when-let ((buffer (get-buffer "*Xwidget WebKit History*"))) (with-current-buffer buffer (revert-buffer))) (with-current-buffer (xwidget-buffer xwidget) (if (string-equal (nth 3 last-input-event) "load-finished") (progn (setq xwidget-webkit--loading-p nil) (cancel-timer xwidget-webkit--progress-update-timer)) (unless xwidget-webkit--loading-p (setq xwidget-webkit--loading-p t xwidget-webkit--progress-update-timer (run-at-time 0.5 0.5 #'xwidget-webkit--update-progress-timer-function xwidget))))) ;; This function will be called multi times, so only ;; change buffer name when the load actually completes ;; this can limit buffer-name flicker in mode-line. (when (or (string-equal (nth 3 last-input-event) "load-finished") (> (length title) 0)) (with-current-buffer (xwidget-buffer xwidget) (force-mode-line-update) (xwidget-log "webkit finished loading: %s" title) ;; Do not adjust webkit size to window here, the ;; selected window can be the mini-buffer window ;; unwantedly. (rename-buffer (format-spec xwidget-webkit-buffer-name-format `((?T . ,title) (?U . ,uri))) t))))) ((eq xwidget-event-type 'decide-policy) (let ((strarg (nth 3 last-input-event))) (if (string-match ".*#\\(.*\\)" strarg) (xwidget-webkit-show-id-or-named-element xwidget (match-string 1 strarg))))) ;; TODO: Response handling other than download. ((eq xwidget-event-type 'download-callback) (let ((url (nth 3 last-input-event)) (mime-type (nth 4 last-input-event)) (file-name (nth 5 last-input-event))) (xwidget-webkit-save-as-file url mime-type file-name))) ((eq xwidget-event-type 'javascript-callback) (let ((proc (nth 3 last-input-event)) (arg (nth 4 last-input-event))) (funcall proc arg))) ((eq xwidget-event-type 'script-message) (let ((name (nth 3 last-input-event)) (value (nth 4 last-input-event))) (let ((handler-pair (assoc name (xwidget-get xwidget 'script-message-handlers)))) (if handler-pair (funcall (cdr handler-pair) xwidget value) (xwidget-log "unhandled script message: %s" name))))) (t (xwidget-log "unhandled event: %s" xwidget-event-type))))) (defun xwidget-webkit-push-script-message-handler (xwidget name handler) "Register HANDLER to handle script messages with NAME for WebKit XWIDGET. HANDLER will be called with two arguments: the WebKit XWIDGET and the JavaScript object passed from the script message converted to a Lisp object." (let ((old-alist (xwidget-get xwidget 'script-message-handlers))) (unless (assoc name old-alist) (xwidget-webkit-register-script-message (xwidget-webkit-current-session) name)) (xwidget-put xwidget 'script-message-handlers (cons (cons name handler) old-alist))) name) (defun xwidget-webkit-pop-script-message-handler (xwidget name) "Remove a handler registered with NAME for WebKit XWIDGET. Return the removed handler function, or NIL if no such handler is found." (let* ((old-alist (xwidget-get xwidget 'script-message-handlers)) (handler-pair (assoc name old-alist))) (when handler-pair (let ((new-alist (delq handler-pair old-alist))) (xwidget-put xwidget 'script-message-handlers new-alist) (unless (assoc name new-alist) (xwidget-webkit-unregister-script-message (xwidget-webkit-current-session) name))) (cdr handler-pair)))) (defvar bookmark-make-record-function) (when (memq window-system '(mac ns)) (defcustom xwidget-webkit-enable-plugins nil "Enable plugins for xwidget webkit. If non-nil, plugins are enabled. Otherwise, disabled." :type 'boolean :version "28.1")) (define-derived-mode xwidget-webkit-mode special-mode "xwidget-webkit" "Xwidget webkit view mode." (setq buffer-read-only t) (add-hook 'kill-buffer-hook #'xwidget-webkit-buffer-kill) (setq-local tool-bar-map xwidget-webkit-tool-bar-map) (setq-local bookmark-make-record-function #'xwidget-webkit-bookmark-make-record) (setq-local header-line-format (list "WebKit: " '(:eval (xwidget-webkit-title (xwidget-webkit-current-session))) '(:eval (when xwidget-webkit--loading-p (let ((session (xwidget-webkit-current-session))) (format " [%d%%%%]" (* 100 (xwidget-webkit-estimated-load-progress session)))))))) ;; Keep track of [vh]scroll when switching buffers (image-mode-setup-winprops)) ;;; Download, save as file. (defcustom xwidget-webkit-download-dir "~/Downloads/" "Directory where download file saved." :version "28.1" :type 'file) (defun xwidget-webkit-save-as-file (url mime-type file-name) "For XWIDGET webkit, save URL of MIME-TYPE to location specified by user. FILE-NAME combined with `xwidget-webkit-download-dir' is the default file name of the prompt when reading. When the file name the user specified is a directory, URL is saved at the specified directory as FILE-NAME." (let ((save-name (read-file-name (format "Save URL `%s' of type `%s' in file/directory: " url mime-type) xwidget-webkit-download-dir (when file-name (expand-file-name file-name xwidget-webkit-download-dir))))) (if (file-directory-p save-name) (setq save-name (expand-file-name (file-name-nondirectory file-name) save-name))) (setq xwidget-webkit-download-dir (file-name-directory save-name)) (url-copy-file url save-name t))) ;;; Bookmarks integration (defcustom xwidget-webkit-bookmark-jump-new-session nil "Whether to jump to a bookmarked URL in a new xwidget webkit session. If non-nil, create a new xwidget webkit session, otherwise use the value of `xwidget-webkit-last-session'." :version "28.1" :type 'boolean) (defun xwidget-webkit-bookmark-make-record () "Create a bookmark record for a webkit xwidget." (nconc (bookmark-make-record-default t t) `((page . ,(xwidget-webkit-uri (xwidget-webkit-current-session))) (handler . xwidget-webkit-bookmark-jump-handler)))) ;;;###autoload (defun xwidget-webkit-bookmark-jump-handler (bookmark) "Jump to the web page bookmarked by the bookmark record BOOKMARK. If `xwidget-webkit-bookmark-jump-new-session' is non-nil, create a new xwidget-webkit session, otherwise use an existing session." (let* ((url (bookmark-prop-get bookmark 'page)) (xwbuf (if (or xwidget-webkit-bookmark-jump-new-session (not (xwidget-webkit-current-session))) (xwidget-webkit--create-new-session-buffer url) (xwidget-buffer (xwidget-webkit-current-session))))) (with-current-buffer xwbuf (xwidget-webkit-goto-uri (xwidget-webkit-current-session) url)) (set-buffer xwbuf))) ;;; xwidget webkit session (defvar xwidget-webkit-last-session-buffer nil) (defun xwidget-webkit-last-session () "Last active webkit, or nil." (if (buffer-live-p xwidget-webkit-last-session-buffer) (with-current-buffer xwidget-webkit-last-session-buffer (xwidget-at (point-min))) nil)) (defun xwidget-webkit-current-session () "Either the webkit in the current buffer, or the last one used. The latter might be nil." (or (xwidget-at (point-min)) (xwidget-webkit-last-session))) (defun xwidget-adjust-size-to-content (xw) "Resize XW to content." ;; xwidgets doesn't support widgets that have their own opinions about ;; size well, yet this reads the desired size and resizes the Emacs ;; allocated area accordingly. (let ((size (xwidget-size-request xw))) (xwidget-resize xw (car size) (cadr size)))) (defun xwidget-webkit-stop () "Stop trying to load the current page." (interactive) (xwidget-webkit-stop-loading (xwidget-webkit-current-session))) (defvar xwidget-webkit-activeelement-js" function findactiveelement(doc){ //alert(doc.activeElement.value); if(doc.activeElement.value != undefined){ return doc.activeElement; }else{ // recurse over the child documents: var frames = doc.getElementsByTagName('frame'); for (var i = 0; i < frames.length; i++) { var d = frames[i].contentDocument; var rv = findactiveelement(d); if(rv != undefined){ return rv; } } } return undefined; }; " "Javascript that finds the active element." ;; Yes it's ugly, because: ;; - there is apparently no way to find the active frame other than recursion ;; - the js "for each" construct misbehaved on the "frames" collection ;; - a window with no frameset still has frames.length == 1, but ;; frames[0].document.activeElement != document.activeElement ;;TODO the activeelement type needs to be examined, for iframe, etc. ) (defun xwidget-webkit-insert-string () "Insert string into the active field in the current webkit widget." ;; Read out the string in the field first and provide for edit. (interactive nil xwidget-webkit-mode) ;; As the prompt differs on JavaScript execution results, ;; the function must handle the prompt itself. (let ((xww (xwidget-webkit-current-session))) (xwidget-webkit-execute-script xww (concat xwidget-webkit-activeelement-js " (function () { var res = findactiveelement(document); if (res) return [res.value, res.type]; })();") (lambda (field) "Prompt a string for the FIELD and insert in the active input." (let ((str (pcase field (`[,val "text"] (read-string "Text: " val)) (`[,val "password"] (read-passwd "Password: " nil val)) (`[,val "textarea"] (xwidget-webkit-begin-edit-textarea xww val))))) (xwidget-webkit-execute-script xww (format "findactiveelement(document).value='%s'" str))))))) (defvar xwidget-xwbl) (defun xwidget-webkit-begin-edit-textarea (xw text) "Start editing of a webkit text area. XW is the xwidget identifier, TEXT is retrieved from the webkit." (switch-to-buffer (generate-new-buffer "textarea")) (setq-local xwidget-xwbl xw) (insert text)) (defun xwidget-webkit-end-edit-textarea () "End editing of a webkit text area." (interactive nil xwidget-webkit-mode) (goto-char (point-min)) (while (search-forward "\n" nil t) (replace-match "\\n" nil t)) (xwidget-webkit-execute-script xwidget-xwbl (format "findactiveelement(document).value='%s'" (buffer-substring (point-min) (point-max)))) ;;TODO convert linefeed to \n ) (defun xwidget-webkit-show-element (xw element-selector) "Make webkit xwidget XW show a named element ELEMENT-SELECTOR. The ELEMENT-SELECTOR must be a valid CSS selector. For example, use this to display an anchor." (interactive (list (xwidget-webkit-current-session) (read-string "Element selector: ")) xwidget-webkit-mode) (xwidget-webkit-execute-script xw (format " (function (query) { var el = document.querySelector(query); if (el !== null) { window.scrollTo(0, el.offsetTop); } })('%s');" element-selector))) (defun xwidget-webkit-show-named-element (xw element-name) "Make webkit xwidget XW show a named element ELEMENT-NAME. For example, use this to display an anchor." (interactive (list (xwidget-webkit-current-session) (read-string "Element name: ")) xwidget-webkit-mode) ;; TODO: This needs to be interfaced into browse-url somehow. The ;; tricky part is that we need to do this in two steps: A: load the ;; base url, wait for load signal to arrive B: navigate to the ;; anchor when the base url is finished rendering (xwidget-webkit-execute-script xw (format " (function (query) { var el = document.getElementsByName(query)[0]; if (el !== undefined) { window.scrollTo(0, el.offsetTop); } })('%s');" element-name))) (defun xwidget-webkit-show-id-element (xw element-id) "Make webkit xwidget XW show an id-element ELEMENT-ID. For example, use this to display an anchor." (interactive (list (xwidget-webkit-current-session) (read-string "Element id: ")) xwidget-webkit-mode) (xwidget-webkit-execute-script xw (format " (function (query) { var el = document.getElementById(query); if (el !== null) { window.scrollTo(0, el.offsetTop); } })('%s');" element-id))) (defun xwidget-webkit-show-id-or-named-element (xw element-id) "Make webkit xwidget XW show a name or element id ELEMENT-ID. For example, use this to display an anchor." (interactive (list (xwidget-webkit-current-session) (read-string "Name or element id: ")) xwidget-webkit-mode) (xwidget-webkit-execute-script xw (format " (function (query) { var el = document.getElementById(query) || document.getElementsByName(query)[0]; if (el !== undefined) { window.scrollTo(0, el.offsetTop); } })('%s');" element-id))) (defun xwidget-webkit-adjust-size-to-content () "Adjust webkit to content size." (interactive nil xwidget-webkit-mode) (xwidget-adjust-size-to-content (xwidget-webkit-current-session))) (defun xwidget-webkit-adjust-size-dispatch () "Adjust size according to mode." (interactive nil xwidget-webkit-mode) (xwidget-webkit-adjust-size-to-window (xwidget-webkit-current-session)) ;; The recenter is intended to correct a visual glitch. ;; It errors out if the buffer isn't visible, but then we don't get ;; the glitch, so silence errors. (ignore-errors (recenter-top-bottom))) ;; Utility functions (defun xwidget-window-inside-pixel-width (window) "Return Emacs WINDOW body width in pixel." (let ((edges (window-inside-pixel-edges window))) (- (nth 2 edges) (nth 0 edges)))) (defun xwidget-window-inside-pixel-height (window) "Return Emacs WINDOW body height in pixel." (let ((edges (window-inside-pixel-edges window))) (- (nth 3 edges) (nth 1 edges)))) (defun xwidget-webkit-adjust-size-to-window (xwidget &optional window) "Adjust the size of the webkit XWIDGET to fit the WINDOW." (xwidget-resize xwidget (xwidget-window-inside-pixel-width window) (xwidget-window-inside-pixel-height window))) (defun xwidget-webkit-adjust-size (w h) "Manually set webkit size to width W, height H." ;; TODO shouldn't be tied to the webkit xwidget (interactive "nWidth:\nnHeight:\n" xwidget-webkit-mode) (xwidget-resize (xwidget-webkit-current-session) w h)) (defun xwidget-webkit-fit-width () "Adjust width of webkit to window width." (interactive nil xwidget-webkit-mode) (xwidget-webkit-adjust-size (- (nth 2 (window-inside-pixel-edges)) (car (window-inside-pixel-edges))) 1000)) (defun xwidget-webkit-auto-adjust-size (window) "Adjust the size of the webkit widget in the given WINDOW." (with-current-buffer (window-buffer window) (when (eq major-mode 'xwidget-webkit-mode) (let ((xwidget (xwidget-webkit-current-session))) (xwidget-webkit-adjust-size-to-window xwidget window))))) (defun xwidget-webkit-adjust-size-in-frame (frame) "Dynamically adjust webkit widget for all windows of the FRAME." (walk-windows 'xwidget-webkit-auto-adjust-size 'no-minibuf frame)) (eval-after-load 'xwidget-webkit-mode (add-to-list 'window-size-change-functions 'xwidget-webkit-adjust-size-in-frame)) (defun xwidget-webkit--create-new-session-buffer (url &optional callback) "Create a new webkit session buffer to display URL in an xwidget. Optional function CALLBACK specifies the callback for webkit xwidgets; see `xwidget-webkit-callback'." (let* ((bufname ;; Generate a temp-name based on current buffer name. The ;; buffer will subsequently be renamed by ;; `xwidget-webkit-callback'. This approach can avoid ;; flicker of buffer-name in mode-line. (generate-new-buffer-name (buffer-name))) (callback (or callback #'xwidget-webkit-callback)) (current-session (xwidget-webkit-current-session)) xw) (setq xwidget-webkit-last-session-buffer (get-buffer-create bufname)) ;; The xwidget id is stored in a text property, so we need to have ;; at least character in this buffer. ;; Insert invisible url, good default for next `g' to browse url. (with-current-buffer xwidget-webkit-last-session-buffer (let ((start (point))) (insert url) (put-text-property start (+ start (length url)) 'invisible t) (setq xw (xwidget-insert start 'webkit bufname (xwidget-window-inside-pixel-width (selected-window)) (xwidget-window-inside-pixel-height (selected-window)) nil current-session))) (when xwidget-webkit-cookie-file (xwidget-webkit-set-cookie-storage-file xw (expand-file-name xwidget-webkit-cookie-file))) (xwidget-put xw 'callback callback) (xwidget-put xw 'display-callback #'xwidget-webkit-display-callback) (xwidget-webkit-mode)) xwidget-webkit-last-session-buffer)) (defun xwidget-webkit-new-session (url) "Display URL in a new webkit xwidget." (switch-to-buffer (xwidget-webkit--create-new-session-buffer url)) (xwidget-webkit-goto-uri (xwidget-webkit-last-session) url)) (defun xwidget-webkit-import-widget (xwidget) "Create a new webkit session buffer from XWIDGET, an existing xwidget. Return the buffer." (let* ((bufname ;; Generate a temp-name based on current buffer name. it ;; will be renamed by `xwidget-webkit-callback' in the ;; future. This approach can limit flicker of buffer-name in ;; mode-line. (generate-new-buffer-name (buffer-name))) (callback #'xwidget-webkit-callback) (buffer (get-buffer-create bufname))) (with-current-buffer buffer (setq xwidget-webkit-last-session-buffer buffer) (save-excursion (erase-buffer) (insert ".") (put-text-property (point-min) (point-max) 'display (list 'xwidget :xwidget xwidget))) (xwidget-put xwidget 'callback callback) (xwidget-put xwidget 'display-callback #'xwidget-webkit-display-callback) (set-xwidget-buffer xwidget buffer) (xwidget-webkit-mode)) buffer)) (defun xwidget-webkit-display-event (event) "Trigger display callback for EVENT." (interactive "e") (let ((xwidget (cadr event)) (source (caddr event))) (when (xwidget-get source 'display-callback) (funcall (xwidget-get source 'display-callback) xwidget source)))) (defun xwidget-webkit-display-callback (xwidget _source) "Import XWIDGET and display it." (display-buffer (xwidget-webkit-import-widget xwidget))) (define-key special-event-map [xwidget-display-event] 'xwidget-webkit-display-event) (defun xwidget-webkit-goto-url (url) "Goto URL with xwidget webkit." (if (xwidget-webkit-current-session) (progn (xwidget-webkit-goto-uri (xwidget-webkit-current-session) url) (switch-to-buffer (xwidget-buffer (xwidget-webkit-current-session)))) (xwidget-webkit-new-session url))) (defun xwidget-webkit-back () "Go back to previous URL in xwidget webkit buffer." (interactive nil xwidget-webkit-mode) (xwidget-webkit-goto-history (xwidget-webkit-current-session) -1)) (defun xwidget-webkit-forward () "Go forward in history." (interactive nil xwidget-webkit-mode) (xwidget-webkit-goto-history (xwidget-webkit-current-session) 1)) (defun xwidget-webkit-reload () "Reload current URL." (interactive nil xwidget-webkit-mode) (xwidget-webkit-goto-history (xwidget-webkit-current-session) 0)) (defun xwidget-webkit-current-url () "Display the current xwidget webkit URL and place it on the `kill-ring'." (interactive nil xwidget-webkit-mode) (let ((url (xwidget-webkit-uri (xwidget-webkit-current-session)))) (message "URL: %s" (kill-new (or url ""))))) (defun xwidget-webkit-browse-history () "Display a buffer containing the history of page loads." (interactive) (setq xwidget-webkit-last-session-buffer (current-buffer)) (let ((buffer (get-buffer-create "*Xwidget WebKit History*"))) (with-current-buffer buffer (xwidget-webkit-history-mode)) (display-buffer buffer))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun xwidget-webkit-get-selection (proc) "Get the webkit selection and pass it to PROC." (xwidget-webkit-execute-script (xwidget-webkit-current-session) "window.getSelection().toString();" proc)) (defun xwidget-webkit-copy-selection-as-kill () "Get the webkit selection and put it on the `kill-ring'." (interactive nil xwidget-webkit-mode) (xwidget-webkit-get-selection #'kill-new)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Xwidget plist management (similar to the process plist functions) (defun xwidget-get (xwidget propname) "Get an xwidget's property value. XWIDGET is an xwidget, PROPNAME a property. Returns the last value stored with `xwidget-put'." (plist-get (xwidget-plist xwidget) propname)) (defun xwidget-put (xwidget propname value) "Set an xwidget's property value. XWIDGET is an xwidget, PROPNAME a property to be set to specified VALUE. You can retrieve the value with `xwidget-get'." (set-xwidget-plist xwidget (plist-put (xwidget-plist xwidget) propname value))) (defvar-keymap xwidget-webkit-edit-mode-map :full t) (define-key xwidget-webkit-edit-mode-map [backspace] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [tab] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [left] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [right] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [up] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [down] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [return] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [C-left] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [C-right] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [C-up] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [C-down] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [C-return] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [S-left] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [S-right] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [S-up] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [S-down] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [S-return] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [M-left] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [M-right] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [M-up] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [M-down] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [M-return] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [C-backspace] 'xwidget-webkit-pass-command-event) (define-minor-mode xwidget-webkit-edit-mode "Minor mode for editing the content of WebKit buffers. This defines most self-inserting characters and some common keyboard shortcuts to `xwidget-webkit-pass-command-event', which will pass the key events corresponding to these characters to the WebKit widget." :keymap xwidget-webkit-edit-mode-map) (substitute-key-definition 'self-insert-command 'xwidget-webkit-pass-command-event xwidget-webkit-edit-mode-map global-map) (declare-function xwidget-webkit-search "xwidget.c") (declare-function xwidget-webkit-next-result "xwidget.c") (declare-function xwidget-webkit-previous-result "xwidget.c") (declare-function xwidget-webkit-finish-search "xwidget.c") (defvar-local xwidget-webkit-isearch--string "" "The current search query.") (defvar-local xwidget-webkit-isearch--is-reverse nil "Whether or not the current isearch should be reverse.") (defvar xwidget-webkit-isearch--read-string-buffer nil "The buffer we are reading input method text for, if any.") (defun xwidget-webkit-isearch--update (&optional only-message) "Update the current buffer's WebKit widget's search query. If ONLY-MESSAGE is non-nil, the query will not be sent to the WebKit widget. The query will be set to the contents of `xwidget-webkit-isearch--string'." (unless only-message (xwidget-webkit-search xwidget-webkit-isearch--string (xwidget-webkit-current-session) t xwidget-webkit-isearch--is-reverse t)) (let ((message-log-max nil)) (message "%s" (concat (propertize "Search contents: " 'face 'minibuffer-prompt) xwidget-webkit-isearch--string)))) (defun xwidget-webkit-isearch-erasing-char (count) "Erase the last COUNT characters of the current query." (interactive (list (prefix-numeric-value current-prefix-arg))) (when (> (length xwidget-webkit-isearch--string) 0) (setq xwidget-webkit-isearch--string (substring xwidget-webkit-isearch--string 0 (- (length xwidget-webkit-isearch--string) count)))) (xwidget-webkit-isearch--update)) (defun xwidget-webkit-isearch-with-input-method () "Handle a request to use the input method to modify the search query." (interactive) (let ((key (car unread-command-events)) events) (setq unread-command-events (cdr unread-command-events) events (funcall input-method-function key)) (dolist (k events) (with-current-buffer xwidget-webkit-isearch--read-string-buffer (setq xwidget-webkit-isearch--string (concat xwidget-webkit-isearch--string (char-to-string k))))) (exit-minibuffer))) (defun xwidget-webkit-isearch-printing-char-with-input-method (char) "Handle printing char CHAR with the current input method." (let ((minibuffer-local-map (make-keymap)) (xwidget-webkit-isearch--read-string-buffer (current-buffer))) (define-key minibuffer-local-map [with-input-method] 'xwidget-webkit-isearch-with-input-method) (setq unread-command-events (cons 'with-input-method (cons char unread-command-events))) (read-string "Search contents: " xwidget-webkit-isearch--string 'junk-hist nil t) (xwidget-webkit-isearch--update))) (defun xwidget-webkit-isearch-printing-char (char &optional count) "Add ordinary character CHAR to the search string and search. With argument, add COUNT copies of CHAR." (interactive (list last-command-event (prefix-numeric-value current-prefix-arg))) (if current-input-method (xwidget-webkit-isearch-printing-char-with-input-method char) (setq xwidget-webkit-isearch--string (concat xwidget-webkit-isearch--string (make-string (or count 1) char)))) (xwidget-webkit-isearch--update)) (defun xwidget-webkit-isearch-forward (count) "Move to the next search result COUNT times." (interactive (list (prefix-numeric-value current-prefix-arg))) (let ((was-reverse xwidget-webkit-isearch--is-reverse)) (setq xwidget-webkit-isearch--is-reverse nil) (when was-reverse (xwidget-webkit-isearch--update) (setq count (1- count)))) (let ((i 0)) (while (< i count) (xwidget-webkit-next-result (xwidget-webkit-current-session)) (cl-incf i))) (xwidget-webkit-isearch--update t)) (defun xwidget-webkit-isearch-backward (count) "Move to the previous search result COUNT times." (interactive (list (prefix-numeric-value current-prefix-arg))) (let ((was-reverse xwidget-webkit-isearch--is-reverse)) (setq xwidget-webkit-isearch--is-reverse t) (unless was-reverse (xwidget-webkit-isearch--update) (setq count (1- count)))) (let ((i 0)) (while (< i count) (xwidget-webkit-previous-result (xwidget-webkit-current-session)) (cl-incf i))) (xwidget-webkit-isearch--update t)) (defun xwidget-webkit-isearch-exit () "Exit incremental search of a WebKit buffer." (interactive) (xwidget-webkit-isearch-mode 0)) (defvar-keymap xwidget-webkit-isearch-mode-map :doc "The keymap used inside `xwidget-webkit-isearch-mode'." :full t) (set-char-table-range (nth 1 xwidget-webkit-isearch-mode-map) (cons 0 (max-char)) 'xwidget-webkit-isearch-exit) (substitute-key-definition 'self-insert-command 'xwidget-webkit-isearch-printing-char xwidget-webkit-isearch-mode-map global-map) (define-key xwidget-webkit-isearch-mode-map (kbd "DEL") 'xwidget-webkit-isearch-erasing-char) (define-key xwidget-webkit-isearch-mode-map [backspace] 'xwidget-webkit-isearch-erasing-char) (define-key xwidget-webkit-isearch-mode-map [return] 'xwidget-webkit-isearch-exit) (define-key xwidget-webkit-isearch-mode-map "\r" 'xwidget-webkit-isearch-exit) (define-key xwidget-webkit-isearch-mode-map "\C-g" 'xwidget-webkit-isearch-exit) (define-key xwidget-webkit-isearch-mode-map "\C-r" 'xwidget-webkit-isearch-backward) (define-key xwidget-webkit-isearch-mode-map "\C-s" 'xwidget-webkit-isearch-forward) (define-key xwidget-webkit-isearch-mode-map "\C-y" 'xwidget-webkit-isearch-yank-kill) (define-key xwidget-webkit-isearch-mode-map "\C-\\" 'toggle-input-method) (define-key xwidget-webkit-isearch-mode-map "\t" 'xwidget-webkit-isearch-printing-char) (let ((meta-map (make-keymap))) (set-char-table-range (nth 1 meta-map) (cons 0 (max-char)) 'xwidget-webkit-isearch-exit) (define-key xwidget-webkit-isearch-mode-map (char-to-string meta-prefix-char) meta-map)) (define-minor-mode xwidget-webkit-isearch-mode "Minor mode for performing incremental search inside WebKit buffers. This resembles the regular incremental search, but it does not support recursive edits. If this mode is activated with `\\\\[xwidget-webkit-isearch-backward]', then the search will by default start in the reverse direction. To navigate around the search results, type \\\\[xwidget-webkit-isearch-forward] to move forward, and \\\\[xwidget-webkit-isearch-backward] to move backward. To insert the string at the front of the kill ring into the search query, type \\\\[xwidget-webkit-isearch-yank-kill]. Press \\\\[xwidget-webkit-isearch-exit] to exit incremental search." :keymap xwidget-webkit-isearch-mode-map (if xwidget-webkit-isearch-mode (progn (setq xwidget-webkit-isearch--string "") (setq xwidget-webkit-isearch--is-reverse (eq last-command-event ?\C-r)) (xwidget-webkit-isearch--update)) (xwidget-webkit-finish-search (xwidget-webkit-current-session)))) (defun xwidget-webkit-isearch-yank-kill () "Append the most recent kill from `kill-ring' to the current query." (interactive) (unless xwidget-webkit-isearch-mode (xwidget-webkit-isearch-mode t)) (setq xwidget-webkit-isearch--string (concat xwidget-webkit-isearch--string (current-kill 0))) (xwidget-webkit-isearch--update)) (defvar-local xwidget-webkit-history--session nil "The xwidget this history buffer controls.") (define-button-type 'xwidget-webkit-history 'action #'xwidget-webkit-history-select-item) (defun xwidget-webkit-history--insert-item (item) "Insert specified ITEM into the current buffer." (let ((idx (car item)) (title (cadr item)) (uri (caddr item))) (push (list idx (vector (list (number-to-string idx) :type 'xwidget-webkit-history) (list title :type 'xwidget-webkit-history) (list uri :type 'xwidget-webkit-history))) tabulated-list-entries))) (defun xwidget-webkit-history-select-item (pos) "Navigate to the history item underneath POS." (interactive "P") (let ((id (tabulated-list-get-id pos))) (xwidget-webkit-goto-history xwidget-webkit-history--session id)) (xwidget-webkit-history-reload)) (defun xwidget-webkit-history-reload (&rest ignored) "Reload the current history buffer." (interactive) (setq tabulated-list-entries nil) (let* ((back-forward-list (xwidget-webkit-back-forward-list xwidget-webkit-history--session)) (back-list (car back-forward-list)) (here (cadr back-forward-list)) (forward-list (caddr back-forward-list))) (mapc #'xwidget-webkit-history--insert-item (nreverse forward-list)) (xwidget-webkit-history--insert-item here) (mapc #'xwidget-webkit-history--insert-item back-list) (tabulated-list-print t nil) (goto-char (point-min)) (let ((position (line-beginning-position (1+ (length back-list))))) (goto-char position) (setq-local overlay-arrow-position (make-marker)) (set-marker overlay-arrow-position position)))) (define-derived-mode xwidget-webkit-history-mode tabulated-list-mode "Xwidget Webkit History" "Major mode for browsing the history of an Xwidget Webkit buffer. Each line describes an entry in history." (setq truncate-lines t) (setq buffer-read-only t) (setq tabulated-list-format [("Index" 10 nil) ("Title" 50 nil) ("URL" 100 nil)]) (setq tabulated-list-entries nil) (setq xwidget-webkit-history--session (xwidget-webkit-current-session)) (xwidget-webkit-history-reload) (setq-local revert-buffer-function #'xwidget-webkit-history-reload) (tabulated-list-init-header)) (define-key xwidget-webkit-history-mode-map (kbd "RET") #'xwidget-webkit-history-select-item) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar xwidget-view-list) ; xwidget.c (defvar xwidget-list) ; xwidget.c (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) xwidget-list))) (delete-xwidget-view xwidget-view)))) (defun xwidget-cleanup () "Delete zombie xwidgets." ;; During development it was sometimes easy to wind up with zombie ;; xwidget instances. ;; This function tries to implement a workaround should it occur again. (interactive) ;; Kill xviews that should have been deleted but still linger. (xwidget-delete-zombies) ;; Redraw display otherwise ghost of zombies will remain to haunt the screen (redraw-display)) (defun xwidget-kill-buffer-query-function () "Ask before killing a buffer that has xwidgets." (let ((xwidgets (get-buffer-xwidgets (current-buffer)))) (or (not xwidgets) (not (memq t (mapcar #'xwidget-query-on-exit-flag xwidgets))) (yes-or-no-p (format "Buffer %S has xwidgets; kill it? " (buffer-name)))))) (when (featurep 'xwidget-internal) (add-hook 'kill-buffer-query-functions #'xwidget-kill-buffer-query-function) ;; This would have felt better in C, but this seems to work well in ;; practice though. (add-hook 'window-configuration-change-hook #'xwidget-delete-zombies)) (provide 'xwidget) ;;; xwidget.el ends here