Mercurial > emacs

changeset 110246:aff5a41a067d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge from mainline.
author Katsumi Yamaoka <yamaoka@jpl.org>
date Fri, 03 Sep 2010 01:17:46 +0000
parents db7a9f029b0e (current diff) 969b41083104 (diff)
children 3112c0c11b6e
files
diffstat 4 files changed, 45 insertions(+), 23 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog	Thu Sep 02 22:44:07 2010 +0000
+++ b/lisp/gnus/ChangeLog	Fri Sep 03 01:17:46 2010 +0000
@@ -1,6 +1,17 @@
+2010-09-03  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus-ems.el (gnus-set-process-plist, gnus-process-plist): Change name
+	of symbol that holds plist data.
+	(gnus-process-plist): Remove plist of process after getting it.
+
 2010-09-02  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
+	* message.el (message-generate-hashcash): Change default to
+	'opportunistic if hashcash is installed.
+
 	* gnus-html.el (gnus-html-rescale-image): Fix up typo in rescaling.
+	(gnus-html-put-image): Only call image-size once, since it's somewhat
+	time-consuming on remote X servers.
 
 2010-09-02  Katsumi Yamaoka  <yamaoka@jpl.org>
 
--- a/lisp/gnus/gnus-ems.el	Thu Sep 02 22:44:07 2010 +0000
+++ b/lisp/gnus/gnus-ems.el	Fri Sep 03 01:17:46 2010 +0000
@@ -314,24 +314,31 @@
 	(defalias 'gnus-process-put 'process-put))
     (defun gnus-set-process-plist (process plist)
       "Replace the plist of PROCESS with PLIST.  Returns PLIST."
-      (put 'gnus-process-plist process plist))
+      (put 'gnus-process-plist-internal process plist))
+
     (defun gnus-process-plist (process)
       "Return the plist of PROCESS."
-      ;; Remove those of dead processes from `gnus-process-plist'
-      ;; to prevent it from growing.
-      (let ((plist (symbol-plist 'gnus-process-plist))
-	    proc)
-	(while (setq proc (car plist))
-	  (if (and (processp proc)
-		   (memq (process-status proc) '(open run)))
-	      (setq plist (cddr plist))
-	    (setcar plist (caddr plist))
-	    (setcdr plist (or (cdddr plist) '(nil))))))
-      (get 'gnus-process-plist process))
+      ;; This form works but can't prevent the plist data from
+      ;; growing infinitely.
+      ;;(get 'gnus-process-plist-internal process)
+      (let* ((plist (symbol-plist 'gnus-process-plist-internal))
+	     (tem (memq process plist)))
+	(prog1
+	    (cadr tem)
+	  ;; Remove it from the plist data.
+	  (when tem
+	    (if (eq plist tem)
+		(progn
+		  (setcar plist (caddr plist))
+		  (setcdr plist (or (cdddr plist) '(nil))))
+	      (setcdr (nthcdr (- (length plist) (length tem) 1) plist)
+		      (cddr tem)))))))
+
     (defun gnus-process-get (process propname)
       "Return the value of PROCESS' PROPNAME property.
 This is the last value stored with `(gnus-process-put PROCESS PROPNAME VALUE)'."
       (plist-get (gnus-process-plist process) propname))
+
     (defun gnus-process-put (process propname value)
       "Change PROCESS' PROPNAME property to VALUE.
 It can be retrieved with `(gnus-process-get PROCESS PROPNAME)'."
--- a/lisp/gnus/gnus-html.el	Thu Sep 02 22:44:07 2010 +0000
+++ b/lisp/gnus/gnus-html.el	Fri Sep 03 01:17:46 2010 +0000
@@ -243,8 +243,10 @@
 
 (defun gnus-html-put-image (file point string)
   (when (display-graphic-p)
-    (let ((image (ignore-errors
-		   (gnus-create-image file))))
+    (let* ((image (ignore-errors
+		   (gnus-create-image file)))
+	  (size (and image
+		     (image-size image t))))
       (save-excursion
 	(goto-char point)
 	(if (and image
@@ -252,10 +254,10 @@
 		 ;; seems to be a signal of a broken image.
 		 (not (and (listp image)
 			   (eq (plist-get (cdr image) :type) 'gif)
-			   (= (car (image-size image t)) 30)
-			   (= (cdr (image-size image t)) 30))))
+			   (= (car size) 30)
+			   (= (cdr size) 30))))
 	    (progn
-	      (gnus-put-image (gnus-html-rescale-image image file)
+	      (gnus-put-image (gnus-html-rescale-image image file size)
 			      (gnus-string-or string "*"))
 	      t)
 	  (insert string)
@@ -265,12 +267,12 @@
 			    (gnus-string-or string "*")))
 	  nil)))))
 
-(defun gnus-html-rescale-image (image file)
+(defun gnus-html-rescale-image (image file size)
   (if (or (not (fboundp 'imagemagick-types))
 	  (not (get-buffer-window (current-buffer))))
       image
-    (let* ((width (car (image-size image t)))
-	   (height (cdr (image-size image t)))
+    (let* ((width (car size))
+	   (height (cdr size))
 	   (edges (window-pixel-edges (get-buffer-window (current-buffer))))
 	   (window-width (truncate (* gnus-max-image-proportion
 				      (- (nth 2 edges) (nth 0 edges)))))
@@ -280,8 +282,9 @@
       (when (> height window-height)
 	(setq image (or (create-image file 'imagemagick nil
 				      :height window-height)
-			image)))
-      (when (> (car (image-size image t)) window-width)
+			image))
+	(setq size (image-size image t)))
+      (when (> (car size) window-width)
 	(setq image (or
 		     (create-image file 'imagemagick nil
 				   :width window-width)
--- a/lisp/gnus/message.el	Thu Sep 02 22:44:07 2010 +0000
+++ b/lisp/gnus/message.el	Fri Sep 03 01:17:46 2010 +0000
@@ -1726,13 +1726,14 @@
 		 (const :tag "Never" nil)
 		 (const :tag "Always" t)))
 
-(defcustom message-generate-hashcash (if (executable-find "hashcash") t)
+(defcustom message-generate-hashcash (if (executable-find "hashcash") 'opportunistic)
   "*Whether to generate X-Hashcash: headers.
 If t, always generate hashcash headers.  If `opportunistic',
 only generate hashcash headers if it can be done without the user
 waiting (i.e., only asynchronously).
 
 You must have the \"hashcash\" binary installed, see `hashcash-path'."
+  :version "24.1"
   :group 'message-headers
   :link '(custom-manual "(message)Mail Headers")
   :type '(choice (const :tag "Always" t)