[Emacs-diffs] /srv/bzr/emacs/trunk r101775: Merge changes made in Gnus trunk.

[Katsumi Yamaoka]

------------------------------------------------------------
revno: 101775
author: Gnus developers
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Mon 2010-10-04 00:17:16 +0000
message:
  Merge changes made in Gnus trunk.
  
  shr.el: Rename the tag functions a bit, and add some new ones.
  gnus-sum.el (gnus-summary-select-article-buffer): If the article buffer isn't 
shown, then select the current article first instead of bugging out.
  gnus-sum.el (gnus-summary-select-article-buffer): Show both the article and 
summary buffers again.
  shr.el (shr-tag-blockquote): Convert name.
  shr.el (shr-rescale-image): Use the right image-size variant.
  shr.el (shr-tag-p): Don't insert newlines at the start of the buffer.
  shr.el: Implement indentation in blockquotes.
  gnus-sum.el (gnus-summary-select-article-buffer): Really select the article 
buffer again.
  shr.el (shr-ensure-paragraph): Don't insert newlines on empty tags at the 
beginning of the buffer.
  gnus-ems.el, gnus-util.el, mm-decode.el, mm-view.el: Add resize for large 
images in mm.
  gnus-html.el (gnus-html-put-image): Use gnus-rescale-image.
  shr.el (shr-tag-p): Don't insert newlines on empty tags at the beginning of 
the buffer.
  gnus-ems.el, gnus-html.el, gnus-util.el, mm-decode.el, mm-view.el: Support 
image resizing.
  shr.el: Add headings.
  shr.el (shr-ensure-paragraph): Actually work.
  shr.el (shr-tag-li): Make <ul> prettier.
  shr.el (shr-insert): Get white space at the beginning/end of elements right.
  shr.el (shr-tag-li): Tweak <li> rendering.
  shr.el (shr-tag-p): Collapse subsequent <p>s.
  shr.el (shr-ensure-paragraph): Don't insert double line feeds after blank 
lines.
  shr.el (shr-tag-h6): Add.
  shr.el (shr-insert): \t is also space.
modified:
  doc/misc/ChangeLog
  doc/misc/emacs-mime.texi
  lisp/gnus/ChangeLog
  lisp/gnus/gnus-ems.el
  lisp/gnus/gnus-html.el
  lisp/gnus/gnus-sum.el
  lisp/gnus/gnus-util.el
  lisp/gnus/mm-decode.el
  lisp/gnus/mm-view.el
  lisp/gnus/shr.el

=== modified file 'doc/misc/ChangeLog'
--- a/doc/misc/ChangeLog        2010-10-03 15:09:11 +0000
+++ b/doc/misc/ChangeLog        2010-10-04 00:17:16 +0000
@@ -1,3 +1,9 @@
+2010-10-03  Julien Danjou  <address@hidden>
+
+       * emacs-mime.texi (Display Customization): Update
+       mm-inline-large-images documentation and add documentation for
+       mm-inline-large-images-proportion.
+
 2010-10-03  Michael Albinus  <address@hidden>
 
        * tramp.texi (Frequently Asked Questions): Mention

=== modified file 'doc/misc/emacs-mime.texi'
--- a/doc/misc/emacs-mime.texi  2010-09-20 23:44:05 +0000
+++ b/doc/misc/emacs-mime.texi  2010-10-04 00:17:16 +0000
@@ -374,12 +374,18 @@
 @vindex mm-inline-large-images
 When displaying inline images that are larger than the window, Emacs
 does not enable scrolling, which means that you cannot see the whole
-image.  To prevent this, the library tries to determine the image size
+image. To prevent this, the library tries to determine the image size
 before displaying it inline, and if it doesn't fit the window, the
 library will display it externally (e.g. with @samp{ImageMagick} or
address@hidden).  Setting this variable to @code{t} disables this check and
address@hidden). Setting this variable to @code{t} disables this check and
 makes the library display all inline images as inline, regardless of
-their size.
+their size. If you set this variable to @code{resize}, the image will
+be displayed resized to fit in the window, if Emacs has the ability to
+resize images.
+
address@hidden mm-inline-large-images-proportion
address@hidden mm-inline-images-max-proportion
+The proportion used when resizing large images.
 
 @item mm-inline-override-types
 @vindex mm-inline-override-types

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2010-10-03 19:54:31 +0000
+++ b/lisp/gnus/ChangeLog       2010-10-04 00:17:16 +0000
@@ -1,3 +1,61 @@
+2010-10-03  Lars Magne Ingebrigtsen  <address@hidden>
+
+       * shr.el: Add headings.
+       (shr-ensure-paragraph): Actually work.
+       (shr-tag-li): Make <ul> prettier.
+       (shr-insert): Get white space at the beginning/end of elements right.
+       (shr-tag-p): Collapse subsequent <p>s.
+       (shr-ensure-paragraph): Don't insert double line feeds after blank
+       lines.
+       (shr-insert): \t is also space.
+       (shr-tag-s): Fix "s" tag name function.
+       (shr-tag-s): Fix face prop name.
+
+2010-10-03  Julien Danjou  <address@hidden>
+
+       * gnus-html.el (gnus-html-put-image): Use gnus-rescale-image.
+
+       * mm-view.el (gnus-window-inside-pixel-edges): Add autoload for
+       gnus-window-inside-pixel-edges.
+
+       * gnus-ems.el (gnus-window-inside-pixel-edges): Move from gnus-html to
+       gnus-ems.
+
+       * mm-view.el (mm-inline-image-emacs): Support image resizing.
+
+       * gnus-util.el (gnus-rescale-image): Add generic gnus-rescale-image
+       function.
+
+       * mm-decode.el (mm-inline-large-images): Enhance defcustom and add
+       resize choice.
+
+2010-10-03  Lars Magne Ingebrigtsen  <address@hidden>
+
+       * shr.el (shr-tag-p): Don't insert newlines on empty tags at the
+       beginning of the buffer.
+
+       * gnus-sum.el (gnus-summary-select-article-buffer): Really select the
+       article buffer again.
+
+       * shr.el (shr-tag-p): Don't insert newlines at the start of the
+       buffer.
+
+       * mm-decode.el (mm-shr): Narrow before inserting, so that shr can know
+       when it's at the start of the buffer.
+
+       * shr.el (shr-tag-blockquote): Convert name.
+       (shr-rescale-image): Use the right image-size variant.
+
+       * gnus-sum.el (gnus-summary-select-article-buffer): If the article
+       buffer isn't shown, then select the current article first instead of
+       bugging out.
+       (gnus-summary-select-article-buffer): Show both the article and summary
+       buffers again.
+
+       * shr.el (shr-fontize-cont): Protect against regions with no text.
+       Rename tag functions to shr-tag-* for enhanced security.
+       (shr-tag-ul, shr-tag-ol, shr-tag-li, shr-tag-br): New functions.
+
 2010-10-03  Chong Yidong  <address@hidden>
 
        * shr.el (shr-insert):

=== modified file 'lisp/gnus/gnus-ems.el'
--- a/lisp/gnus/gnus-ems.el     2010-09-28 11:47:12 +0000
+++ b/lisp/gnus/gnus-ems.el     2010-10-04 00:17:16 +0000
@@ -307,6 +307,12 @@
                end nil))))))
 
 (eval-and-compile
+  ;; XEmacs does not have window-inside-pixel-edges
+  (defalias 'gnus-window-inside-pixel-edges
+    (if (fboundp 'window-inside-pixel-edges)
+        'window-inside-pixel-edges
+      'window-pixel-edges))
+
   (if (fboundp 'set-process-plist)
       (progn
        (defalias 'gnus-set-process-plist 'set-process-plist)

=== modified file 'lisp/gnus/gnus-html.el'
--- a/lisp/gnus/gnus-html.el    2010-10-03 19:54:31 +0000
+++ b/lisp/gnus/gnus-html.el    2010-10-04 00:17:16 +0000
@@ -105,12 +105,7 @@
                                          (match-string 0 encoded-text)))
                                 t t encoded-text)
                  s (1+ s)))
-         encoded-text))))
-  ;; XEmacs does not have window-inside-pixel-edges
-  (defalias 'gnus-window-inside-pixel-edges
-    (if (fboundp 'window-inside-pixel-edges)
-        'window-inside-pixel-edges
-      'window-pixel-edges)))
+         encoded-text)))))
 
 (defun gnus-html-encode-url (url)
   "Encode URL."
@@ -436,7 +431,17 @@
                                  (= (car size) 30)
                                  (= (cdr size) 30))))
                   ;; Good image, add it!
-                  (let ((image (gnus-html-rescale-image image data size)))
+                  (let ((image (gnus-html-rescale-image
+                                image
+                                ;; (width . height)
+                                (cons
+                                 ;; Aimed width
+                                 (truncate
+                                  (* gnus-max-image-proportion
+                                     (- (nth 2 edges) (nth 0 edges))))
+                                 ;; Aimed height
+                                 (truncate (* gnus-max-image-proportion
+                                              (- (nth 3 edges) (nth 1 
edges))))))))
                     (delete-region start end)
                     (gnus-put-image image alt-text 'external)
                     (gnus-put-text-property start (point) 'help-echo alt-text)
@@ -459,31 +464,6 @@
                   (gnus-add-image 'internal image))
                 nil))))))))
 
-(defun gnus-html-rescale-image (image data size)
-  (if (or (not (fboundp 'imagemagick-types))
-         (not (get-buffer-window (current-buffer))))
-      image
-    (let* ((width (car size))
-          (height (cdr size))
-          (edges (gnus-window-inside-pixel-edges
-                  (get-buffer-window (current-buffer))))
-          (window-width (truncate (* gnus-max-image-proportion
-                                     (- (nth 2 edges) (nth 0 edges)))))
-          (window-height (truncate (* gnus-max-image-proportion
-                                      (- (nth 3 edges) (nth 1 edges)))))
-          scaled-image)
-      (when (> height window-height)
-       (setq image (or (create-image data 'imagemagick t
-                                     :height window-height)
-                       image))
-       (setq size (image-size image t)))
-      (when (> (car size) window-width)
-       (setq image (or
-                    (create-image data 'imagemagick t
-                                  :width window-width)
-                    image)))
-      image)))
-
 (defun gnus-html-image-url-blocked-p (url blocked-images)
   "Find out if URL is blocked by BLOCKED-IMAGES."
   (let ((ret (and blocked-images

=== modified file 'lisp/gnus/gnus-sum.el'
--- a/lisp/gnus/gnus-sum.el     2010-10-01 23:08:25 +0000
+++ b/lisp/gnus/gnus-sum.el     2010-10-04 00:17:16 +0000
@@ -6933,8 +6933,10 @@
   (interactive)
   (if (not (gnus-buffer-live-p gnus-article-buffer))
       (error "There is no article buffer for this summary buffer")
-    (select-window (get-buffer-window gnus-article-buffer))
-    (gnus-configure-windows 'only-article t)))
+    (unless (get-buffer-window gnus-article-buffer)
+      (gnus-summary-show-article))
+    (gnus-configure-windows 'article t)
+    (select-window (get-buffer-window gnus-article-buffer))))
 
 (defun gnus-summary-universal-argument (arg)
   "Perform any operation on all articles that are process/prefixed."

=== modified file 'lisp/gnus/gnus-util.el'
--- a/lisp/gnus/gnus-util.el    2010-10-03 02:03:18 +0000
+++ b/lisp/gnus/gnus-util.el    2010-10-04 00:17:16 +0000
@@ -1932,6 +1932,26 @@
             (get-char-table ,character ,display-table)))
     `(aref ,display-table ,character)))
 
+(defun gnus-rescale-image (image size)
+  "Rescale IMAGE to SIZE if possible.
+SIZE is in format (WIDTH . HEIGHT). Return a new image.
+Sizes are in pixels."
+  (if (or (not (fboundp 'imagemagick-types))
+         (not (get-buffer-window (current-buffer))))
+      image
+    (let ((new-width (car size))
+          (new-height (cdr size)))
+      (when (> (cdr (image-size image t)) new-height)
+        (setq image (or (create-image (plist-get (cdr image) :data) 
'imagemagick t
+                                      :height new-height)
+                        image)))
+      (when (> (car (image-size image t)) new-width)
+        (setq image (or
+                   (create-image (plist-get (cdr image) :data) 'imagemagick t
+                                 :width new-width)
+                   image)))
+      image)))
+
 (provide 'gnus-util)
 
 ;;; gnus-util.el ends here

=== modified file 'lisp/gnus/mm-decode.el'
--- a/lisp/gnus/mm-decode.el    2010-10-03 00:33:27 +0000
+++ b/lisp/gnus/mm-decode.el    2010-10-04 00:17:16 +0000
@@ -369,8 +369,12 @@
   :group 'mime-display)
 
 (defcustom mm-inline-large-images nil
-  "If non-nil, then all images fit in the buffer."
-  :type 'boolean
+  "If t, then all images fit in the buffer.
+If 'resize, try to resize the images so they fit."
+  :type '(radio
+          (const :tag "Inline large images as they are." t)
+          (const :tag "Resize large images." resize)
+          (const :tag "Do not inline large images." nil))
   :group 'mime-display)
 
 (defcustom mm-file-name-rewrite-functions
@@ -1679,9 +1683,11 @@
   (let ((article-buffer (current-buffer)))
     (unless handle
       (setq handle (mm-dissect-buffer t)))
-    (shr-insert-document
-     (mm-with-part handle
-       (libxml-parse-html-region (point-min) (point-max))))))
+    (save-restriction
+      (narrow-to-region (point) (point))
+      (shr-insert-document
+       (mm-with-part handle
+        (libxml-parse-html-region (point-min) (point-max)))))))
 
 (provide 'mm-decode)
 

=== modified file 'lisp/gnus/mm-view.el'
--- a/lisp/gnus/mm-view.el      2010-09-30 08:39:23 +0000
+++ b/lisp/gnus/mm-view.el      2010-10-04 00:17:16 +0000
@@ -32,6 +32,7 @@
 (require 'smime)
 
 (autoload 'gnus-completing-read "gnus-util")
+(autoload 'gnus-window-inside-pixel-edges "gnus-ems")
 (autoload 'gnus-article-prepare-display "gnus-art")
 (autoload 'vcard-parse-string "vcard")
 (autoload 'vcard-format-string "vcard")
@@ -76,6 +77,13 @@
   :version "22.1"
   :group 'mime-display)
 
+(defcustom mm-inline-large-images-proportion 0.9
+  "Maximum proportion of large image resized when
+`mm-inline-large-images' is set to resize."
+  :type 'float
+  :version "24.1"
+  :group 'mime-display)
+
 ;;; Internal variables.
 
 ;;;
@@ -85,7 +93,18 @@
 (defun mm-inline-image-emacs (handle)
   (let ((b (point-marker))
        (inhibit-read-only t))
-    (put-image (mm-get-image handle) b)
+    (put-image
+     (let ((image (mm-get-image handle)))
+       (if (eq mm-inline-large-images 'resize)
+           (gnus-rescale-image image
+                               (let ((edges (gnus-window-inside-pixel-edges
+                                             (get-buffer-window 
(current-buffer)))))
+                                 (cons (truncate (* 
mm-inline-large-images-proportion
+                                                    (- (nth 2 edges) (nth 0 
edges))))
+                                       (truncate (* 
mm-inline-large-images-proportion
+                                                    (- (nth 3 edges) (nth 1 
edges)))))))
+         image))
+     b)
     (insert "\n\n")
     (mm-handle-set-undisplayer
      handle

=== modified file 'lisp/gnus/shr.el'
--- a/lisp/gnus/shr.el  2010-10-03 19:54:31 +0000
+++ b/lisp/gnus/shr.el  2010-10-04 00:17:16 +0000
@@ -53,6 +53,7 @@
 (defvar shr-folding-mode nil)
 (defvar shr-state nil)
 (defvar shr-start nil)
+(defvar shr-indentation 0)
 
 (defvar shr-width 70)
 
@@ -75,7 +76,7 @@
     (shr-descend (shr-transform-dom dom))))
 
 (defun shr-descend (dom)
-  (let ((function (intern (concat "shr-" (symbol-name (car dom))) obarray)))
+  (let ((function (intern (concat "shr-tag-" (symbol-name (car dom))) 
obarray)))
     (if (fboundp function)
        (funcall function (cdr dom))
       (shr-generic (cdr dom)))))
@@ -85,37 +86,48 @@
     (cond
      ((eq (car sub) :text)
       (shr-insert (cdr sub)))
-     ((consp (cdr sub))
+     ((listp (cdr sub))
       (shr-descend sub)))))
 
-(defun shr-p (cont)
-  (shr-ensure-newline)
-  (insert "\n")
+(defun shr-tag-p (cont)
+  (shr-ensure-paragraph)
   (shr-generic cont)
-  (insert "\n"))
-
-(defun shr-b (cont)
+  (shr-ensure-paragraph))
+
+(defun shr-ensure-paragraph ()
+  (unless (bobp)
+    (if (bolp)
+       (unless (eql (char-after (- (point) 2)) ?\n)
+         (insert "\n"))
+      (if (save-excursion
+           (beginning-of-line)
+           (looking-at " *"))
+         (insert "\n")
+       (insert "\n\n")))))
+
+(defun shr-tag-b (cont)
   (shr-fontize-cont cont 'bold))
 
-(defun shr-i (cont)
+(defun shr-tag-i (cont)
   (shr-fontize-cont cont 'italic))
 
-(defun shr-u (cont)
+(defun shr-tag-u (cont)
   (shr-fontize-cont cont 'underline))
 
-(defun shr-s (cont)
-  (shr-fontize-cont cont 'strikethru))
+(defun shr-tag-s (cont)
+  (shr-fontize-cont cont 'strike-through))
 
-(defun shr-fontize-cont (cont type)
+(defun shr-fontize-cont (cont &rest types)
   (let (shr-start)
     (shr-generic cont)
-    (shr-add-font shr-start (point) type)))
+    (dolist (type types)
+      (shr-add-font (or shr-start (point)) (point) type))))
 
 (defun shr-add-font (start end type)
   (let ((overlay (make-overlay start end)))
     (overlay-put overlay 'face type)))
 
-(defun shr-a (cont)
+(defun shr-tag-a (cont)
   (let ((url (cdr (assq :href cont)))
        shr-start)
     (shr-generic cont)
@@ -129,7 +141,10 @@
 (defun shr-browse-url (widget &rest stuff)
   (browse-url (widget-get widget :url)))
 
-(defun shr-img (cont)
+(defun shr-tag-img (cont)
+  (when (and (> (current-column) 0)
+            (not (eq shr-state 'image)))
+    (insert "\n"))
   (let ((start (point-marker)))
     (let ((alt (cdr (assq :alt cont)))
          (url (cdr (assq :src cont))))
@@ -166,15 +181,17 @@
 (defun shr-put-image (data point alt)
   (if (not (display-graphic-p))
       (insert alt)
-    (let ((image (shr-rescale-image data)))
-      (put-image image point alt))))
+    (let ((image (ignore-errors
+                  (shr-rescale-image data))))
+      (when image
+       (put-image image point 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))
-          (size (image-size image))
+          (size (image-size image t))
           (width (car size))
           (height (cdr size))
           (edges (window-inside-pixel-edges
@@ -196,14 +213,15 @@
                     image)))
       image)))
 
-(defun shr-pre (cont)
+(defun shr-tag-pre (cont)
   (let ((shr-folding-mode nil))
     (shr-ensure-newline)
     (shr-generic cont)
     (shr-ensure-newline)))
 
-(defun shr-blockquote (cont)
-  (shr-pre cont))
+(defun shr-tag-blockquote (cont)
+  (let ((shr-indentation (+ shr-indentation 4)))
+    (shr-tag-pre cont)))
 
 (defun shr-ensure-newline ()
   (unless (zerop (current-column))
@@ -217,19 +235,32 @@
    ((eq shr-folding-mode 'none)
     (insert t))
    (t
-    (let (column)
+    (let ((first t)
+         column)
+      (when (and (string-match "^[ \t\n]" text)
+                (not (bolp)))
+       (insert " "))
       (dolist (elem (split-string text))
        (setq column (current-column))
        (when (> column 0)
-         (if (> (+ column (length elem) 1) shr-width)
-             (insert "\n")
-           (insert " ")))
+         (cond
+          ((> (+ column (length elem) 1) shr-width)
+           (insert "\n"))
+          ((not first)
+           (insert " "))))
+       (setq first nil)
+       (when (and (bolp)
+                  (> shr-indentation 0))
+         (insert (make-string shr-indentation ? )))
        ;; The shr-start is a special variable that is used to pass
        ;; upwards the first point in the buffer where the text really
        ;; starts.
        (unless shr-start
          (setq shr-start (point)))
-       (insert elem))))))
+       (insert elem))
+      (when (and (string-match "[ \t\n]$" text)
+                (not (bolp)))
+       (insert " "))))))
 
 (defun shr-get-image-data (url)
   "Get image data for URL.
@@ -241,6 +272,53 @@
               (search-forward "\r\n\r\n" nil t))
       (buffer-substring (point) (point-max)))))
 
+(defvar shr-list-mode nil)
+
+(defun shr-tag-ul (cont)
+  (shr-ensure-paragraph)
+  (let ((shr-list-mode 'ul))
+    (shr-generic cont)))
+
+(defun shr-tag-ol (cont)
+  (let ((shr-list-mode 1))
+    (shr-generic cont)))
+
+(defun shr-tag-li (cont)
+  (shr-ensure-newline)
+  (if (numberp shr-list-mode)
+      (progn
+       (insert (format "%d " shr-list-mode))
+       (setq shr-list-mode (1+ shr-list-mode)))
+    (insert "* "))
+  (shr-generic cont))
+
+(defun shr-tag-br (cont)
+  (shr-ensure-newline)
+  (shr-generic cont))
+
+(defun shr-tag-h1 (cont)
+  (shr-heading cont 'bold 'underline))
+
+(defun shr-tag-h2 (cont)
+  (shr-heading cont 'bold))
+
+(defun shr-tag-h3 (cont)
+  (shr-heading cont 'italic))
+
+(defun shr-tag-h4 (cont)
+  (shr-heading cont))
+
+(defun shr-tag-h5 (cont)
+  (shr-heading cont))
+
+(defun shr-tag-h6 (cont)
+  (shr-heading cont))
+
+(defun shr-heading (cont &rest types)
+  (shr-ensure-paragraph)
+  (apply #'shr-fontize-cont cont types)
+  (shr-ensure-paragraph))
+
 (provide 'shr)
 
 ;;; shr.el ends here