# HG changeset patch # User Katsumi Yamaoka # Date 1283476666 0 # Node ID aff5a41a067d4a898467856366de60a84475eb7b # Parent db7a9f029b0e252d484365b5981b0a53e18990a3# Parent 969b41083104b063b37abdc382b59e51b311bf44 Merge from mainline. diff -r db7a9f029b0e -r aff5a41a067d lisp/gnus/ChangeLog --- 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 + + * 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 + * 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 diff -r db7a9f029b0e -r aff5a41a067d lisp/gnus/gnus-ems.el --- 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)'." diff -r db7a9f029b0e -r aff5a41a067d lisp/gnus/gnus-html.el --- 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) diff -r db7a9f029b0e -r aff5a41a067d lisp/gnus/message.el --- 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)