Mercurial > emacs
changeset 110775:6ae391b53988
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.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Tue, 05 Oct 2010 13:19:07 +0000 |
| parents | 276ecc27ad6b |
| children | 073caec7510f |
| files | lisp/gnus/ChangeLog lisp/gnus/gnus-html.el lisp/gnus/sieve-manage.el |
| diffstat | 3 files changed, 41 insertions(+), 25 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog Tue Oct 05 10:46:15 2010 +0000 +++ b/lisp/gnus/ChangeLog Tue Oct 05 13:19:07 2010 +0000 @@ -1,3 +1,12 @@ +2010-10-05 Julien Danjou <julien@danjou.info> + + * gnus-html.el (gnus-html-wash-images): Rescale image from cid too. + (gnus-html-maximum-image-size): Add this function. + (gnus-html-put-image): Use gnus-html-maximum-image-size. + + * sieve-manage.el (sieve-manage-capability): Do not bug out when the + server-value of the capability is nil. + 2010-10-05 Lars Magne Ingebrigtsen <larsi@gnus.org> * shr.el (shr-tag-em): Add <EM> tag.
--- a/lisp/gnus/gnus-html.el Tue Oct 05 10:46:15 2010 +0000 +++ b/lisp/gnus/gnus-html.el Tue Oct 05 13:19:07 2010 +0000 @@ -191,17 +191,16 @@ ;; URLs with cid: have their content stashed in other ;; parts of the MIME structure, so just insert them ;; immediately. - (let ((handle (mm-get-content-id - (setq url (match-string 1 url)))) - image) - (when handle - (mm-with-part handle - (setq image (gnus-create-image (buffer-string) - nil t)))) + (let* ((handle (mm-get-content-id + (setq url (match-string 1 url)))) + (image (when handle + (gnus-create-image (mm-with-part handle (buffer-string)) + nil t)))) (when image (let ((string (buffer-substring start end))) (delete-region start end) - (gnus-put-image image (gnus-string-or string "*") 'cid) + (gnus-put-image (gnus-rescale-image image (gnus-html-maximum-image-size)) + (gnus-string-or string "*") 'cid) (gnus-add-image 'cid image)))) ;; Normal, external URL. (let ((alt-text (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)" @@ -398,7 +397,22 @@ (search-forward "\r\n\r\n" nil t)) (buffer-substring (point) (point-max))))) +(defun gnus-html-maximum-image-size () + "Return the maximum size of an image according to `gnus-max-image-proportion'." + (let ((edges (gnus-window-inside-pixel-edges + (get-buffer-window (current-buffer))))) + ;; (width . height) + (cons + ;; Aimed width + (truncate + (* gnus-max-image-proportion + (- (nth 2 edges) (nth 0 edges)))) + ;; Aimed height + (truncate (* gnus-max-image-proportion + (- (nth 3 edges) (nth 1 edges))))))) + (defun gnus-html-put-image (data url &optional alt-text) + "Put an image with DATA from URL and optional ALT-TEXT." (when (gnus-graphic-display-p) (let* ((start (text-property-any (point-min) (point-max) 'gnus-image-url url)) @@ -434,19 +448,7 @@ (= (car size) 30) (= (cdr size) 30)))) ;; Good image, add it! - (let ((image (gnus-rescale-image - image - (let ((edges (gnus-window-inside-pixel-edges - (get-buffer-window (current-buffer))))) - ;; (width . height) - (cons - ;; Aimed width - (truncate - (* gnus-max-image-proportion - (- (nth 2 edges) (nth 0 edges)))) - ;; Aimed height - (truncate (* gnus-max-image-proportion - (- (nth 3 edges) (nth 1 edges))))))))) + (let ((image (gnus-rescale-image image (gnus-html-maximum-image-size)))) (delete-region start end) (gnus-put-image image alt-text 'external) (gnus-put-text-property start (point) 'help-echo alt-text)
--- a/lisp/gnus/sieve-manage.el Tue Oct 05 10:46:15 2010 +0000 +++ b/lisp/gnus/sieve-manage.el Tue Oct 05 13:19:07 2010 +0000 @@ -553,13 +553,18 @@ (setq sieve-manage-state 'auth))))) (defun sieve-manage-capability (&optional name value buffer) + "Check if capability NAME of server BUFFER match VALUE. +If it does, return the server value of NAME. If not returns nil. +If VALUE is nil, do not check VALUE and return server value. +If NAME is nil, return the full server list of capabilities." (with-current-buffer (or buffer (current-buffer)) (if (null name) sieve-manage-capability - (if (null value) - (nth 1 (assoc name sieve-manage-capability)) - (when (string-match value (nth 1 (assoc name sieve-manage-capability))) - (nth 1 (assoc name sieve-manage-capability))))))) + (let ((server-value (cadr (assoc name sieve-manage-capability)))) + (when (or (null value) + (and server-value + (string-match value server-value))) + server-value))))) (defun sieve-manage-listscripts (&optional buffer) (with-current-buffer (or buffer (current-buffer))