lisp/ChangeLog (2013-06-05): Fix file name

[gnus] / lisp / shr.el

diff --git a/lisp/shr.el b/lisp/shr.el
index e7a6c5d..9284da4 100644 (file)
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -1,6 +1,6 @@
 ;;; shr.el --- Simple HTML Renderer
 
-;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: html
@@ -52,7 +52,7 @@ fit these criteria."
   "Images that have URLs matching this regexp will be blocked."
   :version "24.1"
   :group 'shr
-  :type 'regexp)
+  :type '(choice (const nil) regexp))
 
 (defcustom shr-table-horizontal-line ?\s
   "Character used to draw horizontal table lines."
@@ -347,11 +347,11 @@ size, and full-buffer size."
    ((eq shr-folding-mode 'none)
     (insert text))
    (t
-    (when (and (string-match "\\`[ \t\n ]" text)
+    (when (and (string-match "\\`[ \t\n ]" text)
               (not (bolp))
               (not (eq (char-after (1- (point))) ? )))
       (insert " "))
-    (dolist (elem (split-string text "[ \f\t\n\r\v ]+" t))
+    (dolist (elem (split-string text "[ \f\t\n\r\v ]+" t))
       (when (and (bolp)
                 (> shr-indentation 0))
        (shr-indent))
@@ -391,7 +391,7 @@ size, and full-buffer size."
            (shr-indent))
          (end-of-line))
        (insert " ")))
-    (unless (string-match "[ \t\n ]\\'" text)
+    (unless (string-match "[ \t\r\n ]\\'" text)
       (delete-char -1)))))
 
 (defun shr-find-fill-point ()
@@ -520,6 +520,11 @@ 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 an overlay in 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.
@@ -529,7 +534,7 @@ size, and full-buffer size."
     (while (< (point) end)
       (when (bolp)
        (skip-chars-forward " "))
-      (let ((overlay (make-overlay (point) (min (line-end-position) end))))
+      (let ((overlay (shr-make-overlay (point) (min (line-end-position) end))))
        (overlay-put overlay 'face type))
       (if (< (line-end-position) end)
          (forward-line 1)
@@ -588,6 +593,17 @@ size, and full-buffer size."
                      (put-text-property start (point) type value))))))))))
     (kill-buffer image-buffer)))
 
+(defun shr-image-from-data (data)
+  "Return an image from the data: URI content DATA."
+  (when (string-match
+        "\\(\\([^/;,]+\\(/[^;,]+\\)?\\)\\(;[^;,]+\\)*\\)?,\\(.*\\)"
+        data)
+    (let ((param (match-string 4 data))
+         (payload (url-unhex-string (match-string 5 data))))
+      (when (string-match "^.*\\(;[ \t]*base64\\)$" param)
+       (setq payload (base64-decode-string payload)))
+      payload)))
+
 (defun shr-put-image (data alt &optional flags)
   "Put image DATA with a string ALT.  Return image."
   (if (display-graphic-p)
@@ -615,7 +631,13 @@ size, and full-buffer size."
                  (overlay-put overlay 'face 'default)))
            (insert-image image (or alt "*")))
          (put-text-property start (point) 'image-size size)
-         (when (image-animated-p image)
+         (when (cond ((fboundp 'image-multi-frame-p)
+                      ;; Only animate multi-frame things that specify a
+                      ;; delay; eg animated gifs as opposed to
+                      ;; multi-page tiffs.  FIXME?
+                      (cdr (image-multi-frame-p image)))
+                     ((fboundp 'image-animated-p)
+                      (image-animated-p image)))
            (image-animate image nil 60)))
        image)
     (insert alt)))
@@ -785,7 +807,7 @@ ones, in case fg and bg are nil."
        (when (and (< (setq column (current-column)) width)
                   (< (setq column (shr-previous-newline-padding-width column))
                      width))
-         (let ((overlay (make-overlay (point) (1+ (point)))))
+         (let ((overlay (shr-make-overlay (point) (1+ (point)))))
            (overlay-put overlay 'before-string
                         (concat
                          (mapconcat
@@ -894,7 +916,7 @@ ones, in case fg and bg are nil."
   (shr-fontize-cont cont 'italic))
 
 (defun shr-tag-em (cont)
-  (shr-fontize-cont cont 'bold))
+  (shr-fontize-cont cont 'italic))
 
 (defun shr-tag-strong (cont)
   (shr-fontize-cont cont 'bold))
@@ -931,7 +953,8 @@ ones, in case fg and bg are nil."
        (start (point))
        shr-start)
     (shr-generic cont)
-    (shr-urlify (or shr-start start) (shr-expand-url url) title)))
+    (when url
+      (shr-urlify (or shr-start start) (shr-expand-url url) title))))
 
 (defun shr-tag-object (cont)
   (let ((start (point))
@@ -971,6 +994,12 @@ ones, in case fg and bg are nil."
              (member (cdr (assq :width cont)) '("0" "1")))
          ;; Ignore zero-sized or single-pixel images.
          )
+        ((and (not shr-inhibit-images)
+              (string-match "\\`data:" url))
+         (let ((image (shr-image-from-data (substring url (match-end 0)))))
+           (if image
+               (funcall shr-put-image-function image alt)
+             (insert alt))))
         ((and (not shr-inhibit-images)
               (string-match "\\`cid:" url))
          (let ((url (substring url (match-end 0)))
@@ -1060,6 +1089,14 @@ ones, in case fg and bg are nil."
     (shr-indent))
   (shr-generic cont))
 
+(defun shr-tag-span (cont)
+  (let ((title (cdr (assq :title cont))))
+    (shr-generic cont)
+    (when title
+      (when shr-start
+        (let ((overlay (shr-make-overlay shr-start (point))))
+          (overlay-put overlay 'help-echo title))))))
+
 (defun shr-tag-h1 (cont)
   (shr-heading cont 'bold 'underline))
 
@@ -1232,8 +1269,8 @@ ones, in case fg and bg are nil."
            (end-of-line)
            (insert line shr-table-vertical-line)
            (dolist (overlay overlay-line)
-             (let ((o (make-overlay (- (point) (nth 0 overlay) 1)
-                                    (- (point) (nth 1 overlay) 1)))
+             (let ((o (shr-make-overlay (- (point) (nth 0 overlay) 1)
+                                        (- (point) (nth 1 overlay) 1)))
                    (properties (nth 2 overlay)))
                (while properties
                  (overlay-put o (pop properties) (pop properties)))))
@@ -1334,8 +1371,8 @@ ones, in case fg and bg are nil."
              (let ((end (length (car cache))))
                (dolist (overlay (cadr cache))
                  (let ((new-overlay
-                        (make-overlay (1+ (- end (nth 0 overlay)))
-                                      (1+ (- end (nth 1 overlay)))))
+                        (shr-make-overlay (1+ (- end (nth 0 overlay)))
+                                          (1+ (- end (nth 1 overlay)))))
                        (properties (nth 2 overlay)))
                    (while properties
                      (overlay-put new-overlay
@@ -1465,7 +1502,7 @@ ones, in case fg and bg are nil."
 (provide 'shr)
 
 ;; Local Variables:
-;; coding: iso-8859-1
+;; coding: utf-8
 ;; End:
 
 ;;; shr.el ends here