aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorPaul Eggert2016-01-30 11:27:34 -0800
committerPaul Eggert2016-01-30 11:27:34 -0800
commit82b089783e71b2aeef950eaecfe4cbc0735e64a2 (patch)
treea826c20768071bda95a69b2632718c1641c6d0cc /lisp
parentd27c8078ef766dae3587bc82b70128a70efaa223 (diff)
parentf7dc6d8b5bb318e02a4016d93f8b34de0716f4dc (diff)
downloademacs-82b089783e71b2aeef950eaecfe4cbc0735e64a2.tar.gz
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
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.
111CASES is a list of elements of the form (PATTERN CODE...). 111CASES is a list of elements of the form (PATTERN CODE...).
112 112
113Patterns can take the following forms: 113A structural PATTERN describes a template that identifies a class
114of values. For example, the pattern `(,foo ,bar) matches any
115two element list, binding its elements to symbols named `foo' and
116`bar' -- in much the same way that `cl-destructuring-bind' would.
117
118A significant difference from `cl-destructuring-bind' is that, if
119a pattern match fails, the next case is tried until either a
120succesful match is found or there are no more cases.
121
122Another difference is that pattern elements may be backquoted,
123meaning they must match exactly: The pattern \\='(foo bar)
124matches only against two element lists containing the symbols
125`foo' and `bar' in that order. (As a short-hand, atoms always
126match themselves, such as numbers or strings, and need not be
127quoted).
128
129Lastly, a pattern can be logical, such as (pred numberp), that
130matches any number-like element; or the symbol `_', that matches
131anything. Also, when patterns are backquoted, a comma may be
132used to introduce logical patterns inside backquoted patterns.
133
134The 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.
125If 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
128FUN can take the form 150Additional patterns can be defined using `pcase-defmacro'.
151
152The 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.
132So a FUN of the form SYMBOL is equivalent to one of the form (FUN). 156So a FUN of the form SYMBOL is equivalent to (FUN).
133FUN can refer to variables bound earlier in the pattern. 157FUN can refer to variables bound earlier in the pattern.
134E.g. you can match pairs where the cdr is larger than the car with a pattern 158
135like \\=`(,a . ,(pred (< a))) or, with more checks: 159See Info node `(elisp) Pattern matching case statement' in the
136\\=`(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a)))) 160Emacs Lisp manual for more information and examples."
137FUN is assumed to be pure, i.e. it can be dropped if its result is not used,
138and two identical calls can be merged into one.
139
140Additional patterns can be defined via `pcase-defmacro'.
141Currently, 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.
1062FN may be either a face or a face specification. If the latter,
1063then 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).
160WIDTH and HEIGHT are in canonical character units if PIXELS is 162WIDTH and HEIGHT are in canonical character units if PIXELS is
161nil, and in pixel units if PIXELS is non-nil. 163nil, and in pixel units if PIXELS is non-nil.
162 164
163If SPEC is an image display property, this function is equivalent 165If SPEC is an image display property, this function is equivalent to
164to `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 167If SPEC is a list of properties containing `image' and `slice' properties,
166the slice property into account. If the list contains `image' 168return the display size taking the slice property into account. If the list
167but not `slice', return the `image-size' of the specified image." 169contains `image' but not `slice', return the `image-size' of the specified
168 (if (eq (car spec) 'image) 170image."
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'.
2648This variable's value should be a function, which will be called 2648This variable's value should be a function, which will be called
2649with no arguments, and should return a function that takes three 2649with no arguments, and should return a function that takes three
2650arguments: STRING, BOUND, and NOERROR. 2650arguments: STRING, BOUND, and NOERROR. See `re-search-forward'
2651for the meaning of BOUND and NOERROR arguments.
2651 2652
2652This returned function will be used by `isearch-search-string' to 2653This returned function will be used by `isearch-search-string' to
2653search for the first occurrence of STRING or its translation.") 2654search 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.
2699STRING's characters are translated using `translation-table-for-input'
2700if that is non-nil.
2698If found, move point to the end of the occurrence, 2701If found, move point to the end of the occurrence,
2699update the match data, and return point." 2702update the match data, and return point.
2703An optional second argument bounds the search; it is a buffer position.
2704The match found must not extend after that position.
2705Optional 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.
62given ID, TYPE, TITLE WIDTH and
63HEIGHT in the current buffer.
64
65Return ID
66
67see `make-xwidget' for types suitable for TYPE.
68Optional 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.
95NEW-SESSION specifies whether to create a new xwidget-webkit session. URL
96defaults 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.
199XWIDGET 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.
250The 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"
263function 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.
296Argument XW webkit.
297Argument 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.
325XW 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.
347Argument XW is the xwidget.
348Argument 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.
375Argument XW is the webkit xwidget.
376Argument 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.
391Argument XW is the webkit xwidget.
392Argument 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.
436Argument W width.
437Argument 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.
493XW is the webkit instance. SCRIPT is the script to execute.
494DEFAULT 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.
531This 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.
536It 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