[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] trunk r113007: 2013-06-16 Lars Magne Ingebrigtsen <address
|
From: |
Katsumi Yamaoka |
|
Subject: |
[Emacs-diffs] trunk r113007: 2013-06-16 Lars Magne Ingebrigtsen <address@hidden> |
|
Date: |
Sun, 16 Jun 2013 22:22:29 +0000 |
|
User-agent: |
Bazaar (2.6b2) |
------------------------------------------------------------
revno: 113007
revision-id: address@hidden
parent: address@hidden
author: Gnus developers <address@hidden>
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Sun 2013-06-16 22:20:55 +0000
message:
2013-06-16 Lars Magne Ingebrigtsen <address@hidden>
* eww.el (eww-display-html): Default to using the entire window width.
* shr.el (shr-make-table): Cache the table rendering at the table level, and
not the <td> level. This is a bit faster.
* eww.el (eww-render): Go to the correct ID when given URLs ending with #id.
* shr.el (shr-tag-li): Don't require a new paragraph, since other browsers
don't.
(shr-expand-url): Respect #anchor links.
(shr-parse-base): Chop off the anchor before using.
(shr-descend): Respect display: none.
(shr-descend): Allow marking elements that have certain IDs.
* eww.el (eww-tag-textarea): Use `text' instead of `editable-field'.
* shr.el (shr-expand-url): Don't bug out on zero-length links.
* eww.el (eww-tag-textarea): Support <textarea>.
2013-06-16 Rüdiger Sonderfeld <address@hidden>
* shr.el (shr-dom-to-xml): Fixed function call.
* eww.el (eww): New group.
(eww-header-line-format): New custom variable.
(eww-current-title): New variable.
(eww-display-html): Update header and handle title tag.
(eww-update-header-line-format): New function.
(eww-tag-title): New function.
* shr.el (shr-dom-to-xml): (shr-dom-to-xml): New function.
(shr-tag-svg): Add support for the SVG tag.
(shr-bullet): New custom variable.
(shr-tag-li): Support custom bullet in unordered lists.
2013-06-16 Lars Magne Ingebrigtsen <address@hidden>
* shr.el (shr-expand-url): Respect // URLs.
* eww.el (eww-tag-body): Override the shr body rendering so that we can
put a background colour onto the entire buffer.
(eww-render): When being redirected, use the redirect URL as the new
base URL.
* shr.el (shr-parse-base): Fix parsing error.
* eww.el (eww-submit): Pass the base in to `shr-expand-url'.
* shr.el (shr-parse-base): New function.
(shr-expand-url): Use it to expand relative URLs reliably.
modified:
lisp/gnus/ChangeLog changelog-20091113204419-o5vbwnq5f7feedwu-1433
lisp/gnus/eww.el eww.el-20130610114603-80ap3gwnw4x4m5ix-1
lisp/gnus/shr.el shr.el-20101002102929-yfzewk55rsg0mn93-1
=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog 2013-06-15 21:59:59 +0000
+++ b/lisp/gnus/ChangeLog 2013-06-16 22:20:55 +0000
@@ -1,3 +1,58 @@
+2013-06-16 Lars Magne Ingebrigtsen <address@hidden>
+
+ * eww.el (eww-display-html): Default to using the entire window width.
+
+ * shr.el (shr-make-table): Cache the table rendering at the table
+ level, and not the <td> level. This is a bit faster.
+
+ * eww.el (eww-render): Go to the correct ID when given URLs ending with
+ #id.
+
+ * shr.el (shr-tag-li): Don't require a new paragraph, since other
+ browsers don't.
+ (shr-expand-url): Respect #anchor links.
+ (shr-parse-base): Chop off the anchor before using.
+ (shr-descend): Respect display: none.
+ (shr-descend): Allow marking elements that have certain IDs.
+
+ * eww.el (eww-tag-textarea): Use `text' instead of `editable-field'.
+
+ * shr.el (shr-expand-url): Don't bug out on zero-length links.
+
+ * eww.el (eww-tag-textarea): Support <textarea>.
+
+2013-06-16 Rüdiger Sonderfeld <address@hidden>
+
+ * shr.el (shr-dom-to-xml): Fixed function call.
+
+ * eww.el (eww): New group.
+ (eww-header-line-format): New custom variable.
+ (eww-current-title): New variable.
+ (eww-display-html): Update header and handle title tag.
+ (eww-update-header-line-format): New function.
+ (eww-tag-title): New function.
+
+ * shr.el (shr-dom-to-xml): (shr-dom-to-xml): New function.
+ (shr-tag-svg): Add support for the SVG tag.
+ (shr-bullet): New custom variable.
+ (shr-tag-li): Support custom bullet in unordered lists.
+
+2013-06-16 Lars Magne Ingebrigtsen <address@hidden>
+
+ * shr.el (shr-expand-url): Respect // URLs.
+
+ * eww.el (eww-tag-body): Override the shr body rendering so that we can
+ put a background colour onto the entire buffer.
+ (eww-render): When being redirected, use the redirect URL as the new
+ base URL.
+
+ * shr.el (shr-parse-base): Fix parsing error.
+
+ * eww.el (eww-submit): Pass the base in to `shr-expand-url'.
+
+ * shr.el (shr-parse-base): New function.
+ (shr-expand-url): Use it to expand relative URLs reliably.
+
2013-06-15 Teodor Zlatanov <address@hidden>
* auth-source.el (auth-source-search-collection): Fix docstring.
=== modified file 'lisp/gnus/eww.el'
--- a/lisp/gnus/eww.el 2013-06-14 11:16:26 +0000
+++ b/lisp/gnus/eww.el 2013-06-16 22:20:55 +0000
@@ -29,7 +29,22 @@
(require 'url)
(require 'mm-url)
+(defgroup eww nil
+ "Emacs Web Wowser"
+ :version "24.4"
+ :group 'hypermedia
+ :prefix "eww-")
+
+(defcustom eww-header-line-format "%t: %u"
+ "Header line format.
+- %t is replaced by the title.
+- %u is replaced by the URL."
+ :group 'eww
+ :type 'string)
+
(defvar eww-current-url nil)
+(defvar eww-current-title ""
+ "Title of current page.")
(defvar eww-history nil)
;;;###autoload
@@ -53,7 +68,13 @@
(match-string 1)))))
(defun eww-render (status url &optional point)
+ (let ((redirect (plist-get status :redirect)))
+ (when redirect
+ (setq url redirect)))
(let* ((headers (eww-parse-headers))
+ (shr-target-id
+ (and (string-match "#\\(.*\\)" url)
+ (match-string 1 url)))
(content-type
(mail-header-parse-content-type
(or (cdr (assoc "content-type" headers))
@@ -74,8 +95,14 @@
(eww-display-image))
(t
(eww-display-raw charset)))
- (when point
- (goto-char point)))
+ (cond
+ (point
+ (goto-char point))
+ (shr-target-id
+ (let ((point (next-single-property-change
+ (point-min) 'shr-target-id)))
+ (when point
+ (goto-char (1+ point)))))))
(kill-buffer data-buffer))))
(defun eww-parse-headers ()
@@ -101,15 +128,56 @@
(libxml-parse-html-region (point) (point-max)))))
(eww-setup-buffer)
(setq eww-current-url url)
+ (eww-update-header-line-format)
(let ((inhibit-read-only t)
+ (shr-width nil)
(shr-external-rendering-functions
- '((form . eww-tag-form)
+ '((title . eww-tag-title)
+ (form . eww-tag-form)
(input . eww-tag-input)
+ (textarea . eww-tag-textarea)
+ (body . eww-tag-body)
(select . eww-tag-select))))
(shr-insert-document document)
(eww-convert-widgets))
(goto-char (point-min))))
+(defun eww-update-header-line-format ()
+ (if eww-header-line-format
+ (setq header-line-format (format-spec eww-header-line-format
+ `((?u . ,eww-current-url)
+ (?t . ,eww-current-title))))
+ (setq header-line-format nil)))
+
+(defun eww-tag-title (cont)
+ (setq eww-current-title "")
+ (dolist (sub cont)
+ (when (eq (car sub) 'text)
+ (setq eww-current-title (concat eww-current-title (cdr sub)))))
+ (eww-update-header-line-format))
+
+(defun eww-tag-body (cont)
+ (let* ((start (point))
+ (fgcolor (cdr (or (assq :fgcolor cont)
+ (assq :text cont))))
+ (bgcolor (cdr (assq :bgcolor cont)))
+ (shr-stylesheet (list (cons 'color fgcolor)
+ (cons 'background-color bgcolor))))
+ (shr-generic cont)
+ (eww-colorize-region start (point) fgcolor bgcolor)))
+
+(defun eww-colorize-region (start end fg &optional bg)
+ (when (or fg bg)
+ (let ((new-colors (shr-color-check fg bg)))
+ (when new-colors
+ (when fg
+ (eww-put-color start end :foreground (cadr new-colors)))
+ (when bg
+ (eww-put-color start end :background (car new-colors)))))))
+
+(defun eww-put-color (start end type color)
+ (shr-put-color-1 start end type color))
+
(defun eww-display-raw (charset)
(let ((data (buffer-substring (point) (point-max))))
(eww-setup-buffer)
@@ -240,6 +308,21 @@
(apply 'widget-create widget)
(put-text-property start (point) 'eww-widget widget))))
+(defun eww-tag-textarea (cont)
+ (let* ((start (point))
+ (widget
+ (list 'text
+ :size (string-to-number
+ (or (cdr (assq :cols cont))
+ "40"))
+ :value (or (cdr (assq 'text cont)) "")
+ :action 'eww-submit
+ :name (cdr (assq :name cont))
+ :eww-form eww-form)))
+ (nconc eww-form (list widget))
+ (apply 'widget-create widget)
+ (put-text-property start (point) 'eww-widget widget)))
+
(defun eww-tag-select (cont)
(shr-ensure-paragraph)
(let ((menu (list 'menu-choice
@@ -330,22 +413,22 @@
(plist-get (cdr elem) :value))
values)
(setq rest nil))))))
- (debug values)
- (let ((shr-base eww-current-url))
- (if (and (stringp (cdr (assq :method form)))
- (equal (downcase (cdr (assq :method form))) "post"))
- (let ((url-request-method "POST")
- (url-request-extra-headers
- '(("Content-Type" . "application/x-www-form-urlencoded")))
- (url-request-data (mm-url-encode-www-form-urlencoded values)))
- (eww-browse-url (shr-expand-url (cdr (assq :action form)))))
- (eww-browse-url
- (concat
- (if (cdr (assq :action form))
- (shr-expand-url (cdr (assq :action form)))
- eww-current-url)
- "?"
- (mm-url-encode-www-form-urlencoded values)))))))
+ (if (and (stringp (cdr (assq :method form)))
+ (equal (downcase (cdr (assq :method form))) "post"))
+ (let ((url-request-method "POST")
+ (url-request-extra-headers
+ '(("Content-Type" . "application/x-www-form-urlencoded")))
+ (url-request-data (mm-url-encode-www-form-urlencoded values)))
+ (eww-browse-url (shr-expand-url (cdr (assq :action form))
+ eww-current-url)))
+ (eww-browse-url
+ (concat
+ (if (cdr (assq :action form))
+ (shr-expand-url (cdr (assq :action form))
+ eww-current-url)
+ eww-current-url)
+ "?"
+ (mm-url-encode-www-form-urlencoded values))))))
(defun eww-convert-widgets ()
(let ((start (point-min))
=== modified file 'lisp/gnus/shr.el'
--- a/lisp/gnus/shr.el 2013-06-14 11:16:26 +0000
+++ b/lisp/gnus/shr.el 2013-06-16 22:20:55 +0000
@@ -83,6 +83,14 @@
(const :tag "Use the width of the window" nil))
:group 'shr)
+(defcustom shr-bullet "* "
+ "Bullet used for unordered lists.
+Alternative suggestions are:
+- \" \"
+- \" \""
+ :type 'string
+ :group 'shr)
+
(defvar shr-content-function nil
"If bound, this should be a function that will return the content.
This is used for cid: URLs, and the function is called with the
@@ -115,6 +123,7 @@
(defvar shr-base nil)
(defvar shr-ignore-cache nil)
(defvar shr-external-rendering-functions nil)
+(defvar shr-target-id nil)
(defvar shr-map
(let ((map (make-sparse-keymap)))
@@ -303,18 +312,24 @@
(shr-stylesheet shr-stylesheet)
(start (point)))
(when style
- (if (string-match "color" style)
+ (if (string-match "color\\|display" style)
(setq shr-stylesheet (nconc (shr-parse-style style)
shr-stylesheet))
(setq style nil)))
- (if (fboundp function)
- (funcall function (cdr dom))
- (shr-generic (cdr dom)))
- ;; If style is set, then this node has set the color.
- (when style
- (shr-colorize-region start (point)
- (cdr (assq 'color shr-stylesheet))
- (cdr (assq 'background-color shr-stylesheet))))))
+ ;; If we have a display:none, then just ignore this part of the
+ ;; DOM.
+ (unless (equal (cdr (assq 'display shr-stylesheet)) "none")
+ (if (fboundp function)
+ (funcall function (cdr dom))
+ (shr-generic (cdr dom)))
+ (when (and shr-target-id
+ (equal (cdr (assq :id (cdr dom))) shr-target-id))
+ (put-text-property start (1+ start) 'shr-target-id shr-target-id))
+ ;; If style is set, then this node has set the color.
+ (when style
+ (shr-colorize-region start (point)
+ (cdr (assq 'color shr-stylesheet))
+ (cdr (assq 'background-color shr-stylesheet)))))))
(defun shr-generic (cont)
(dolist (sub cont)
@@ -484,31 +499,51 @@
(forward-char 1))))
(not failed)))
-(defun shr-expand-url (url)
- (if (or (not url)
- (string-match "\\`[a-z]*:" url)
- (not shr-base))
- ;; Absolute URL.
- url
- (let ((base shr-base))
- ;; Chop off query string.
- (when (string-match "\\`\\([^?]+\\)[?]" base)
- (setq base (match-string 1 base)))
- ;; Chop off the bit after the last slash.
- (when (string-match "\\`\\(.*\\)[/][^/]+" base)
- (setq base (match-string 1 base)))
- (cond
- ((and (string-match "\\`//" url)
- (string-match "\\`[a-z]*:" base))
- (concat (match-string 0 base) url))
- ((and (not (string-match "/\\'" base))
- (not (string-match "\\`/" url)))
- (concat base "/" url))
- ((and (string-match "\\`/" url)
- (string-match "\\(\\`[^:]*://[^/]+\\)/" base))
- (concat (match-string 1 base) url))
- (t
- (concat base url))))))
+(defun shr-parse-base (url)
+ ;; Always chop off anchors.
+ (when (string-match "#.*" url)
+ (setq url (substring url 0 (match-beginning 0))))
+ (let* ((parsed (url-generic-parse-url url))
+ (local (url-filename parsed)))
+ (setf (url-filename parsed) "")
+ ;; Chop off the bit after the last slash.
+ (when (string-match "\\`\\(.*/\\)[^/]+\\'" local)
+ (setq local (match-string 1 local)))
+ ;; Always make the local bit end with a slash.
+ (when (and (not (zerop (length local)))
+ (not (eq (aref local (1- (length local))) ?/)))
+ (setq local (concat local "/")))
+ (list (url-recreate-url parsed)
+ local
+ (url-type parsed)
+ url)))
+
+(defun shr-expand-url (url &optional base)
+ (setq base
+ (if base
+ (shr-parse-base base)
+ ;; Bound by the parser.
+ shr-base))
+ (when (zerop (length url))
+ (setq url nil))
+ (cond ((or (not url)
+ (not base)
+ (string-match "\\`[a-z]*:" url))
+ ;; Absolute URL.
+ (or url (car base)))
+ ((eq (aref url 0) ?/)
+ (if (and (> (length url) 1)
+ (eq (aref url 1) ?/))
+ ;; //host...; just use the protocol
+ (concat (nth 2 base) ":" url)
+ ;; Just use the host name part.
+ (concat (car base) url)))
+ ((eq (aref url 0) ?#)
+ ;; A link to an anchor.
+ (concat (nth 3 base) url))
+ (t
+ ;; Totally relative.
+ (concat (car base) (cadr base) url))))
(defun shr-ensure-newline ()
(unless (zerop (current-column))
@@ -894,8 +929,31 @@
(defun shr-tag-comment (cont)
)
+(defun shr-dom-to-xml (dom)
+ "Convert DOM into a string containing the xml representation."
+ (let ((arg " ")
+ (text ""))
+ (dolist (sub (cdr dom))
+ (cond
+ ((listp (cdr sub))
+ (setq text (concat text (shr-dom-to-xml sub))))
+ ((eq (car sub) 'text)
+ (setq text (concat text (cdr sub))))
+ (t
+ (setq arg (concat arg (format "%s=\"%s\" "
+ (substring (symbol-name (car sub)) 1)
+ (cdr sub)))))))
+ (format "<%s%s>%s</%s>"
+ (car dom)
+ (substring arg 0 (1- (length arg)))
+ text
+ (car dom))))
+
(defun shr-tag-svg (cont)
- )
+ (when (image-type-available-p 'svg)
+ (funcall shr-put-image-function
+ (shr-dom-to-xml (cons 'svg cont))
+ "SVG Image")))
(defun shr-tag-sup (cont)
(let ((start (point)))
@@ -965,7 +1023,7 @@
plist)))
(defun shr-tag-base (cont)
- (setq shr-base (cdr (assq :href cont)))
+ (setq shr-base (shr-parse-base (cdr (assq :href cont))))
(shr-generic cont))
(defun shr-tag-a (cont)
@@ -1087,14 +1145,14 @@
(shr-ensure-paragraph))
(defun shr-tag-li (cont)
- (shr-ensure-paragraph)
+ (shr-ensure-newline)
(shr-indent)
(let* ((bullet
(if (numberp shr-list-mode)
(prog1
(format "%d " shr-list-mode)
(setq shr-list-mode (1+ shr-list-mode)))
- "* "))
+ shr-bullet))
(shr-indentation (+ shr-indentation (length bullet))))
(insert bullet)
(shr-generic cont)))
@@ -1352,6 +1410,13 @@
widths))
(defun shr-make-table (cont widths &optional fill)
+ (or (cadr (assoc (list cont widths fill) shr-content-cache))
+ (let ((data (shr-make-table-1 cont widths fill)))
+ (push (list (list cont widths fill) data)
+ shr-content-cache)
+ data)))
+
+(defun shr-make-table-1 (cont widths &optional fill)
(let ((trs nil))
(dolist (row cont)
(when (eq (car row) 'tr)
@@ -1385,32 +1450,16 @@
(setq style (nconc (list (cons 'color fgcolor)) style)))
(when style
(setq shr-stylesheet (append style shr-stylesheet)))
- (let ((cache (cdr (assoc (cons width cont) shr-content-cache))))
- (if cache
- (progn
- (insert (car cache))
- (let ((end (length (car cache))))
- (dolist (overlay (cadr cache))
- (let ((new-overlay
- (shr-make-overlay (1+ (- end (nth 0 overlay)))
- (1+ (- end (nth 1 overlay)))))
- (properties (nth 2 overlay)))
- (while properties
- (overlay-put new-overlay
- (pop properties) (pop properties)))))))
- (let ((shr-width width)
- (shr-indentation 0))
- (shr-descend (cons 'td cont)))
- ;; Delete padding at the bottom of the TDs.
- (delete-region
- (point)
- (progn
- (skip-chars-backward " \t\n")
- (end-of-line)
- (point)))
- (push (list (cons width cont) (buffer-string)
- (shr-overlays-in-region (point-min) (point-max)))
- shr-content-cache)))
+ (let ((shr-width width)
+ (shr-indentation 0))
+ (shr-descend (cons 'td cont)))
+ ;; Delete padding at the bottom of the TDs.
+ (delete-region
+ (point)
+ (progn
+ (skip-chars-backward " \t\n")
+ (end-of-line)
+ (point)))
(goto-char (point-min))
(let ((max 0))
(while (not (eobp))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] trunk r113007: 2013-06-16 Lars Magne Ingebrigtsen <address@hidden>,
Katsumi Yamaoka <=