diff options
| author | Paul Eggert | 2016-01-30 11:27:34 -0800 |
|---|---|---|
| committer | Paul Eggert | 2016-01-30 11:27:34 -0800 |
| commit | 82b089783e71b2aeef950eaecfe4cbc0735e64a2 (patch) | |
| tree | a826c20768071bda95a69b2632718c1641c6d0cc /lisp | |
| parent | d27c8078ef766dae3587bc82b70128a70efaa223 (diff) | |
| parent | f7dc6d8b5bb318e02a4016d93f8b34de0716f4dc (diff) | |
| download | emacs-82b089783e71b2aeef950eaecfe4cbc0735e64a2.tar.gz emacs-82b089783e71b2aeef950eaecfe4cbc0735e64a2.zip | |
-
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/calendar/todo-mode.el | 10 | ||||
| -rw-r--r-- | lisp/doc-view.el | 7 | ||||
| -rw-r--r-- | lisp/emacs-lisp/pcase.el | 47 | ||||
| -rw-r--r-- | lisp/gnus/nnir.el | 6 | ||||
| -rw-r--r-- | lisp/htmlfontify.el | 14 | ||||
| -rw-r--r-- | lisp/image-mode.el | 43 | ||||
| -rw-r--r-- | lisp/international/mule-cmds.el | 2 | ||||
| -rw-r--r-- | lisp/international/quail.el | 2 | ||||
| -rw-r--r-- | lisp/isearch.el | 13 | ||||
| -rw-r--r-- | lisp/net/shr.el | 2 | ||||
| -rw-r--r-- | lisp/progmodes/ruby-mode.el | 2 | ||||
| -rw-r--r-- | lisp/progmodes/xref.el | 8 | ||||
| -rw-r--r-- | lisp/xwidget.el | 580 |
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 | |||
| 4654 | (goto-char (match-beginning 0)) | 4654 | (goto-char (match-beginning 0)) |
| 4655 | (goto-char (point-max))) | 4655 | (goto-char (point-max))) |
| 4656 | (backward-char) | 4656 | (backward-char) |
| 4657 | (when (looking-back "\\[\\([^][]+\\)\\]") | 4657 | (when (looking-back "\\[\\([^][]+\\)\\]" |
| 4658 | (line-beginning-position)) | ||
| 4658 | (setq cat (match-string 1)) | 4659 | (setq cat (match-string 1)) |
| 4659 | (goto-char (match-beginning 0)) | 4660 | (goto-char (match-beginning 0)) |
| 4660 | (replace-match "")) | 4661 | (replace-match "")) |
| 4661 | ;; If the item ends with a non-comment parenthesis not | 4662 | ;; If the item ends with a non-comment parenthesis not |
| 4662 | ;; followed by a period, we lose (but we inherit that | 4663 | ;; followed by a period, we lose (but we inherit that |
| 4663 | ;; problem from the legacy code). | 4664 | ;; problem from the legacy code). |
| 4665 | ;; FIXME: fails on multiline comment | ||
| 4664 | (when (looking-back "(\\(.*\\)) " (line-beginning-position)) | 4666 | (when (looking-back "(\\(.*\\)) " (line-beginning-position)) |
| 4665 | (setq comment (match-string 1)) | 4667 | (setq comment (match-string 1)) |
| 4666 | (replace-match "") | 4668 | (replace-match "") |
| @@ -5230,7 +5232,8 @@ Also preserve category display, if applicable." | |||
| 5230 | (with-current-buffer buffer | 5232 | (with-current-buffer buffer |
| 5231 | (widen) | 5233 | (widen) |
| 5232 | (let ((todo-category-number (cdr (assq 'catnum misc)))) | 5234 | (let ((todo-category-number (cdr (assq 'catnum misc)))) |
| 5233 | (todo-category-select)))) | 5235 | (todo-category-select) |
| 5236 | (current-buffer)))) | ||
| 5234 | 5237 | ||
| 5235 | (add-to-list 'desktop-buffer-mode-handlers | 5238 | (add-to-list 'desktop-buffer-mode-handlers |
| 5236 | '(todo-mode . todo-restore-desktop-buffer)) | 5239 | '(todo-mode . todo-restore-desktop-buffer)) |
| @@ -6579,8 +6582,7 @@ Added to `window-configuration-change-hook' in Todo mode." | |||
| 6579 | "Make some settings that apply to multiple Todo modes." | 6582 | "Make some settings that apply to multiple Todo modes." |
| 6580 | (add-to-invisibility-spec 'todo) | 6583 | (add-to-invisibility-spec 'todo) |
| 6581 | (setq buffer-read-only t) | 6584 | (setq buffer-read-only t) |
| 6582 | (when (and (boundp 'desktop-save-mode) desktop-save-mode) | 6585 | (setq-local desktop-save-buffer 'todo-desktop-save-buffer) |
| 6583 | (setq-local desktop-save-buffer 'todo-desktop-save-buffer)) | ||
| 6584 | (when (boundp 'hl-line-range-function) | 6586 | (when (boundp 'hl-line-range-function) |
| 6585 | (setq-local hl-line-range-function | 6587 | (setq-local hl-line-range-function |
| 6586 | (lambda() (save-excursion | 6588 | (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." | |||
| 1714 | ;; window-parameters in the window-state(s) and then restoring this | 1714 | ;; window-parameters in the window-state(s) and then restoring this |
| 1715 | ;; window-state should call us back (to interpret/use those parameters). | 1715 | ;; window-state should call us back (to interpret/use those parameters). |
| 1716 | (doc-view-goto-page page) | 1716 | (doc-view-goto-page page) |
| 1717 | (when slice (apply 'doc-view-set-slice slice))))) | 1717 | (when slice (apply 'doc-view-set-slice slice)) |
| 1718 | (current-buffer)))) | ||
| 1718 | 1719 | ||
| 1719 | (add-to-list 'desktop-buffer-mode-handlers | 1720 | (add-to-list 'desktop-buffer-mode-handlers |
| 1720 | '(doc-view-mode . doc-view-restore-desktop-buffer)) | 1721 | '(doc-view-mode . doc-view-restore-desktop-buffer)) |
| @@ -1788,9 +1789,7 @@ toggle between displaying the document or editing it as text. | |||
| 1788 | nil t) | 1789 | nil t) |
| 1789 | (add-hook 'clone-indirect-buffer-hook 'doc-view-clone-buffer-hook nil t) | 1790 | (add-hook 'clone-indirect-buffer-hook 'doc-view-clone-buffer-hook nil t) |
| 1790 | (add-hook 'kill-buffer-hook 'doc-view-kill-proc nil t) | 1791 | (add-hook 'kill-buffer-hook 'doc-view-kill-proc nil t) |
| 1791 | (when (and (boundp 'desktop-save-mode) | 1792 | (setq-local desktop-save-buffer 'doc-view-desktop-save-buffer) |
| 1792 | desktop-save-mode) | ||
| 1793 | (setq-local desktop-save-buffer 'doc-view-desktop-save-buffer)) | ||
| 1794 | 1793 | ||
| 1795 | (remove-overlays (point-min) (point-max) 'doc-view t) ;Just in case. | 1794 | (remove-overlays (point-min) (point-max) 'doc-view t) ;Just in case. |
| 1796 | ;; Keep track of display info ([vh]scroll, page number, overlay, | 1795 | ;; 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 @@ | |||
| 107 | 107 | ||
| 108 | ;;;###autoload | 108 | ;;;###autoload |
| 109 | (defmacro pcase (exp &rest cases) | 109 | (defmacro pcase (exp &rest cases) |
| 110 | "Eval EXP and perform ML-style pattern matching on that value. | 110 | "Evaluate EXP and attempt to match it against structural patterns. |
| 111 | CASES is a list of elements of the form (PATTERN CODE...). | 111 | CASES is a list of elements of the form (PATTERN CODE...). |
| 112 | 112 | ||
| 113 | Patterns can take the following forms: | 113 | A structural PATTERN describes a template that identifies a class |
| 114 | of values. For example, the pattern `(,foo ,bar) matches any | ||
| 115 | two element list, binding its elements to symbols named `foo' and | ||
| 116 | `bar' -- in much the same way that `cl-destructuring-bind' would. | ||
| 117 | |||
| 118 | A significant difference from `cl-destructuring-bind' is that, if | ||
| 119 | a pattern match fails, the next case is tried until either a | ||
| 120 | succesful match is found or there are no more cases. | ||
| 121 | |||
| 122 | Another difference is that pattern elements may be backquoted, | ||
| 123 | meaning they must match exactly: The pattern \\='(foo bar) | ||
| 124 | matches only against two element lists containing the symbols | ||
| 125 | `foo' and `bar' in that order. (As a short-hand, atoms always | ||
| 126 | match themselves, such as numbers or strings, and need not be | ||
| 127 | quoted). | ||
| 128 | |||
| 129 | Lastly, a pattern can be logical, such as (pred numberp), that | ||
| 130 | matches any number-like element; or the symbol `_', that matches | ||
| 131 | anything. Also, when patterns are backquoted, a comma may be | ||
| 132 | used to introduce logical patterns inside backquoted patterns. | ||
| 133 | |||
| 134 | The complete list of standard patterns is as follows: | ||
| 135 | |||
| 114 | _ matches anything. | 136 | _ matches anything. |
| 115 | SYMBOL matches anything and binds it to SYMBOL. | 137 | SYMBOL matches anything and binds it to SYMBOL. |
| 138 | If a SYMBOL is used twice in the same pattern | ||
| 139 | the second occurrence becomes an `eq'uality test. | ||
| 116 | (or PAT...) matches if any of the patterns matches. | 140 | (or PAT...) matches if any of the patterns matches. |
| 117 | (and PAT...) matches if all the patterns match. | 141 | (and PAT...) matches if all the patterns match. |
| 118 | \\='VAL matches if the object is `equal' to VAL. | 142 | \\='VAL matches if the object is `equal' to VAL. |
| @@ -122,23 +146,18 @@ Patterns can take the following forms: | |||
| 122 | (guard BOOLEXP) matches if BOOLEXP evaluates to non-nil. | 146 | (guard BOOLEXP) matches if BOOLEXP evaluates to non-nil. |
| 123 | (let PAT EXP) matches if EXP matches PAT. | 147 | (let PAT EXP) matches if EXP matches PAT. |
| 124 | (app FUN PAT) matches if FUN applied to the object matches PAT. | 148 | (app FUN PAT) matches if FUN applied to the object matches PAT. |
| 125 | If a SYMBOL is used twice in the same pattern (i.e. the pattern is | ||
| 126 | \"non-linear\"), then the second occurrence is turned into an `eq'uality test. | ||
| 127 | 149 | ||
| 128 | FUN can take the form | 150 | Additional patterns can be defined using `pcase-defmacro'. |
| 151 | |||
| 152 | The FUN argument in the `app' pattern may have the following forms: | ||
| 129 | SYMBOL or (lambda ARGS BODY) in which case it's called with one argument. | 153 | SYMBOL or (lambda ARGS BODY) in which case it's called with one argument. |
| 130 | (F ARG1 .. ARGn) in which case F gets called with an n+1'th argument | 154 | (F ARG1 .. ARGn) in which case F gets called with an n+1'th argument |
| 131 | which is the value being matched. | 155 | which is the value being matched. |
| 132 | So a FUN of the form SYMBOL is equivalent to one of the form (FUN). | 156 | So a FUN of the form SYMBOL is equivalent to (FUN). |
| 133 | FUN can refer to variables bound earlier in the pattern. | 157 | FUN can refer to variables bound earlier in the pattern. |
| 134 | E.g. you can match pairs where the cdr is larger than the car with a pattern | 158 | |
| 135 | like \\=`(,a . ,(pred (< a))) or, with more checks: | 159 | See Info node `(elisp) Pattern matching case statement' in the |
| 136 | \\=`(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a)))) | 160 | Emacs Lisp manual for more information and examples." |
| 137 | FUN is assumed to be pure, i.e. it can be dropped if its result is not used, | ||
| 138 | and two identical calls can be merged into one. | ||
| 139 | |||
| 140 | Additional patterns can be defined via `pcase-defmacro'. | ||
| 141 | Currently, the following patterns are provided this way:" | ||
| 142 | (declare (indent 1) (debug (form &rest (pcase-PAT body)))) | 161 | (declare (indent 1) (debug (form &rest (pcase-PAT body)))) |
| 143 | ;; We want to use a weak hash table as a cache, but the key will unavoidably | 162 | ;; We want to use a weak hash table as a cache, but the key will unavoidably |
| 144 | ;; be based on `exp' and `cases', yet `cases' is a fresh new list each time | 163 | ;; 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." | |||
| 822 | (deffoo nnir-request-update-mark (group article mark) | 822 | (deffoo nnir-request-update-mark (group article mark) |
| 823 | (let ((artgroup (nnir-article-group article)) | 823 | (let ((artgroup (nnir-article-group article)) |
| 824 | (artnumber (nnir-article-number article))) | 824 | (artnumber (nnir-article-number article))) |
| 825 | (when (and artgroup artnumber) | 825 | (or (and artgroup |
| 826 | (gnus-request-update-mark artgroup artnumber mark)))) | 826 | artnumber |
| 827 | (gnus-request-update-mark artgroup artnumber mark)) | ||
| 828 | mark))) | ||
| 827 | 829 | ||
| 828 | (deffoo nnir-request-set-mark (group actions &optional server) | 830 | (deffoo nnir-request-set-mark (group actions &optional server) |
| 829 | (nnir-possibly-change-group group server) | 831 | (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." | |||
| 1001 | (append | 1001 | (append |
| 1002 | parent | 1002 | parent |
| 1003 | (hfy-face-to-style-i | 1003 | (hfy-face-to-style-i |
| 1004 | (hfy-face-attr-for-class v hfy-display-class)) )))) | 1004 | (hfy-face-attr-for-class v hfy-display-class)))))) |
| 1005 | (setq this | 1005 | (setq this |
| 1006 | (if val (case key | 1006 | (if val (case key |
| 1007 | (:family (hfy-family val)) | 1007 | (:family (hfy-family val)) |
| @@ -1020,7 +1020,7 @@ merged by the user - `hfy-flatten-style' should do this." | |||
| 1020 | (:italic (hfy-slant 'italic)))))) | 1020 | (:italic (hfy-slant 'italic)))))) |
| 1021 | (setq that (hfy-face-to-style-i next)) | 1021 | (setq that (hfy-face-to-style-i next)) |
| 1022 | ;;(lwarn t :warning "%S => %S" fn (nconc this that parent)) | 1022 | ;;(lwarn t :warning "%S => %S" fn (nconc this that parent)) |
| 1023 | (nconc this that parent))) ) | 1023 | (nconc this parent that))) ) |
| 1024 | 1024 | ||
| 1025 | (defun hfy-size-to-int (spec) | 1025 | (defun hfy-size-to-int (spec) |
| 1026 | "Convert SPEC, a CSS font-size specifier, to an Emacs :height attribute value. | 1026 | "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'." | |||
| 1058 | (nconc r (hfy-size (if x (round n) (* n 1.0)))) )) | 1058 | (nconc r (hfy-size (if x (round n) (* n 1.0)))) )) |
| 1059 | 1059 | ||
| 1060 | (defun hfy-face-resolve-face (fn) | 1060 | (defun hfy-face-resolve-face (fn) |
| 1061 | "For FN return a face specification. | ||
| 1062 | FN may be either a face or a face specification. If the latter, | ||
| 1063 | then the specification is returned unchanged." | ||
| 1061 | (cond | 1064 | (cond |
| 1062 | ((facep fn) | 1065 | ((facep fn) |
| 1063 | (hfy-face-attr-for-class fn hfy-display-class)) | 1066 | (hfy-face-attr-for-class fn hfy-display-class)) |
| 1067 | ;; FIXME: is this necessary? Faces can be symbols, but | ||
| 1068 | ;; not symbols refering to other symbols? | ||
| 1064 | ((and (symbolp fn) | 1069 | ((and (symbolp fn) |
| 1065 | (facep (symbol-value fn))) | 1070 | (facep (symbol-value fn))) |
| 1066 | (hfy-face-attr-for-class (symbol-value fn) hfy-display-class)) | 1071 | (hfy-face-attr-for-class |
| 1067 | (t nil))) | 1072 | (symbol-value fn) hfy-display-class)) |
| 1073 | (t fn))) | ||
| 1068 | 1074 | ||
| 1069 | 1075 | ||
| 1070 | (defun hfy-face-to-style (fn) | 1076 | (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." | |||
| 153 | (selected-window)))) | 153 | (selected-window)))) |
| 154 | 154 | ||
| 155 | (declare-function image-size "image.c" (spec &optional pixels frame)) | 155 | (declare-function image-size "image.c" (spec &optional pixels frame)) |
| 156 | (declare-function xwidget-info "xwidget.c" (xwidget)) | ||
| 157 | (declare-function xwidget-at "xwidget.el" (pos)) | ||
| 156 | 158 | ||
| 157 | (defun image-display-size (spec &optional pixels frame) | 159 | (defun image-display-size (spec &optional pixels frame) |
| 158 | "Wrapper around `image-size', handling slice display properties. | 160 | "Wrapper around `image-size', handling slice display properties. |
| @@ -160,24 +162,29 @@ Like `image-size', the return value is (WIDTH . HEIGHT). | |||
| 160 | WIDTH and HEIGHT are in canonical character units if PIXELS is | 162 | WIDTH and HEIGHT are in canonical character units if PIXELS is |
| 161 | nil, and in pixel units if PIXELS is non-nil. | 163 | nil, and in pixel units if PIXELS is non-nil. |
| 162 | 164 | ||
| 163 | If SPEC is an image display property, this function is equivalent | 165 | If SPEC is an image display property, this function is equivalent to |
| 164 | to `image-size'. If SPEC is a list of properties containing | 166 | `image-size'. If SPEC represents an xwidget object, defer to `xwidget-info'. |
| 165 | `image' and `slice' properties, return the display size taking | 167 | If SPEC is a list of properties containing `image' and `slice' properties, |
| 166 | the slice property into account. If the list contains `image' | 168 | return the display size taking the slice property into account. If the list |
| 167 | but not `slice', return the `image-size' of the specified image." | 169 | contains `image' but not `slice', return the `image-size' of the specified |
| 168 | (if (eq (car spec) 'image) | 170 | image." |
| 169 | (image-size spec pixels frame) | 171 | (cond ((eq (car spec) 'xwidget) |
| 170 | (let ((image (assoc 'image spec)) | 172 | (let ((xwi (xwidget-info (xwidget-at (point-min))))) |
| 171 | (slice (assoc 'slice spec))) | 173 | (cons (aref xwi 2) (aref xwi 3)))) |
| 172 | (cond ((and image slice) | 174 | ((eq (car spec) 'image) |
| 173 | (if pixels | 175 | (image-size spec pixels frame)) |
| 174 | (cons (nth 3 slice) (nth 4 slice)) | 176 | (t (let ((image (assoc 'image spec)) |
| 175 | (cons (/ (float (nth 3 slice)) (frame-char-width frame)) | 177 | (slice (assoc 'slice spec))) |
| 176 | (/ (float (nth 4 slice)) (frame-char-height frame))))) | 178 | (cond ((and image slice) |
| 177 | (image | 179 | (if pixels |
| 178 | (image-size image pixels frame)) | 180 | (cons (nth 3 slice) (nth 4 slice)) |
| 179 | (t | 181 | (cons (/ (float (nth 3 slice)) (frame-char-width frame)) |
| 180 | (error "Invalid image specification: %s" spec)))))) | 182 | (/ (float (nth 4 slice)) |
| 183 | (frame-char-height frame))))) | ||
| 184 | (image | ||
| 185 | (image-size image pixels frame)) | ||
| 186 | (t | ||
| 187 | (error "Invalid image specification: %s" spec))))))) | ||
| 181 | 188 | ||
| 182 | (defun image-forward-hscroll (&optional n) | 189 | (defun image-forward-hscroll (&optional n) |
| 183 | "Scroll image in current window to the left by N character widths. | 190 | "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." | |||
| 2119 | (with-current-buffer standard-output | 2119 | (with-current-buffer standard-output |
| 2120 | (insert language-name " language environment\n\n") | 2120 | (insert language-name " language environment\n\n") |
| 2121 | (if (stringp doc) | 2121 | (if (stringp doc) |
| 2122 | (insert doc "\n\n")) | 2122 | (insert (substitute-command-keys doc) "\n\n")) |
| 2123 | (condition-case nil | 2123 | (condition-case nil |
| 2124 | (let ((str (eval (get-language-info language-name 'sample-text)))) | 2124 | (let ((str (eval (get-language-info language-name 'sample-text)))) |
| 2125 | (if (stringp str) | 2125 | (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." | |||
| 2516 | ")\n\n") | 2516 | ")\n\n") |
| 2517 | (save-restriction | 2517 | (save-restriction |
| 2518 | (narrow-to-region (point) (point)) | 2518 | (narrow-to-region (point) (point)) |
| 2519 | (insert (quail-docstring)) | 2519 | (insert (substitute-command-keys (quail-docstring))) |
| 2520 | (goto-char (point-min)) | 2520 | (goto-char (point-min)) |
| 2521 | (with-syntax-table emacs-lisp-mode-syntax-table | 2521 | (with-syntax-table emacs-lisp-mode-syntax-table |
| 2522 | (while (re-search-forward "\\\\<\\sw\\(\\sw\\|\\s_\\)+>" nil t) | 2522 | (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." | |||
| 2647 | "Non-default value overrides the behavior of `isearch-search-fun-default'. | 2647 | "Non-default value overrides the behavior of `isearch-search-fun-default'. |
| 2648 | This variable's value should be a function, which will be called | 2648 | This variable's value should be a function, which will be called |
| 2649 | with no arguments, and should return a function that takes three | 2649 | with no arguments, and should return a function that takes three |
| 2650 | arguments: STRING, BOUND, and NOERROR. | 2650 | arguments: STRING, BOUND, and NOERROR. See `re-search-forward' |
| 2651 | for the meaning of BOUND and NOERROR arguments. | ||
| 2651 | 2652 | ||
| 2652 | This returned function will be used by `isearch-search-string' to | 2653 | This returned function will be used by `isearch-search-string' to |
| 2653 | search for the first occurrence of STRING or its translation.") | 2654 | search for the first occurrence of STRING.") |
| 2654 | 2655 | ||
| 2655 | (defun isearch-search-fun () | 2656 | (defun isearch-search-fun () |
| 2656 | "Return the function to use for the search. | 2657 | "Return the function to use for the search. |
| @@ -2695,8 +2696,14 @@ Can be changed via `isearch-search-fun-function' for special needs." | |||
| 2695 | 2696 | ||
| 2696 | (defun isearch-search-string (string bound noerror) | 2697 | (defun isearch-search-string (string bound noerror) |
| 2697 | "Search for the first occurrence of STRING or its translation. | 2698 | "Search for the first occurrence of STRING or its translation. |
| 2699 | STRING's characters are translated using `translation-table-for-input' | ||
| 2700 | if that is non-nil. | ||
| 2698 | If found, move point to the end of the occurrence, | 2701 | If found, move point to the end of the occurrence, |
| 2699 | update the match data, and return point." | 2702 | update the match data, and return point. |
| 2703 | An optional second argument bounds the search; it is a buffer position. | ||
| 2704 | The match found must not extend after that position. | ||
| 2705 | Optional third argument, if t, means if fail just return nil (no error). | ||
| 2706 | If not nil and not t, move to limit of search and return nil." | ||
| 2700 | (let* ((func (isearch-search-fun)) | 2707 | (let* ((func (isearch-search-fun)) |
| 2701 | (pos1 (save-excursion (funcall func string bound noerror))) | 2708 | (pos1 (save-excursion (funcall func string bound noerror))) |
| 2702 | pos2) | 2709 | 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'." | |||
| 1619 | (defun shr-table-body (dom) | 1619 | (defun shr-table-body (dom) |
| 1620 | (let ((tbodies (seq-filter (lambda (child) | 1620 | (let ((tbodies (seq-filter (lambda (child) |
| 1621 | (eq (dom-tag child) 'tbody)) | 1621 | (eq (dom-tag child) 'tbody)) |
| 1622 | (dom-children dom)))) | 1622 | (dom-non-text-children dom)))) |
| 1623 | (cond | 1623 | (cond |
| 1624 | ((null tbodies) | 1624 | ((null tbodies) |
| 1625 | dom) | 1625 | 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 @@ | |||
| 102 | 102 | ||
| 103 | (eval-and-compile | 103 | (eval-and-compile |
| 104 | (defconst ruby-here-doc-beg-re | 104 | (defconst ruby-here-doc-beg-re |
| 105 | "\\(<\\)<\\(-\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)" | 105 | "\\(<\\)<\\([~-]\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)" |
| 106 | "Regexp to match the beginning of a heredoc.") | 106 | "Regexp to match the beginning of a heredoc.") |
| 107 | 107 | ||
| 108 | (defconst ruby-expression-expansion-re | 108 | (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." | |||
| 861 | (cl-assert (directory-name-p dir)) | 861 | (cl-assert (directory-name-p dir)) |
| 862 | (require 'semantic/symref) | 862 | (require 'semantic/symref) |
| 863 | (defvar semantic-symref-tool) | 863 | (defvar semantic-symref-tool) |
| 864 | (let* ((default-directory dir) | 864 | |
| 865 | ;; Some symref backends use `ede-project-root-directory' as the root | ||
| 866 | ;; directory for the search, rather than `default-directory'. Since | ||
| 867 | ;; the caller has specified `dir', we bind `ede-minor-mode' to nil | ||
| 868 | ;; to force the backend to use `default-directory'. | ||
| 869 | (let* ((ede-minor-mode nil) | ||
| 870 | (default-directory dir) | ||
| 865 | (semantic-symref-tool 'detect) | 871 | (semantic-symref-tool 'detect) |
| 866 | (res (semantic-symref-find-references-by-name symbol 'subdirs)) | 872 | (res (semantic-symref-find-references-by-name symbol 'subdirs)) |
| 867 | (hits (and res (oref res hit-lines))) | 873 | (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 @@ | |||
| 1 | ;;; xwidget.el --- api functions for xwidgets -*- lexical-binding: t -*- | ||
| 2 | ;; | ||
| 3 | ;; Copyright (C) 2011-2016 Free Software Foundation, Inc. | ||
| 4 | ;; | ||
| 5 | ;; Author: Joakim Verona (joakim@verona.se) | ||
| 6 | ;; | ||
| 7 | ;; This file is part of GNU Emacs. | ||
| 8 | ;; | ||
| 9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 10 | ;; it under the terms of the GNU General Public License as published by | ||
| 11 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 12 | ;; (at your option) any later version. | ||
| 13 | |||
| 14 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 17 | ;; GNU General Public License for more details. | ||
| 18 | |||
| 19 | ;; You should have received a copy of the GNU General Public License | ||
| 20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 21 | ;; | ||
| 22 | ;; -------------------------------------------------------------------- | ||
| 23 | |||
| 24 | ;;; Commentary: | ||
| 25 | ;; | ||
| 26 | ;; See xwidget.c for more api functions. | ||
| 27 | |||
| 28 | ;; TODO this breaks compilation when we don't have xwidgets. | ||
| 29 | ;;(require 'xwidget-internal) | ||
| 30 | |||
| 31 | ;;; Code: | ||
| 32 | |||
| 33 | (require 'cl-lib) | ||
| 34 | (require 'bookmark) | ||
| 35 | |||
| 36 | (defcustom xwidget-webkit-scroll-behaviour 'native | ||
| 37 | "Scroll behaviour of the webkit instance. | ||
| 38 | 'native or 'image." | ||
| 39 | :version "25.1" | ||
| 40 | :group 'frames ; TODO add xwidgets group if more options are added | ||
| 41 | :type '(choice (const native) (const image))) | ||
| 42 | |||
| 43 | (declare-function make-xwidget "xwidget.c" | ||
| 44 | (beg end type title width height arguments &optional buffer)) | ||
| 45 | (declare-function xwidget-set-adjustment "xwidget.c" | ||
| 46 | (xwidget axis relative value)) | ||
| 47 | (declare-function xwidget-buffer "xwidget.c" (xwidget)) | ||
| 48 | (declare-function xwidget-webkit-get-title "xwidget.c" (xwidget)) | ||
| 49 | (declare-function xwidget-size-request "xwidget.c" (xwidget)) | ||
| 50 | (declare-function xwidget-resize "xwidget.c" (xwidget new-width new-height)) | ||
| 51 | (declare-function xwidget-webkit-execute-script "xwidget.c" (xwidget script)) | ||
| 52 | (declare-function xwidget-webkit-goto-uri "xwidget.c" (xwidget uri)) | ||
| 53 | (declare-function xwidget-plist "xwidget.c" (xwidget)) | ||
| 54 | (declare-function set-xwidget-plist "xwidget.c" (xwidget plist)) | ||
| 55 | (declare-function xwidget-view-window "xwidget.c" (xwidget-view)) | ||
| 56 | (declare-function xwidget-view-model "xwidget.c" (xwidget-view)) | ||
| 57 | (declare-function delete-xwidget-view "xwidget.c" (xwidget-view)) | ||
| 58 | (declare-function get-buffer-xwidgets "xwidget.c" (buffer)) | ||
| 59 | |||
| 60 | (defun xwidget-insert (pos type title width height &optional args) | ||
| 61 | "Insert an xwidget at POS. | ||
| 62 | given ID, TYPE, TITLE WIDTH and | ||
| 63 | HEIGHT in the current buffer. | ||
| 64 | |||
| 65 | Return ID | ||
| 66 | |||
| 67 | see `make-xwidget' for types suitable for TYPE. | ||
| 68 | Optional argument ARGS usage depends on the xwidget." | ||
| 69 | (goto-char pos) | ||
| 70 | (let ((id (make-xwidget (point) (point) | ||
| 71 | type title width height args))) | ||
| 72 | (put-text-property (point) (+ 1 (point)) | ||
| 73 | 'display (list 'xwidget ':xwidget id)) | ||
| 74 | id)) | ||
| 75 | |||
| 76 | (defun xwidget-at (pos) | ||
| 77 | "Return xwidget at POS." | ||
| 78 | ;; TODO this function is a bit tedious because the C layer isn't well | ||
| 79 | ;; protected yet and xwidgetp apparently doesn't work yet. | ||
| 80 | (let* ((disp (get-text-property pos 'display)) | ||
| 81 | (xw (car (cdr (cdr disp))))) | ||
| 82 | ;;(if (xwidgetp xw) xw nil) | ||
| 83 | (if (equal 'xwidget (car disp)) xw))) | ||
| 84 | |||
| 85 | |||
| 86 | |||
| 87 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 88 | ;;; webkit support | ||
| 89 | (require 'browse-url) | ||
| 90 | (require 'image-mode);;for some image-mode alike functionality | ||
| 91 | |||
| 92 | ;;;###autoload | ||
| 93 | (defun xwidget-webkit-browse-url (url &optional new-session) | ||
| 94 | "Ask xwidget-webkit to browse URL. | ||
| 95 | NEW-SESSION specifies whether to create a new xwidget-webkit session. URL | ||
| 96 | defaults to the string looking like a url around the cursor position." | ||
| 97 | (interactive (progn | ||
| 98 | (require 'browse-url) | ||
| 99 | (browse-url-interactive-arg "xwidget-webkit URL: " | ||
| 100 | ;;(xwidget-webkit-current-url) | ||
| 101 | ))) | ||
| 102 | (when (stringp url) | ||
| 103 | (if new-session | ||
| 104 | (xwidget-webkit-new-session url) | ||
| 105 | (xwidget-webkit-goto-url url)))) | ||
| 106 | |||
| 107 | ;;todo. | ||
| 108 | ;; - check that the webkit support is compiled in | ||
| 109 | (defvar xwidget-webkit-mode-map | ||
| 110 | (let ((map (make-sparse-keymap))) | ||
| 111 | (define-key map "g" 'xwidget-webkit-browse-url) | ||
| 112 | (define-key map "a" 'xwidget-webkit-adjust-size-dispatch) | ||
| 113 | (define-key map "b" 'xwidget-webkit-back) | ||
| 114 | (define-key map "r" 'xwidget-webkit-reload) | ||
| 115 | (define-key map "t" (lambda () (interactive) (message "o"))) ;FIXME: ?!? | ||
| 116 | (define-key map "\C-m" 'xwidget-webkit-insert-string) | ||
| 117 | (define-key map "w" 'xwidget-webkit-current-url) | ||
| 118 | |||
| 119 | ;;similar to image mode bindings | ||
| 120 | (define-key map (kbd "SPC") 'xwidget-webkit-scroll-up) | ||
| 121 | (define-key map (kbd "DEL") 'xwidget-webkit-scroll-down) | ||
| 122 | |||
| 123 | (define-key map [remap scroll-up] 'xwidget-webkit-scroll-up) | ||
| 124 | (define-key map [remap scroll-up-command] 'xwidget-webkit-scroll-up) | ||
| 125 | |||
| 126 | (define-key map [remap scroll-down] 'xwidget-webkit-scroll-down) | ||
| 127 | (define-key map [remap scroll-down-command] 'xwidget-webkit-scroll-down) | ||
| 128 | |||
| 129 | (define-key map [remap forward-char] 'xwidget-webkit-scroll-forward) | ||
| 130 | (define-key map [remap backward-char] 'xwidget-webkit-scroll-backward) | ||
| 131 | (define-key map [remap right-char] 'xwidget-webkit-scroll-forward) | ||
| 132 | (define-key map [remap left-char] 'xwidget-webkit-scroll-backward) | ||
| 133 | ;; (define-key map [remap previous-line] 'image-previous-line) | ||
| 134 | ;; (define-key map [remap next-line] 'image-next-line) | ||
| 135 | |||
| 136 | ;; (define-key map [remap move-beginning-of-line] 'image-bol) | ||
| 137 | ;; (define-key map [remap move-end-of-line] 'image-eol) | ||
| 138 | ;; (define-key map [remap beginning-of-buffer] 'image-bob) | ||
| 139 | ;; (define-key map [remap end-of-buffer] 'image-eob) | ||
| 140 | map) | ||
| 141 | "Keymap for `xwidget-webkit-mode'.") | ||
| 142 | |||
| 143 | (defun xwidget-webkit-scroll-up () | ||
| 144 | "Scroll webkit up,either native or like image mode." | ||
| 145 | (interactive) | ||
| 146 | (if (eq xwidget-webkit-scroll-behaviour 'native) | ||
| 147 | (xwidget-set-adjustment (xwidget-webkit-last-session) 'vertical t 50) | ||
| 148 | (image-scroll-up))) | ||
| 149 | |||
| 150 | (defun xwidget-webkit-scroll-down () | ||
| 151 | "Scroll webkit down,either native or like image mode." | ||
| 152 | (interactive) | ||
| 153 | (if (eq xwidget-webkit-scroll-behaviour 'native) | ||
| 154 | (xwidget-set-adjustment (xwidget-webkit-last-session) 'vertical t -50) | ||
| 155 | (image-scroll-down))) | ||
| 156 | |||
| 157 | (defun xwidget-webkit-scroll-forward () | ||
| 158 | "Scroll webkit forward,either native or like image mode." | ||
| 159 | (interactive) | ||
| 160 | (if (eq xwidget-webkit-scroll-behaviour 'native) | ||
| 161 | (xwidget-set-adjustment (xwidget-webkit-last-session) 'horizontal t 50) | ||
| 162 | (xwidget-webkit-scroll-forward))) | ||
| 163 | |||
| 164 | (defun xwidget-webkit-scroll-backward () | ||
| 165 | "Scroll webkit backward,either native or like image mode." | ||
| 166 | (interactive) | ||
| 167 | (if (eq xwidget-webkit-scroll-behaviour 'native) | ||
| 168 | (xwidget-set-adjustment (xwidget-webkit-last-session) 'horizontal t -50) | ||
| 169 | (xwidget-webkit-scroll-backward))) | ||
| 170 | |||
| 171 | |||
| 172 | ;; The xwidget event needs to go into a higher level handler | ||
| 173 | ;; since the xwidget can generate an event even if it's offscreen. | ||
| 174 | ;; TODO this needs to use callbacks and consider different xwidget event types. | ||
| 175 | (define-key (current-global-map) [xwidget-event] #'xwidget-event-handler) | ||
| 176 | (defun xwidget-log (&rest msg) | ||
| 177 | "Log MSG to a buffer." | ||
| 178 | (let ((buf (get-buffer-create " *xwidget-log*"))) | ||
| 179 | (with-current-buffer buf | ||
| 180 | (insert (apply #'format msg)) | ||
| 181 | (insert "\n")))) | ||
| 182 | |||
| 183 | (defun xwidget-event-handler () | ||
| 184 | "Receive xwidget event." | ||
| 185 | (interactive) | ||
| 186 | (xwidget-log "stuff happened to xwidget %S" last-input-event) | ||
| 187 | (let* | ||
| 188 | ((xwidget-event-type (nth 1 last-input-event)) | ||
| 189 | (xwidget (nth 2 last-input-event)) | ||
| 190 | ;;(xwidget-callback (xwidget-get xwidget 'callback)) | ||
| 191 | ;;TODO stopped working for some reason | ||
| 192 | ) | ||
| 193 | ;;(funcall xwidget-callback xwidget xwidget-event-type) | ||
| 194 | (message "xw callback %s" xwidget) | ||
| 195 | (funcall 'xwidget-webkit-callback xwidget xwidget-event-type))) | ||
| 196 | |||
| 197 | (defun xwidget-webkit-callback (xwidget xwidget-event-type) | ||
| 198 | "Callback for xwidgets. | ||
| 199 | XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." | ||
| 200 | (if (not (buffer-live-p (xwidget-buffer xwidget))) | ||
| 201 | (xwidget-log | ||
| 202 | "error: callback called for xwidget with dead buffer") | ||
| 203 | (with-current-buffer (xwidget-buffer xwidget) | ||
| 204 | (let* ((strarg (nth 3 last-input-event))) | ||
| 205 | (cond ((eq xwidget-event-type 'document-load-finished) | ||
| 206 | (xwidget-log "webkit finished loading: '%s'" | ||
| 207 | (xwidget-webkit-get-title xwidget)) | ||
| 208 | ;;TODO - check the native/internal scroll | ||
| 209 | ;;(xwidget-adjust-size-to-content xwidget) | ||
| 210 | (xwidget-webkit-adjust-size-dispatch) ;;TODO xwidget arg | ||
| 211 | (rename-buffer (format "*xwidget webkit: %s *" | ||
| 212 | (xwidget-webkit-get-title xwidget))) | ||
| 213 | (pop-to-buffer (current-buffer))) | ||
| 214 | ((eq xwidget-event-type | ||
| 215 | 'navigation-policy-decision-requested) | ||
| 216 | (if (string-match ".*#\\(.*\\)" strarg) | ||
| 217 | (xwidget-webkit-show-id-or-named-element | ||
| 218 | xwidget | ||
| 219 | (match-string 1 strarg)))) | ||
| 220 | (t (xwidget-log "unhandled event:%s" xwidget-event-type))))))) | ||
| 221 | |||
| 222 | (defvar bookmark-make-record-function) | ||
| 223 | (define-derived-mode xwidget-webkit-mode | ||
| 224 | special-mode "xwidget-webkit" "Xwidget webkit view mode." | ||
| 225 | (setq buffer-read-only t) | ||
| 226 | (setq-local bookmark-make-record-function | ||
| 227 | #'xwidget-webkit-bookmark-make-record) | ||
| 228 | ;; Keep track of [vh]scroll when switching buffers | ||
| 229 | (image-mode-setup-winprops)) | ||
| 230 | |||
| 231 | (defun xwidget-webkit-bookmark-make-record () | ||
| 232 | "Integrate Emacs bookmarks with the webkit xwidget." | ||
| 233 | (nconc (bookmark-make-record-default t t) | ||
| 234 | `((page . ,(xwidget-webkit-current-url)) | ||
| 235 | (handler . (lambda (bmk) (browse-url | ||
| 236 | (bookmark-prop-get bmk 'page))))))) | ||
| 237 | |||
| 238 | |||
| 239 | (defvar xwidget-webkit-last-session-buffer nil) | ||
| 240 | |||
| 241 | (defun xwidget-webkit-last-session () | ||
| 242 | "Last active webkit, or nil." | ||
| 243 | (if (buffer-live-p xwidget-webkit-last-session-buffer) | ||
| 244 | (with-current-buffer xwidget-webkit-last-session-buffer | ||
| 245 | (xwidget-at (point-min))) | ||
| 246 | nil)) | ||
| 247 | |||
| 248 | (defun xwidget-webkit-current-session () | ||
| 249 | "Either the webkit in the current buffer, or the last one used. | ||
| 250 | The latter might be nil." | ||
| 251 | (or (xwidget-at (point-min)) (xwidget-webkit-last-session))) | ||
| 252 | |||
| 253 | (defun xwidget-adjust-size-to-content (xw) | ||
| 254 | "Resize XW to content." | ||
| 255 | ;; xwidgets doesn't support widgets that have their own opinions about | ||
| 256 | ;; size well, yet this reads the desired size and resizes the Emacs | ||
| 257 | ;; allocated area accordingly. | ||
| 258 | (let ((size (xwidget-size-request xw))) | ||
| 259 | (xwidget-resize xw (car size) (cadr size)))) | ||
| 260 | |||
| 261 | |||
| 262 | (defvar xwidget-webkit-activeelement-js" | ||
| 263 | function findactiveelement(doc){ | ||
| 264 | //alert(doc.activeElement.value); | ||
| 265 | if(doc.activeElement.value != undefined){ | ||
| 266 | return doc.activeElement; | ||
| 267 | }else{ | ||
| 268 | // recurse over the child documents: | ||
| 269 | var frames = doc.getElementsByTagName('frame'); | ||
| 270 | for (var i = 0; i < frames.length; i++) | ||
| 271 | { | ||
| 272 | var d = frames[i].contentDocument; | ||
| 273 | var rv = findactiveelement(d); | ||
| 274 | if(rv != undefined){ | ||
| 275 | return rv; | ||
| 276 | } | ||
| 277 | } | ||
| 278 | } | ||
| 279 | return undefined; | ||
| 280 | }; | ||
| 281 | |||
| 282 | |||
| 283 | " | ||
| 284 | |||
| 285 | "javascript that finds the active element." | ||
| 286 | ;; Yes it's ugly, because: | ||
| 287 | ;; - there is apparently no way to find the active frame other than recursion | ||
| 288 | ;; - the js "for each" construct misbehaved on the "frames" collection | ||
| 289 | ;; - a window with no frameset still has frames.length == 1, but | ||
| 290 | ;; frames[0].document.activeElement != document.activeElement | ||
| 291 | ;;TODO the activeelement type needs to be examined, for iframe, etc. | ||
| 292 | ) | ||
| 293 | |||
| 294 | (defun xwidget-webkit-insert-string (xw str) | ||
| 295 | "Insert string in the active field in the webkit. | ||
| 296 | Argument XW webkit. | ||
| 297 | Argument STR string." | ||
| 298 | ;; Read out the string in the field first and provide for edit. | ||
| 299 | (interactive | ||
| 300 | (let* ((xww (xwidget-webkit-current-session)) | ||
| 301 | |||
| 302 | (field-value | ||
| 303 | (progn | ||
| 304 | (xwidget-webkit-execute-script xww xwidget-webkit-activeelement-js) | ||
| 305 | (xwidget-webkit-execute-script-rv | ||
| 306 | xww | ||
| 307 | "findactiveelement(document).value;"))) | ||
| 308 | (field-type (xwidget-webkit-execute-script-rv | ||
| 309 | xww | ||
| 310 | "findactiveelement(document).type;"))) | ||
| 311 | (list xww | ||
| 312 | (cond ((equal "text" field-type) | ||
| 313 | (read-string "text:" field-value)) | ||
| 314 | ((equal "password" field-type) | ||
| 315 | (read-passwd "password:" nil field-value)) | ||
| 316 | ((equal "textarea" field-type) | ||
| 317 | (xwidget-webkit-begin-edit-textarea xww field-value)))))) | ||
| 318 | (xwidget-webkit-execute-script | ||
| 319 | xw | ||
| 320 | (format "findactiveelement(document).value='%s'" str))) | ||
| 321 | |||
| 322 | (defvar xwidget-xwbl) | ||
| 323 | (defun xwidget-webkit-begin-edit-textarea (xw text) | ||
| 324 | "Start editing of a webkit text area. | ||
| 325 | XW is the xwidget identifier, TEXT is retrieved from the webkit." | ||
| 326 | (switch-to-buffer | ||
| 327 | (generate-new-buffer "textarea")) | ||
| 328 | |||
| 329 | (set (make-local-variable 'xwidget-xwbl) xw) | ||
| 330 | (insert text)) | ||
| 331 | |||
| 332 | (defun xwidget-webkit-end-edit-textarea () | ||
| 333 | "End editing of a webkit text area." | ||
| 334 | (interactive) | ||
| 335 | (goto-char (point-min)) | ||
| 336 | (while (search-forward "\n" nil t) | ||
| 337 | (replace-match "\\n" nil t)) | ||
| 338 | (xwidget-webkit-execute-script | ||
| 339 | xwidget-xwbl | ||
| 340 | (format "findactiveelement(document).value='%s'" | ||
| 341 | (buffer-substring (point-min) (point-max)))) | ||
| 342 | ;;TODO convert linefeed to \n | ||
| 343 | ) | ||
| 344 | |||
| 345 | (defun xwidget-webkit-show-named-element (xw element-name) | ||
| 346 | "Make named-element show. for instance an anchor. | ||
| 347 | Argument XW is the xwidget. | ||
| 348 | Argument ELEMENT-NAME is the element name to display in the webkit xwidget." | ||
| 349 | (interactive (list (xwidget-webkit-current-session) | ||
| 350 | (read-string "element name:"))) | ||
| 351 | ;;TODO since an xwidget is an Emacs object, it is not trivial to do | ||
| 352 | ;; some things that are taken for granted in a normal browser. | ||
| 353 | ;; scrolling an anchor/named-element into view is one such thing. | ||
| 354 | ;; This function implements a proof-of-concept for this. Problems | ||
| 355 | ;; remaining: - The selected window is scrolled but this is not | ||
| 356 | ;; always correct - This needs to be interfaced into browse-url | ||
| 357 | ;; somehow. The tricky part is that we need to do this in two steps: | ||
| 358 | ;; A: load the base url, wait for load signal to arrive B: navigate | ||
| 359 | ;; to the anchor when the base url is finished rendering | ||
| 360 | |||
| 361 | ;; This part figures out the Y coordinate of the element | ||
| 362 | (let ((y (string-to-number | ||
| 363 | (xwidget-webkit-execute-script-rv | ||
| 364 | xw | ||
| 365 | (format | ||
| 366 | "document.getElementsByName('%s')[0].getBoundingClientRect().top" | ||
| 367 | element-name) | ||
| 368 | 0)))) | ||
| 369 | ;; Now we need to tell Emacs to scroll the element into view. | ||
| 370 | (xwidget-log "scroll: %d" y) | ||
| 371 | (set-window-vscroll (selected-window) y t))) | ||
| 372 | |||
| 373 | (defun xwidget-webkit-show-id-element (xw element-id) | ||
| 374 | "Make id-element show. for instance an anchor. | ||
| 375 | Argument XW is the webkit xwidget. | ||
| 376 | Argument ELEMENT-ID is the id of the element to show." | ||
| 377 | (interactive (list (xwidget-webkit-current-session) | ||
| 378 | (read-string "element id:"))) | ||
| 379 | (let ((y (string-to-number | ||
| 380 | (xwidget-webkit-execute-script-rv | ||
| 381 | xw | ||
| 382 | (format "document.getElementById('%s').getBoundingClientRect().top" | ||
| 383 | element-id) | ||
| 384 | 0)))) | ||
| 385 | ;; Now we need to tell Emacs to scroll the element into view. | ||
| 386 | (xwidget-log "scroll: %d" y) | ||
| 387 | (set-window-vscroll (selected-window) y t))) | ||
| 388 | |||
| 389 | (defun xwidget-webkit-show-id-or-named-element (xw element-id) | ||
| 390 | "Make id-element show. for instance an anchor. | ||
| 391 | Argument XW is the webkit xwidget. | ||
| 392 | Argument ELEMENT-ID is either a name or an element id." | ||
| 393 | (interactive (list (xwidget-webkit-current-session) | ||
| 394 | (read-string "element id:"))) | ||
| 395 | (let* ((y1 (string-to-number | ||
| 396 | (xwidget-webkit-execute-script-rv | ||
| 397 | xw | ||
| 398 | (format "document.getElementsByName('%s')[0].getBoundingClientRect().top" element-id) | ||
| 399 | "0"))) | ||
| 400 | (y2 (string-to-number | ||
| 401 | (xwidget-webkit-execute-script-rv | ||
| 402 | xw | ||
| 403 | (format "document.getElementById('%s').getBoundingClientRect().top" element-id) | ||
| 404 | "0"))) | ||
| 405 | (y3 (max y1 y2))) | ||
| 406 | ;; Now we need to tell Emacs to scroll the element into view. | ||
| 407 | (xwidget-log "scroll: %d" y3) | ||
| 408 | (set-window-vscroll (selected-window) y3 t))) | ||
| 409 | |||
| 410 | (defun xwidget-webkit-adjust-size-to-content () | ||
| 411 | "Adjust webkit to content size." | ||
| 412 | (interactive) | ||
| 413 | (xwidget-adjust-size-to-content (xwidget-webkit-current-session))) | ||
| 414 | |||
| 415 | (defun xwidget-webkit-adjust-size-dispatch () | ||
| 416 | "Adjust size according to mode." | ||
| 417 | (interactive) | ||
| 418 | (if (eq xwidget-webkit-scroll-behaviour 'native) | ||
| 419 | (xwidget-webkit-adjust-size-to-window) | ||
| 420 | (xwidget-webkit-adjust-size-to-content)) | ||
| 421 | ;; The recenter is intended to correct a visual glitch. | ||
| 422 | ;; It errors out if the buffer isn't visible, but then we don't get | ||
| 423 | ;; the glitch, so silence errors. | ||
| 424 | (ignore-errors | ||
| 425 | (recenter-top-bottom)) | ||
| 426 | ) | ||
| 427 | |||
| 428 | (defun xwidget-webkit-adjust-size-to-window () | ||
| 429 | "Adjust webkit to window." | ||
| 430 | (interactive) | ||
| 431 | (xwidget-resize (xwidget-webkit-current-session) (window-pixel-width) | ||
| 432 | (window-pixel-height))) | ||
| 433 | |||
| 434 | (defun xwidget-webkit-adjust-size (w h) | ||
| 435 | "Manually set webkit size. | ||
| 436 | Argument W width. | ||
| 437 | Argument H height." | ||
| 438 | ;; TODO shouldn't be tied to the webkit xwidget | ||
| 439 | (interactive "nWidth:\nnHeight:\n") | ||
| 440 | (xwidget-resize (xwidget-webkit-current-session) w h)) | ||
| 441 | |||
| 442 | (defun xwidget-webkit-fit-width () | ||
| 443 | "Adjust width of webkit to window width." | ||
| 444 | (interactive) | ||
| 445 | (xwidget-webkit-adjust-size (- (nth 2 (window-inside-pixel-edges)) | ||
| 446 | (car (window-inside-pixel-edges))) | ||
| 447 | 1000)) | ||
| 448 | |||
| 449 | (defun xwidget-webkit-new-session (url) | ||
| 450 | "Create a new webkit session buffer with URL." | ||
| 451 | (let* | ||
| 452 | ((bufname (generate-new-buffer-name "*xwidget-webkit*")) | ||
| 453 | xw) | ||
| 454 | (setq xwidget-webkit-last-session-buffer (switch-to-buffer | ||
| 455 | (get-buffer-create bufname))) | ||
| 456 | (insert " 'a' adjusts the xwidget size.") | ||
| 457 | (setq xw (xwidget-insert 1 'webkit-osr bufname 1000 1000)) | ||
| 458 | (xwidget-put xw 'callback 'xwidget-webkit-callback) | ||
| 459 | (xwidget-webkit-mode) | ||
| 460 | (xwidget-webkit-goto-uri (xwidget-webkit-last-session) url))) | ||
| 461 | |||
| 462 | |||
| 463 | (defun xwidget-webkit-goto-url (url) | ||
| 464 | "Goto URL." | ||
| 465 | (if (xwidget-webkit-current-session) | ||
| 466 | (progn | ||
| 467 | (xwidget-webkit-goto-uri (xwidget-webkit-current-session) url)) | ||
| 468 | (xwidget-webkit-new-session url))) | ||
| 469 | |||
| 470 | (defun xwidget-webkit-back () | ||
| 471 | "Back in history." | ||
| 472 | (interactive) | ||
| 473 | (xwidget-webkit-execute-script (xwidget-webkit-current-session) | ||
| 474 | "history.go(-1);")) | ||
| 475 | |||
| 476 | (defun xwidget-webkit-reload () | ||
| 477 | "Reload current url." | ||
| 478 | (interactive) | ||
| 479 | (xwidget-webkit-execute-script (xwidget-webkit-current-session) | ||
| 480 | "history.go(0);")) | ||
| 481 | |||
| 482 | (defun xwidget-webkit-current-url () | ||
| 483 | "Get the webkit url. place it on kill ring." | ||
| 484 | (interactive) | ||
| 485 | (let* ((rv (xwidget-webkit-execute-script-rv (xwidget-webkit-current-session) | ||
| 486 | "document.URL")) | ||
| 487 | (url (kill-new (or rv "")))) | ||
| 488 | (message "url: %s" url) | ||
| 489 | url)) | ||
| 490 | |||
| 491 | (defun xwidget-webkit-execute-script-rv (xw script &optional default) | ||
| 492 | "Same as 'xwidget-webkit-execute-script' but but with return value. | ||
| 493 | XW is the webkit instance. SCRIPT is the script to execute. | ||
| 494 | DEFAULT is the defaultreturn value." | ||
| 495 | ;; Notice the ugly "title" hack. It is needed because the Webkit | ||
| 496 | ;; API at the time of writing didn't support returning values. This | ||
| 497 | ;; is a wrapper for the title hack so it's easy to remove should | ||
| 498 | ;; Webkit someday support JS return values or we find some other way | ||
| 499 | ;; to access the DOM. | ||
| 500 | |||
| 501 | ;; Reset webkit title. Not very nice. | ||
| 502 | (let* ((emptytag "titlecantbewhitespaceohthehorror") | ||
| 503 | title) | ||
| 504 | (xwidget-webkit-execute-script xw (format "document.title=\"%s\";" | ||
| 505 | (or default emptytag))) | ||
| 506 | (xwidget-webkit-execute-script xw (format "document.title=%s;" script)) | ||
| 507 | (setq title (xwidget-webkit-get-title xw)) | ||
| 508 | (if (equal emptytag title) | ||
| 509 | (setq title "")) | ||
| 510 | (unless title | ||
| 511 | (setq title default)) | ||
| 512 | title)) | ||
| 513 | |||
| 514 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 515 | (defun xwidget-webkit-get-selection () | ||
| 516 | "Get the webkit selection." | ||
| 517 | (xwidget-webkit-execute-script-rv (xwidget-webkit-current-session) | ||
| 518 | "window.getSelection().toString();")) | ||
| 519 | |||
| 520 | (defun xwidget-webkit-copy-selection-as-kill () | ||
| 521 | "Get the webkit selection and put it on the kill ring." | ||
| 522 | (interactive) | ||
| 523 | (kill-new (xwidget-webkit-get-selection))) | ||
| 524 | |||
| 525 | |||
| 526 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 527 | ;; Xwidget plist management (similar to the process plist functions) | ||
| 528 | |||
| 529 | (defun xwidget-get (xwidget propname) | ||
| 530 | "Return the value of XWIDGET' PROPNAME property. | ||
| 531 | This is the last value stored with `(xwidget-put XWIDGET PROPNAME VALUE)'." | ||
| 532 | (plist-get (xwidget-plist xwidget) propname)) | ||
| 533 | |||
| 534 | (defun xwidget-put (xwidget propname value) | ||
| 535 | "Change XWIDGET' PROPNAME property to VALUE. | ||
| 536 | It can be retrieved with `(xwidget-get XWIDGET PROPNAME)'." | ||
| 537 | (set-xwidget-plist xwidget | ||
| 538 | (plist-put (xwidget-plist xwidget) propname value))) | ||
| 539 | |||
| 540 | |||
| 541 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 542 | |||
| 543 | (defvar xwidget-view-list) ; xwidget.c | ||
| 544 | (defvar xwidget-list) ; xwidget.c | ||
| 545 | |||
| 546 | (defun xwidget-delete-zombies () | ||
| 547 | "Helper for `xwidget-cleanup'." | ||
| 548 | (dolist (xwidget-view xwidget-view-list) | ||
| 549 | (when (or (not (window-live-p (xwidget-view-window xwidget-view))) | ||
| 550 | (not (memq (xwidget-view-model xwidget-view) | ||
| 551 | xwidget-list))) | ||
| 552 | (delete-xwidget-view xwidget-view)))) | ||
| 553 | |||
| 554 | (defun xwidget-cleanup () | ||
| 555 | "Delete zombie xwidgets." | ||
| 556 | ;; During development it was sometimes easy to wind up with zombie | ||
| 557 | ;; xwidget instances. | ||
| 558 | ;; This function tries to implement a workaround should it occur again. | ||
| 559 | (interactive) | ||
| 560 | ;; Kill xviews that should have been deleted but still linger. | ||
| 561 | (xwidget-delete-zombies) | ||
| 562 | ;; Redraw display otherwise ghost of zombies will remain to haunt the screen | ||
| 563 | (redraw-display)) | ||
| 564 | |||
| 565 | (defun xwidget-kill-buffer-query-function () | ||
| 566 | "Ask before killing a buffer that has xwidgets." | ||
| 567 | (let ((xwidgets (get-buffer-xwidgets (current-buffer)))) | ||
| 568 | (or (not xwidgets) | ||
| 569 | (not (memq t (mapcar #'xwidget-query-on-exit-flag xwidgets))) | ||
| 570 | (yes-or-no-p | ||
| 571 | (format "Buffer %S has xwidgets; kill it? " (buffer-name)))))) | ||
| 572 | |||
| 573 | (when (featurep 'xwidget-internal) | ||
| 574 | (add-hook 'kill-buffer-query-functions #'xwidget-kill-buffer-query-function) | ||
| 575 | ;; This would have felt better in C, but this seems to work well in | ||
| 576 | ;; practice though. | ||
| 577 | (add-hook 'window-configuration-change-hook #'xwidget-delete-zombies)) | ||
| 578 | |||
| 579 | (provide 'xwidget) | ||
| 580 | ;;; xwidget.el ends here | ||