Mercurial > emacs
diff lisp/gnus/gnus-html.el @ 110422:93e093c035a0
Merge changes made in Gnus trunk.
nnimap.el (nnimap-request-group): Use the stored info for the dont-check case.
nnimap.el: Use deffoo instead of defun for interface functions.
gnus-int.el (gnus-request-group): Take an optional `info' parameter.
nnimap.el: Allow nnimap-request-group to do a complete marks sync on `M-g'.
nnimap.el: Get credentials for numerical equivalents of the port numbers.
gnus-html.el (gnus-html-wash-tags): Add support for i, b and u HTML tags.
nnimap.el (nnimap-update-info): Extend the info so that we can set the marks.
nnimap.el (nnimap-open-connection): Fix typo -- should be 'shell, not 'stream.
nnimap.el: Allow PREAUTH nnimap connections to log in without credentials.
nnimap.el (nnimap-update-info): Fix off-by-one error when concatenating ranges when doing a partial update.
gnus-html.el (gnus-html-schedule-image-fetching): Use `url' rather than curl to retrieve images.
nnimap.el (nnimap-update-info): When doing partial marks update, get the range update right.
nnimap.el (nnimap-wait-for-response): Be a bit more lax in finding the end of the command we're looking for.
nnimap.el: Allow sending \n instead of \r\n on 'shell streams.
gnus-html.el (gnus-html-schedule-image-fetching): Fetch all images in parallel.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Sat, 18 Sep 2010 23:36:29 +0000 |
parents | 23ce0716c272 |
children | 6060b86fc551 |
line wrap: on
line diff
--- a/lisp/gnus/gnus-html.el Sat Sep 18 13:54:55 2010 -0700 +++ b/lisp/gnus/gnus-html.el Sat Sep 18 23:36:29 2010 +0000 @@ -33,6 +33,7 @@ (require 'gnus-art) (require 'mm-url) +(require 'url) (defcustom gnus-html-cache-directory (nnheader-concat gnus-directory "html-cache/") "Where Gnus will cache images it downloads from the web." @@ -253,6 +254,12 @@ ((equal tag "IMG_ALT") (delete-region start end)) ;; Whatever. Just ignore the tag. + ((equal tag "b") + (gnus-overlay-put (gnus-make-overlay start end) 'face 'bold)) + ((equal tag "U") + (gnus-overlay-put (gnus-make-overlay start end) 'face 'underline)) + ((equal tag "i") + (gnus-overlay-put (gnus-make-overlay start end) 'face 'italic)) (t )) (goto-char start)) @@ -290,42 +297,32 @@ (defun gnus-html-schedule-image-fetching (buffer images) (gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, images %s" buffer images) - (when (executable-find "curl") - (let* ((url (caar images)) - (process (start-process - "images" nil "curl" - "-s" "--create-dirs" - "--location" - "--max-time" "60" - "-o" (gnus-html-image-id url) - (mm-url-decode-entities-string url)))) - (gnus-set-process-query-on-exit-flag process nil) - (set-process-sentinel process 'gnus-html-curl-sentinel) - (gnus-set-process-plist process (list 'images images - 'buffer buffer))))) + (dolist (image images) + (url-retrieve (car image) + 'gnus-html-image-fetched + (list buffer image)))) (defun gnus-html-image-id (url) (expand-file-name (sha1 url) gnus-html-cache-directory)) -(defun gnus-html-curl-sentinel (process event) - (when (string-match "finished" event) - (let* ((images (gnus-process-get process 'images)) - (buffer (gnus-process-get process 'buffer)) - (spec (pop images)) - (file (gnus-html-image-id (car spec)))) - (when (and (buffer-live-p buffer) - ;; If the position of the marker is 1, then that - ;; means that the text it was in has been deleted; - ;; i.e., that the user has selected a different - ;; article before the image arrived. - (not (= (marker-position (cadr spec)) (point-min)))) - (with-current-buffer buffer - (let ((inhibit-read-only t) - (string (buffer-substring (cadr spec) (caddr spec)))) - (delete-region (cadr spec) (caddr spec)) - (gnus-html-put-image file (cadr spec) string)))) - (when images - (gnus-html-schedule-image-fetching buffer images))))) +(defun gnus-html-image-fetched (status buffer image) + (when (and (buffer-live-p buffer) + ;; If the position of the marker is 1, then that + ;; means that the text it was in has been deleted; + ;; i.e., that the user has selected a different + ;; article before the image arrived. + (not (= (marker-position (cadr image)) (point-min)))) + (let ((file (gnus-html-image-id (car image)))) + ;; Search the start of the image data + (search-forward "\n\n") + ;; Write region (image) silently + (write-region (point) (point-max) file nil 1) + (kill-buffer) + (with-current-buffer buffer + (let ((inhibit-read-only t) + (string (buffer-substring (cadr image) (caddr image)))) + (delete-region (cadr image) (caddr image)) + (gnus-html-put-image file (cadr image) string)))))) (defun gnus-html-put-image (file point string &optional url alt-text) (when (gnus-graphic-display-p)