+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.
(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))
;;; Code:
(require 'gravatar)
+(require 'gnus-art)
(defgroup gnus-gravatar nil
"Gnus Gravatar."
: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"
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 ()
(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))))))
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)
(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))
(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))))
(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 " ")
projects / emacs.git / commitdiff