Mercurial > emacs
changeset 110957:627742e646c4
Merge changes made in Gnus trunk.
gnus-gravatar.el (gnus-art): Required.
shr.el (shr-tag-img): Add align attribute support for <img>.
gnus-gravatar.el (gnus-gravatar-insert): Check if buffer is alive.
shr.el (shr-tag-img): Encode URL properly when retrieving.
shr.el (shr-get-image-data): Encode URL properly when fetching from cache.
shr.el (shr-tag-img): Use aligned-to spaces to align correctly images.
nnimap.el (nnimap-request-rename-group): Unselect by selecting a mailbox that doesn't exist.
rfc2231.el (rfc2231-parse-string): Ignore repeated parts.
gnus-gravatar.el (gnus-gravatar-too-ugly): Don't test if gnus-article-x-face-too-ugly is bound.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Tue, 12 Oct 2010 22:18:24 +0000 |
| parents | 07776ed6876f |
| children | ea91aa0b9743 |
| files | lisp/gnus/ChangeLog lisp/gnus/ecomplete.el lisp/gnus/gnus-gravatar.el lisp/gnus/nnimap.el lisp/gnus/rfc2231.el lisp/gnus/shr.el |
| diffstat | 6 files changed, 104 insertions(+), 45 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog Tue Oct 12 14:03:09 2010 -0700 +++ b/lisp/gnus/ChangeLog Tue Oct 12 22:18:24 2010 +0000 @@ -1,5 +1,30 @@ +2010-10-12 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-gravatar.el (gnus-gravatar-too-ugly): Don't test if + gnus-article-x-face-too-ugly is bound. + 2010-10-12 Lars Magne Ingebrigtsen <larsi@gnus.org> + * rfc2231.el (rfc2231-parse-string): Ignore repeated parts. + + * nnimap.el (nnimap-request-rename-group): Unselect by selecting a + mailbox that doesn't exist. + +2010-10-12 Julien Danjou <julien@danjou.info> + + * shr.el (shr-tag-img): Encode URL properly when retrieving. + (shr-get-image-data): Encode URL properly when fetching from cache. + (shr-tag-img): Use aligned-to spaces to align correctly images. + + * gnus-gravatar.el (gnus-gravatar-insert): Check if buffer is alive + before inserting the Gravatar. + + * shr.el (shr-tag-img): Add align attribute support for <img>. + +2010-10-12 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-gravatar.el (gnus-art): Required. + * gnus-sum.el (gnus-summary-mark-as-unread-forward) (gnus-summary-mark-as-unread-backward, gnus-summary-mark-as-unread): Remove long obsoleted functions.
--- a/lisp/gnus/ecomplete.el Tue Oct 12 14:03:09 2010 -0700 +++ b/lisp/gnus/ecomplete.el Tue Oct 12 22:18:24 2010 +0000 @@ -147,7 +147,7 @@ (save-restriction (narrow-to-region (point) (point-at-eol)) (while (not (eobp)) - ;; Put the 'region face on any charactes on this line that + ;; Put the 'region face on any characters on this line that ;; aren't already highlighted. (unless (get-text-property (point) 'face) (put-text-property (point) (1+ (point)) 'face 'highlight))
--- a/lisp/gnus/gnus-gravatar.el Tue Oct 12 14:03:09 2010 -0700 +++ b/lisp/gnus/gnus-gravatar.el Tue Oct 12 22:18:24 2010 +0000 @@ -25,6 +25,7 @@ ;;; Code: (require 'gravatar) +(require 'gnus-art) (defgroup gnus-gravatar nil "Gnus Gravatar." @@ -42,8 +43,7 @@ :version "24.1" :group 'gnus-gravatar) -(defcustom gnus-gravatar-too-ugly (if (boundp 'gnus-article-x-face-too-ugly) - gnus-article-x-face-too-ugly) +(defcustom gnus-gravatar-too-ugly gnus-article-x-face-too-ugly "Regexp matching posters whose avatar shouldn't be shown automatically." :type '(choice regexp (const nil)) :version "24.1" @@ -79,32 +79,34 @@ Set image category to CATEGORY." (unless (eq gravatar 'error) (gnus-with-article-headers - (gnus-article-goto-header header) - (mail-header-narrow-to-field) - (let ((real-name (cdr address)) - (mail-address (car address))) - (when (if real-name ; have a realname, go for it! - (and (search-forward real-name nil t) - (search-backward real-name nil t)) - (and (search-forward mail-address nil t) - (search-backward mail-address nil t))) - (goto-char (1- (point))) - ;; If we're on the " quoting the name, go backward - (when (looking-at "[\"<]") - (goto-char (1- (point)))) - ;; Do not do anything if there's already a gravatar. This can - ;; happens if the buffer has been regenerated in the mean time, for - ;; example we were fetching someaddress, and then we change to - ;; another mail with the same someaddress. - (unless (memq 'gnus-gravatar (text-properties-at (point))) - (let ((inhibit-read-only t) - (point (point))) - (unless (featurep 'xemacs) - (setq gravatar (append gravatar gnus-gravatar-properties))) - (gnus-put-image gravatar nil category) - (put-text-property point (point) 'gnus-gravatar address) - (gnus-add-wash-type category) - (gnus-add-image category gravatar)))))))) + ;; The buffer can be gone at this time + (when (buffer-live-p (current-buffer)) + (gnus-article-goto-header header) + (mail-header-narrow-to-field) + (let ((real-name (cdr address)) + (mail-address (car address))) + (when (if real-name ; have a realname, go for it! + (and (search-forward real-name nil t) + (search-backward real-name nil t)) + (and (search-forward mail-address nil t) + (search-backward mail-address nil t))) + (goto-char (1- (point))) + ;; If we're on the " quoting the name, go backward + (when (looking-at "[\"<]") + (goto-char (1- (point)))) + ;; Do not do anything if there's already a gravatar. This can + ;; happens if the buffer has been regenerated in the mean time, for + ;; example we were fetching someaddress, and then we change to + ;; another mail with the same someaddress. + (unless (memq 'gnus-gravatar (text-properties-at (point))) + (let ((inhibit-read-only t) + (point (point))) + (unless (featurep 'xemacs) + (setq gravatar (append gravatar gnus-gravatar-properties))) + (gnus-put-image gravatar nil category) + (put-text-property point (point) 'gnus-gravatar address) + (gnus-add-wash-type category) + (gnus-add-image category gravatar))))))))) ;;;###autoload (defun gnus-treat-from-gravatar ()
--- a/lisp/gnus/nnimap.el Tue Oct 12 14:03:09 2010 -0700 +++ b/lisp/gnus/nnimap.el Tue Oct 12 22:18:24 2010 +0000 @@ -673,8 +673,11 @@ (deffoo nnimap-request-rename-group (group new-name &optional server) (when (nnimap-possibly-change-group nil server) (with-current-buffer (nnimap-buffer) - ;; Make sure we don't have this group open read/write. - (nnimap-command "EXAMINE %S" (utf7-encode group 7)) + ;; Make sure we don't have this group open read/write by asking + ;; to examine a mailbox that doesn't exist. This seems to be + ;; the only way that allows us to reliably go back to unselected + ;; state on Courier. + (nnimap-command "EXAMINE DOES.NOT.EXIST") (setf (nnimap-group nnimap-object) nil) (car (nnimap-command "RENAME %S %S" (utf7-encode group t) (utf7-encode new-name t))))))
--- a/lisp/gnus/rfc2231.el Tue Oct 12 14:03:09 2010 -0700 +++ b/lisp/gnus/rfc2231.el Tue Oct 12 22:18:24 2010 +0000 @@ -185,11 +185,19 @@ in (sort parameters (lambda (e1 e2) (< (or (caddr e1) 0) (or (caddr e2) 0)))) - do (if (or (not (setq elem (assq attribute cparams))) - (and (numberp part) - (zerop part))) - (push (list attribute value encoded) cparams) - (setcar (cdr elem) (concat (cadr elem) value)))) + do (cond + ;; First part. + ((or (not (setq elem (assq attribute cparams))) + (and (numberp part) + (zerop part))) + (push (list attribute value encoded) cparams)) + ;; Repetition of a part; do nothing. + ((and elem + (null number)) + ) + ;; Concatenate continuation parts. + (t + (setcar (cdr elem) (concat (cadr elem) value))))) ;; Finally decode encoded values. (cons type (mapcar (lambda (elem)
--- a/lisp/gnus/shr.el Tue Oct 12 14:03:09 2010 -0700 +++ b/lisp/gnus/shr.el Tue Oct 12 22:18:24 2010 +0000 @@ -344,7 +344,7 @@ (with-temp-buffer (mm-disable-multibyte) (when (ignore-errors - (url-cache-extract (url-cache-create-filename url)) + (url-cache-extract (url-cache-create-filename (shr-encode-url url))) t) (when (or (search-forward "\n\n" nil t) (search-forward "\r\n\r\n" nil t)) @@ -389,19 +389,40 @@ (put-text-property (or shr-start start) (point) 'keymap shr-map) (put-text-property (or shr-start start) (point) 'shr-url url))) +(defun shr-encode-url (url) + "Encode URL." + (browse-url-url-encode-chars url "[)$ ]")) + (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)))) + (let ((alt (cdr (assq :alt cont))) + (url (cdr (assq :src cont))) + (width (cdr (assq :width cont)))) + ;; Only respect align if width specified. + (when width + ;; Check that width is not larger than max width, otherwise ignore + ;; align + (let ((max-width (* fill-column (frame-char-width))) + (width (string-to-number width))) + (when (< width max-width) + (let ((align (cdr (assq :align cont)))) + (cond ((string= align "right") + (insert (propertize + " " 'display + `(space . (:align-to ,(list (- max-width width))))))) + ((string= align "center") + (insert (propertize + " " 'display + `(space . (:balign-to ,(list (- (/ max-width 2) width)))))))))))) + (let ((start (point-marker))) (when (zerop (length alt)) - (setq alt "[img]")) + (setq alt "[img]")) (cond ((and (not shr-inhibit-images) - (string-match "\\`cid:" url)) - (let ((url (substring url (match-end 0))) + (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)))) @@ -415,12 +436,12 @@ (if (> (length alt) 8) (shr-insert (substring alt 0 8)) (shr-insert alt)))) - ((url-is-cached (browse-url-url-encode-chars url "[&)$ ]")) + ((url-is-cached (shr-encode-url url)) (shr-put-image (shr-get-image-data url) (point) alt)) (t (insert alt) (ignore-errors - (url-retrieve url 'shr-image-fetched + (url-retrieve (shr-encode-url url) 'shr-image-fetched (list (current-buffer) start (point-marker)) t)))) (insert " ")