* gnus-art.el (gnus-treat-hide-citation-maybe): Add more doc to the string.

[gnus] / lisp / shr.el

diff --git a/lisp/shr.el b/lisp/shr.el
index da27edc..8faa507 100644 (file)
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -183,14 +183,23 @@ redirects somewhere else."
        (message "No image under point")
       (message "%s" text))))
 
-(defun shr-browse-image ()
-  "Browse the image under point."
-  (interactive)
+(defun shr-browse-image (&optional copy-url)
+  "Browse the image under point.
+If COPY-URL (the prefix if called interactively) is non-nil, copy
+the URL of the image to the kill buffer instead."
+  (interactive "P")
   (let ((url (get-text-property (point) 'image-url)))
-    (if (not url)
-       (message "No image under point")
+    (cond
+     ((not url)
+      (message "No image under point"))
+     (copy-url
+      (with-temp-buffer
+       (insert url)
+       (copy-region-as-kill (point-min) (point-max))
+       (message "Copied %s" url)))
+     (t
       (message "Browsing %s..." url)
-      (browse-url url))))
+      (browse-url url)))))
 
 (defun shr-insert-image ()
   "Insert the image under point into the buffer."
@@ -517,15 +526,18 @@ redirects somewhere else."
          (when (and (> (current-column) 0)
                     (> (car (image-size image t)) 400))
            (insert "\n"))
-         (insert-image image (or alt "*")))
+         (insert-image image (or alt "*"))
+         (when (image-animated-p image)
+           (image-animate image nil 60)))
        image)
     (insert alt)))
 
 (defun shr-rescale-image (data)
   (if (or (not (fboundp 'imagemagick-types))
          (not (get-buffer-window (current-buffer))))
-      (create-image data nil t)
-    (let* ((image (create-image data nil t))
+      (create-image data nil t
+                   :ascent 100)
+    (let* ((image (create-image data nil t :ascent 100))
           (size (image-size image t))
           (width (car size))
           (height (cdr size))
@@ -544,11 +556,9 @@ redirects somewhere else."
       (when (> (car size) window-width)
        (setq image (or
                     (create-image data 'imagemagick t
-                                  :width window-width)
+                                  :width window-width
+                                  :ascent 100)
                     image)))
-      (when (and (fboundp 'create-animated-image)
-                (eq (image-type data nil t) 'gif))
-       (setq image (create-animated-image data 'gif t)))
       image)))
 
 ;; url-cache-extract autoloads url-cache.
@@ -582,7 +592,7 @@ START, and END.  Note that START and END should be merkers."
                 (when image
                   (goto-char start)
                   (funcall shr-put-image-function
-                           image (buffer-substring-no-properties start end))
+                           image (buffer-substring start end))
                   (delete-region (point) end))))
         (url-retrieve url 'shr-image-fetched
                       (list (current-buffer) start end)
@@ -601,7 +611,7 @@ START, and END.  Note that START and END should be merkers."
    :help-echo (if title (format "%s (%s)" url title) url)
    :keymap shr-map
    url)
-  (put-text-property start (point) 'face 'shr-link)
+  (shr-add-font start (point) 'shr-link)
   (put-text-property start (point) 'shr-url url))
 
 (defun shr-encode-url (url)
@@ -643,7 +653,7 @@ ones, in case fg and bg are nil."
          (shr-put-color start end :background (car new-colors))))
       new-colors)))
 
-;; Put a color in the region, but avoid putting colors on on blank
+;; 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
@@ -716,7 +726,8 @@ ones, in case fg and bg are nil."
 
 (defun shr-put-color-1 (start end type color)
   (let* ((old-props (get-text-property start 'face))
-        (do-put (not (memq type old-props)))
+        (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))
@@ -724,7 +735,8 @@ ones, in case fg and bg are nil."
        (put-text-property start change 'face
                           (nconc (list type color) old-props)))
       (setq old-props (get-text-property change 'face))
-      (setq do-put (not (memq type old-props)))
+      (setq do-put (and (listp old-props)
+                        (not (memq type old-props))))
       (setq start change))
     (when (and do-put
               (> end start))
@@ -749,6 +761,9 @@ ones, in case fg and bg are nil."
 (defun shr-tag-script (cont)
   )
 
+(defun shr-tag-comment (cont)
+  )
+
 (defun shr-tag-sup (cont)
   (let ((start (point)))
     (shr-generic cont)
@@ -778,6 +793,9 @@ ones, in case fg and bg are nil."
 (defun shr-tag-s (cont)
   (shr-fontize-cont cont 'shr-strike-through))
 
+(defun shr-tag-del (cont)
+  (shr-fontize-cont cont 'shr-strike-through))
+
 (defun shr-tag-b (cont)
   (shr-fontize-cont cont 'bold))