lisp/gnus/mm-decode.el (mm-convert-shr-links): Override the shr local map, so...

lisp/gnus/mm-decode.el (mm-convert-shr-links): Override the shr local map, so that Gnus commands work

lisp/gnus/shr.el (shr-render-td): Support horizontal alignment

Make eww use `add-face-text-property', too
lisp/gnus/shr.el (shr-make-overlay): Obsolete function
lisp/gnus/eww.el (eww-put-color): Removed
(eww-colorize-region): Use `add-face-text-property'

Get correct presedence for font data
lisp/gnus/shr.el (shr-add-font): Append face data, so that we get the correct presedence: The innermost value (which is applied first) wins

lisp/gnus/ChangeLog

 2013-06-17  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+	* mm-decode.el (mm-convert-shr-links): Override the shr local map, so
+	that Gnus commands work.
+
+	* shr.el (shr-render-td): Support horizontal alignment.
+
+	* eww.el (eww-put-color): Removed.
+	(eww-colorize-region): Use `add-face-text-property'.
+
+	* shr.el (shr-add-font): Append face data, so that we get the correct
+	presedence: The innermost value (which is applied first) wins.
+	(shr-make-overlay): Obsolete function.
+
 	* mm-decode.el (mm-convert-shr-links): New function to convert
 	new-style shr URL links into widgets.
 	(mm-shr): Use it.

lisp/gnus/eww.el

@@ -172,12 +172,11 @@
     (let ((new-colors (shr-color-check fg bg)))
       (when new-colors
 	(when fg
-	  (eww-put-color start end :foreground (cadr new-colors)))
+	  (add-face-text-property start end
+				  (list :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))
+	  (add-face-text-property start end
+				  (list :background (car new-colors))))))))
 
 (defun eww-display-raw (charset)
   (let ((data (buffer-substring (point) (point-max))))

lisp/gnus/mm-decode.el

@@ -1831,6 +1831,7 @@ If RECURSIVE, search recursively."
 	 :help-echo (get-text-property start 'help-echo)
 	 :keymap shr-map
 	 (get-text-property start 'shr-url))
+	(put-text-property start end 'local-map nil)
 	(setq start end)))))
 
 (defun mm-handle-filename (handle)

lisp/gnus/shr.el

@@ -609,11 +609,6 @@ size, and full-buffer size."
     (dolist (type types)
       (shr-add-font (or shr-start (point)) (point) type))))
 
-(defun shr-make-overlay (beg end &optional buffer front-advance rear-advance)
-  (let ((overlay (make-overlay beg end buffer front-advance rear-advance)))
-    (overlay-put overlay 'evaporate t)
-    overlay))
-
 ;; Add face to the region, but avoid putting the font properties on
 ;; blank text at the start of the line, and the newline at the end, to
 ;; avoid ugliness.
@@ -623,7 +618,7 @@ size, and full-buffer size."
     (while (< (point) end)
       (when (bolp)
 	(skip-chars-forward " "))
-      (add-face-text-property (point) (min (line-end-position) end) type)
+      (add-face-text-property (point) (min (line-end-position) end) type t)
       (if (< (line-end-position) end)
 	  (forward-line 1)
 	(goto-char end)))))
@@ -843,32 +838,11 @@ ones, in case fg and bg are nil."
     (let ((new-colors (shr-color-check fg bg)))
       (when new-colors
 	(when fg
-	  (shr-put-color start end :foreground (cadr new-colors)))
+	  (shr-add-font start end (list :foreground (cadr new-colors))))
 	(when bg
-	  (shr-put-color start end :background (car new-colors))))
+	  (shr-add-font start end (list :background (car new-colors)))))
       new-colors)))
 
-;; Put a color in the region, but avoid putting colors on blank
-;; text at the start of the line, and the newline at the end, to avoid
-;; ugliness.  Also, don't overwrite any existing color information,
-;; since this can be called recursively, and we want the "inner" color
-;; to win.
-(defun shr-put-color (start end type color)
-  (save-excursion
-    (goto-char start)
-    (while (< (point) end)
-      (when (and (bolp)
-		 (not (eq type :background)))
-	(skip-chars-forward " "))
-      (when (> (line-end-position) (point))
-	(shr-put-color-1 (point) (min (line-end-position) end) type color))
-      (if (< (line-end-position) end)
-	  (forward-line 1)
-	(goto-char end)))
-    (when (and (eq type :background)
-	       (= shr-table-depth 0))
-      (shr-expand-newlines start end color))))
-
 (defun shr-expand-newlines (start end color)
   (save-restriction
     ;; Skip past all white space at the start and ends.
@@ -919,24 +893,6 @@ ones, in case fg and bg are nil."
 				    'before-string)))))
       (+ width previous-width))))
 
-(defun shr-put-color-1 (start end type color)
-  (let* ((old-props (get-text-property start 'face))
-	 (do-put (and (listp old-props)
-                      (not (memq type old-props))))
-	 change)
-    (while (< start end)
-      (setq change (next-single-property-change start 'face nil end))
-      (when do-put
-	(add-face-text-property start change (list type color)))
-      (setq old-props (get-text-property change 'face))
-      (setq do-put (and (listp old-props)
-                        (not (memq type old-props))))
-      (setq start change))
-    (when (and do-put
-	       (> end start))
-      (put-text-property start end 'face
-			 (nconc (list type color old-props))))))
-
 ;;; Tag-specific rendering rules.
 
 (defun shr-tag-body (cont)
@@ -1381,7 +1337,8 @@ ones, in case fg and bg are nil."
 	      (insert (make-string (string-width (car lines)) ? )
 		      shr-table-vertical-line)
 	      (when (nth 4 column)
-		(shr-put-color start (1- (point)) :background (nth 4 column))))
+		(shr-add-font start (1- (point))
+			      (list :background (nth 4 column)))))
 	    (forward-line 1)))))
     (shr-insert-table-ruler widths)))
 
@@ -1492,11 +1449,23 @@ ones, in case fg and bg are nil."
 	  (if (zerop (buffer-size))
 	      (insert (make-string width ? ))
 	    ;; Otherwise, fill the buffer.
-	    (while (not (eobp))
-	      (end-of-line)
-	      (when (> (- width (current-column)) 0)
-		(insert (make-string (- width (current-column)) ? )))
-	      (forward-line 1)))
+	    (let ((align (cdr (assq :align cont)))
+		  length)
+	      (while (not (eobp))
+		(end-of-line)
+		(setq length (- width (current-column)))
+		(when (> length 0)
+		  (cond
+		   ((equal align "right")
+		    (beginning-of-line)
+		    (insert (make-string length ? )))
+		   ((equal align "center")
+		    (insert (make-string (/ length 2) ? ))
+		    (beginning-of-line)
+		    (insert (make-string (- length (/ length 2)) ? )))
+		   (t
+		    (insert (make-string length ? )))))
+		(forward-line 1))))
 	  (when style
 	    (setq actual-colors
 		  (shr-colorize-region
@@ -1567,7 +1536,7 @@ ones, in case fg and bg are nil."
 
 ;; Emacs less than 24.3
 (unless (fboundp 'add-face-text-property)
-  (defun add-face-text-property (beg end face)
+  (defun add-face-text-property (beg end face &optional appendp object)
     "Combine FACE BEG and END."
     (let ((b beg))
       (while (< b end)
@@ -1578,9 +1547,13 @@ ones, in case fg and bg are nil."
 			face)
 		       ((and (consp oldval)
 			     (not (keywordp (car oldval))))
-			(cons face oldval))
+			(if appendp
+			    (nconc oldval (list face))
+			  (cons face oldval)))
 		       (t
-			(list face oldval)))))))))
+			(if appendp
+			    (list oldval face)
+			  (list face oldval))))))))))
 
 (provide 'shr)