emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

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


From: Katsumi Yamaoka
Subject: [Emacs-diffs] /srv/bzr/emacs/trunk r101805: Merge changes made in Gnus trunk.
Date: Tue, 05 Oct 2010 22:43:06 +0000
User-agent: Bazaar (2.0.3)

------------------------------------------------------------
revno: 101805
author: Lars Magne Ingebrigtsen <address@hidden>
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Tue 2010-10-05 22:43:06 +0000
message:
  Merge changes made in Gnus trunk.
  
  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.
modified:
  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
=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2010-10-05 13:19:07 +0000
+++ b/lisp/gnus/ChangeLog       2010-10-05 22:43:06 +0000
@@ -1,3 +1,41 @@
+2010-10-05  Lars Magne Ingebrigtsen  <address@hidden>
+
+       * 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  <address@hidden>
 
        * gnus-html.el (gnus-html-wash-images): Rescale image from cid too.
@@ -41,6 +79,9 @@
 
 2010-10-04  Lars Magne Ingebrigtsen  <address@hidden>
 
+       * 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.
 

=== modified file 'lisp/gnus/gnus-art.el'
--- a/lisp/gnus/gnus-art.el     2010-10-03 02:07:11 +0000
+++ b/lisp/gnus/gnus-art.el     2010-10-05 22:43:06 +0000
@@ -1639,6 +1639,12 @@
   :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

=== modified file 'lisp/gnus/gnus-group.el'
--- a/lisp/gnus/gnus-group.el   2010-10-04 22:26:51 +0000
+++ b/lisp/gnus/gnus-group.el   2010-10-05 22:43:06 +0000
@@ -2651,7 +2651,10 @@
   "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: ")

=== modified file 'lisp/gnus/gnus-html.el'
--- a/lisp/gnus/gnus-html.el    2010-10-05 13:19:07 +0000
+++ b/lisp/gnus/gnus-html.el    2010-10-05 22:43:06 +0000
@@ -57,12 +57,6 @@
   :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 @@
                       (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."

=== modified file 'lisp/gnus/gnus-sum.el'
--- a/lisp/gnus/gnus-sum.el     2010-10-04 22:26:51 +0000
+++ b/lisp/gnus/gnus-sum.el     2010-10-05 22:43:06 +0000
@@ -4985,6 +4985,10 @@
    (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 @@
                        (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)))

=== modified file 'lisp/gnus/mm-decode.el'
--- a/lisp/gnus/mm-decode.el    2010-10-05 02:08:37 +0000
+++ b/lisp/gnus/mm-decode.el    2010-10-05 22:43:06 +0000
@@ -1684,7 +1684,16 @@
 (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)))

=== modified file 'lisp/gnus/nnimap.el'
--- a/lisp/gnus/nnimap.el       2010-10-04 22:26:51 +0000
+++ b/lisp/gnus/nnimap.el       2010-10-05 22:43:06 +0000
@@ -926,7 +926,8 @@
                     (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)

=== modified file 'lisp/gnus/nnir.el'
--- a/lisp/gnus/nnir.el 2010-10-04 22:26:51 +0000
+++ b/lisp/gnus/nnir.el 2010-10-05 22:43:06 +0000
@@ -792,40 +792,30 @@
          (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)

=== modified file 'lisp/gnus/shr.el'
--- a/lisp/gnus/shr.el  2010-10-05 10:46:15 +0000
+++ b/lisp/gnus/shr.el  2010-10-05 22:43:06 +0000
@@ -52,10 +52,16 @@
   :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 @@
       (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 @@
   (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 @@
        (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 @@
          (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 @@
                           (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 @@
   (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)


reply via email to

[Prev in Thread] Current Thread [Next in Thread]