Commit b069e5a6 authored by Gnus developers's avatar Gnus developers Committed by Katsumi Yamaoka

Merge Changes made in Gnus trunk.

gnus-html.el (gnus-html-get-image-data): Search also for \r\n\r\n to get the start of data.
gnus-html.el: Use gnus-html-encode-url to encode URL.
gnus-sum.el (gnus-update-marks): Add sanity check to not delete marks outside the active range.
gnus.el: Try to keep the server/method cache unique.
gnus-html.el (gnus-html-rescale-image): Use window-inside-pixel-edges rather than window-pixel-edges.
gnus-html.el (gnus-html-put-image): Stop using markers.
gnus-html.el (gnus-html-image-fetched): Search also for \r\n\r\n to get the start of data.
nnimap.el: Expunge IMAP groups by default on article deletion.
gnus-int.el (gnus-request-expire-articles): Inhibit the daemon, since this command might take a while.
nnimap.el (nnimap-request-list): Set the current nnimap group to nil, since EXAMINE changes it on the server.
nnmail.el, nnimap.el: Allow nnimap to just delete 'junk messages when splitting.
nnimap.el (nnimap-parse-flags): Make IMAP flags parsing much faster by using `read'.
nnimap.el (nnimap-make-process-buffer): Record the server name.
gnus-html.el (gnus-html-image-fetched): Only cache if gnus-html-image-automatic-caching is set.
gnus-html.el (gnus-html-image-fetched): Check for errors.
gnus-start.el (gnus-read-active-for-groups): Only run -request-scan once per method on `g'.
nnimap.el (nnimap-request-expire-articles): If nnmail-expiry-wait is immediate, then expire all articles.
gnus-group.el (gnus-group-get-icon): Compute icon to return.
gnus-group.el (gnus-group-icon-list): Fix bad docstring information.
nnimap.el (nnimap-update-info): Fix up various off-by-one errors when syncing flags in nnimap.
time-date.el (date-to-time): Speed up date-to-time.
gnus-start.el (gnus-get-unread-articles): Don't have `gnus-get-unread-articles-in-group' update info.
gnus-group.el: Remove gnus-group-highlight-line from the default hook list.
gnus-group.el (gnus-group-highlight-line): Typo fix: beg, not start.
gnus-group.el (gnus-group-insert-group-line): Pass the real group name so that it gets the right data.
gnus-int.el (gnus-open-server): Add tracing for performance debugging.
nnimap.el (nnimap-parse-flags): Parse the data in any order.
nnimap.el (nnimap-update-info): Fix up code slightly.
parent 05212154
......@@ -1996,8 +1996,7 @@ functions for snarfing info on the group.
@vindex gnus-group-update-hook
@findex gnus-group-highlight-line
@code{gnus-group-update-hook} is called when a group line is changed.
It will not be called when @code{gnus-visual} is @code{nil}. This hook
calls @code{gnus-group-highlight-line} by default.
It will not be called when @code{gnus-visual} is @code{nil}.
@node Group Maneuvering
2010-09-22 Dan Christensen <jdc@uwo.ca>
* calendar/time-date.el (date-to-time): Try using parse-time-string
first before using the slower timezone-make-date-arpa-standard.
2010-09-22 Katsumi Yamaoka <yamaoka@jpl.org>
* calendar/time-date.el (format-seconds): Comment fix.
......
......@@ -97,20 +97,20 @@ and type 2 is the list (HIGH LOW MICRO)."
(autoload 'timezone-make-date-arpa-standard "timezone")
;;;###autoload
;; `parse-time-string' isn't sufficiently general or robust. It fails
;; to grok some of the formats that timezone does (e.g. dodgy
;; post-2000 stuff from some Elms) and either fails or returns bogus
;; values. timezone-make-date-arpa-standard should help.
(defun date-to-time (date)
"Parse a string DATE that represents a date-time and return a time value.
If DATE lacks timezone information, GMT is assumed."
(condition-case ()
(apply 'encode-time
(parse-time-string
;; `parse-time-string' isn't sufficiently general or
;; robust. It fails to grok some of the formats that
;; timezone does (e.g. dodgy post-2000 stuff from some
;; Elms) and either fails or returns bogus values. Lars
;; reverted this change, but that loses non-trivially
;; often for me. -- fx
(timezone-make-date-arpa-standard date)))
(error (error "Invalid date: %s" date))))
(apply 'encode-time (parse-time-string date))
(error (condition-case ()
(apply 'encode-time
(parse-time-string
(timezone-make-date-arpa-standard date)))
(error (error "Invalid date: %s" date))))))
;; Bit of a mess. Emacs has float-time since at least 21.1.
;; This file is synced to Gnus, and XEmacs packages may have been written
......
2010-09-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
* nnimap.el (nnimap-parse-flags): Parse the data in any order.
(nnimap-update-info): Fix up code slightly.
* gnus-int.el (gnus-open-server): Add tracing for performance
debugging.
* gnus-group.el (gnus-group-highlight-line): Typo fix: beg, not start.
(gnus-group-insert-group-line): Pass the real group name so that it
gets the right data.
* gnus-start.el (gnus-get-unread-articles): Don't have
`gnus-get-unread-articles-in-group' update info, since that can be
really slow and doesn't seem to be needed?
2010-09-22 Dan Christensen <jdc@uwo.ca>
* time-date.el (date-to-time): Try using parse-time-string first before
using the slower timezone-make-date-arpa-standard.
2010-09-22 Julien Danjou <julien@danjou.info>
* gnus-group.el (gnus-group-insert-group-line): Call
gnus-group-highlight-line.
(gnus-group-update-hook): Remove gnus-group-highlight-line from the
default hook list.
(gnus-group-update-eval-form): Add new function.
(gnus-group-highlight-line): Use gnus-group-update-eval-form.
(gnus-group-get-icon): Use gnus-group-update-eval-form.
2010-09-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
* nnimap.el (nnimap-request-expire-articles): If nnmail-expiry-wait is
immediate, then expire all articles.
(nnimap-update-info): Fix off-by-one errors.
(nnimap-flags-to-marks): Would return no marks lists for group with no
flags. Instead return the other data.
2010-09-22 Julien Danjou <julien@danjou.info>
* gnus-group.el (gnus-group-get-icon): Renamed gnus-group-add-icon that
Only return an icon.
(gnus-group-insert-group-line): Compute icon to return.
* gnus-html.el (gnus-html-image-automatic-caching): Add custom
variable.
(gnus-html-image-fetched): Only cache if
gnus-html-image-automatic-caching is set.
(gnus-html-image-fetched): Check for errors.
2010-09-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-start.el (gnus-read-active-for-groups): Only run -request-scan
once per method on `g'. This ensures that backends like nnfolder don't
open all their folders.
* nnimap.el (nnimap-split-incoming-mail): Delete 'junk.
(nnimap-request-list): Nix out group in the correct buffer.
(nnimap-parse-flags): Implement by using `read' instead of
hand-parsing.
(nnimap-flags-to-marks): Pass on permanent-flags.
(nnimap-make-process-buffer): Record the server name.
(nnimap-parse-flags): Fix typo.
(nnimap-request-scan): Run split on the server in general, not just a
single group.
* nnmail.el (nnmail-split-incoming): Take an optional junk-func
parameter, and propagate this downwards.
* nnimap.el (nnimap-request-list): Set the current nnimap group to nil,
since EXAMINE changes it on the server.
* gnus-int.el (gnus-request-expire-articles): Inhibit the daemon, since
this command might take a while.
2010-09-22 Julien Danjou <julien@danjou.info>
* gnus-html.el (gnus-html-rescale-image): Use window-inside-pixel-edges
rather than window-pixel-edges.
(gnus-html-put-image): Stop using markers. They are harmful if you have
2 images side-by-side, they can't be properly update on text deletion.
Using text-property is safer here.
(gnus-html-image-fetched): Search also for \r\n\r\n to get the start of
data.
2010-09-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
* nnimap.el (nnimap-expunge-inbox): Removed.
(nnimap-mark-and-expunge-incoming): Use nnimap-expunge instead.
(nnimap-expunge): Flip default to t.
* gnus.el (gnus-method-to-server): Don't push things to the cache
unless it's unique.
(gnus-server-to-method): Ditto.
2010-09-22 Teodor Zlatanov <tzz@lifelogs.com>
* nnimap.el (nnimap-delete-article): Tell user if expunge won't happen.
2010-09-22 Julien Danjou <julien@danjou.info>
* gnus-html.el (gnus-html-get-image-data): Search also for \r\n\r\n to
get the start of data.
(gnus-html-encode-url): Add this function to encode special chars in
URL.
(gnus-html-wash-images): Use gnus-html-encode-url to encode URL.
(gnus-html-prefetch-images): Use gnus-html-encode-url to encode URL.
* gnus-group.el (gnus-group-update-hook): Call gnus-group-add-icon by
default.
(gnus-group-add-icon): Move to gnus-group.el, and rewrite so it works.
......@@ -19,6 +122,19 @@
* nnir.el (nnir-run-find-grep)
* pop3.el (pop3-list): Use 3rd arg of split-string.
2010-09-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-sum.el (gnus-update-marks): Add sanity check to not delete marks
outside the active range. Suggested by Dan Christensen.
* gnus-start.el (gnus-get-unread-articles): Get the extended method
slightly later to avoid double-getting it.
* nnml.el (nnml-generate-nov-file): Fix variable name clobbering from
previous patch.
* gnus-sum.el (gnus-adjust-marked-articles): Fix another typo.
2010-09-21 Adam Sjøgren <asjo@koldfront.dk>
* gnus-sum.el (gnus-adjust-marked-articles): Fix typo.
......@@ -103,6 +219,9 @@
2010-09-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-group.el (gnus-group-line-format-alist): Have the ?U (unseen)
spec inser "*" if the group isn't active instead of 0.
* nnimap.el (nnimap-request-group): Don't select the imap buffer before
opening the server.
(nnimap-request-delete-group): Implement group deletion.
......@@ -369,7 +488,7 @@
* dgnushack.el: Define netrc-credentials.
2010-09-17 Julien Danjou <julien@danjou.info> (tiny fix)
2010-09-17 Julien Danjou <julien@danjou.info>
* mm-decode.el (mm-text-html-renderer): Document gnus-article-html.
......@@ -439,6 +558,9 @@
2010-09-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-registry.el (gnus-registry-install-shortcuts): The second
parameter to unintern is mandatory-ish in Emacs 24.
* gnus-html.el (gnus-html-schedule-image-fetching)
(gnus-html-prefetch-images): Check for curl before using it.
......
......@@ -292,14 +292,8 @@ If you want to modify the group buffer, you can use this hook."
:group 'gnus-exit
:type 'hook)
(defcustom gnus-group-update-hook '(gnus-group-highlight-line gnus-group-add-icon)
"Hook called when a group line is changed.
The hook will not be called if `gnus-visual' is nil.
The default functions `gnus-group-highlight-line' will highlight
the line according to the `gnus-group-highlight' variable, and
`gnus-group-add-icon' will add an icon according to
`gnus-group-icon-list'"
(defcustom gnus-group-update-hook nil
"Hook called when a group line is changed."
:group 'gnus-group-visual
:type 'hook)
......@@ -429,7 +423,6 @@ group: The name of the group.
unread: The number of unread articles in the group.
method: The select method used.
mailp: Whether it's a mail group or not.
newsp: Whether it's a news group or not
level: The level of the group.
score: The score of the group.
ticked: The number of ticked articles."
......@@ -1579,7 +1572,7 @@ if it is a string, only list groups matching REGEXP."
?m ? ))
(gnus-tmp-moderated-string
(if (eq gnus-tmp-moderated ?m) "(m)" ""))
(gnus-tmp-group-icon (propertize " " 'gnus-group-icon t))
(gnus-tmp-group-icon (gnus-group-get-icon gnus-tmp-qualified-group))
(gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
(gnus-tmp-news-method (or (car gnus-tmp-method) ""))
(gnus-tmp-news-method-string
......@@ -1626,108 +1619,85 @@ if it is a string, only list groups matching REGEXP."
'gnus-tool-bar-update))
(forward-line -1)
(when (inline (gnus-visual-p 'group-highlight 'highlight))
(gnus-run-hooks 'gnus-group-update-hook))
(gnus-group-highlight-line gnus-tmp-group beg end))
(gnus-run-hooks 'gnus-group-update-hook)
(forward-line)
;; Allow XEmacs to remove front-sticky text properties.
(gnus-group-remove-excess-properties)))
(defun gnus-group-highlight-line ()
"Highlight the current line according to `gnus-group-highlight'."
(let* ((list gnus-group-highlight)
(p (point))
(end (point-at-eol))
;; now find out where the line starts and leave point there.
(beg (progn (beginning-of-line) (point)))
(group (gnus-group-group-name))
(entry (gnus-group-entry group))
(unread (if (numberp (car entry)) (car entry) 0))
(active (gnus-active group))
(total (if active (1+ (- (cdr active) (car active))) 0))
(info (nth 2 entry))
(method (inline (gnus-server-get-method group (gnus-info-method info))))
(marked (gnus-info-marks info))
(mailp (apply 'append
(mapcar
(lambda (x)
(memq x (assoc (symbol-name
(car (or method gnus-select-method)))
gnus-valid-select-methods)))
'(mail post-mail))))
(level (or (gnus-info-level info) gnus-level-killed))
(score (or (gnus-info-score info) 0))
(ticked (gnus-range-length (cdr (assq 'tick marked))))
(group-age (gnus-group-timestamp-delta group))
(inhibit-read-only t))
;; FIXME: http://thread.gmane.org/gmane.emacs.gnus.general/65451/focus=65465
;; ======================================================================
;; From: Richard Stallman
;; Subject: Re: Rewriting gnus-group-highlight-line (was: [...])
;; Cc: ding@gnus.org
;; Date: Sat, 27 Oct 2007 19:41:20 -0400
;; Message-ID: <E1IlvHM-0006TS-7t@fencepost.gnu.org>
;;
;; [...]
;; The kludge is that the alist elements contain expressions that refer
;; to local variables with short names. Perhaps write your own tiny
;; evaluator that handles just `and', `or', and numeric comparisons
;; and just a few specific variables.
;; ======================================================================
;;
;; Similar for other evaluated variables. Grep for risky-local-variable
;; to find them! -- rsteib
;;
;; Eval the cars of the lists until we find a match.
(while (and list
(not (eval (caar list))))
(setq list (cdr list)))
(let ((face (cdar list)))
(unless (eq face (get-text-property beg 'face))
(gnus-put-text-property-excluding-characters-with-faces
beg end 'face
(setq face (if (boundp face) (symbol-value face) face)))
(gnus-extent-start-open beg)))
(goto-char p)))
(defun gnus-group-add-icon ()
"Add an icon to the current line according to `gnus-group-icon-list'."
(save-excursion
(let* ((end (line-end-position))
;; now find out where the line starts and leave point there.
(beg (line-beginning-position)))
(save-restriction
(narrow-to-region beg end)
(goto-char beg)
(let ((mystart (text-property-any beg end 'gnus-group-icon t)))
(when mystart
(let* ((group (gnus-group-group-name))
(entry (gnus-group-entry group))
(unread (if (numberp (car entry)) (car entry) 0))
(active (gnus-active group))
(total (if active (1+ (- (cdr active) (car active))) 0))
(info (nth 2 entry))
(method (gnus-server-get-method group (gnus-info-method info)))
(marked (gnus-info-marks info))
(mailp (memq 'mail (assoc (symbol-name
(car (or method gnus-select-method)))
gnus-valid-select-methods)))
(level (or (gnus-info-level info) gnus-level-killed))
(score (or (gnus-info-score info) 0))
(ticked (gnus-range-length (cdr (assq 'tick marked))))
(group-age (gnus-group-timestamp-delta group))
(inhibit-read-only t)
(list gnus-group-icon-list)
(myend (next-single-property-change
mystart 'gnus-group-icon)))
(while (and list
(not (eval (caar list))))
(setq list (cdr list)))
(when list
(put-text-property
mystart myend
'display
(append
(gnus-create-image (expand-file-name (cdar list)))
'(:ascent center)))))))))))
(defun gnus-group-update-eval-form (group list)
"Eval `car' of each element of LIST, and return the first that return t.
Some value are bound so the form can use them."
(when list
(let* ((entry (gnus-group-entry group))
(unread (if (numberp (car entry)) (car entry) 0))
(active (gnus-active group))
(total (if active (1+ (- (cdr active) (car active))) 0))
(info (nth 2 entry))
(method (inline (gnus-server-get-method group (gnus-info-method info))))
(marked (gnus-info-marks info))
(mailp (apply 'append
(mapcar
(lambda (x)
(memq x (assoc (symbol-name
(car (or method gnus-select-method)))
gnus-valid-select-methods)))
'(mail post-mail))))
(level (or (gnus-info-level info) gnus-level-killed))
(score (or (gnus-info-score info) 0))
(ticked (gnus-range-length (cdr (assq 'tick marked))))
(group-age (gnus-group-timestamp-delta group)))
;; FIXME: http://thread.gmane.org/gmane.emacs.gnus.general/65451/focus=65465
;; ======================================================================
;; From: Richard Stallman
;; Subject: Re: Rewriting gnus-group-highlight-line (was: [...])
;; Cc: ding@gnus.org
;; Date: Sat, 27 Oct 2007 19:41:20 -0400
;; Message-ID: <E1IlvHM-0006TS-7t@fencepost.gnu.org>
;;
;; [...]
;; The kludge is that the alist elements contain expressions that refer
;; to local variables with short names. Perhaps write your own tiny
;; evaluator that handles just `and', `or', and numeric comparisons
;; and just a few specific variables.
;; ======================================================================
;;
;; Similar for other evaluated variables. Grep for risky-local-variable
;; to find them! -- rsteib
;;
;; Eval the cars of the lists until we find a match.
(while (and list
(not (eval (caar list))))
(setq list (cdr list)))
list)))
(defun gnus-group-highlight-line (group beg end)
"Highlight the current line according to `gnus-group-highlight'.
GROUP is current group, and the line to highlight starts at START
and ends at END."
(let ((face (cdar (gnus-group-update-eval-form
group
gnus-group-highlight))))
(unless (eq face (get-text-property beg 'face))
(let ((inhibit-read-only t))
(gnus-put-text-property-excluding-characters-with-faces
beg end 'face
(if (boundp face) (symbol-value face) face)))
(gnus-extent-start-open beg))))
(defun gnus-group-get-icon (group)
"Return an icon for GROUP according to `gnus-group-icon-list'."
(if gnus-group-icon-list
(let ((image-path
(cdar (gnus-group-update-eval-form group gnus-group-icon-list))))
(if image-path
(propertize " "
'display
(append
(gnus-create-image (expand-file-name image-path))
'(:ascent center)))
" "))
" "))
(defun gnus-group-update-group (group &optional visible-only)
"Update all lines where GROUP appear.
......
......@@ -36,13 +36,20 @@
(require 'url)
(require 'url-cache)
(require 'xml)
(require 'browse-url)
(defcustom gnus-html-image-cache-ttl (days-to-time 7)
"Time in seconds used to cache the image on disk."
"Time used to determine if we should use images from the cache."
:version "24.1"
:group 'gnus-art
:type 'integer)
(defcustom gnus-html-image-automatic-caching t
"Whether automatically cache retrieve images."
:version "24.1"
:group 'gnus-art
:type 'boolean)
(defcustom gnus-html-frame-width 70
"What width to use when rendering HTML."
:version "24.1"
......@@ -81,6 +88,10 @@ fit these criteria."
(define-key map [tab] 'widget-forward)
map))
(defun gnus-html-encode-url (url)
"Encode URL."
(browse-url-url-encode-chars url "[)$ ]"))
(defun gnus-html-cache-expired (url ttl)
"Check if URL is cached for more than TTL."
(cond (url-standalone-mode
......@@ -155,7 +166,7 @@ fit these criteria."
(delete-region (match-beginning 0) (match-end 0)))
(setq end (point))
(when (string-match "src=\"\\([^\"]+\\)" parameters)
(setq url (match-string 1 parameters))
(setq url (gnus-html-encode-url (match-string 1 parameters)))
(gnus-message 8 "gnus-html-wash-tags: fetching image URL %s" url)
(if (string-match "^cid:\\(.*\\)" url)
;; URLs with cid: have their content stashed in other
......@@ -177,6 +188,7 @@ fit these criteria."
(let ((alt-text (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)"
parameters)
(xml-substitute-special (match-string 2 parameters)))))
(gnus-put-text-property start end 'gnus-image-url url)
(if (gnus-html-image-url-blocked-p
url
(if (buffer-live-p gnus-summary-buffer)
......@@ -191,13 +203,9 @@ fit these criteria."
:keymap gnus-html-image-map
:button-keymap gnus-html-image-map)
(let ((overlay (gnus-make-overlay start end))
(spec (list url
(set-marker (make-marker) start)
(set-marker (make-marker) end)
alt-text)))
(spec (list url alt-text)))
(gnus-overlay-put overlay 'local-map gnus-html-image-map)
(gnus-overlay-put overlay 'gnus-image spec)
(gnus-put-text-property start end 'gnus-image-url url)
(gnus-put-text-property
start end
'gnus-image spec)))
......@@ -224,13 +232,9 @@ Use ALT-TEXT for the image string."
;; asynchronously.
(gnus-html-schedule-image-fetching
(current-buffer)
(list url
(set-marker (make-marker) start)
(set-marker (make-marker) end)
alt-text))
(list url alt-text))
;; It's already cached, so just insert it.
(gnus-html-put-image (gnus-html-get-image-data url)
start end url alt-text)))
(gnus-html-put-image (gnus-html-get-image-data url) url alt-text)))
(defun gnus-html-wash-tags ()
(let (tag parameters string start end images url)
......@@ -347,22 +351,17 @@ Use ALT-TEXT for the image string."
(list buffer image))))
(defun gnus-html-image-fetched (status buffer image)
(url-store-in-cache (current-buffer))
(when (and (search-forward "\n\n" nil t)
(buffer-live-p buffer)
;; If the `image' has no marker, do not replace anything
(cadr image)
;; 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))
(with-current-buffer buffer
(point-min)))))
(let ((data (buffer-substring (point) (point-max))))
(with-current-buffer buffer
(let ((inhibit-read-only t))
(gnus-html-put-image data (cadr image) (caddr image) (car image) (cadddr image))))))
"Callback function called when image has been fetched."
(unless (plist-get status :error)
(when gnus-html-image-automatic-caching
(url-store-in-cache (current-buffer)))
(when (and (or (search-forward "\n\n" nil t)
(search-forward "\r\n\r\n" nil t))
(buffer-live-p buffer))
(let ((data (buffer-substring (point) (point-max))))
(with-current-buffer buffer
(let ((inhibit-read-only t))
(gnus-html-put-image data (car image) (cadr image)))))))
(kill-buffer (current-buffer)))
(defun gnus-html-get-image-data (url)
......@@ -371,54 +370,61 @@ Return a string with image data."
(with-temp-buffer
(mm-disable-multibyte)
(url-cache-extract (url-cache-create-filename url))
(when (search-forward "\n\n" nil t)
(when (or (search-forward "\n\n" nil t)
(search-forward "\r\n\r\n" nil t))
(buffer-substring (point) (point-max)))))
(defun gnus-html-put-image (data start end &optional url alt-text)
(defun gnus-html-put-image (data url &optional alt-text)
(when (gnus-graphic-display-p)
(let* ((image (ignore-errors
(gnus-create-image data nil t)))
(size (and image
(if (featurep 'xemacs)
(cons (glyph-width image) (glyph-height image))
(image-size image t)))))
(save-excursion
(goto-char start)
(let ((alt-text (or alt-text (buffer-substring-no-properties start end))))
(if (and image
;; Kludge to avoid displaying 30x30 gif images, which
;; seems to be a signal of a broken image.
(not (and (if (featurep 'xemacs)
(glyphp image)
(listp image))
(eq (if (featurep 'xemacs)
(let ((d (cdadar (specifier-spec-list
(glyph-image image)))))
(and (vectorp d)
(aref d 0)))
(plist-get (cdr image) :type))
'gif)
(= (car size) 30)
(= (cdr size) 30))))
;; Good image, add it!
(let ((image (gnus-html-rescale-image image data size)))
(delete-region start end)
(gnus-put-image image alt-text 'external)
(gnus-put-text-property start (point) 'help-echo alt-text)
(gnus-overlay-put (gnus-make-overlay start (point)) 'local-map
gnus-html-displayed-image-map)
(gnus-put-text-property start (point) 'gnus-alt-text alt-text)
(when url
(gnus-put-text-property start (point) 'gnus-image-url url))
(gnus-add-image 'external image)
t)
;; Bad image, try to show something else
(delete-region start end)
(when (fboundp 'find-image)
(setq image (find-image '((:type xpm :file "lock-broken.xpm"))))
(gnus-put-image image alt-text 'internal)
(gnus-add-image 'internal image))
nil))))))
(let* ((start (text-property-any (point-min) (point-max) 'gnus-image-url url))
(end (when start
(next-single-property-change start 'gnus-image-url))))
;; Image found?
(when start
(let* ((image
(ignore-errors
(gnus-create-image data nil t)))
(size (and image
(if (featurep 'xemacs)
(cons (glyph-width image) (glyph-height image))
(image-size image t)))))
(save-excursion
(goto-char start)
(let ((alt-text (or alt-text (buffer-substring-no-properties start end))))
(if (and image
;; Kludge to avoid displaying 30x30 gif images, which
;; seems to be a signal of a broken image.
(not (and (if (featurep 'xemacs)
(glyphp image)
(listp image))
(eq (if (featurep 'xemacs)
(let ((d (cdadar (specifier-spec-list
(glyph-image image)))))
(and (vectorp d)
(aref d 0)))
(plist-get (cdr image) :type))
'gif)
(= (car size) 30)
(= (cdr size) 30))))
;; Good image, add it!
(let ((image (gnus-html-rescale-image image data size)))
(delete-region start end)
(gnus-put-image image alt-text 'external)
(gnus-put-text-property start (point) 'help-echo alt-text)
(gnus-overlay-put (gnus-make-overlay start (point)) 'local-map
gnus-html-displayed-image-map)
(gnus-put-text-property start (point) 'gnus-alt-text alt-text)
(when url
(gnus-put-text-property start (point) 'gnus-image-url url))
(gnus-add-image 'external image)
t)
;; Bad image, try to show something else
(when (fboundp 'find-image)
(delete-region start end)
(setq image (find-image '((:type xpm :file "lock-broken.xpm"))))
(gnus-put-image image alt-text 'internal)
(gnus-add-image 'internal image))
nil))))))))