]> code.delx.au - gnu-emacs/commitdiff
Merge changes made in Gnus trunk.
authorLars Magne Ingebrigtsen <larsi@gnus.org>
Tue, 5 Oct 2010 22:43:06 +0000 (22:43 +0000)
committerKatsumi Yamaoka <yamaoka@jpl.org>
Tue, 5 Oct 2010 22:43:06 +0000 (22:43 +0000)
mm-decode.el (mm-shr): Bind shr-blocked-images to gnus-blocked-images.
shr.el (shr-tag-table): Put all the images after the table.
shr.el (shr-tag-table): Really inhibit images inside the table.
shr.el (shr-collect-overlays): Copy over overlays from the TD elements to the main document.
nnimap.el (nnimap-request-newgroups): Return success.
gnus-group.el (gnus-group-make-group): Doc fix.
nnir.el (nnir-retrieve-headers): Don't bug out on invalid data.
gnus-sum.el (gnus-article-sort-by-most-recent-date): New function, added for symmetry.
mm-decode.el (mm-shr): Allow displaying cid: images from shr.el.
shr.el (shr-insert-table): Bind free variable.
gnus-art.el (gnus-blocked-images): Move variable here.
mm-decode.el (mm-shr): Require shr.
shr.el (shr-tag-img): Shorten ALT texts and allow them to be line-broken.
shr.el (shr-tag-img): Ignore image fetching errors.
shr.el (shr-overlays-in-region): Compute overlay positions correctly.
gnus-html.el (gnus-html-schedule-image-fetching): Protect against invalid URLs.

lisp/gnus/ChangeLog
lisp/gnus/gnus-art.el
lisp/gnus/gnus-group.el
lisp/gnus/gnus-html.el
lisp/gnus/gnus-sum.el
lisp/gnus/mm-decode.el
lisp/gnus/nnimap.el
lisp/gnus/nnir.el
lisp/gnus/shr.el

index 241c8148dc1243b22932fd6de50fce67dd6892cc..1217f548a6af2c3b5bbe708447ae67afacce3735 100644 (file)
@@ -1,3 +1,41 @@
+2010-10-05  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus-html.el (gnus-html-schedule-image-fetching): Protect against
+       invalid URLs.
+
+       * shr.el (shr-tag-img): Shorten ALT texts and allow them to be
+       line-broken.
+       (shr-tag-img): Ignore image fetching errors.
+       (shr-overlays-in-region): Compute overlay positions correctly.
+
+       * mm-decode.el (mm-shr): Require shr.
+
+       * gnus-art.el (gnus-blocked-images): Move variable here.
+
+       * shr.el (shr-insert-table): Bind free variable.
+
+       * mm-decode.el (mm-shr): Bind shr-content-function.
+
+       * shr.el (shr-content-function): New variable.
+
+       * gnus-sum.el (gnus-article-sort-by-most-recent-date): New function,
+       added for symmetry.
+
+       * nnir.el (nnir-retrieve-headers): Don't bug out on invalid data.
+
+       * gnus-group.el (gnus-group-make-group): Doc fix.
+
+       * nnimap.el (nnimap-request-newgroups): Return success.
+
+       * shr.el (shr-find-elements): New function.
+       (shr-tag-table): Put all the images after the table.
+       (shr-tag-table): Really inhibit images inside the table.
+       (shr-collect-overlays): Copy over overlays from the TD elements to the
+       main document.
+
+       * mm-decode.el (mm-shr): Bind shr-blocked-images to
+       gnus-blocked-images.
+
 2010-10-05  Julien Danjou  <julien@danjou.info>
 
        * gnus-html.el (gnus-html-wash-images): Rescale image from cid too.
@@ -41,6 +79,9 @@
 
 2010-10-04  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
+       * nnimap.el (nnimap-open-connection): Give an error if nnimap-stream is
+       unknown.
+
        * shr.el (shr-tag-blockquote): Ensure paragraph after quote, too.
        (shr-get-image-data): Ensure against the cache file missing.
 
index d96df61a1f882f50cf24e24a17ccfc5aaedbf347..d7dcf9017135daf218133b00da1a38afaf912f7f 100644 (file)
@@ -1639,6 +1639,12 @@ This requires GNU Libidn, and by default only enabled if it is found."
   :group 'gnus-article
   :type 'boolean)
 
+(defcustom gnus-blocked-images "."
+  "Images that have URLs matching this regexp will be blocked."
+  :version "24.1"
+  :group 'gnus-art
+  :type 'regexp)
+
 ;;; Internal variables
 
 (defvar gnus-english-month-names
index d9e36ae6eaedd508052c1c5e5fa50654127b9382..a700b5ee8cf963c90f7ee8c5fd1e300595ab48d7 100644 (file)
@@ -2651,7 +2651,10 @@ The user will be prompted for GROUP."
   "Add a new newsgroup.
 The user will be prompted for a NAME, for a select METHOD, and an
 ADDRESS.  NAME should be a human-readable string (i.e., not be encoded
-even if it contains non-ASCII characters) unless ENCODED is non-nil."
+even if it contains non-ASCII characters) unless ENCODED is non-nil.
+
+If the backend supports it, the group will also be created on the
+server."
   (interactive
    (list
     (gnus-read-group "Group name: ")
index d30b574b55e510bca867ae25694299698bc37cd3..a21c4784d80d5f066902fba96a7186be106dd05f 100644 (file)
   :group 'gnus-art
   :type 'integer)
 
-(defcustom gnus-blocked-images "."
-  "Images that have URLs matching this regexp will be blocked."
-  :version "24.1"
-  :group 'gnus-art
-  :type 'regexp)
-
 (defcustom gnus-max-image-proportion 0.9
   "How big pictures displayed are in relation to the window they're in.
 A value of 0.7 means that they are allowed to take up 70% of the
@@ -371,7 +365,8 @@ Use ALT-TEXT for the image string."
                       (help-function-arglist 'url-retrieve)))
             4)
       (setq args (nconc args (list t))))
-    (apply #'url-retrieve args)))
+    (ignore-errors
+      (apply #'url-retrieve args))))
 
 (defun gnus-html-image-fetched (status buffer image)
   "Callback function called when image has been fetched."
index a0e38d4f4f5b1e11e5dc45f0d32bb1786e5bfaf4..484837f7ff96328c1797d43325819455d1afff6e 100644 (file)
@@ -4985,6 +4985,10 @@ Unscored articles will be counted as having a score of zero."
    (t
     (gnus-thread-total-score-1 (list thread)))))
 
+(defun gnus-article-sort-by-most-recent-number (h1 h2)
+  "Sort articles by number."
+  (gnus-article-sort-by-number h1 h2))
+
 (defun gnus-thread-sort-by-most-recent-number (h1 h2)
   "Sort threads such that the thread with the most recently arrived article comes first."
   (> (gnus-thread-highest-number h1) (gnus-thread-highest-number h2)))
@@ -4995,6 +4999,10 @@ Unscored articles will be counted as having a score of zero."
                        (mail-header-number header))
                      (message-flatten-list thread))))
 
+(defun gnus-article-sort-by-most-recent-date (h1 h2)
+  "Sort articles by number."
+  (gnus-article-sort-by-date h1 h2))
+
 (defun gnus-thread-sort-by-most-recent-date (h1 h2)
   "Sort threads such that the thread with the most recently dated article comes first."
   (> (gnus-thread-latest-date h1) (gnus-thread-latest-date h2)))
index edbd252c3c8f80bbb12011392f9e7db996094000..70b735a70f93e7c2c1fd7e8ee20d14d2482f5dde 100644 (file)
@@ -1684,7 +1684,16 @@ If RECURSIVE, search recursively."
 (declare-function shr-insert-document "shr" (dom))
 
 (defun mm-shr (handle)
+  ;; Require since we bind its variables.
+  (require 'shr)
   (let ((article-buffer (current-buffer))
+       (shr-blocked-images (with-current-buffer gnus-summary-buffer
+                             gnus-blocked-images))
+       (shr-content-function (lambda (id)
+                               (let ((handle (mm-get-content-id id)))
+                                 (when handle
+                                   (mm-with-part handle
+                                     (buffer-string))))))
        charset)
     (unless handle
       (setq handle (mm-dissect-buffer t)))
index c3c25cbf1942acc5dbf2a4fcfb7837240670cd16..d56e2f4b76ed50177907a61ed1e1fae469351f23 100644 (file)
@@ -926,7 +926,8 @@ textual parts.")
                     (nnimap-get-groups)))
       (unless (assoc group nnimap-current-infos)
        ;; Insert dummy numbers here -- they don't matter.
-       (insert (format "%S 0 1 y\n" group))))))
+       (insert (format "%S 0 1 y\n" group))))
+    t))
 
 (deffoo nnimap-retrieve-group-data-early (server infos)
   (when (nnimap-possibly-change-group nil server)
index baba9e0098a60844585e75e029a47a5175db846a..7a5380c52bbdcb4c4f7e0831333392fb5e2592dc 100644 (file)
@@ -792,40 +792,30 @@ and show thread that contains this article."
          (if nnir-get-article-nov-override-function
              (setq novitem (funcall nnir-get-article-nov-override-function
                                     artitem))
-         ;; else, set novitem through nnheader-parse-nov/nnheader-parse-head
+           ;; else, set novitem through nnheader-parse-nov/nnheader-parse-head
            (case (setq foo (gnus-retrieve-headers (list artno)
                                                   artfullgroup nil))
              (nov
               (goto-char (point-min))
-              (setq novitem (nnheader-parse-nov))
-              (unless novitem
-                (pop-to-buffer nntp-server-buffer)
-                (error
-                 "nnheader-parse-nov returned nil for article %s in group %s"
-                 artno artfullgroup)))
+              (setq novitem (nnheader-parse-nov)))
              (headers
               (goto-char (point-min))
-              (setq novitem (nnheader-parse-head))
-              (unless novitem
-                (pop-to-buffer nntp-server-buffer)
-                (error
-                 "nnheader-parse-head returned nil for article %s in group %s"
-                 artno artfullgroup)))
+              (setq novitem (nnheader-parse-head)))
              (t (error "Unknown header type %s while requesting article %s of group %s"
                        foo artno artfullgroup)))))
        ;; replace article number in original group with article number
         ;; in nnir group
-        (mail-header-set-number novitem art)
-        (mail-header-set-from novitem
-                              (mail-header-from novitem))
-        (mail-header-set-subject
-         novitem
-         (format "[%d: %s/%d] %s"
-                 artrsv artgroup artno
-                 (mail-header-subject novitem)))
-        ;;-(mail-header-set-extra novitem nil)
-        (push novitem novdata)
-        (setq artlist (cdr artlist)))
+       (when novitem
+         (mail-header-set-number novitem art)
+         (mail-header-set-from novitem
+                               (mail-header-from novitem))
+         (mail-header-set-subject
+          novitem
+          (format "[%d: %s/%d] %s"
+                  artrsv artgroup artno
+                  (mail-header-subject novitem)))
+         (push novitem novdata)
+         (setq artlist (cdr artlist))))
       (setq novdata (nreverse novdata))
       (set-buffer nntp-server-buffer) (erase-buffer)
       (mapc 'nnheader-insert-nov novdata)
index f905bf5ac050da3d8ec126180b6afeb6df501f90..2d5d4d623fbcb8bd5dd505372f50ac9c63cc9554 100644 (file)
@@ -52,10 +52,16 @@ fit these criteria."
   :group 'shr
   :type 'regexp)
 
+(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
+cid: URL as the argument.")
+
 (defvar shr-folding-mode nil)
 (defvar shr-state nil)
 (defvar shr-start nil)
 (defvar shr-indentation 0)
+(defvar shr-inhibit-images nil)
 
 (defvar shr-width 70)
 
@@ -204,16 +210,30 @@ redirects somewhere else."
       (when (zerop (length alt))
        (setq alt "[img]"))
       (cond
-       ((and shr-blocked-images
-            (string-match shr-blocked-images url))
-       (insert alt))
+       ((and (not shr-inhibit-images)
+            (string-match "\\`cid:" url))
+       (let ((url (substring url (match-end 0)))
+             image)
+         (if (or (not shr-content-function)
+                 (not (setq image (funcall shr-content-function url))))
+             (insert alt)
+           (shr-put-image image (point) alt))))
+       ((or shr-inhibit-images
+           (and shr-blocked-images
+                (string-match shr-blocked-images url)))
+       (setq shr-start (point))
+       (let ((shr-state 'space))
+         (if (> (length alt) 8)
+             (shr-insert (substring alt 0 8))
+           (shr-insert alt))))
        ((url-is-cached (browse-url-url-encode-chars url "[&)$ ]"))
        (shr-put-image (shr-get-image-data url) (point) alt))
        (t
        (insert alt)
-       (url-retrieve url 'shr-image-fetched
-                     (list (current-buffer) start (point-marker))
-                     t)))
+       (ignore-errors
+         (url-retrieve url 'shr-image-fetched
+                       (list (current-buffer) start (point-marker))
+                       t))))
       (insert " ")
       (put-text-property start (point) 'keymap shr-map)
       (put-text-property start (point) 'shr-alt alt)
@@ -411,11 +431,23 @@ Return a string with image data."
   (shr-ensure-paragraph)
   (setq cont (or (cdr (assq 'tbody cont))
                 cont))
-  (let* ((columns (shr-column-specs cont))
+  (let* ((shr-inhibit-images t)
+        (columns (shr-column-specs cont))
         (suggested-widths (shr-pro-rate-columns columns))
         (sketch (shr-make-table cont suggested-widths))
         (sketch-widths (shr-table-widths sketch (length suggested-widths))))
-    (shr-insert-table (shr-make-table cont sketch-widths t) sketch-widths)))
+    (shr-insert-table (shr-make-table cont sketch-widths t) sketch-widths))
+  (dolist (elem (shr-find-elements cont 'img))
+    (shr-tag-img (cdr elem))))
+
+(defun shr-find-elements (cont type)
+  (let (result)
+    (dolist (elem cont)
+      (cond ((eq (car elem) type)
+            (push elem result))
+           ((consp (cdr elem))
+            (setq result (nconc (shr-find-elements (cdr elem) type) result)))))
+    (nreverse result)))
 
 (defun shr-insert-table (table widths)
   (shr-insert-table-ruler widths)
@@ -430,11 +462,20 @@ Return a string with image data."
        (insert "|\n"))
       (dolist (column row)
        (goto-char start)
-       (let ((lines (split-string (nth 2 column) "\n")))
+       (let ((lines (split-string (nth 2 column) "\n"))
+             (overlay-lines (nth 3 column))
+             overlay overlay-line)
          (dolist (line lines)
+           (setq overlay-line (pop overlay-lines))
            (when (> (length line) 0)
              (end-of-line)
              (insert line "|")
+             (dolist (overlay overlay-line)
+               (let ((o (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)))))
              (forward-line 1)))
          ;; Add blank lines at padding at the bottom of the TD,
          ;; possibly.
@@ -495,7 +536,34 @@ Return a string with image data."
          (when (> (- width (current-column)) 0)
            (insert (make-string (- width (current-column)) ? )))
          (forward-line 1)))
-      (list max (count-lines (point-min) (point-max)) (buffer-string)))))
+      (list max
+           (count-lines (point-min) (point-max))
+           (buffer-string)
+           (and fill
+                (shr-collect-overlays))))))
+
+(defun shr-collect-overlays ()
+  (save-excursion
+    (goto-char (point-min))
+    (let ((overlays nil))
+      (while (not (eobp))
+       (push (shr-overlays-in-region (point) (line-end-position))
+             overlays)
+       (forward-line 1))
+      (nreverse overlays))))
+
+(defun shr-overlays-in-region (start end)
+  (let (result)
+    (dolist (overlay (overlays-in start end))
+      (push (list (if (> start (overlay-start overlay))
+                     (- end start)
+                   (- end (overlay-start overlay)))
+                 (if (< end (overlay-end overlay))
+                     0
+                   (- end (overlay-end overlay)))
+                 (overlay-properties overlay))
+           result))
+    (nreverse result)))
 
 (defun shr-pro-rate-columns (columns)
   (let ((total-percentage 0)
@@ -523,8 +591,8 @@ Return a string with image data."
                           (string-match "\\([0-9]+\\)%" width))
                  (aset columns i
                        (/ (string-to-number (match-string 1 width))
-                          100.0)))))
-           (setq i (1+ i))))))
+                          100.0))))
+             (setq i (1+ i)))))))
     columns))
 
 (defun shr-count (cont elem)
@@ -538,7 +606,8 @@ Return a string with image data."
   (let ((max 0))
     (dolist (row cont)
       (when (eq (car row) 'tr)
-       (setq max (max max (shr-count (cdr row) 'td)))))
+       (setq max (max max (+ (shr-count (cdr row) 'td)
+                             (shr-count (cdr row) 'th))))))
     max))
 
 (provide 'shr)