Mercurial > emacs
comparison lisp/gnus/gnus-html.el @ 110433:33cf78a271ef
Merge changes made in Gnus trunk.
mail-parse.el (mail-header-encode-parameter): Define as rfc2045-encode-string.
nnheader.el (nnheader-insert-nov): Protect against junk appearing in the extra mail headers.
gnus-html.el: Prefetch and html washing additions.
gnus-html.el (gnus-html-prefetch-images): Fix up the url-retrieve calling conventions so that prefetch doesn't bug out.
Pass proper format strings to gnus-message.
nnimap.el: Allow anonymous login.
nnimap.el (nnimap-transform-headers): The chars header is called Chars not Bytes.
nnimap.el (nnimap-wait-for-response): Don't infloop if the IMAP connection drops.
gnus-start.el (gnus-get-unread-articles): Call `gnus-open-server' on each method before trying to scan them etc.
gnus-sum.el (gnus-summary-update-mark): Replace subst-char-in-region by subst-char-in-region.
gnus.el (gnus-similar-server-opened): Refactor a bit and add comments.
gnus.el: Fix a speed regression based in methods that were similar weren't the same.
gnus.el (gnus): When using the development version of Gnus, load the gnus-load file.
nnimap.el (nnimap-open-connection): When looking for credentials, also use the nnimap-server-port.
nnimap.el (nnimap-request-article): Return the group/article number, so that Gnus `^' works as expected.
nnimap.el (nnimap-find-wanted-parts-1): Return the MIME parts as IMAP wants them.
gnus-start.el (gnus-ignored-newsgroups): Remove [] from the list of bogus characters.
gnus-html.el (gnus-html-image-fetched): Protect against the data not arriving.
nnimap.el (nnimap-wait-for-connection): Avoid a race condition while waiting for the connection string.
gnus.texi (Required Back End Functions): Document INFO.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Mon, 20 Sep 2010 00:36:54 +0000 |
| parents | 6060b86fc551 |
| children | de3a95d08649 |
comparison
equal
deleted
inserted
replaced
| 110432:6b2714f6bd1f | 110433:33cf78a271ef |
|---|---|
| 112 "-halfdump" | 112 "-halfdump" |
| 113 "-no-cookie" | 113 "-no-cookie" |
| 114 "-I" "UTF-8" | 114 "-I" "UTF-8" |
| 115 "-O" "UTF-8" | 115 "-O" "UTF-8" |
| 116 "-o" "ext_halfdump=1" | 116 "-o" "ext_halfdump=1" |
| 117 "-o" "display_ins_del=2" | |
| 117 "-o" "pre_conv=1" | 118 "-o" "pre_conv=1" |
| 118 "-t" (format "%s" tab-width) | 119 "-t" (format "%s" tab-width) |
| 119 "-cols" (format "%s" gnus-html-frame-width) | 120 "-cols" (format "%s" gnus-html-frame-width) |
| 120 "-o" "display_image=on" | 121 "-o" "display_image=on" |
| 121 "-T" "text/html")))) | 122 "-T" "text/html")))) |
| 251 (gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face))))) | 252 (gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face))))) |
| 252 ;; The upper-case IMG_ALT is apparently just an artifact that | 253 ;; The upper-case IMG_ALT is apparently just an artifact that |
| 253 ;; should be deleted. | 254 ;; should be deleted. |
| 254 ((equal tag "IMG_ALT") | 255 ((equal tag "IMG_ALT") |
| 255 (delete-region start end)) | 256 (delete-region start end)) |
| 257 ;; w3m does not normalize the case | |
| 258 ((or (equal tag "b") | |
| 259 (equal tag "B")) | |
| 260 (gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-bold)) | |
| 261 ((or (equal tag "u") | |
| 262 (equal tag "U")) | |
| 263 (gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-underline)) | |
| 264 ((or (equal tag "i") | |
| 265 (equal tag "I")) | |
| 266 (gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-italic)) | |
| 267 ((or (equal tag "s") | |
| 268 (equal tag "S")) | |
| 269 (gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-strikethru)) | |
| 270 ((or (equal tag "ins") | |
| 271 (equal tag "INS")) | |
| 272 (gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-underline)) | |
| 273 ;; Handle different UL types | |
| 274 ((equal tag "_SYMBOL") | |
| 275 (when (string-match "TYPE=\\(.+\\)" parameters) | |
| 276 (let ((type (string-to-number (match-string 1 parameters)))) | |
| 277 (delete-region start end) | |
| 278 (cond ((= type 33) (insert " ")) | |
| 279 ((= type 34) (insert " ")) | |
| 280 ((= type 35) (insert " ")) | |
| 281 ((= type 36) (insert " ")) | |
| 282 ((= type 37) (insert " ")) | |
| 283 ((= type 38) (insert " ")) | |
| 284 ((= type 39) (insert " ")) | |
| 285 ((= type 40) (insert " ")) | |
| 286 ((= type 42) (insert " ")) | |
| 287 ((= type 43) (insert " ")) | |
| 288 (t (insert " ")))))) | |
| 256 ;; Whatever. Just ignore the tag. | 289 ;; Whatever. Just ignore the tag. |
| 257 ((equal tag "b") | |
| 258 (gnus-overlay-put (gnus-make-overlay start end) 'face 'bold)) | |
| 259 ((equal tag "U") | |
| 260 (gnus-overlay-put (gnus-make-overlay start end) 'face 'underline)) | |
| 261 ((equal tag "i") | |
| 262 (gnus-overlay-put (gnus-make-overlay start end) 'face 'italic)) | |
| 263 (t | 290 (t |
| 264 )) | 291 )) |
| 265 (goto-char start)) | 292 (goto-char start)) |
| 266 (goto-char (point-min)) | 293 (goto-char (point-min)) |
| 267 ;; The output from -halfdump isn't totally regular, so strip | 294 ;; The output from -halfdump isn't totally regular, so strip |
| 305 | 332 |
| 306 (defun gnus-html-image-id (url) | 333 (defun gnus-html-image-id (url) |
| 307 (expand-file-name (sha1 url) gnus-html-cache-directory)) | 334 (expand-file-name (sha1 url) gnus-html-cache-directory)) |
| 308 | 335 |
| 309 (defun gnus-html-image-fetched (status buffer image) | 336 (defun gnus-html-image-fetched (status buffer image) |
| 310 (when (and (buffer-live-p buffer) | 337 (let ((file (gnus-html-image-id (car image)))) |
| 311 ;; If the position of the marker is 1, then that | 338 ;; Search the start of the image data |
| 312 ;; means that the text it was in has been deleted; | 339 (when (search-forward "\n\n" nil t) |
| 313 ;; i.e., that the user has selected a different | 340 ;; Write region (image data) silently |
| 314 ;; article before the image arrived. | |
| 315 (not (= (marker-position (cadr image)) (point-min)))) | |
| 316 (let ((file (gnus-html-image-id (car image)))) | |
| 317 ;; Search the start of the image data | |
| 318 (search-forward "\n\n") | |
| 319 ;; Write region (image) silently | |
| 320 (write-region (point) (point-max) file nil 1) | 341 (write-region (point) (point-max) file nil 1) |
| 321 (kill-buffer) | 342 (kill-buffer) |
| 322 (with-current-buffer buffer | 343 (when (and (buffer-live-p buffer) |
| 323 (let ((inhibit-read-only t) | 344 ;; If the `image' has no marker, do not replace anything |
| 324 (string (buffer-substring (cadr image) (caddr image)))) | 345 (cadr image) |
| 325 (delete-region (cadr image) (caddr image)) | 346 ;; If the position of the marker is 1, then that |
| 326 (gnus-html-put-image file (cadr image) string)))))) | 347 ;; means that the text it was in has been deleted; |
| 348 ;; i.e., that the user has selected a different | |
| 349 ;; article before the image arrived. | |
| 350 (not (= (marker-position (cadr image)) (point-min)))) | |
| 351 (with-current-buffer buffer | |
| 352 (let ((inhibit-read-only t) | |
| 353 (string (buffer-substring (cadr image) (caddr image)))) | |
| 354 (delete-region (cadr image) (caddr image)) | |
| 355 (gnus-html-put-image file (cadr image) (car image) string))))))) | |
| 327 | 356 |
| 328 (defun gnus-html-put-image (file point string &optional url alt-text) | 357 (defun gnus-html-put-image (file point string &optional url alt-text) |
| 329 (when (gnus-graphic-display-p) | 358 (when (gnus-graphic-display-p) |
| 330 (let* ((image (ignore-errors | 359 (let* ((image (ignore-errors |
| 331 (gnus-create-image file))) | 360 (gnus-create-image file))) |
| 439 (message "No images to show") | 468 (message "No images to show") |
| 440 (gnus-html-schedule-image-fetching (current-buffer) images))))) | 469 (gnus-html-schedule-image-fetching (current-buffer) images))))) |
| 441 | 470 |
| 442 ;;;###autoload | 471 ;;;###autoload |
| 443 (defun gnus-html-prefetch-images (summary) | 472 (defun gnus-html-prefetch-images (summary) |
| 444 (let (blocked-images urls) | 473 (when (buffer-live-p summary) |
| 445 (when (and (buffer-live-p summary) | 474 (let ((blocked-images (with-current-buffer summary |
| 446 (executable-find "curl")) | 475 gnus-blocked-images))) |
| 447 (with-current-buffer summary | |
| 448 (setq blocked-images gnus-blocked-images)) | |
| 449 (save-match-data | 476 (save-match-data |
| 450 (while (re-search-forward "<img.*src=[\"']\\([^\"']+\\)" nil t) | 477 (while (re-search-forward "<img.*src=[\"']\\([^\"']+\\)" nil t) |
| 451 (let ((url (match-string 1))) | 478 (let ((url (match-string 1))) |
| 452 (unless (gnus-html-image-url-blocked-p url blocked-images) | 479 (unless (gnus-html-image-url-blocked-p url blocked-images) |
| 453 (unless (file-exists-p (gnus-html-image-id url)) | 480 (unless (file-exists-p (gnus-html-image-id url)) |
| 454 (push (mm-url-decode-entities-string url) urls) | 481 (ignore-errors |
| 455 (push (gnus-html-image-id url) urls) | 482 (url-retrieve (mm-url-decode-entities-string url) |
| 456 (push "-o" urls))))) | 483 'gnus-html-image-fetched |
| 457 (let ((process | 484 (list nil (list url)))))))))))) |
| 458 (apply 'start-process | |
| 459 "images" nil "curl" | |
| 460 "-s" "--create-dirs" | |
| 461 "--location" | |
| 462 "--max-time" "60" | |
| 463 urls))) | |
| 464 (gnus-set-process-query-on-exit-flag process nil)))))) | |
| 465 | 485 |
| 466 (provide 'gnus-html) | 486 (provide 'gnus-html) |
| 467 | 487 |
| 468 ;;; gnus-html.el ends here | 488 ;;; gnus-html.el ends here |