Mercurial > emacs
comparison lisp/gnus/gnus-gravatar.el @ 112451:98ad7c9e56a3
gnus-html.el (gnus-html-image-fetched): Don't kill the temporary buffer after being called. It's apparently being killed by url.el, and killing it made point move to end-of-buffer in a random buffer.
shr.el (shr-image-fetched): Ditto.
shr.el (shr-image-fetched): Avoid having point move in the article buffer.
gnus-html.el (gnus-html-image-fetched): Kill the buffer anyway, and fix the bug in url-http.el instead.
shr.el (shr-image-fetched): Ditto.
gravatar.el (gravatar-retrieve): Be silent when retrieving.
gnus-gravatar.el (gnus-gravatar-insert): Don't move point around in the article buffer.
(gnus-gravatar-insert): Use blank space from the current buffer to avoid breaking text properties. This makes X-Sent updating work again.
gnus-art.el (gnus-article-read-summary-keys): Don't call disabled commands.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Mon, 24 Jan 2011 04:10:19 +0000 |
| parents | b1eac6d41a93 |
| children |
comparison
equal
deleted
inserted
replaced
| 112449:5e6007430c1e | 112451:98ad7c9e56a3 |
|---|---|
| 78 | 78 |
| 79 (defun gnus-gravatar-insert (gravatar header address category) | 79 (defun gnus-gravatar-insert (gravatar header address category) |
| 80 "Insert GRAVATAR for ADDRESS in HEADER in current article buffer. | 80 "Insert GRAVATAR for ADDRESS in HEADER in current article buffer. |
| 81 Set image category to CATEGORY." | 81 Set image category to CATEGORY." |
| 82 (unless (eq gravatar 'error) | 82 (unless (eq gravatar 'error) |
| 83 (gnus-with-article-headers | 83 (with-current-buffer gnus-article-buffer |
| 84 ;; The buffer can be gone at this time | 84 (let ((mark (point-marker)) |
| 85 (when (buffer-live-p (current-buffer)) | 85 (inhibit-read-only t) |
| 86 (gnus-article-goto-header header) | 86 (inhibit-point-motion-hooks t) |
| 87 (mail-header-narrow-to-field) | 87 (case-fold-search t)) |
| 88 (let ((real-name (car address)) | 88 (save-restriction |
| 89 (mail-address (cadr address))) | 89 (article-narrow-to-head) |
| 90 (when (if real-name | 90 ;; The buffer can be gone at this time |
| 91 (re-search-forward | 91 (when (buffer-live-p (current-buffer)) |
| 92 (concat (gnus-replace-in-string | 92 (gnus-article-goto-header header) |
| 93 (regexp-quote real-name) "[\t ]+" "[\t\n ]+") | 93 (mail-header-narrow-to-field) |
| 94 "\\|" | 94 (let ((real-name (car address)) |
| 95 (regexp-quote mail-address)) | 95 (mail-address (cadr address))) |
| 96 nil t) | 96 (when (if real-name |
| 97 (search-forward mail-address nil t)) | 97 (re-search-forward |
| 98 (goto-char (1- (match-beginning 0))) | 98 (concat (gnus-replace-in-string |
| 99 ;; If we're on the " quoting the name, go backward | 99 (regexp-quote real-name) "[\t ]+" "[\t\n ]+") |
| 100 (when (looking-at "[\"<]") | 100 "\\|" |
| 101 (goto-char (1- (point)))) | 101 (regexp-quote mail-address)) |
| 102 ;; Do not do anything if there's already a gravatar. This can | 102 nil t) |
| 103 ;; happens if the buffer has been regenerated in the mean time, for | 103 (search-forward mail-address nil t)) |
| 104 ;; example we were fetching someaddress, and then we change to | 104 (goto-char (1- (match-beginning 0))) |
| 105 ;; another mail with the same someaddress. | 105 ;; If we're on the " quoting the name, go backward |
| 106 (unless (memq 'gnus-gravatar (text-properties-at (point))) | 106 (when (looking-at "[\"<]") |
| 107 (let ((point (point))) | 107 (goto-char (1- (point)))) |
| 108 (unless (featurep 'xemacs) | 108 ;; Do not do anything if there's already a gravatar. This can |
| 109 (setq gravatar (append gravatar gnus-gravatar-properties))) | 109 ;; happens if the buffer has been regenerated in the mean time, for |
| 110 (gnus-put-image gravatar nil category) | 110 ;; example we were fetching someaddress, and then we change to |
| 111 (put-text-property point (point) 'gnus-gravatar address) | 111 ;; another mail with the same someaddress. |
| 112 (gnus-add-wash-type category) | 112 (unless (memq 'gnus-gravatar (text-properties-at (point))) |
| 113 (gnus-add-image category gravatar))))))))) | 113 (let ((point (point))) |
| 114 (unless (featurep 'xemacs) | |
| 115 (setq gravatar (append gravatar gnus-gravatar-properties))) | |
| 116 (gnus-put-image gravatar (buffer-substring (point) (1+ point)) category) | |
| 117 (put-text-property point (point) 'gnus-gravatar address) | |
| 118 (gnus-add-wash-type category) | |
| 119 (gnus-add-image category gravatar))))))) | |
| 120 (goto-char (marker-position mark)))))) | |
| 114 | 121 |
| 115 ;;;###autoload | 122 ;;;###autoload |
| 116 (defun gnus-treat-from-gravatar (&optional force) | 123 (defun gnus-treat-from-gravatar (&optional force) |
| 117 "Display gravatar in the From header. | 124 "Display gravatar in the From header. |
| 118 If gravatar is already displayed, remove it." | 125 If gravatar is already displayed, remove it." |