summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authorPaul Eggert <eggert@cs.ucla.edu>2016-01-30 11:27:34 -0800
committerPaul Eggert <eggert@cs.ucla.edu>2016-01-30 11:27:34 -0800
commit82b089783e71b2aeef950eaecfe4cbc0735e64a2 (patch)
treea826c20768071bda95a69b2632718c1641c6d0cc /lisp
parentd27c8078ef766dae3587bc82b70128a70efaa223 (diff)
parentf7dc6d8b5bb318e02a4016d93f8b34de0716f4dc (diff)
downloademacs-82b089783e71b2aeef950eaecfe4cbc0735e64a2.tar.gz
emacs-82b089783e71b2aeef950eaecfe4cbc0735e64a2.tar.bz2
emacs-82b089783e71b2aeef950eaecfe4cbc0735e64a2.zip
-
Diffstat (limited to 'lisp')
-rw-r--r--lisp/calendar/todo-mode.el10
-rw-r--r--lisp/doc-view.el7
-rw-r--r--lisp/emacs-lisp/pcase.el47
-rw-r--r--lisp/gnus/nnir.el6
-rw-r--r--lisp/htmlfontify.el14
-rw-r--r--lisp/image-mode.el43
-rw-r--r--lisp/international/mule-cmds.el2
-rw-r--r--lisp/international/quail.el2
-rw-r--r--lisp/isearch.el13
-rw-r--r--lisp/net/shr.el2
-rw-r--r--lisp/progmodes/ruby-mode.el2
-rw-r--r--lisp/progmodes/xref.el8
-rw-r--r--lisp/xwidget.el580
13 files changed, 682 insertions, 54 deletions
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index 353ca69a1ba..29d8dfcfb7f 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -4654,13 +4654,15 @@ name in `todo-directory'. See also the documentation string of
(goto-char (match-beginning 0))
(goto-char (point-max)))
(backward-char)
- (when (looking-back "\\[\\([^][]+\\)\\]")
+ (when (looking-back "\\[\\([^][]+\\)\\]"
+ (line-beginning-position))
(setq cat (match-string 1))
(goto-char (match-beginning 0))
(replace-match ""))
;; If the item ends with a non-comment parenthesis not
;; followed by a period, we lose (but we inherit that
;; problem from the legacy code).
+ ;; FIXME: fails on multiline comment
(when (looking-back "(\\(.*\\)) " (line-beginning-position))
(setq comment (match-string 1))
(replace-match "")
@@ -5230,7 +5232,8 @@ Also preserve category display, if applicable."
(with-current-buffer buffer
(widen)
(let ((todo-category-number (cdr (assq 'catnum misc))))
- (todo-category-select))))
+ (todo-category-select)
+ (current-buffer))))
(add-to-list 'desktop-buffer-mode-handlers
'(todo-mode . todo-restore-desktop-buffer))
@@ -6579,8 +6582,7 @@ Added to `window-configuration-change-hook' in Todo mode."
"Make some settings that apply to multiple Todo modes."
(add-to-invisibility-spec 'todo)
(setq buffer-read-only t)
- (when (and (boundp 'desktop-save-mode) desktop-save-mode)
- (setq-local desktop-save-buffer 'todo-desktop-save-buffer))
+ (setq-local desktop-save-buffer 'todo-desktop-save-buffer)
(when (boundp 'hl-line-range-function)
(setq-local hl-line-range-function
(lambda() (save-excursion
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index 286811358fb..06cf8dcef3a 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -1714,7 +1714,8 @@ If BACKWARD is non-nil, jump to the previous match."
;; window-parameters in the window-state(s) and then restoring this
;; window-state should call us back (to interpret/use those parameters).
(doc-view-goto-page page)
- (when slice (apply 'doc-view-set-slice slice)))))
+ (when slice (apply 'doc-view-set-slice slice))
+ (current-buffer))))
(add-to-list 'desktop-buffer-mode-handlers
'(doc-view-mode . doc-view-restore-desktop-buffer))
@@ -1788,9 +1789,7 @@ toggle between displaying the document or editing it as text.
nil t)
(add-hook 'clone-indirect-buffer-hook 'doc-view-clone-buffer-hook nil t)
(add-hook 'kill-buffer-hook 'doc-view-kill-proc nil t)
- (when (and (boundp 'desktop-save-mode)
- desktop-save-mode)
- (setq-local desktop-save-buffer 'doc-view-desktop-save-buffer))
+ (setq-local desktop-save-buffer 'doc-view-desktop-save-buffer)
(remove-overlays (point-min) (point-max) 'doc-view t) ;Just in case.
;; Keep track of display info ([vh]scroll, page number, overlay,
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 3b224814e9e..549ee96dd5f 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -107,12 +107,36 @@
;;;###autoload
(defmacro pcase (exp &rest cases)
- "Eval EXP and perform ML-style pattern matching on that value.
+ "Evaluate EXP and attempt to match it against structural patterns.
CASES is a list of elements of the form (PATTERN CODE...).
-Patterns can take the following forms:
+A structural PATTERN describes a template that identifies a class
+of values. For example, the pattern `(,foo ,bar) matches any
+two element list, binding its elements to symbols named `foo' and
+`bar' -- in much the same way that `cl-destructuring-bind' would.
+
+A significant difference from `cl-destructuring-bind' is that, if
+a pattern match fails, the next case is tried until either a
+succesful match is found or there are no more cases.
+
+Another difference is that pattern elements may be backquoted,
+meaning they must match exactly: The pattern \\='(foo bar)
+matches only against two element lists containing the symbols
+`foo' and `bar' in that order. (As a short-hand, atoms always
+match themselves, such as numbers or strings, and need not be
+quoted).
+
+Lastly, a pattern can be logical, such as (pred numberp), that
+matches any number-like element; or the symbol `_', that matches
+anything. Also, when patterns are backquoted, a comma may be
+used to introduce logical patterns inside backquoted patterns.
+
+The complete list of standard patterns is as follows:
+
_ matches anything.
SYMBOL matches anything and binds it to SYMBOL.
+ If a SYMBOL is used twice in the same pattern
+ the second occurrence becomes an `eq'uality test.
(or PAT...) matches if any of the patterns matches.
(and PAT...) matches if all the patterns match.
\\='VAL matches if the object is `equal' to VAL.
@@ -122,23 +146,18 @@ Patterns can take the following forms:
(guard BOOLEXP) matches if BOOLEXP evaluates to non-nil.
(let PAT EXP) matches if EXP matches PAT.
(app FUN PAT) matches if FUN applied to the object matches PAT.
-If a SYMBOL is used twice in the same pattern (i.e. the pattern is
-\"non-linear\"), then the second occurrence is turned into an `eq'uality test.
-FUN can take the form
+Additional patterns can be defined using `pcase-defmacro'.
+
+The FUN argument in the `app' pattern may have the following forms:
SYMBOL or (lambda ARGS BODY) in which case it's called with one argument.
(F ARG1 .. ARGn) in which case F gets called with an n+1'th argument
which is the value being matched.
-So a FUN of the form SYMBOL is equivalent to one of the form (FUN).
+So a FUN of the form SYMBOL is equivalent to (FUN).
FUN can refer to variables bound earlier in the pattern.
-E.g. you can match pairs where the cdr is larger than the car with a pattern
-like \\=`(,a . ,(pred (< a))) or, with more checks:
-\\=`(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))
-FUN is assumed to be pure, i.e. it can be dropped if its result is not used,
-and two identical calls can be merged into one.
-
-Additional patterns can be defined via `pcase-defmacro'.
-Currently, the following patterns are provided this way:"
+
+See Info node `(elisp) Pattern matching case statement' in the
+Emacs Lisp manual for more information and examples."
(declare (indent 1) (debug (form &rest (pcase-PAT body))))
;; We want to use a weak hash table as a cache, but the key will unavoidably
;; be based on `exp' and `cases', yet `cases' is a fresh new list each time
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el
index 183e1443dac..560ba8ad2e5 100644
--- a/lisp/gnus/nnir.el
+++ b/lisp/gnus/nnir.el
@@ -822,8 +822,10 @@ skips all prompting."
(deffoo nnir-request-update-mark (group article mark)
(let ((artgroup (nnir-article-group article))
(artnumber (nnir-article-number article)))
- (when (and artgroup artnumber)
- (gnus-request-update-mark artgroup artnumber mark))))
+ (or (and artgroup
+ artnumber
+ (gnus-request-update-mark artgroup artnumber mark))
+ mark)))
(deffoo nnir-request-set-mark (group actions &optional server)
(nnir-possibly-change-group group server)
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index 964d7440332..431300c81c2 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -1001,7 +1001,7 @@ merged by the user - `hfy-flatten-style' should do this."
(append
parent
(hfy-face-to-style-i
- (hfy-face-attr-for-class v hfy-display-class)) ))))
+ (hfy-face-attr-for-class v hfy-display-class))))))
(setq this
(if val (case key
(:family (hfy-family val))
@@ -1020,7 +1020,7 @@ merged by the user - `hfy-flatten-style' should do this."
(:italic (hfy-slant 'italic))))))
(setq that (hfy-face-to-style-i next))
;;(lwarn t :warning "%S => %S" fn (nconc this that parent))
- (nconc this that parent))) )
+ (nconc this parent that))) )
(defun hfy-size-to-int (spec)
"Convert SPEC, a CSS font-size specifier, to an Emacs :height attribute value.
@@ -1058,13 +1058,19 @@ haven't encountered them yet. Returns a `hfy-style-assoc'."
(nconc r (hfy-size (if x (round n) (* n 1.0)))) ))
(defun hfy-face-resolve-face (fn)
+ "For FN return a face specification.
+FN may be either a face or a face specification. If the latter,
+then the specification is returned unchanged."
(cond
((facep fn)
(hfy-face-attr-for-class fn hfy-display-class))
+ ;; FIXME: is this necessary? Faces can be symbols, but
+ ;; not symbols refering to other symbols?
((and (symbolp fn)
(facep (symbol-value fn)))
- (hfy-face-attr-for-class (symbol-value fn) hfy-display-class))
- (t nil)))
+ (hfy-face-attr-for-class
+ (symbol-value fn) hfy-display-class))
+ (t fn)))
(defun hfy-face-to-style (fn)
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index e677dd0d0e7..e549b49001e 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -153,6 +153,8 @@ otherwise it defaults to t, used for times when the buffer is not displayed."
(selected-window))))
(declare-function image-size "image.c" (spec &optional pixels frame))
+(declare-function xwidget-info "xwidget.c" (xwidget))
+(declare-function xwidget-at "xwidget.el" (pos))
(defun image-display-size (spec &optional pixels frame)
"Wrapper around `image-size', handling slice display properties.
@@ -160,24 +162,29 @@ Like `image-size', the return value is (WIDTH . HEIGHT).
WIDTH and HEIGHT are in canonical character units if PIXELS is
nil, and in pixel units if PIXELS is non-nil.
-If SPEC is an image display property, this function is equivalent
-to `image-size'. If SPEC is a list of properties containing
-`image' and `slice' properties, return the display size taking
-the slice property into account. If the list contains `image'
-but not `slice', return the `image-size' of the specified image."
- (if (eq (car spec) 'image)
- (image-size spec pixels frame)
- (let ((image (assoc 'image spec))
- (slice (assoc 'slice spec)))
- (cond ((and image slice)
- (if pixels
- (cons (nth 3 slice) (nth 4 slice))
- (cons (/ (float (nth 3 slice)) (frame-char-width frame))
- (/ (float (nth 4 slice)) (frame-char-height frame)))))
- (image
- (image-size image pixels frame))
- (t
- (error "Invalid image specification: %s" spec))))))
+If SPEC is an image display property, this function is equivalent to
+`image-size'. If SPEC represents an xwidget object, defer to `xwidget-info'.
+If SPEC is a list of properties containing `image' and `slice' properties,
+return the display size taking the slice property into account. If the list
+contains `image' but not `slice', return the `image-size' of the specified
+image."
+ (cond ((eq (car spec) 'xwidget)
+ (let ((xwi (xwidget-info (xwidget-at (point-min)))))
+ (cons (aref xwi 2) (aref xwi 3))))
+ ((eq (car spec) 'image)
+ (image-size spec pixels frame))
+ (t (let ((image (assoc 'image spec))
+ (slice (assoc 'slice spec)))
+ (cond ((and image slice)
+ (if pixels
+ (cons (nth 3 slice) (nth 4 slice))
+ (cons (/ (float (nth 3 slice)) (frame-char-width frame))
+ (/ (float (nth 4 slice))
+ (frame-char-height frame)))))
+ (image
+ (image-size image pixels frame))
+ (t
+ (error "Invalid image specification: %s" spec)))))))
(defun image-forward-hscroll (&optional n)
"Scroll image in current window to the left by N character widths.
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 79e9c7b4adc..2df847acc25 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -2119,7 +2119,7 @@ See `set-language-info-alist' for use in programs."
(with-current-buffer standard-output
(insert language-name " language environment\n\n")
(if (stringp doc)
- (insert doc "\n\n"))
+ (insert (substitute-command-keys doc) "\n\n"))
(condition-case nil
(let ((str (eval (get-language-info language-name 'sample-text))))
(if (stringp str)
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index 75cb7f787df..f5e390278ca 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -2516,7 +2516,7 @@ package to describe."
")\n\n")
(save-restriction
(narrow-to-region (point) (point))
- (insert (quail-docstring))
+ (insert (substitute-command-keys (quail-docstring)))
(goto-char (point-min))
(with-syntax-table emacs-lisp-mode-syntax-table
(while (re-search-forward "\\\\<\\sw\\(\\sw\\|\\s_\\)+>" nil t)
diff --git a/lisp/isearch.el b/lisp/isearch.el
index e636ccc0d22..c36f4631549 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -2647,10 +2647,11 @@ the word mode."
"Non-default value overrides the behavior of `isearch-search-fun-default'.
This variable's value should be a function, which will be called
with no arguments, and should return a function that takes three
-arguments: STRING, BOUND, and NOERROR.
+arguments: STRING, BOUND, and NOERROR. See `re-search-forward'
+for the meaning of BOUND and NOERROR arguments.
This returned function will be used by `isearch-search-string' to
-search for the first occurrence of STRING or its translation.")
+search for the first occurrence of STRING.")
(defun isearch-search-fun ()
"Return the function to use for the search.
@@ -2695,8 +2696,14 @@ Can be changed via `isearch-search-fun-function' for special needs."
(defun isearch-search-string (string bound noerror)
"Search for the first occurrence of STRING or its translation.
+STRING's characters are translated using `translation-table-for-input'
+if that is non-nil.
If found, move point to the end of the occurrence,
-update the match data, and return point."
+update the match data, and return point.
+An optional second argument bounds the search; it is a buffer position.
+The match found must not extend after that position.
+Optional third argument, if t, means if fail just return nil (no error).
+ If not nil and not t, move to limit of search and return nil."
(let* ((func (isearch-search-fun))
(pos1 (save-excursion (funcall func string bound noerror)))
pos2)
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 290a6422bd7..ab416146595 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -1619,7 +1619,7 @@ The preference is a float determined from `shr-prefer-media-type'."
(defun shr-table-body (dom)
(let ((tbodies (seq-filter (lambda (child)
(eq (dom-tag child) 'tbody))
- (dom-children dom))))
+ (dom-non-text-children dom))))
(cond
((null tbodies)
dom)
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 53f8a6bb4c0..e3fe315f3bd 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -102,7 +102,7 @@
(eval-and-compile
(defconst ruby-here-doc-beg-re
- "\\(<\\)<\\(-\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)"
+ "\\(<\\)<\\([~-]\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)"
"Regexp to match the beginning of a heredoc.")
(defconst ruby-expression-expansion-re
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 2bccd857576..d32da371771 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -861,7 +861,13 @@ tools are used, and when."
(cl-assert (directory-name-p dir))
(require 'semantic/symref)
(defvar semantic-symref-tool)
- (let* ((default-directory dir)
+
+ ;; Some symref backends use `ede-project-root-directory' as the root
+ ;; directory for the search, rather than `default-directory'. Since
+ ;; the caller has specified `dir', we bind `ede-minor-mode' to nil
+ ;; to force the backend to use `default-directory'.
+ (let* ((ede-minor-mode nil)
+ (default-directory dir)
(semantic-symref-tool 'detect)
(res (semantic-symref-find-references-by-name symbol 'subdirs))
(hits (and res (oref res hit-lines)))
diff --git a/lisp/xwidget.el b/lisp/xwidget.el
new file mode 100644
index 00000000000..f184eb31dbb
--- /dev/null
+++ b/lisp/xwidget.el
@@ -0,0 +1,580 @@
+;;; xwidget.el --- api functions for xwidgets -*- lexical-binding: t -*-
+;;
+;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
+;;
+;; Author: Joakim Verona (joakim@verona.se)
+;;
+;; 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 <http://www.gnu.org/licenses/>.
+;;
+;; --------------------------------------------------------------------
+
+;;; Commentary:
+;;
+;; See xwidget.c for more api functions.
+
+;; TODO this breaks compilation when we don't have xwidgets.
+;;(require 'xwidget-internal)
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'bookmark)
+
+(defcustom xwidget-webkit-scroll-behaviour 'native
+ "Scroll behaviour of the webkit instance.
+'native or 'image."
+ :version "25.1"
+ :group 'frames ; TODO add xwidgets group if more options are added
+ :type '(choice (const native) (const image)))
+
+(declare-function make-xwidget "xwidget.c"
+ (beg end type title width height arguments &optional buffer))
+(declare-function xwidget-set-adjustment "xwidget.c"
+ (xwidget axis relative value))
+(declare-function xwidget-buffer "xwidget.c" (xwidget))
+(declare-function xwidget-webkit-get-title "xwidget.c" (xwidget))
+(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))
+(declare-function xwidget-webkit-goto-uri "xwidget.c" (xwidget uri))
+(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))
+
+(defun xwidget-insert (pos type title width height &optional args)
+ "Insert an xwidget at POS.
+given ID, TYPE, TITLE WIDTH and
+HEIGHT in the current buffer.
+
+Return ID
+
+see `make-xwidget' for types suitable for TYPE.
+Optional argument ARGS usage depends on the xwidget."
+ (goto-char pos)
+ (let ((id (make-xwidget (point) (point)
+ type title width height args)))
+ (put-text-property (point) (+ 1 (point))
+ 'display (list 'xwidget ':xwidget id))
+ id))
+
+(defun xwidget-at (pos)
+ "Return xwidget at POS."
+ ;; TODO this function is a bit tedious because the C layer isn't well
+ ;; protected yet and xwidgetp apparently doesn't work yet.
+ (let* ((disp (get-text-property pos 'display))
+ (xw (car (cdr (cdr disp)))))
+ ;;(if (xwidgetp xw) xw nil)
+ (if (equal 'xwidget (car disp)) xw)))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; webkit support
+(require 'browse-url)
+(require 'image-mode);;for some image-mode alike functionality
+
+;;;###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. URL
+defaults to the string looking like a url around the cursor position."
+ (interactive (progn
+ (require 'browse-url)
+ (browse-url-interactive-arg "xwidget-webkit URL: "
+ ;;(xwidget-webkit-current-url)
+ )))
+ (when (stringp url)
+ (if new-session
+ (xwidget-webkit-new-session url)
+ (xwidget-webkit-goto-url url))))
+
+;;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 "r" 'xwidget-webkit-reload)
+ (define-key map "t" (lambda () (interactive) (message "o"))) ;FIXME: ?!?
+ (define-key map "\C-m" 'xwidget-webkit-insert-string)
+ (define-key map "w" 'xwidget-webkit-current-url)
+
+ ;;similar to image mode bindings
+ (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 ()
+ "Scroll webkit forward,either native or like image mode."
+ (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 ()
+ "Scroll webkit backward,either native or like image mode."
+ (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 it's offscreen.
+;; TODO this needs to use callbacks and consider different xwidget event 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*")))
+ (with-current-buffer buf
+ (insert (apply #'format msg))
+ (insert "\n"))))
+
+(defun xwidget-event-handler ()
+ "Receive xwidget event."
+ (interactive)
+ (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))
+ ;;TODO stopped working for some reason
+ )
+ ;;(funcall xwidget-callback xwidget xwidget-event-type)
+ (message "xw callback %s" xwidget)
+ (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."
+ (if (not (buffer-live-p (xwidget-buffer xwidget)))
+ (xwidget-log
+ "error: callback called for xwidget with dead buffer")
+ (with-current-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))
+ ;;TODO - check the native/internal scroll
+ ;;(xwidget-adjust-size-to-content xwidget)
+ (xwidget-webkit-adjust-size-dispatch) ;;TODO xwidget arg
+ (rename-buffer (format "*xwidget webkit: %s *"
+ (xwidget-webkit-get-title xwidget)))
+ (pop-to-buffer (current-buffer)))
+ ((eq xwidget-event-type
+ 'navigation-policy-decision-requested)
+ (if (string-match ".*#\\(.*\\)" strarg)
+ (xwidget-webkit-show-id-or-named-element
+ xwidget
+ (match-string 1 strarg))))
+ (t (xwidget-log "unhandled event:%s" xwidget-event-type)))))))
+
+(defvar bookmark-make-record-function)
+(define-derived-mode xwidget-webkit-mode
+ special-mode "xwidget-webkit" "Xwidget webkit view mode."
+ (setq buffer-read-only t)
+ (setq-local bookmark-make-record-function
+ #'xwidget-webkit-bookmark-make-record)
+ ;; Keep track of [vh]scroll when switching buffers
+ (image-mode-setup-winprops))
+
+(defun xwidget-webkit-bookmark-make-record ()
+ "Integrate Emacs bookmarks with the webkit xwidget."
+ (nconc (bookmark-make-record-default t t)
+ `((page . ,(xwidget-webkit-current-url))
+ (handler . (lambda (bmk) (browse-url
+ (bookmark-prop-get bmk 'page)))))))
+
+
+(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))))
+
+
+(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 (xw str)
+ "Insert string in the active field in the webkit.
+Argument XW webkit.
+Argument STR string."
+ ;; Read out the string in the field first and provide for edit.
+ (interactive
+ (let* ((xww (xwidget-webkit-current-session))
+
+ (field-value
+ (progn
+ (xwidget-webkit-execute-script xww xwidget-webkit-activeelement-js)
+ (xwidget-webkit-execute-script-rv
+ xww
+ "findactiveelement(document).value;")))
+ (field-type (xwidget-webkit-execute-script-rv
+ xww
+ "findactiveelement(document).type;")))
+ (list xww
+ (cond ((equal "text" field-type)
+ (read-string "text:" field-value))
+ ((equal "password" field-type)
+ (read-passwd "password:" nil field-value))
+ ((equal "textarea" field-type)
+ (xwidget-webkit-begin-edit-textarea xww field-value))))))
+ (xwidget-webkit-execute-script
+ xw
+ (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"))
+
+ (set (make-local-variable 'xwidget-xwbl) xw)
+ (insert text))
+
+(defun xwidget-webkit-end-edit-textarea ()
+ "End editing of a webkit text area."
+ (interactive)
+ (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-named-element (xw element-name)
+ "Make named-element show. for instance an anchor.
+Argument XW is the xwidget.
+Argument ELEMENT-NAME is the element name to display in the webkit xwidget."
+ (interactive (list (xwidget-webkit-current-session)
+ (read-string "element name:")))
+ ;;TODO since an xwidget is an Emacs object, it is not trivial to do
+ ;; some things that are taken for granted in a normal browser.
+ ;; scrolling an anchor/named-element into view is one such thing.
+ ;; This function implements a proof-of-concept for this. Problems
+ ;; remaining: - The selected window is scrolled but this is not
+ ;; always correct - 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
+
+ ;; This part figures out the Y coordinate of the element
+ (let ((y (string-to-number
+ (xwidget-webkit-execute-script-rv
+ xw
+ (format
+ "document.getElementsByName('%s')[0].getBoundingClientRect().top"
+ element-name)
+ 0))))
+ ;; Now we need to tell Emacs to scroll the element into view.
+ (xwidget-log "scroll: %d" y)
+ (set-window-vscroll (selected-window) y t)))
+
+(defun xwidget-webkit-show-id-element (xw element-id)
+ "Make id-element show. for instance an anchor.
+Argument XW is the webkit xwidget.
+Argument ELEMENT-ID is the id of the element to show."
+ (interactive (list (xwidget-webkit-current-session)
+ (read-string "element id:")))
+ (let ((y (string-to-number
+ (xwidget-webkit-execute-script-rv
+ xw
+ (format "document.getElementById('%s').getBoundingClientRect().top"
+ element-id)
+ 0))))
+ ;; Now we need to tell Emacs to scroll the element into view.
+ (xwidget-log "scroll: %d" y)
+ (set-window-vscroll (selected-window) y t)))
+
+(defun xwidget-webkit-show-id-or-named-element (xw element-id)
+ "Make id-element show. for instance an anchor.
+Argument XW is the webkit xwidget.
+Argument ELEMENT-ID is either a name or an element id."
+ (interactive (list (xwidget-webkit-current-session)
+ (read-string "element id:")))
+ (let* ((y1 (string-to-number
+ (xwidget-webkit-execute-script-rv
+ xw
+ (format "document.getElementsByName('%s')[0].getBoundingClientRect().top" element-id)
+ "0")))
+ (y2 (string-to-number
+ (xwidget-webkit-execute-script-rv
+ xw
+ (format "document.getElementById('%s').getBoundingClientRect().top" element-id)
+ "0")))
+ (y3 (max y1 y2)))
+ ;; Now we need to tell Emacs to scroll the element into view.
+ (xwidget-log "scroll: %d" y3)
+ (set-window-vscroll (selected-window) y3 t)))
+
+(defun xwidget-webkit-adjust-size-to-content ()
+ "Adjust webkit to content size."
+ (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))
+ ;; 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))
+ )
+
+(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)
+ "Manually set webkit size.
+Argument W width.
+Argument H height."
+ ;; TODO shouldn't be tied to the webkit xwidget
+ (interactive "nWidth:\nnHeight:\n")
+ (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 (- (nth 2 (window-inside-pixel-edges))
+ (car (window-inside-pixel-edges)))
+ 1000))
+
+(defun xwidget-webkit-new-session (url)
+ "Create a new webkit session buffer with URL."
+ (let*
+ ((bufname (generate-new-buffer-name "*xwidget-webkit*"))
+ xw)
+ (setq xwidget-webkit-last-session-buffer (switch-to-buffer
+ (get-buffer-create bufname)))
+ (insert " 'a' adjusts the xwidget size.")
+ (setq xw (xwidget-insert 1 'webkit-osr bufname 1000 1000))
+ (xwidget-put xw 'callback 'xwidget-webkit-callback)
+ (xwidget-webkit-mode)
+ (xwidget-webkit-goto-uri (xwidget-webkit-last-session) url)))
+
+
+(defun xwidget-webkit-goto-url (url)
+ "Goto URL."
+ (if (xwidget-webkit-current-session)
+ (progn
+ (xwidget-webkit-goto-uri (xwidget-webkit-current-session) url))
+ (xwidget-webkit-new-session url)))
+
+(defun xwidget-webkit-back ()
+ "Back in history."
+ (interactive)
+ (xwidget-webkit-execute-script (xwidget-webkit-current-session)
+ "history.go(-1);"))
+
+(defun xwidget-webkit-reload ()
+ "Reload current url."
+ (interactive)
+ (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."
+ (interactive)
+ (let* ((rv (xwidget-webkit-execute-script-rv (xwidget-webkit-current-session)
+ "document.URL"))
+ (url (kill-new (or rv ""))))
+ (message "url: %s" url)
+ url))
+
+(defun xwidget-webkit-execute-script-rv (xw script &optional default)
+ "Same as 'xwidget-webkit-execute-script' but but with return value.
+XW is the webkit instance. SCRIPT is the script to execute.
+DEFAULT is the defaultreturn value."
+ ;; Notice the ugly "title" hack. It is needed because the Webkit
+ ;; API at the time of writing didn't support returning values. This
+ ;; is a wrapper for the title hack so it's easy to remove should
+ ;; Webkit someday support JS return values or we find some other way
+ ;; to access the DOM.
+
+ ;; Reset webkit title. Not very nice.
+ (let* ((emptytag "titlecantbewhitespaceohthehorror")
+ title)
+ (xwidget-webkit-execute-script xw (format "document.title=\"%s\";"
+ (or default emptytag)))
+ (xwidget-webkit-execute-script xw (format "document.title=%s;" script))
+ (setq title (xwidget-webkit-get-title xw))
+ (if (equal emptytag title)
+ (setq title ""))
+ (unless title
+ (setq title default))
+ title))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(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)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Xwidget plist management (similar to the process plist functions)
+
+(defun xwidget-get (xwidget propname)
+ "Return the value of XWIDGET' PROPNAME property.
+This is the last value stored with `(xwidget-put XWIDGET PROPNAME VALUE)'."
+ (plist-get (xwidget-plist xwidget) propname))
+
+(defun xwidget-put (xwidget propname value)
+ "Change XWIDGET' PROPNAME property to VALUE.
+It can be retrieved with `(xwidget-get XWIDGET PROPNAME)'."
+ (set-xwidget-plist xwidget
+ (plist-put (xwidget-plist xwidget) propname value)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(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