2013-06-16 Lars Magne Ingebrigtsen <larsi@gnus.org>

* 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 <ruediger@c-plusplus.de>
* 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 <larsi@gnus.org>
* 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.

1 files changed, 102 insertions, 19 deletions

diff --git a/lisp/gnus/eww.el b/lisp/gnus/eww.el
index 270c3ee3ed..b34ec7655c 100644
--- a/lisp/gnus/eww.el
+++ b/lisp/gnus/eww.el
@@ -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))