Mercurial > emacs
changeset 110777:895607aec71e
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.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Tue, 05 Oct 2010 22:43:06 +0000 |
| parents | 073caec7510f |
| children | 5a595f515d1c |
| files | 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 |
| diffstat | 9 files changed, 168 insertions(+), 46 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog Tue Oct 05 16:20:24 2010 +0200 +++ b/lisp/gnus/ChangeLog Tue Oct 05 22:43:06 2010 +0000 @@ -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.
--- a/lisp/gnus/gnus-art.el Tue Oct 05 16:20:24 2010 +0200 +++ b/lisp/gnus/gnus-art.el Tue Oct 05 22:43:06 2010 +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
--- a/lisp/gnus/gnus-group.el Tue Oct 05 16:20:24 2010 +0200 +++ b/lisp/gnus/gnus-group.el Tue Oct 05 22:43:06 2010 +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: ")
--- a/lisp/gnus/gnus-html.el Tue Oct 05 16:20:24 2010 +0200 +++ b/lisp/gnus/gnus-html.el Tue Oct 05 22:43:06 2010 +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."
--- a/lisp/gnus/gnus-sum.el Tue Oct 05 16:20:24 2010 +0200 +++ b/lisp/gnus/gnus-sum.el Tue Oct 05 22:43:06 2010 +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)))
--- a/lisp/gnus/mm-decode.el Tue Oct 05 16:20:24 2010 +0200 +++ b/lisp/gnus/mm-decode.el Tue Oct 05 22:43:06 2010 +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)))
--- a/lisp/gnus/nnimap.el Tue Oct 05 16:20:24 2010 +0200 +++ b/lisp/gnus/nnimap.el Tue Oct 05 22:43:06 2010 +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)
--- a/lisp/gnus/nnir.el Tue Oct 05 16:20:24 2010 +0200 +++ b/lisp/gnus/nnir.el Tue Oct 05 22:43:06 2010 +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)
--- a/lisp/gnus/shr.el Tue Oct 05 16:20:24 2010 +0200 +++ b/lisp/gnus/shr.el Tue Oct 05 22:43:06 2010 +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)