From 6f7e2ffd5e39425cedf22aa444d7fb642840e52b Mon Sep 17 00:00:00 2001 From: Julien Danjou Date: Tue, 5 Oct 2010 13:19:07 +0000 Subject: [PATCH] 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. --- lisp/gnus/ChangeLog | 9 +++++++++ lisp/gnus/gnus-html.el | 44 +++++++++++++++++++++++--------------------- lisp/gnus/sieve-manage.el | 13 +++++++++---- 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 @@ +2010-10-05 Julien Danjou + + * 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 * shr.el (shr-tag-em): Add 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., \"[)$]\")." ;; 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 @@ Return a string with image data." (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 @@ Return a string with image data." (= (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) 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." (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)) -- 2.11.4.GIT