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.
This commit is contained in:
Gnus developers
Katsumi Yamaoka
parent
fe239e8e52
commit
ab67634f9d
6 changed files with 104 additions and 45 deletions
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
|
|
|
|||
|
|
@ -673,8 +673,11 @@ textual parts.")
|
|||
(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))))))
|
||||
|
|
|
|||
|
|
@ -185,11 +185,19 @@ must never cause a Lisp error."
|
|||
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)
|
||||
|
|
|
|||
|
|
@ -344,7 +344,7 @@ Return a string with image data."
|
|||
(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 @@ Return a string with image data."
|
|||
(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 @@ Return a string with image data."
|
|||
(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 " ")
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue