X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-gravatar.el;h=de373cfdf051cb41cafa074bf1dd99df627fd279;hb=8339220cc25db3fbdab4367d6252e596bddd9cb1;hp=3edf34895a6ca1af7d3b00da985cbf383346eedc;hpb=d5ca78e640b975f65d831ae291e5c50f69313a12;p=gnus diff --git a/lisp/gnus-gravatar.el b/lisp/gnus-gravatar.el index 3edf34895..de373cfdf 100644 --- a/lisp/gnus-gravatar.el +++ b/lisp/gnus-gravatar.el @@ -33,14 +33,13 @@ (defcustom gnus-gravatar-size 32 "How big should gravatars be displayed." :type 'integer + :version "24.1" :group 'gnus-gravatar) -(defcustom gnus-gravatar-relief 1 - "If non-nil, adds a shadow rectangle around the image. The -value, relief, specifies the width of the shadow lines, in -pixels. If relief is negative, shadows are drawn so that the -image appears as a pressed button; otherwise, it appears as an -unpressed button." +(defcustom gnus-gravatar-properties '(:ascent center :relief 1) + "List of image properties applied to Gravatar images." + :type 'list + :version "24.1" :group 'gnus-gravatar) (defun gnus-gravatar-transform-address (header category) @@ -59,7 +58,7 @@ unpressed button." (gravatar-retrieve (car address) 'gnus-gravatar-insert - (list header (car address) category))))))) + (list header address category))))))) (defun gnus-gravatar-insert (gravatar header address category) "Insert GRAVATAR for ADDRESS in HEADER in current article buffer. @@ -68,25 +67,31 @@ Set image category to CATEGORY." (gnus-with-article-headers (gnus-article-goto-header header) (mail-header-narrow-to-field) - (when (and (search-forward address nil t) - (or (search-backward ",\n" nil t) - (search-backward ", " nil t) - (search-backward ": " nil t))) - (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)) - (gravatar (append - gravatar - `(:ascent center :relief ,gnus-gravatar-relief)))) - (gnus-put-image gravatar nil category) - (put-text-property point (point) 'gnus-gravatar address) - (gnus-add-wash-type category) - (gnus-add-image category gravatar))))))) + (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)) + (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 ()