diff options
| author | Gnus developers | 2010-10-12 22:18:24 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka | 2010-10-12 22:18:24 +0000 |
| commit | ab67634f9dff508ec35159fc72d64c917c106305 (patch) | |
| tree | 16500dd2b09647d1a33067ae81b33239c67dec8b | |
| parent | fe239e8e52c9aa8e0e23790b4a7a12a5da49625a (diff) | |
| download | emacs-ab67634f9dff508ec35159fc72d64c917c106305.tar.gz emacs-ab67634f9dff508ec35159fc72d64c917c106305.zip | |
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.
| -rw-r--r-- | lisp/gnus/ChangeLog | 25 | ||||
| -rw-r--r-- | lisp/gnus/ecomplete.el | 2 | ||||
| -rw-r--r-- | lisp/gnus/gnus-gravatar.el | 58 | ||||
| -rw-r--r-- | lisp/gnus/nnimap.el | 7 | ||||
| -rw-r--r-- | lisp/gnus/rfc2231.el | 18 | ||||
| -rw-r--r-- | lisp/gnus/shr.el | 39 |
6 files changed, 104 insertions, 45 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 7898f380028..53da34ae6ce 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,5 +1,30 @@ | |||
| 1 | 2010-10-12 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 2 | |||
| 3 | * gnus-gravatar.el (gnus-gravatar-too-ugly): Don't test if | ||
| 4 | gnus-article-x-face-too-ugly is bound. | ||
| 5 | |||
| 1 | 2010-10-12 Lars Magne Ingebrigtsen <larsi@gnus.org> | 6 | 2010-10-12 Lars Magne Ingebrigtsen <larsi@gnus.org> |
| 2 | 7 | ||
| 8 | * rfc2231.el (rfc2231-parse-string): Ignore repeated parts. | ||
| 9 | |||
| 10 | * nnimap.el (nnimap-request-rename-group): Unselect by selecting a | ||
| 11 | mailbox that doesn't exist. | ||
| 12 | |||
| 13 | 2010-10-12 Julien Danjou <julien@danjou.info> | ||
| 14 | |||
| 15 | * shr.el (shr-tag-img): Encode URL properly when retrieving. | ||
| 16 | (shr-get-image-data): Encode URL properly when fetching from cache. | ||
| 17 | (shr-tag-img): Use aligned-to spaces to align correctly images. | ||
| 18 | |||
| 19 | * gnus-gravatar.el (gnus-gravatar-insert): Check if buffer is alive | ||
| 20 | before inserting the Gravatar. | ||
| 21 | |||
| 22 | * shr.el (shr-tag-img): Add align attribute support for <img>. | ||
| 23 | |||
| 24 | 2010-10-12 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 25 | |||
| 26 | * gnus-gravatar.el (gnus-art): Required. | ||
| 27 | |||
| 3 | * gnus-sum.el (gnus-summary-mark-as-unread-forward) | 28 | * gnus-sum.el (gnus-summary-mark-as-unread-forward) |
| 4 | (gnus-summary-mark-as-unread-backward, gnus-summary-mark-as-unread): | 29 | (gnus-summary-mark-as-unread-backward, gnus-summary-mark-as-unread): |
| 5 | Remove long obsoleted functions. | 30 | Remove long obsoleted functions. |
diff --git a/lisp/gnus/ecomplete.el b/lisp/gnus/ecomplete.el index 1e9769f757d..33d2ddd6a71 100644 --- a/lisp/gnus/ecomplete.el +++ b/lisp/gnus/ecomplete.el | |||
| @@ -147,7 +147,7 @@ | |||
| 147 | (save-restriction | 147 | (save-restriction |
| 148 | (narrow-to-region (point) (point-at-eol)) | 148 | (narrow-to-region (point) (point-at-eol)) |
| 149 | (while (not (eobp)) | 149 | (while (not (eobp)) |
| 150 | ;; Put the 'region face on any charactes on this line that | 150 | ;; Put the 'region face on any characters on this line that |
| 151 | ;; aren't already highlighted. | 151 | ;; aren't already highlighted. |
| 152 | (unless (get-text-property (point) 'face) | 152 | (unless (get-text-property (point) 'face) |
| 153 | (put-text-property (point) (1+ (point)) 'face 'highlight)) | 153 | (put-text-property (point) (1+ (point)) 'face 'highlight)) |
diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el index 9c130274375..bcc097b7d0f 100644 --- a/lisp/gnus/gnus-gravatar.el +++ b/lisp/gnus/gnus-gravatar.el | |||
| @@ -25,6 +25,7 @@ | |||
| 25 | ;;; Code: | 25 | ;;; Code: |
| 26 | 26 | ||
| 27 | (require 'gravatar) | 27 | (require 'gravatar) |
| 28 | (require 'gnus-art) | ||
| 28 | 29 | ||
| 29 | (defgroup gnus-gravatar nil | 30 | (defgroup gnus-gravatar nil |
| 30 | "Gnus Gravatar." | 31 | "Gnus Gravatar." |
| @@ -42,8 +43,7 @@ | |||
| 42 | :version "24.1" | 43 | :version "24.1" |
| 43 | :group 'gnus-gravatar) | 44 | :group 'gnus-gravatar) |
| 44 | 45 | ||
| 45 | (defcustom gnus-gravatar-too-ugly (if (boundp 'gnus-article-x-face-too-ugly) | 46 | (defcustom gnus-gravatar-too-ugly gnus-article-x-face-too-ugly |
| 46 | gnus-article-x-face-too-ugly) | ||
| 47 | "Regexp matching posters whose avatar shouldn't be shown automatically." | 47 | "Regexp matching posters whose avatar shouldn't be shown automatically." |
| 48 | :type '(choice regexp (const nil)) | 48 | :type '(choice regexp (const nil)) |
| 49 | :version "24.1" | 49 | :version "24.1" |
| @@ -79,32 +79,34 @@ | |||
| 79 | Set image category to CATEGORY." | 79 | Set image category to CATEGORY." |
| 80 | (unless (eq gravatar 'error) | 80 | (unless (eq gravatar 'error) |
| 81 | (gnus-with-article-headers | 81 | (gnus-with-article-headers |
| 82 | (gnus-article-goto-header header) | 82 | ;; The buffer can be gone at this time |
| 83 | (mail-header-narrow-to-field) | 83 | (when (buffer-live-p (current-buffer)) |
| 84 | (let ((real-name (cdr address)) | 84 | (gnus-article-goto-header header) |
| 85 | (mail-address (car address))) | 85 | (mail-header-narrow-to-field) |
| 86 | (when (if real-name ; have a realname, go for it! | 86 | (let ((real-name (cdr address)) |
| 87 | (and (search-forward real-name nil t) | 87 | (mail-address (car address))) |
| 88 | (search-backward real-name nil t)) | 88 | (when (if real-name ; have a realname, go for it! |
| 89 | (and (search-forward mail-address nil t) | 89 | (and (search-forward real-name nil t) |
| 90 | (search-backward mail-address nil t))) | 90 | (search-backward real-name nil t)) |
| 91 | (goto-char (1- (point))) | 91 | (and (search-forward mail-address nil t) |
| 92 | ;; If we're on the " quoting the name, go backward | 92 | (search-backward mail-address nil t))) |
| 93 | (when (looking-at "[\"<]") | 93 | (goto-char (1- (point))) |
| 94 | (goto-char (1- (point)))) | 94 | ;; If we're on the " quoting the name, go backward |
| 95 | ;; Do not do anything if there's already a gravatar. This can | 95 | (when (looking-at "[\"<]") |
| 96 | ;; happens if the buffer has been regenerated in the mean time, for | 96 | (goto-char (1- (point)))) |
| 97 | ;; example we were fetching someaddress, and then we change to | 97 | ;; Do not do anything if there's already a gravatar. This can |
| 98 | ;; another mail with the same someaddress. | 98 | ;; happens if the buffer has been regenerated in the mean time, for |
| 99 | (unless (memq 'gnus-gravatar (text-properties-at (point))) | 99 | ;; example we were fetching someaddress, and then we change to |
| 100 | (let ((inhibit-read-only t) | 100 | ;; another mail with the same someaddress. |
| 101 | (point (point))) | 101 | (unless (memq 'gnus-gravatar (text-properties-at (point))) |
| 102 | (unless (featurep 'xemacs) | 102 | (let ((inhibit-read-only t) |
| 103 | (setq gravatar (append gravatar gnus-gravatar-properties))) | 103 | (point (point))) |
| 104 | (gnus-put-image gravatar nil category) | 104 | (unless (featurep 'xemacs) |
| 105 | (put-text-property point (point) 'gnus-gravatar address) | 105 | (setq gravatar (append gravatar gnus-gravatar-properties))) |
| 106 | (gnus-add-wash-type category) | 106 | (gnus-put-image gravatar nil category) |
| 107 | (gnus-add-image category gravatar)))))))) | 107 | (put-text-property point (point) 'gnus-gravatar address) |
| 108 | (gnus-add-wash-type category) | ||
| 109 | (gnus-add-image category gravatar))))))))) | ||
| 108 | 110 | ||
| 109 | ;;;###autoload | 111 | ;;;###autoload |
| 110 | (defun gnus-treat-from-gravatar () | 112 | (defun gnus-treat-from-gravatar () |
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index b58c7473d51..c6c8787a6c0 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el | |||
| @@ -673,8 +673,11 @@ textual parts.") | |||
| 673 | (deffoo nnimap-request-rename-group (group new-name &optional server) | 673 | (deffoo nnimap-request-rename-group (group new-name &optional server) |
| 674 | (when (nnimap-possibly-change-group nil server) | 674 | (when (nnimap-possibly-change-group nil server) |
| 675 | (with-current-buffer (nnimap-buffer) | 675 | (with-current-buffer (nnimap-buffer) |
| 676 | ;; Make sure we don't have this group open read/write. | 676 | ;; Make sure we don't have this group open read/write by asking |
| 677 | (nnimap-command "EXAMINE %S" (utf7-encode group 7)) | 677 | ;; to examine a mailbox that doesn't exist. This seems to be |
| 678 | ;; the only way that allows us to reliably go back to unselected | ||
| 679 | ;; state on Courier. | ||
| 680 | (nnimap-command "EXAMINE DOES.NOT.EXIST") | ||
| 678 | (setf (nnimap-group nnimap-object) nil) | 681 | (setf (nnimap-group nnimap-object) nil) |
| 679 | (car (nnimap-command "RENAME %S %S" | 682 | (car (nnimap-command "RENAME %S %S" |
| 680 | (utf7-encode group t) (utf7-encode new-name t)))))) | 683 | (utf7-encode group t) (utf7-encode new-name t)))))) |
diff --git a/lisp/gnus/rfc2231.el b/lisp/gnus/rfc2231.el index 7cb1740c635..0b028a08b83 100644 --- a/lisp/gnus/rfc2231.el +++ b/lisp/gnus/rfc2231.el | |||
| @@ -185,11 +185,19 @@ must never cause a Lisp error." | |||
| 185 | in (sort parameters (lambda (e1 e2) | 185 | in (sort parameters (lambda (e1 e2) |
| 186 | (< (or (caddr e1) 0) | 186 | (< (or (caddr e1) 0) |
| 187 | (or (caddr e2) 0)))) | 187 | (or (caddr e2) 0)))) |
| 188 | do (if (or (not (setq elem (assq attribute cparams))) | 188 | do (cond |
| 189 | (and (numberp part) | 189 | ;; First part. |
| 190 | (zerop part))) | 190 | ((or (not (setq elem (assq attribute cparams))) |
| 191 | (push (list attribute value encoded) cparams) | 191 | (and (numberp part) |
| 192 | (setcar (cdr elem) (concat (cadr elem) value)))) | 192 | (zerop part))) |
| 193 | (push (list attribute value encoded) cparams)) | ||
| 194 | ;; Repetition of a part; do nothing. | ||
| 195 | ((and elem | ||
| 196 | (null number)) | ||
| 197 | ) | ||
| 198 | ;; Concatenate continuation parts. | ||
| 199 | (t | ||
| 200 | (setcar (cdr elem) (concat (cadr elem) value))))) | ||
| 193 | ;; Finally decode encoded values. | 201 | ;; Finally decode encoded values. |
| 194 | (cons type (mapcar | 202 | (cons type (mapcar |
| 195 | (lambda (elem) | 203 | (lambda (elem) |
diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index 4031386368c..03c0ec84d5d 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/shr.el | |||
| @@ -344,7 +344,7 @@ Return a string with image data." | |||
| 344 | (with-temp-buffer | 344 | (with-temp-buffer |
| 345 | (mm-disable-multibyte) | 345 | (mm-disable-multibyte) |
| 346 | (when (ignore-errors | 346 | (when (ignore-errors |
| 347 | (url-cache-extract (url-cache-create-filename url)) | 347 | (url-cache-extract (url-cache-create-filename (shr-encode-url url))) |
| 348 | t) | 348 | t) |
| 349 | (when (or (search-forward "\n\n" nil t) | 349 | (when (or (search-forward "\n\n" nil t) |
| 350 | (search-forward "\r\n\r\n" nil t)) | 350 | (search-forward "\r\n\r\n" nil t)) |
| @@ -389,19 +389,40 @@ Return a string with image data." | |||
| 389 | (put-text-property (or shr-start start) (point) 'keymap shr-map) | 389 | (put-text-property (or shr-start start) (point) 'keymap shr-map) |
| 390 | (put-text-property (or shr-start start) (point) 'shr-url url))) | 390 | (put-text-property (or shr-start start) (point) 'shr-url url))) |
| 391 | 391 | ||
| 392 | (defun shr-encode-url (url) | ||
| 393 | "Encode URL." | ||
| 394 | (browse-url-url-encode-chars url "[)$ ]")) | ||
| 395 | |||
| 392 | (defun shr-tag-img (cont) | 396 | (defun shr-tag-img (cont) |
| 393 | (when (and (> (current-column) 0) | 397 | (when (and (> (current-column) 0) |
| 394 | (not (eq shr-state 'image))) | 398 | (not (eq shr-state 'image))) |
| 395 | (insert "\n")) | 399 | (insert "\n")) |
| 396 | (let ((start (point-marker))) | 400 | (let ((alt (cdr (assq :alt cont))) |
| 397 | (let ((alt (cdr (assq :alt cont))) | 401 | (url (cdr (assq :src cont))) |
| 398 | (url (cdr (assq :src cont)))) | 402 | (width (cdr (assq :width cont)))) |
| 403 | ;; Only respect align if width specified. | ||
| 404 | (when width | ||
| 405 | ;; Check that width is not larger than max width, otherwise ignore | ||
| 406 | ;; align | ||
| 407 | (let ((max-width (* fill-column (frame-char-width))) | ||
| 408 | (width (string-to-number width))) | ||
| 409 | (when (< width max-width) | ||
| 410 | (let ((align (cdr (assq :align cont)))) | ||
| 411 | (cond ((string= align "right") | ||
| 412 | (insert (propertize | ||
| 413 | " " 'display | ||
| 414 | `(space . (:align-to ,(list (- max-width width))))))) | ||
| 415 | ((string= align "center") | ||
| 416 | (insert (propertize | ||
| 417 | " " 'display | ||
| 418 | `(space . (:balign-to ,(list (- (/ max-width 2) width)))))))))))) | ||
| 419 | (let ((start (point-marker))) | ||
| 399 | (when (zerop (length alt)) | 420 | (when (zerop (length alt)) |
| 400 | (setq alt "[img]")) | 421 | (setq alt "[img]")) |
| 401 | (cond | 422 | (cond |
| 402 | ((and (not shr-inhibit-images) | 423 | ((and (not shr-inhibit-images) |
| 403 | (string-match "\\`cid:" url)) | 424 | (string-match "\\`cid:" url)) |
| 404 | (let ((url (substring url (match-end 0))) | 425 | (let ((url (substring url (match-end 0))) |
| 405 | image) | 426 | image) |
| 406 | (if (or (not shr-content-function) | 427 | (if (or (not shr-content-function) |
| 407 | (not (setq image (funcall shr-content-function url)))) | 428 | (not (setq image (funcall shr-content-function url)))) |
| @@ -415,12 +436,12 @@ Return a string with image data." | |||
| 415 | (if (> (length alt) 8) | 436 | (if (> (length alt) 8) |
| 416 | (shr-insert (substring alt 0 8)) | 437 | (shr-insert (substring alt 0 8)) |
| 417 | (shr-insert alt)))) | 438 | (shr-insert alt)))) |
| 418 | ((url-is-cached (browse-url-url-encode-chars url "[&)$ ]")) | 439 | ((url-is-cached (shr-encode-url url)) |
| 419 | (shr-put-image (shr-get-image-data url) (point) alt)) | 440 | (shr-put-image (shr-get-image-data url) (point) alt)) |
| 420 | (t | 441 | (t |
| 421 | (insert alt) | 442 | (insert alt) |
| 422 | (ignore-errors | 443 | (ignore-errors |
| 423 | (url-retrieve url 'shr-image-fetched | 444 | (url-retrieve (shr-encode-url url) 'shr-image-fetched |
| 424 | (list (current-buffer) start (point-marker)) | 445 | (list (current-buffer) start (point-marker)) |
| 425 | t)))) | 446 | t)))) |
| 426 | (insert " ") | 447 | (insert " ") |