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, 113 insertions, 64 deletions

diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el
index c93357efd2..339b969892 100644
--- a/lisp/gnus/shr.el
+++ b/lisp/gnus/shr.el
@@ -83,6 +83,14 @@ used."
 		 (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 @@ cid: URL as the argument.")
 (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 @@ size, and full-buffer size."
 	(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 @@ size, and full-buffer size."
 	 (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 @@ ones, in case fg and bg are nil."
 (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 @@ ones, in case fg and bg are nil."
       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 @@ ones, in case fg and bg are nil."
   (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 @@ ones, in case fg and bg are nil."
     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 @@ ones, in case fg and bg are nil."
 	(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))