aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJulien Danjou2010-10-05 13:19:07 +0000
committerKatsumi Yamaoka2010-10-05 13:19:07 +0000
commit6f7e2ffd5e39425cedf22aa444d7fb642840e52b (patch)
tree32546339e8ef2cb1a94d8a34f9810cb76786b550
parent562f5ce55c90f66679adc959c8aa9cc4a9bf0c83 (diff)
downloademacs-6f7e2ffd5e39425cedf22aa444d7fb642840e52b.tar.gz
emacs-6f7e2ffd5e39425cedf22aa444d7fb642840e52b.zip
sieve-manage.el (sieve-manage-capability): Do not bug out when the server-value of the capability is nil.
gnus-html.el (gnus-html-wash-images): Rescale image from cid too.
-rw-r--r--lisp/gnus/ChangeLog9
-rw-r--r--lisp/gnus/gnus-html.el44
-rw-r--r--lisp/gnus/sieve-manage.el13
3 files changed, 41 insertions, 25 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 45fcb4a2cf3..241c8148dc1 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,12 @@
12010-10-05 Julien Danjou <julien@danjou.info>
2
3 * gnus-html.el (gnus-html-wash-images): Rescale image from cid too.
4 (gnus-html-maximum-image-size): Add this function.
5 (gnus-html-put-image): Use gnus-html-maximum-image-size.
6
7 * sieve-manage.el (sieve-manage-capability): Do not bug out when the
8 server-value of the capability is nil.
9
12010-10-05 Lars Magne Ingebrigtsen <larsi@gnus.org> 102010-10-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
2 11
3 * shr.el (shr-tag-em): Add <EM> tag. 12 * shr.el (shr-tag-em): Add <EM> tag.
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index bfbdc41e98c..d30b574b55e 100644
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -191,17 +191,16 @@ CHARS is a regexp-like character alternative (e.g., \"[)$]\")."
191 ;; URLs with cid: have their content stashed in other 191 ;; URLs with cid: have their content stashed in other
192 ;; parts of the MIME structure, so just insert them 192 ;; parts of the MIME structure, so just insert them
193 ;; immediately. 193 ;; immediately.
194 (let ((handle (mm-get-content-id 194 (let* ((handle (mm-get-content-id
195 (setq url (match-string 1 url)))) 195 (setq url (match-string 1 url))))
196 image) 196 (image (when handle
197 (when handle 197 (gnus-create-image (mm-with-part handle (buffer-string))
198 (mm-with-part handle 198 nil t))))
199 (setq image (gnus-create-image (buffer-string)
200 nil t))))
201 (when image 199 (when image
202 (let ((string (buffer-substring start end))) 200 (let ((string (buffer-substring start end)))
203 (delete-region start end) 201 (delete-region start end)
204 (gnus-put-image image (gnus-string-or string "*") 'cid) 202 (gnus-put-image (gnus-rescale-image image (gnus-html-maximum-image-size))
203 (gnus-string-or string "*") 'cid)
205 (gnus-add-image 'cid image)))) 204 (gnus-add-image 'cid image))))
206 ;; Normal, external URL. 205 ;; Normal, external URL.
207 (let ((alt-text (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)" 206 (let ((alt-text (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)"
@@ -398,7 +397,22 @@ Return a string with image data."
398 (search-forward "\r\n\r\n" nil t)) 397 (search-forward "\r\n\r\n" nil t))
399 (buffer-substring (point) (point-max))))) 398 (buffer-substring (point) (point-max)))))
400 399
400(defun gnus-html-maximum-image-size ()
401 "Return the maximum size of an image according to `gnus-max-image-proportion'."
402 (let ((edges (gnus-window-inside-pixel-edges
403 (get-buffer-window (current-buffer)))))
404 ;; (width . height)
405 (cons
406 ;; Aimed width
407 (truncate
408 (* gnus-max-image-proportion
409 (- (nth 2 edges) (nth 0 edges))))
410 ;; Aimed height
411 (truncate (* gnus-max-image-proportion
412 (- (nth 3 edges) (nth 1 edges)))))))
413
401(defun gnus-html-put-image (data url &optional alt-text) 414(defun gnus-html-put-image (data url &optional alt-text)
415 "Put an image with DATA from URL and optional ALT-TEXT."
402 (when (gnus-graphic-display-p) 416 (when (gnus-graphic-display-p)
403 (let* ((start (text-property-any (point-min) (point-max) 417 (let* ((start (text-property-any (point-min) (point-max)
404 'gnus-image-url url)) 418 'gnus-image-url url))
@@ -434,19 +448,7 @@ Return a string with image data."
434 (= (car size) 30) 448 (= (car size) 30)
435 (= (cdr size) 30)))) 449 (= (cdr size) 30))))
436 ;; Good image, add it! 450 ;; Good image, add it!
437 (let ((image (gnus-rescale-image 451 (let ((image (gnus-rescale-image image (gnus-html-maximum-image-size))))
438 image
439 (let ((edges (gnus-window-inside-pixel-edges
440 (get-buffer-window (current-buffer)))))
441 ;; (width . height)
442 (cons
443 ;; Aimed width
444 (truncate
445 (* gnus-max-image-proportion
446 (- (nth 2 edges) (nth 0 edges))))
447 ;; Aimed height
448 (truncate (* gnus-max-image-proportion
449 (- (nth 3 edges) (nth 1 edges)))))))))
450 (delete-region start end) 452 (delete-region start end)
451 (gnus-put-image image alt-text 'external) 453 (gnus-put-image image alt-text 'external)
452 (gnus-put-text-property start (point) 'help-echo alt-text) 454 (gnus-put-text-property start (point) 'help-echo alt-text)
diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el
index 8749864d81b..69f21b0112f 100644
--- a/lisp/gnus/sieve-manage.el
+++ b/lisp/gnus/sieve-manage.el
@@ -553,13 +553,18 @@ password is remembered in the buffer."
553 (setq sieve-manage-state 'auth))))) 553 (setq sieve-manage-state 'auth)))))
554 554
555(defun sieve-manage-capability (&optional name value buffer) 555(defun sieve-manage-capability (&optional name value buffer)
556 "Check if capability NAME of server BUFFER match VALUE.
557If it does, return the server value of NAME. If not returns nil.
558If VALUE is nil, do not check VALUE and return server value.
559If NAME is nil, return the full server list of capabilities."
556 (with-current-buffer (or buffer (current-buffer)) 560 (with-current-buffer (or buffer (current-buffer))
557 (if (null name) 561 (if (null name)
558 sieve-manage-capability 562 sieve-manage-capability
559 (if (null value) 563 (let ((server-value (cadr (assoc name sieve-manage-capability))))
560 (nth 1 (assoc name sieve-manage-capability)) 564 (when (or (null value)
561 (when (string-match value (nth 1 (assoc name sieve-manage-capability))) 565 (and server-value
562 (nth 1 (assoc name sieve-manage-capability))))))) 566 (string-match value server-value)))
567 server-value)))))
563 568
564(defun sieve-manage-listscripts (&optional buffer) 569(defun sieve-manage-listscripts (&optional buffer)
565 (with-current-buffer (or buffer (current-buffer)) 570 (with-current-buffer (or buffer (current-buffer))